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