PACKAGE BODY Currency IS ------------------------------------------------------------------ --| --| Body of the abstract data type for representing --| and manipulating Currency numbers. --| All values of type Currency.Quantity are initialized to 0.0. --| --| Author: Michael B. Feldman, The George Washington University --| Last Modified: July 1995 --| ------------------------------------------------------------------ -- internal operations, not exported to the client SUBTYPE NonNegFloat IS Float RANGE 0.0 .. Float'Last; FUNCTION Add (Q1: Quantity; Q2: Quantity) RETURN Quantity IS -- Pre: Q1 >= 0.0 and Q2 >= 0.0. -- Post: Returns the sum of Q1 and Q2. -- This is just an auxiliary routine used in "+" and "-" below. Result : Quantity; TempCents : Natural; BEGIN -- Add TempCents := Q1.Cents + Q2.Cents; IF TempCents > 99 THEN -- we had a carry Result.Cents := TempCents - 100; Result.Dollars := Q1.Dollars + Q2.Dollars + 1; ELSE Result.Cents := TempCents; Result.Dollars := Q1.Dollars + Q2.Dollars; END IF; RETURN Result; END Add; FUNCTION Subtract (Q1: Quantity; Q2: Quantity) RETURN Quantity IS -- Pre: Q1 >= 0.0 and Q2 >= 0.0. -- Post: Returns the difference of Q1 and Q2. -- This is just an auxiliary routine used in "+" and "-" below. Result : Quantity; TempCents : Natural; BEGIN -- Subtract IF Q1 > Q2 THEN -- Result is positive IF Q2.Cents > Q1.Cents THEN -- we need a borrow Result.Cents := (100 + Q1.Cents) - Q2.Cents; Result.Dollars := (Q1.Dollars - 1) - Q2.Dollars; ELSE Result.Cents := Q1.Cents - Q2.Cents; Result.Dollars := Q1.Dollars - Q2.Dollars; END IF; ELSE -- Result is negative Result.Positive := False; IF Q1.Cents > Q2.Cents THEN -- we need a borrow Result.Cents := (100 + Q2.Cents) - Q1.Cents; Result.Dollars := (Q2.Dollars - 1) - Q1.Dollars; ELSE Result.Cents := Q2.Cents - Q1.Cents; Result.Dollars := Q2.Dollars - Q1.Dollars; END IF; END IF; RETURN Result; END Subtract; -- Exported Operators FUNCTION "+"(Q1 : Quantity; Q2 : Quantity) RETURN Quantity IS BEGIN IF Q1.Positive AND Q2.Positive THEN RETURN Add(Q1,Q2); ELSIF (NOT Q1.Positive) AND (NOT Q2.Positive) THEN RETURN -Add(-Q1, -Q2); ELSIF Q1.Positive AND (NOT Q2.Positive) THEN RETURN Subtract(Q1, -Q2); ELSE -- NOT Q1.Positive AND Q2.Positive; RETURN Subtract(Q2, -Q1); END IF; END "+"; FUNCTION "-"(Q1 : Quantity; Q2 : Quantity) RETURN Quantity IS BEGIN RETURN Q1 + (-Q2); END "-"; FUNCTION MakeCurrency (F : Float) RETURN Quantity IS Result: Quantity; T: Float; BEGIN T := Float'Truncation(ABS F); -- get whole-number part Result := (Positive => True, Dollars => Natural(T), -- just a type change Cents => Natural(100.0 * (ABS F - T))); IF F < 0.0 THEN Result.Positive := False; END IF; RETURN Result; END MakeCurrency; FUNCTION MakeFloat (Q : Quantity) RETURN Float IS Result: Float; BEGIN Result := Float(100 * Q.Dollars + Q.Cents) / 100.0; IF Q.Positive THEN RETURN Result; ELSE RETURN -Result; END IF; END MakeFloat; FUNCTION Dollars (Q : Quantity) RETURN Natural IS BEGIN RETURN Q.Dollars; END Dollars; FUNCTION Cents (Q : Quantity) RETURN CentsType IS BEGIN RETURN Q.Cents; END Cents; FUNCTION IsPositive(Q : Quantity) RETURN Boolean IS BEGIN RETURN Q.Positive; END IsPositive; FUNCTION ">" (Q1 : Quantity; Q2 : Quantity) RETURN Boolean IS BEGIN RETURN MakeFloat(Q1) > MakeFloat(Q2); END ">"; FUNCTION "<" (Q1 : Quantity; Q2 : Quantity) RETURN Boolean IS BEGIN -- stub RETURN True; END "<"; FUNCTION "<=" (Q1 : Quantity; Q2 : Quantity) RETURN Boolean IS BEGIN -- stub RETURN True; END "<="; FUNCTION ">=" (Q1 : Quantity; Q2 : Quantity) RETURN Boolean IS BEGIN -- stub RETURN True; END ">="; FUNCTION "+"(Q : Quantity) RETURN Quantity IS BEGIN RETURN Q; END "+"; FUNCTION "-"(Q : Quantity) RETURN Quantity IS BEGIN RETURN (Positive => NOT Q.Positive, Dollars => Q.Dollars, Cents => Q.Cents); END "-"; FUNCTION "ABS"(Q : Quantity) RETURN Quantity IS BEGIN -- stub RETURN Q; END "ABS"; FUNCTION "*"(F : Float; Q : Quantity) RETURN Quantity IS BEGIN RETURN(MakeCurrency(F * MakeFloat(Q))); END "*"; FUNCTION "*"(Q : Quantity; F : Float ) RETURN Quantity IS BEGIN -- stub RETURN Q; END "*"; FUNCTION "/"(Q1 : Quantity; Q2 : Quantity) RETURN Float IS BEGIN RETURN MakeFloat(Q1) / MakeFloat(Q2); END "/"; FUNCTION "/"(Q : Quantity; F : Float ) RETURN Quantity IS BEGIN -- stub RETURN Q; END "/"; END Currency;