note description: "[ Efficient value type for handling money objects in dollars and cents, with precision and safety in plus and minus operators. See end of class for specification. ]" author: "JSO" date: "$Date$" revision: "$Revision$" expanded class MONEY create make, make_with_float, make_from_int, default_create feature {NONE} -- Initialization default_create -- Process instances of classes with no creation clause. -- (Default: do nothing.) -- (from ANY) do end make (a_dollars: INTEGER_64; a_cents: INTEGER_64) -- make a money object with dollars and cents do cents := a_dollars * 100 + a_cents ensure cents = a_dollars * 100 + a_cents end make_from_int (a_amount: INTEGER_64) -- make from an integer amount of cents do cents := a_amount end make_with_float (a_amount: FLOAT) -- make money from a real amount of dollars -- rounded to two decimal places local r: FLOAT do r := a_amount * create {FLOAT}.make_from_integer_32 (100) cents := r.rounded.to_integer_64 end feature -- Access generating_type: TYPE [detachable MONEY] -- Type of current object -- (type of which it is a direct instance) -- (from ANY) external "built_in" ensure -- from ANY generating_type_not_void: Result /= Void end generator: STRING_8 -- Name of current object's generating class -- (base class of the type of which it is a direct instance) -- (from ANY) external "built_in" ensure -- from ANY generator_not_void: Result /= Void generator_not_empty: not Result.is_empty end feature -- Comparison frozen deep_equal (a: detachable ANY; b: like arg #1): BOOLEAN -- Are a and b either both void -- or attached to isomorphic object structures? -- (from ANY) do if a = Void then Result := b = Void else Result := b /= Void and then a.is_deep_equal (b) end ensure -- from ANY instance_free: class shallow_implies_deep: standard_equal (a, b) implies Result both_or_none_void: (a = Void) implies (Result = (b = Void)) same_type: (Result and (a /= Void)) implies (b /= Void and then a.same_type (b)) symmetric: Result implies deep_equal (b, a) end frozen equal (a: detachable ANY; b: like arg #1): BOOLEAN -- Are a and b either both void or attached -- to objects considered equal? -- (from ANY) do if a = Void then Result := b = Void else Result := b /= Void and then a.is_equal (b) end ensure -- from ANY instance_free: class definition: Result = (a = Void and b = Void) or else ((a /= Void and b /= Void) and then a.is_equal (b)) end frozen is_deep_equal (other: MONEY): BOOLEAN -- Are Current and other attached to isomorphic object structures? -- (from ANY) require -- from ANY other_not_void: other /= Void external "built_in" ensure -- from ANY shallow_implies_deep: standard_is_equal (other) implies Result same_type: Result implies same_type (other) symmetric: Result implies other.is_deep_equal (Current) end is_greater alias ">" (other: MONEY): BOOLEAN -- Is current object greater than other? -- (from COMPARABLE) require -- from PART_COMPARABLE other_exists: other /= Void do Result := other < Current ensure then -- from COMPARABLE definition: Result = (other < Current) end is_greater_equal alias ">=" (other: MONEY): BOOLEAN -- Is current object greater than or equal to other? -- (from COMPARABLE) require -- from PART_COMPARABLE other_exists: other /= Void do Result := not (Current < other) ensure then -- from COMPARABLE definition: Result = (other <= Current) end is_less_equal alias "<=" (other: MONEY): BOOLEAN -- Is current object less than or equal to other? -- (from COMPARABLE) require -- from PART_COMPARABLE other_exists: other /= Void do Result := not (other < Current) ensure then -- from COMPARABLE definition: Result = ((Current < other) or (Current ~ other)) end max (other: MONEY): MONEY -- The greater of current object and other -- (from COMPARABLE) require -- from COMPARABLE other_exists: other /= Void do if Current >= other then Result := Current else Result := other end ensure -- from COMPARABLE current_if_not_smaller: Current >= other implies Result = Current other_if_smaller: Current < other implies Result = other end min (other: MONEY): MONEY -- The smaller of current object and other -- (from COMPARABLE) require -- from COMPARABLE other_exists: other /= Void do if Current <= other then Result := Current else Result := other end ensure -- from COMPARABLE current_if_not_greater: Current <= other implies Result = Current other_if_greater: Current > other implies Result = other end frozen standard_equal (a: detachable ANY; b: like arg #1): BOOLEAN -- Are a and b either both void or attached to -- field-by-field identical objects of the same type? -- Always uses default object comparison criterion. -- (from ANY) do if a = Void then Result := b = Void else Result := b /= Void and then a.standard_is_equal (b) end ensure -- from ANY instance_free: class definition: Result = (a = Void and b = Void) or else ((a /= Void and b /= Void) and then a.standard_is_equal (b)) end frozen standard_is_equal (other: MONEY): BOOLEAN -- Is other attached to an object of the same type -- as current object, and field-by-field identical to it? -- (from ANY) require -- from ANY other_not_void: other /= Void external "built_in" ensure -- from ANY same_type: Result implies same_type (other) symmetric: Result implies other.standard_is_equal (Current) end three_way_comparison (other: MONEY): INTEGER_32 -- If current object equal to other, 0; -- if smaller, -1; if greater, 1 -- (from COMPARABLE) require -- from COMPARABLE other_exists: other /= Void do if Current < other then Result := -1 elseif other < Current then Result := 1 end ensure -- from COMPARABLE equal_zero: (Result = 0) = (Current ~ other) smaller_negative: (Result = -1) = (Current < other) greater_positive: (Result = 1) = (Current > other) end feature -- Status report conforms_to (other: ANY): BOOLEAN -- Does type of current object conform to type -- of other (as per Eiffel: The Language, chapter 13)? -- (from ANY) require -- from ANY other_not_void: other /= Void external "built_in" end same_type (other: ANY): BOOLEAN -- Is type of current object identical to type of other? -- (from ANY) require -- from ANY other_not_void: other /= Void external "built_in" ensure -- from ANY definition: Result = (conforms_to (other) and other.conforms_to (Current)) end feature -- Duplication frozen clone (other: detachable ANY): like other obsolete "Use `twin' instead. [2017-05-31]" -- Void if other is void; otherwise new object -- equal to other -- -- For non-void other, clone calls copy; -- to change copying/cloning semantics, redefine copy. -- (from ANY) do if other /= Void then Result := other.twin end ensure -- from ANY instance_free: class equal: Result ~ other end copy (other: MONEY) -- Update current object using fields of object attached -- to other, so as to yield equal objects. -- (from ANY) require -- from ANY other_not_void: other /= Void type_identity: same_type (other) external "built_in" ensure -- from ANY is_equal: Current ~ other end frozen deep_clone (other: detachable ANY): like other obsolete "Use `deep_twin' instead. [2017-05-31]" -- Void if other is void: otherwise, new object structure -- recursively duplicated from the one attached to other -- (from ANY) do if other /= Void then Result := other.deep_twin end ensure -- from ANY instance_free: class deep_equal: deep_equal (other, Result) end frozen deep_copy (other: MONEY) -- Effect equivalent to that of: -- copy (other . deep_twin) -- (from ANY) require -- from ANY other_not_void: other /= Void do copy (other.deep_twin) ensure -- from ANY deep_equal: deep_equal (Current, other) end frozen deep_twin: MONEY -- New object structure recursively duplicated from Current. -- (from ANY) external "built_in" ensure -- from ANY deep_twin_not_void: Result /= Void deep_equal: deep_equal (Current, Result) end frozen standard_clone (other: detachable ANY): like other obsolete "Use `standard_twin' instead. [2017-05-31]" -- Void if other is void; otherwise new object -- field-by-field identical to other. -- Always uses default copying semantics. -- (from ANY) do if other /= Void then Result := other.standard_twin end ensure -- from ANY instance_free: class equal: standard_equal (Result, other) end frozen standard_copy (other: MONEY) -- Copy every field of other onto corresponding field -- of current object. -- (from ANY) require -- from ANY other_not_void: other /= Void type_identity: same_type (other) external "built_in" ensure -- from ANY is_standard_equal: standard_is_equal (other) end frozen standard_twin: MONEY -- New object field-by-field identical to other. -- Always uses default copying semantics. -- (from ANY) external "built_in" ensure -- from ANY standard_twin_not_void: Result /= Void equal: standard_equal (Result, Current) end frozen twin: MONEY -- New object equal to Current -- twin calls copy; to change copying/twinning semantics, redefine copy. -- (from ANY) external "built_in" ensure -- from ANY twin_not_void: Result /= Void is_equal: Result ~ Current end feature -- Basic operations frozen as_attached: attached MONEY obsolete "Remove calls to this feature. [2017-05-31]" -- Attached version of Current. -- (Can be used during transitional period to convert -- non-void-safe classes to void-safe ones.) -- (from ANY) do Result := Current end frozen default: detachable MONEY -- Default value of object's type -- (from ANY) do end frozen default_pointer: POINTER -- Default value of type POINTER -- (Avoid the need to write p.default for -- some p of type POINTER.) -- (from ANY) do ensure -- from ANY instance_free: class end default_rescue -- Process exception for routines with no Rescue clause. -- (Default: do nothing.) -- (from ANY) do end frozen do_nothing -- Execute a null action. -- (from ANY) do ensure -- from ANY instance_free: class end feature Max_int: INTEGER_64 -- (from INTEGER_OVERFLOW) once Result := Result.Max_value end Min_int: INTEGER_64 -- (from INTEGER_OVERFLOW) once Result := Result.Min_value end safe_minus (left, right: INTEGER_64): BOOLEAN -- (from INTEGER_OVERFLOW) do if right > 0 then Result := (left >= Min_int + right) else Result := (left <= Max_int + right) end ensure -- from INTEGER_OVERFLOW right >= 0 implies Result = (left >= Min_int + right) right <= 0 implies Result = (left <= Max_int + right) end safe_plus (left, right: INTEGER_64): BOOLEAN -- (from INTEGER_OVERFLOW) do if right > 0 then Result := (left <= Max_int - right) else Result := (left >= Min_int - right) end ensure -- from INTEGER_OVERFLOW right >= 0 implies Result = (left <= Max_int - right) right <= 0 implies Result = (left >= Min_int - right) end feature -- Output Io: STD_FILES -- Handle to standard file setup -- (from ANY) once create Result Result.set_output_default ensure -- from ANY instance_free: class io_not_void: Result /= Void end print (o: detachable ANY) -- Write terse external representation of o -- on standard output. -- (from ANY) do if o /= Void then Io.put_string (o.out) end ensure -- from ANY instance_free: class end frozen tagged_out: STRING_8 -- New string containing terse printable representation -- of current object -- (from ANY) external "built_in" ensure -- from ANY tagged_out_not_void: Result /= Void end feature -- Platform Operating_environment: OPERATING_ENVIRONMENT -- Objects available from the operating system -- (from ANY) once create Result ensure -- from ANY instance_free: class operating_environment_not_void: Result /= Void end feature {NONE} -- Retrieval frozen internal_correct_mismatch -- Called from runtime to perform a proper dynamic dispatch on correct_mismatch -- from MISMATCH_CORRECTOR. -- (from ANY) local l_msg: STRING_8 l_exc: EXCEPTIONS do if attached {MISMATCH_CORRECTOR} Current as l_corrector then l_corrector.correct_mismatch else create l_msg.make_from_string ("Mismatch: ") create l_exc l_msg.append (generating_type.name) l_exc.raise_retrieval_exception (l_msg) end end feature -- allocation allocated (arg: INTEGER_32): MONEY_ARRAY -- Divide by arg into equal amounts require comment ("Avoid division by zero and within range") arg_positive: arg > 0 and arg.to_integer_64 <= cents local base_result: INTEGER_64 base_money: MONEY remainder: INTEGER_64 one_cent: MONEY i: INTEGER_32 do base_result := cents // arg.to_integer_64 create base_money.make_from_int (base_result) create Result.make_filled (base_money, 1, arg) remainder := cents - base_result * arg.to_integer_64 from i := 1 create one_cent.make_from_int (1) until i.to_integer_64 > remainder loop Result [i] := Result [i] + one_cent i := i + 1 end ensure Result.count = arg Result.sum = Current result_correct: across 1 |..| arg as j all (j.item.to_integer_64 <= cents \\ arg.to_integer_64 implies Result [j.item].cents = (cents // arg.to_integer_64) + 1) and (j.item.to_integer_64 > cents \\ arg.to_integer_64 implies Result [j.item].cents = (cents // arg.to_integer_64)) end end allocated_by_ratios (ratios: NUM_ARRAY [INTEGER_32]): MONEY_ARRAY -- Divide according to ratios require ratios /= Void and then ratios.sum /= ratios.sum.zero local total: INTEGER_32 i: INTEGER_32 remainder: INTEGER_64 m: MONEY do total := ratios.sum from remainder := cents create Result.make_filled (m.zero, 1, ratios.count) i := ratios.lower until i > ratios.upper loop create m.make_from_int (((cents * ratios [i].to_integer_64) / total.to_integer_64).floor.to_integer_64) Result [i] := m remainder := remainder - m.cents i := i + 1 end from i := 1 until i.to_integer_64 > remainder loop Result [i] := Result [i] + m.one i := i + 1 end Result.compare_objects ensure Result.count = ratios.count Result.sum = Current result_correct: across 1 |..| ratios.count as j all Result [j.item].cents = ((cents * ratios [j.item].to_integer_64) / ratios.sum.to_integer_64).floor.to_integer_64 or Result [j.item].cents = ((cents * ratios [j.item].to_integer_64) / ratios.sum.to_integer_64).floor + 1.to_integer_64 end end feature -- effect numeric divisible (other: FLOAT): BOOLEAN -- May current object be divided by other? do Result := other /= create {FLOAT}.make_from_real (0.0) end identity alias "+": MONEY -- Unary plus do create Result.make_from_int (cents) end minus alias "-" (other: MONEY): MONEY -- minus with other safely require safe_to_do_minus: safe_minus (cents, other.cents) do create Result.make_from_int (- other.cents) Result := Current + Result ensure correct: Result = (create {MONEY}.make_from_int (cents - other.cents)) end one: like Current -- Neutral element for "*" and "/" do create Result.make_from_int (1) end opposite alias "-": MONEY -- Unary minus do create Result.make_from_int (- cents) end plus alias "+" (other: MONEY): MONEY -- Sum with other safely require safe_to_do_plus: safe_plus (cents, other.cents) local l_amount_imp: INTEGER_64 do l_amount_imp := cents + other.cents create Result.make_from_int (l_amount_imp) ensure correct: Result = (create {MONEY}.make_from_int (cents + other.cents)) end product alias "*" (arg: FLOAT): MONEY -- Product by arg do create Result.make_with_float (amount * arg) ensure then Result = (create {MONEY}.make_with_float ((amount * arg))) end quotient alias "/" (other: FLOAT): MONEY -- Division by other require else other /= create {FLOAT}.make_from_real (0.0) do create Result.make_with_float (amount / other) end zero: like Current -- Neutral element for "+" and "-" do create Result.make_from_int (0) end feature -- out comment (s: STRING_8): BOOLEAN do Result := True end out: STRING_8 -- New string containing terse printable representation -- of current object require -- from DEBUG_OUTPUT True require -- from ANY True do Result := amount.formatted (2) ensure -- from DEBUG_OUTPUT result_not_void: Result /= Void ensure -- from ANY out_not_void: Result /= Void end feature -- public amount: FLOAT -- float value of cents do Result := create {FLOAT}.make_from_real (cents / 100) ensure Result = create {FLOAT}.make_from_real (cents / 100) end cents: INTEGER_64 feature --compare is_equal (other: like Current): BOOLEAN -- Is other attached to an object of the same type -- as current object and identical to it? require -- from ANY other_not_void: other /= Void do Result := cents = other.cents ensure -- from ANY symmetric: Result implies other ~ Current consistent: standard_is_equal (other) implies Result ensure then -- from COMPARABLE trichotomy: Result = (not (Current < other) and not (other < Current)) end is_less alias "<" (other: MONEY): BOOLEAN -- Is current money less than other? require -- from PART_COMPARABLE other_exists: other /= Void do Result := cents < other.cents ensure then -- from COMPARABLE asymmetric: Result implies not (other < Current) end invariant min: cents.Min_value = -9223372036854775808 max: cents.Max_value = 9223372036854775807 consistent_amount: amount = create {FLOAT}.make_from_real (cents / 100) -- from COMPARABLE irreflexive_comparison: not (Current < Current) -- from ANY reflexive_equality: standard_is_equal (Current) reflexive_conformance: conforms_to (Current) note specification: "[ Efficient value type for handling money in dollars and cents. The class stores money as an INTEGER_64. MONEY values are within about 92,000 trillion dollars: $92,233,720,368,547,758.07 Min_value: INTEGER_64 = -9223372036854775808 Max_value: INTEGER_64 = 9223372036854775807 But the API works in terms of dollars and cents. Thus create {MONEY}.make(10,966)creates $10.966. Addition and subtraction are meaningful with type MONEY x MONEY -> MONEY. Addition and subtraction are precise within the stated range, and are protected with preconditions to stay safely within range without overflows. For product, we have only one choice: MONEY x SCALAR -> MONEY where scalar can be float or int; we have float. For quotient we have MONEY x SCALAR -> MONEY which tells us amount / number_of_people i.e. approximately the amount that each person gets dividing equally.Protected so that there is no division by zero. These signatures satisfy dimensional analysis constraints. As an alternative to the imprecise quotient (which can loose pennies), there are pecise allocation queries to divide money into equal amounts without loss. Class MONEY uses a new type FLOAT with approximately equal operators. Division and multiplication using float is imprecise. Feature 'out' displays money rounded to two decimal points. ]" end -- class MONEY
Generated by ISE EiffelStudio