The module:
{ This module defines an interface for an integer data type with no lower
or upper bound and implements it for HP 9000 Series 700 workstations
under HP-UX 9.x, using HP Pascal.
Programmer: John Stone, Grinnell College.
Original version: December 8, 1996
}
$heap_dispose on$
module Ints;
$search 'naturals.o, bidirectional-lists.o, natural-elements.o'$
import
Naturals;
export
type
Int = ^IntRecord; { an opaque type }
{ The NegateInt function constructs and returns the negative -- that is,
the additive inverse -- of a given integer. }
function NegateInt (Negand: Int): Int;
{ The AbsoluteValueOfInt function constructs and returns the absolute
value of a given integer. }
function AbsoluteValueOfInt (Operand: Int): Int;
{ The AddInt function adds any two integers and returns their sum. }
function AddInt (Augend, Addend: Int): Int;
{ The SubtractInt function subtracts one integer (the subtrahend) from
another (the minuend) and returns their difference. }
function SubtractInt (Minuend, Subtrahend: Int): Int;
{ The MultiplyInt function multiplies one integer (the multiplicand) by
another (the multiplier) and returns their product. }
function MultiplyInt (Multiplicand, Multiplier: Int): Int;
{ The DivideInt procedure divides one integer (the dividend) by another
(the divisor), returning both the quotient and the remainder as
integers. It presupposes that the divisor is not zero. }
procedure DivideInt (Dividend, Divisor: Int; var Quotient,
Remainder: Int);
{ The QuotientInt function divides one integer (the dividend) by another
(the divisor) and returns the quotient as an integer, discarding the
remainder. It presupposes that the divisor is not zero. }
function QuotientInt (Dividend, Divisor: Int): Int;
{ The RemainderInt function divides one integer (the dividend) by another
(the divisor) and returns the remainder as an integer, discarding the
quotient. It presupposes that the divisor is not zero. The remainder,
if not zero, has the same sign as the dividend. }
function RemainderInt (Dividend, Divisor: Int): Int;
{ The ModuloInt function determines the congruence class to which a given
integer (the moduland) belongs, modulo another given integer (the
modulus), and returns the principal value of that class -- the member
that lies between zero (inclusive) and the modulus (exclusive). It
presupposes that the modulus is not zero. The value returned, if not
zero, has the same sign as the modulus. }
function ModuloInt (Moduland, Modulus: Int): Int;
{ The RaiseInt function raises an integer (the base) to the power
specified by a natural number (the exponent) and returns the result as
an integer. It returns 1 whenever the exponent is zero, even if the
base is also zero. }
function RaiseInt (Base: Int; Exponent: Natural): Int;
{ The SuccessorOfInt function returns the integer that immediately
follows a given integer. }
function SuccessorOfInt (Operand: Int): Int;
{ The PredecessorOfInt function returns the integer that immediately
precedes a given integer. }
function PredecessorOfInt (Operand: Int): Int;
{ Given an integer, the TwiceInt function computes and returns its
double. }
function TwiceInt (Operand: Int): Int;
{ Given an integer, the SquareInt function computes and returns its
square. }
function SquareInt (Operand: Int): Int;
{ Given an integer, the CubeInt function computes and returns its cube. }
function CubeInt (Operand: Int): Int;
{ The EqualInts function determines whether its arguments are numerically
equal -- not necessarily identical as storage structures, but equal in
value. }
function EqualInts (LeftOperand, RightOperand: Int): Boolean;
{ The UnequalInts function determines whether the first of its arguments
differs in value from its second -- not whether they differ as storage
structures, but whether their numerical values differ. }
function UnequalInts (LeftOperand, RightOperand: Int): Boolean;
{ The LessInt function determines whether the first of its arguments is
numerically less than the second. }
function LessInt (LeftOperand, RightOperand: Int): Boolean;
{ The LessOrEqualInt function returns True if its first argument is
numerically less than or equal to its second, False otherwise. }
function LessOrEqualInt (LeftOperand, RightOperand: Int): Boolean;
{ The GreaterInt function determines whether the first of its arguments
is numerically greater than the second. }
function GreaterInt (LeftOperand, RightOperand: Int): Boolean;
{ The GreaterOrEqualInt function returns True if its first argument is
numerically greater than or equal to its second, False otherwise. }
function GreaterOrEqualInt (LeftOperand, RightOperand: Int): Boolean;
{ The MajorInt function returns the greater of its two arguments; if they
are equal, it returns the first of the two. }
function MajorInt (LeftOperand, RightOperand: Int): Int;
{ The MinorInt function returns the lesser of its two arguments; if they
are equal, it returns the first of the two. }
function MinorInt (LeftOperand, RightOperand: Int): Int;
{ The ZeroInt function determines whether a given integer is 0, returning
True if it is and False if it is not. }
function ZeroInt (Operand: Int): Boolean;
{ The NegativeInt function determines whether a given integer is strictly
negative, returning True if it is and False if it is not. }
function NegativeInt (Operand: Int): Boolean;
{ The PositiveInt function determines whether a given integer is strictly
positive, returning True if it is and False if it is not. }
function PositiveInt (Operand: Int): Boolean;
{ The MultipleInt function determines whether its first argument is an
exact multiple of its second. (The only exact multiple of 0 is 0.) }
function MultipleInt (Candidate, Unit: Int): Boolean;
{ The EvenInt function determines whether its argument is even -- that
is, whether it is an integer multiple of 2. }
function EvenInt (Operand: Int): Boolean;
{ The OddInt function determines whether its argument is odd -- that is,
whether dividing it by 2 leaves a remainder of 1. }
function OddInt (Operand: Int): Boolean;
{ The ReadInt procedure collects a sequence of decimal digits, optionally
preceded by any number of whitespace characters and/or a sign (+ or -),
from a specified text file and stores the integer that they represent
into a given variable. It presupposes that the text file has already
been opened for input. }
procedure ReadInt (var Source: Text; var Legend: Int;
var Success: Boolean);
{ The WriteInt procedure writes the decimal numeral for a given integer,
preceded by a minus sign if the integer is negative, to a specified
text file, with no leading zeroes or spaces. (But the single digit '0'
is written if the given integer is 0.) It presupposes that the text
file has already been opened for output. }
procedure WriteInt (var Target: Text; Scribend: Int);
{ Given any argument of Pascal's built-in integer type, the
PascalIntegerInt function constructs and returns an Int of equal
value. }
function PascalIntegerToInt (N: Integer): Int;
{ Given any Int in the range from -MaxInt - 1 to MaxInt, inclusive, the
IntToPascalInteger function returns the Pascal integer of equal
value. }
function IntToPascalInteger (N: Int): Integer;
{ The AssignInt procedure creates an integer equal in value to its second
argument, but in separately allocated storage, and returns it through
its first argument. }
procedure AssignInt (var Target: Int; Source: Int);
{ The DeallocateInt procedure frees all of the storage allocated for a
given integer and changes the value of its argument to nil. It
presupposes that an integer has been stored in Operand and not
previously deallocated. }
procedure DeallocateInt (var Operand: Int);
implement
import
StdErr;
const
Debug = True;
{ Debugging is turned on while the module is under development. }
{ The following constants are more or less arbitrary integers
signifying various kinds of exceptions that can occur within this
module. }
FirstExceptionCode = 1;
UndefinedArgumentException = 1;
InvalidReturnException = 2;
ZeroDivisorOrModulusException = 3;
PascalIntegerRangeException = 4;
ExceptionException = 5;
LastExceptionCode = ExceptionException;
type
Signum = (Positive, Negative);
IntRecord = record
Sign: Signum;
Magnitude: Natural
end;
{ The IntExceptionHandler procedure is invoked whenever one of the
preconditions for the successful execution of a procedure is found to
be false. It prints out an appropriate explanation of the exception
just before the program is halted. }
procedure IntExceptionHandler (ExceptionCode: Integer);
begin
if (ExceptionCode < FirstExceptionCode) or
(LastExceptionCode < ExceptionCode) then
ExceptionCode := ExceptionException;
Write (StdErr, 'Exception #', ExceptionCode : 1,
' in module Ints: ');
case ExceptionCode of
UndefinedArgumentException:
WriteLn (StdErr, 'The argument to a procedure or function ',
'requiring an Int value was undefined.');
InvalidReturnException:
WriteLn (StdErr, 'A procedure or function in the Ints module ',
'was about to return an incorrectly constructed result.');
ZeroDivisorOrModulusException:
WriteLn (StdErr, 'The divisor or modulus argument to a procedure ',
'or function involving division was zero.');
PascalIntegerRangeException:
WriteLn (StdErr, 'An argument to the IntToPascalInteger ',
'procedure was outside the range of Pascal ',
'integers.');
ExceptionException:
WriteLn (StdErr, 'An argument to the IntExceptionHandler ',
'procedure was out of range.')
end
end;
{ The ValidInt function determines whether a given value is a valid
Int -- a non-nil pointer to an appropriate record -- and checks the
module invariant that an Int of zero magnitude should always have
Positive sign. }
function ValidInt (Operand: Int): Boolean;
begin
if Operand = nil then
ValidInt := False
else if (Operand^.Sign <> Positive) and (Operand^.Sign <> Negative) then
ValidInt := False
else if ZeroNatural (Operand^.Magnitude) then
ValidInt := (Operand^.Sign = Positive)
else
ValidInt := True
end;
function NegateInt (Negand: Int): Int;
var
Result: Int;
begin
Assert (Negand <> nil, UndefinedArgumentException, IntExceptionHandler);
New (Result);
if ZeroNatural (Negand^.Magnitude) or (Negand^.Sign = Negative) then
Result^.Sign := Positive
else
Result^.Sign := Negative;
AssignNatural (Result^.Magnitude, Negand^.Magnitude);
if Debug then
Assert (ValidInt (Result), InvalidReturnException,
IntExceptionHandler);
NegateInt := Result
end;
function AbsoluteValueOfInt (Operand: Int): Int;
var
Result: Int;
begin
Assert (Operand <> nil, UndefinedArgumentException, IntExceptionHandler);
New (Result);
Result^.Sign := Positive;
AssignNatural (Result^.Magnitude, Operand^.Magnitude);
if Debug then
Assert (ValidInt (Result), InvalidReturnException,
IntExceptionHandler);
AbsoluteValueOfInt := Result
end;
function AddInt (Augend, Addend: Int): Int;
var
Result: Int;
begin
Assert ((Augend <> nil) and (Addend <> nil), UndefinedArgumentException,
IntExceptionHandler);
New (Result);
if Augend^.Sign = Addend^.Sign then begin
Result^.Sign := Augend^.Sign;
Result^.Magnitude :=
AddNatural (Augend^.Magnitude, Addend^.Magnitude)
end
else if LessNatural (Augend^.Magnitude, Addend^.Magnitude) then begin
Result^.Sign := Addend^.Sign;
Result^.Magnitude :=
SubtractNatural (Addend^.Magnitude, Augend^.Magnitude)
end
else if LessNatural (Addend^.Magnitude, Augend^.Magnitude) then begin
Result^.Sign := Augend^.Sign;
Result^.Magnitude :=
SubtractNatural (Augend^.Magnitude, Addend^.Magnitude)
end
else begin
Result^.Sign := Positive;
Result^.Magnitude := PascalIntegerToNatural (0)
end;
if Debug then
Assert (ValidInt (Result), InvalidReturnException,
IntExceptionHandler);
AddInt := Result
end;
function SubtractInt (Minuend, Subtrahend: Int): Int;
var
Result: Int;
begin
Assert ((Minuend <> nil) and (Subtrahend <> nil),
UndefinedArgumentException, IntExceptionHandler);
New (Result);
if Minuend^.Sign <> Subtrahend^.Sign then begin
Result^.Sign := Minuend^.Sign;
Result^.Magnitude :=
AddNatural (Minuend^.Magnitude, Subtrahend^.Magnitude)
end
else if LessNatural (Minuend^.Magnitude, Subtrahend^.Magnitude) then begin
case Subtrahend^.Sign of
Positive:
Result^.Sign := Negative;
Negative:
Result^.Sign := Positive
end;
Result^.Magnitude :=
SubtractNatural (Subtrahend^.Magnitude, Minuend^.Magnitude)
end
else if LessNatural (Subtrahend^.Magnitude, Minuend^.Magnitude) then begin
Result^.Sign := Minuend^.Sign;
Result^.Magnitude :=
SubtractNatural (Minuend^.Magnitude, Subtrahend^.Magnitude)
end
else begin
Result^.Sign := Positive;
Result^.Magnitude := PascalIntegerToNatural (0)
end;
if Debug then
Assert (ValidInt (Result), InvalidReturnException,
IntExceptionHandler);
SubtractInt := Result
end;
function MultiplyInt (Multiplicand, Multiplier: Int): Int;
var
Result: Int;
begin
Assert ((Multiplicand <> nil) and (Multiplier <> nil),
UndefinedArgumentException, IntExceptionHandler);
New (Result);
if (Multiplicand^.Sign = Multiplier^.Sign) or
ZeroNatural (Multiplicand^.Magnitude) or
ZeroNatural (Multiplier^.Magnitude) then
Result^.Sign := Positive
else
Result^.Sign := Negative;
Result^.Magnitude :=
MultiplyNatural (Multiplicand^.Magnitude, Multiplier^.Magnitude);
if Debug then
Assert (ValidInt (Result), InvalidReturnException,
IntExceptionHandler);
MultiplyInt := Result
end;
procedure DivideInt (Dividend, Divisor: Int; var Quotient,
Remainder: Int);
begin
Assert ((Dividend <> nil) and (Divisor <> nil), UndefinedArgumentException,
IntExceptionHandler);
Assert (not ZeroNatural (Divisor^.Magnitude),
ZeroDivisorOrModulusException, IntExceptionHandler);
New (Quotient);
New (Remainder);
DivideNatural (Dividend^.Magnitude, Divisor^.Magnitude,
Quotient^.Magnitude, Remainder^.Magnitude);
if (Dividend^.Sign = Divisor^.Sign) or
ZeroNatural (Quotient^.Magnitude) then
Quotient^.Sign := Positive
else
Quotient^.Sign := Negative;
if ZeroNatural (Remainder^.Magnitude) then
Remainder^.Sign := Positive
else
Remainder^.Sign := Dividend^.Sign;
if Debug then
Assert (ValidInt (Quotient) and ValidInt (Remainder),
InvalidReturnException, IntExceptionHandler)
end;
function QuotientInt (Dividend, Divisor: Int): Int;
var
Result: Int;
Wastebasket: Natural;
{ storage for the discarded remainder of the bignum division }
begin
Assert ((Dividend <> nil) and (Divisor <> nil), UndefinedArgumentException,
IntExceptionHandler);
Assert (not ZeroNatural (Divisor^.Magnitude),
ZeroDivisorOrModulusException, IntExceptionHandler);
New (Result);
DivideNatural (Dividend^.Magnitude, Divisor^.Magnitude,
Result^.Magnitude, Wastebasket);
DeallocateNatural (Wastebasket);
if (Dividend^.Sign = Divisor^.Sign) or
ZeroNatural (Result^.Magnitude) then
Result^.Sign := Positive
else
Result^.Sign := Negative;
if Debug then
Assert (ValidInt (Result), InvalidReturnException,
IntExceptionHandler);
QuotientInt := Result
end;
function RemainderInt (Dividend, Divisor: Int): Int;
var
Result: Int;
Wastebasket: Natural;
{ storage for the discarded quotient of the bignum division }
begin
Assert ((Dividend <> nil) and (Divisor <> nil), UndefinedArgumentException,
IntExceptionHandler);
Assert (not ZeroNatural (Divisor^.Magnitude),
ZeroDivisorOrModulusException, IntExceptionHandler);
New (Result);
DivideNatural (Dividend^.Magnitude, Divisor^.Magnitude,
Wastebasket, Result^.Magnitude);
DeallocateNatural (Wastebasket);
if ZeroNatural (Result^.Magnitude) then
Result^.Sign := Positive
else
Result^.Sign := Dividend^.Sign;
if Debug then
Assert (ValidInt (Result), InvalidReturnException,
IntExceptionHandler);
RemainderInt := Result
end;
function ModuloInt (Moduland, Modulus: Int): Int;
var
Result: Int;
Wastebasket: Natural;
{ storage for the discarded quotient of the bignum division }
Remainder: Natural;
{ the remainder of the bignum division }
begin
Assert ((Moduland <> nil) and (Modulus <> nil), UndefinedArgumentException,
IntExceptionHandler);
Assert (not ZeroNatural (Modulus^.Magnitude),
ZeroDivisorOrModulusException, IntExceptionHandler);
New (Result);
DivideNatural (Moduland^.Magnitude, Modulus^.Magnitude,
Wastebasket, Remainder);
DeallocateNatural (Wastebasket);
if ZeroNatural (Remainder) then begin
Result^.Sign := Positive;
Result^.Magnitude := Remainder
end
else begin
Result^.Sign := Modulus^.Sign;
if Moduland^.Sign = Modulus^.Sign then
Result^.Magnitude := Remainder
else begin
Result^.Magnitude :=
SubtractNatural (Modulus^.Magnitude, Remainder);
DeallocateNatural (Remainder)
end
end;
if Debug then
Assert (ValidInt (Result), InvalidReturnException,
IntExceptionHandler);
ModuloInt := Result
end;
function RaiseInt (Base: Int; Exponent: Natural): Int;
var
Result: Int;
begin
Assert (Base <> nil, UndefinedArgumentException, IntExceptionHandler);
New (Result);
if (Base^.Sign = Negative) and OddNatural (Exponent) then
Result^.Sign := Negative
else
Result^.Sign := Positive;
Result^.Magnitude := RaiseNatural (Base^.Magnitude, Exponent);
if Debug then
Assert (ValidInt (Result), InvalidReturnException,
IntExceptionHandler);
RaiseInt := Result
end;
function SuccessorOfInt (Operand: Int): Int;
var
Result: Int;
begin
Assert (Operand <> nil, UndefinedArgumentException, IntExceptionHandler);
New (Result);
case Operand^.Sign of
Positive:
Result^.Magnitude := SuccessorOfNatural (Operand^.Magnitude);
Negative:
Result^.Magnitude := PredecessorOfNatural (Operand^.Magnitude)
end;
if ZeroNatural (Result^.Magnitude) then
Result^.Sign := Positive
else
Result^.Sign := Operand^.Sign;
if Debug then
Assert (ValidInt (Result), InvalidReturnException,
IntExceptionHandler);
SuccessorOfInt := Result
end;
function PredecessorOfInt (Operand: Int): Int;
var
Result: Int;
begin
Assert (Operand <> nil, UndefinedArgumentException, IntExceptionHandler);
New (Result);
if ZeroNatural (Operand^.Magnitude) then begin
Result^.Sign := Negative;
Result^.Magnitude := PascalIntegerToNatural (1)
end
else begin
Result^.Sign := Operand^.Sign;
case Operand^.Sign of
Positive:
Result^.Magnitude := PredecessorOfNatural (Operand^.Magnitude);
Negative:
Result^.Magnitude := SuccessorOfNatural (Operand^.Magnitude)
end
end;
if Debug then
Assert (ValidInt (Result), InvalidReturnException,
IntExceptionHandler);
PredecessorOfInt := Result
end;
function TwiceInt (Operand: Int): Int;
var
Result: Int;
begin
Assert (Operand <> nil, UndefinedArgumentException, IntExceptionHandler);
New (Result);
Result^.Sign := Operand^.Sign;
Result^.Magnitude := TwiceNatural (Operand^.Magnitude);
if Debug then
Assert (ValidInt (Result), InvalidReturnException,
IntExceptionHandler);
TwiceInt := Result
end;
function SquareInt (Operand: Int): Int;
var
Result: Int;
begin
Assert (Operand <> nil, UndefinedArgumentException, IntExceptionHandler);
New (Result);
Result^.Sign := Positive;
Result^.Magnitude := SquareNatural (Operand^.Magnitude);
if Debug then
Assert (ValidInt (Result), InvalidReturnException,
IntExceptionHandler);
SquareInt := Result
end;
function CubeInt (Operand: Int): Int;
var
Result: Int;
begin
Assert (Operand <> nil, UndefinedArgumentException, IntExceptionHandler);
New (Result);
Result^.Sign := Operand^.Sign;
Result^.Magnitude := CubeNatural (Operand^.Magnitude);
if Debug then
Assert (ValidInt (Result), InvalidReturnException,
IntExceptionHandler);
CubeInt := Result
end;
function EqualInts (LeftOperand, RightOperand: Int): Boolean;
begin
Assert ((LeftOperand <> nil) and (RightOperand <> nil),
UndefinedArgumentException, IntExceptionHandler);
if LeftOperand^.Sign = RightOperand^.Sign then
EqualInts :=
EqualNaturals (LeftOperand^.Magnitude, RightOperand^.Magnitude)
else
EqualInts := False
end;
function UnequalInts (LeftOperand, RightOperand: Int): Boolean;
begin
Assert ((LeftOperand <> nil) and (RightOperand <> nil),
UndefinedArgumentException, IntExceptionHandler);
if LeftOperand^.Sign = RightOperand^.Sign then
UnequalInts :=
UnequalNaturals (LeftOperand^.Magnitude, RightOperand^.Magnitude)
else
UnequalInts := True
end;
function LessInt (LeftOperand, RightOperand: Int): Boolean;
begin
Assert ((LeftOperand <> nil) and (RightOperand <> nil),
UndefinedArgumentException, IntExceptionHandler);
case LeftOperand^.Sign of
Positive:
case RightOperand^.Sign of
Positive:
LessInt := LessNatural (LeftOperand^.Magnitude,
RightOperand^.Magnitude);
Negative:
LessInt := False
end;
Negative:
case RightOperand^.Sign of
Positive:
LessInt := True;
Negative:
LessInt := LessNatural (RightOperand^.Magnitude,
LeftOperand^.Magnitude)
end
end
end;
function LessOrEqualInt (LeftOperand, RightOperand: Int): Boolean;
begin
Assert ((LeftOperand <> nil) and (RightOperand <> nil),
UndefinedArgumentException, IntExceptionHandler);
case LeftOperand^.Sign of
Positive:
case RightOperand^.Sign of
Positive:
LessOrEqualInt := LessOrEqualNatural (LeftOperand^.Magnitude,
RightOperand^.Magnitude);
Negative:
LessOrEqualInt := False
end;
Negative:
case RightOperand^.Sign of
Positive:
LessOrEqualInt := True;
Negative:
LessOrEqualInt := LessOrEqualNatural (RightOperand^.Magnitude,
LeftOperand^.Magnitude)
end
end
end;
function GreaterInt (LeftOperand, RightOperand: Int): Boolean;
begin
Assert ((LeftOperand <> nil) and (RightOperand <> nil),
UndefinedArgumentException, IntExceptionHandler);
case LeftOperand^.Sign of
Positive:
case RightOperand^.Sign of
Positive:
GreaterInt := LessNatural (RightOperand^.Magnitude,
LeftOperand^.Magnitude);
Negative:
GreaterInt := True
end;
Negative:
case RightOperand^.Sign of
Positive:
GreaterInt := False;
Negative:
GreaterInt := LessNatural (LeftOperand^.Magnitude,
RightOperand^.Magnitude)
end
end
end;
function GreaterOrEqualInt (LeftOperand, RightOperand: Int): Boolean;
begin
Assert ((LeftOperand <> nil) and (RightOperand <> nil),
UndefinedArgumentException, IntExceptionHandler);
case LeftOperand^.Sign of
Positive:
case RightOperand^.Sign of
Positive:
GreaterOrEqualInt := LessOrEqualNatural (RightOperand^.Magnitude,
LeftOperand^.Magnitude);
Negative:
GreaterOrEqualInt := True
end;
Negative:
case RightOperand^.Sign of
Positive:
GreaterOrEqualInt := False;
Negative:
GreaterOrEqualInt := LessOrEqualNatural (LeftOperand^.Magnitude,
RightOperand^.Magnitude)
end
end
end;
function MajorInt (LeftOperand, RightOperand: Int): Int;
begin
Assert ((LeftOperand <> nil) and (RightOperand <> nil),
UndefinedArgumentException, IntExceptionHandler);
if LessInt (LeftOperand, RightOperand) then
MajorInt := RightOperand
else
MajorInt := LeftOperand
end;
function MinorInt (LeftOperand, RightOperand: Int): Int;
begin
Assert ((LeftOperand <> nil) and (RightOperand <> nil),
UndefinedArgumentException, IntExceptionHandler);
if LessOrEqualInt (LeftOperand, RightOperand) then
MinorInt := LeftOperand
else
MinorInt := RightOperand
end;
function ZeroInt (Operand: Int): Boolean;
begin
Assert (Operand <> nil, UndefinedArgumentException, IntExceptionHandler);
ZeroInt := ZeroNatural (Operand^.Magnitude)
end;
function NegativeInt (Operand: Int): Boolean;
begin
Assert (Operand <> nil, UndefinedArgumentException, IntExceptionHandler);
NegativeInt := (Operand^.Sign = Negative)
end;
function PositiveInt (Operand: Int): Boolean;
begin
Assert (Operand <> nil, UndefinedArgumentException, IntExceptionHandler);
case Operand^.Sign of
Positive:
PositiveInt := not ZeroNatural (Operand^.Magnitude);
Negative:
PositiveInt := False
end
end;
function MultipleInt (Candidate, Unit: Int): Boolean;
begin
Assert ((Candidate <> nil) and (Unit <> nil), UndefinedArgumentException,
IntExceptionHandler);
MultipleInt := MultipleNatural (Candidate^.Magnitude, Unit^.Magnitude)
end;
function EvenInt (Operand: Int): Boolean;
begin
Assert (Operand <> nil, UndefinedArgumentException, IntExceptionHandler);
EvenInt := EvenNatural (Operand^.Magnitude)
end;
function OddInt (Operand: Int): Boolean;
begin
Assert (Operand <> nil, UndefinedArgumentException, IntExceptionHandler);
OddInt := OddNatural (Operand^.Magnitude)
end;
procedure ReadInt (var Source: Text; var Legend: Int;
var Success: Boolean);
var
TentativeSign: Signum;
{ The SkipWhiteSpace procedure advances through a text file until
a non-whitespace character (or the end of the file) is encountered. }
procedure SkipWhiteSpace (var Source: Text);
const
Space = ' ';
var
Finished: Boolean;
{ indicates whether it is necessary to keep looking for white space
to skip }
begin
Finished := False;
while not Finished do
if EOF (Source) then
Finished := True
else if (Source^ <= Space) or (Source^ = Chr (127)) then
Get (Source)
else
Finished := True
end;
procedure ReadOptionalSign (var Source: Text; var SignRead: Signum;
var Success: Boolean);
begin
if EOF (Source) then
Success := False
else if Source^ = '+' then begin
SignRead := Positive;
Get (Source)
end
else if Source^ = '-' then begin
SignRead := Negative;
Get (Source)
end
else
SignRead := Positive
end;
function Numeric (Ch: Char): Boolean;
begin
Numeric := ('0' <= Ch) and (Ch <= '9')
end;
begin { procedure ReadInt }
SkipWhiteSpace (Source);
ReadOptionalSign (Source, TentativeSign, Success);
if EOF (Source) then
Success := False
else if not Numeric (Source^) then
Success := False
else begin
New (Legend);
ReadNatural (Source, Legend^.Magnitude, Success); { always succeeds }
if ZeroNatural (Legend^.Magnitude) then
Legend^.Sign := Positive
else
Legend^.Sign := TentativeSign;
if Debug then
Assert (ValidInt (Legend), InvalidReturnException,
IntExceptionHandler)
end
end;
procedure WriteInt (var Target: Text; Scribend: Int);
begin
Assert (Scribend <> nil, UndefinedArgumentException, IntExceptionHandler);
if Scribend^.Sign = Negative then
Write (Target, '-');
WriteNatural (Target, Scribend^.Magnitude)
end;
function PascalIntegerToInt (N: Integer): Int;
var
Result: Int;
Temporary: Natural;
begin
New (Result);
if 0 <= N then begin
Result^.Sign := Positive;
Result^.Magnitude := PascalIntegerToNatural (N)
end
else if -MaxInt <= N then begin
Result^.Sign := Negative;
Result^.Magnitude := PascalIntegerToNatural (-N)
end
else begin
Result^.Sign := Negative;
Temporary := PascalIntegerToNatural (MaxInt);
Result^.Magnitude := SuccessorOfNatural (Temporary);
DeallocateNatural (Temporary)
end;
if Debug then
Assert (ValidInt (Result), InvalidReturnException,
IntExceptionHandler);
PascalIntegerToInt := Result
end;
function IntToPascalInteger (N: Int): Integer;
var
MaxIntAsNatural, MaxIntPlusOneAsNatural: Natural;
begin
Assert (N <> nil, UndefinedArgumentException, IntExceptionHandler);
MaxIntAsNatural := PascalIntegerToNatural (MaxInt);
case N^.Sign of
Positive:
begin
Assert (LessOrEqualNatural (N^.Magnitude, MaxIntAsNatural),
PascalIntegerRangeException, IntExceptionHandler);
DeallocateNatural (MaxIntAsNatural);
IntToPascalInteger := NaturalToPascalInteger (N^.Magnitude)
end;
Negative:
begin
MaxIntPlusOneAsNatural := SuccessorOfNatural (MaxIntAsNatural);
DeallocateNatural (MaxIntAsNatural);
Assert (LessOrEqualNatural (N^.Magnitude, MaxIntPlusOneAsNatural),
PascalIntegerRangeException, IntExceptionHandler);
if EqualNaturals (N^.Magnitude, MaxIntPlusOneAsNatural) then
IntToPascalInteger := -MaxInt - 1
else
IntToPascalInteger := -NaturalToPascalInteger (N^.Magnitude);
DeallocateNatural (MaxIntPlusOneAsNatural)
end
end
end;
procedure AssignInt (var Target: Int; Source: Int);
begin
Assert (Source <> nil, UndefinedArgumentException, IntExceptionHandler);
New (Target);
Target^.Sign := Source^.Sign;
AssignNatural (Target^.Magnitude, Source^.Magnitude);
if Debug then
Assert (ValidInt (Target), InvalidReturnException,
IntExceptionHandler)
end;
procedure DeallocateInt (var Operand: Int);
begin
Assert (Operand <> nil, UndefinedArgumentException, IntExceptionHandler);
DeallocateNatural (Operand^.Magnitude);
Dispose (Operand);
Operand := nil
end;
end.
The test program:
{ This is a test program for the accompanying Ints module.
Programmer: John Stone, Grinnell College.
Original version: December 11-13, 1996.
}
$heap_dispose on$
program TestInts (Input, Output, Stderr, Scratch);
import
$search 'ints.o, naturals.o, bidirectional-lists.o, natural-elements.o'$
Ints, Naturals;
const
Cases = 24;
{ the number of different integer values that will be constructed and
examined }
BaseOfNumeration = 1290;
{ Esoteric knowledge: The Naturals module uses this base of numeration
internally, so many boundary conditions are associated with it. }
var
PascalInts: array [1 .. Cases - 2] of Integer;
{ Pascal integer equivalents for the Int values that have them }
NewInts: array [1 .. Cases] of Int;
{ the integer values to be constructed and tested }
Index, Outer, Inner: Integer;
{ loop controls for simple loops (Index) and nested loops (Outer and
Inner) }
Result: Int;
{ an Int value returned by some arithmetic function }
Quot, Rem: Int;
{ values returned by the DivideInt function -- the quotient and
remainder of a division }
TempNat: Natural;
{ the exponent to be supplied to the RaiseInt function }
Scratch: Text;
{ a scratch file on which the WriteInt and ReadInt procedures are
tested }
Success: Boolean;
{ indicates whether a ReadInt operation was successful }
begin
{ Construct a number of representative and boundary-condition Pascal
integers. }
PascalInts[1] := 0;
PascalInts[2] := 1;
PascalInts[3] := 2;
PascalInts[4] := 20;
PascalInts[5] := BaseOfNumeration - 1;
PascalInts[6] := BaseOfNumeration;
PascalInts[7] := 2718282;
PascalInts[8] := 3141593;
PascalInts[9] := BaseOfNumeration * BaseOfNumeration * BaseOfNumeration - 1;
PascalInts[10] := BaseOfNumeration * BaseOfNumeration * BaseOfNumeration;
PascalInts[11] := MaxInt;
for Index := 12 to 21 do
PascalInts[Index] := -PascalInts[Index - 10];
PascalInts[22] := -MaxInt - 1;
{ Convert them to Ints and write them out. }
WriteLn ('Test #1: PascalIntegerToInt, WriteInt');
for Index := 1 to Cases - 2 do begin
NewInts[Index] := PascalIntegerToInt (PascalInts[Index]);
Write (PascalInts[Index] : 1, ' = ');
WriteInt (Output, NewInts[Index]);
WriteLn
end;
WriteLn;
{ Add two outsize Int values. }
NewInts[23] := MultiplyInt (NewInts[7], NewInts[8]);
NewInts[24] := AddInt (NewInts[2], NewInts[11]);
{ Test all the arithmetic functions, deallocating the result after
each test. }
WriteLn ('Test #2: NegateInt');
for Index := 1 to Cases do begin
Result := NegateInt (NewInts[Index]);
Write ('-');
WriteInt (Output, NewInts[Index]);
Write (' = ');
WriteInt (Output, Result);
WriteLn;
DeallocateInt (Result);
end;
WriteLn;
WriteLn ('Test #3: AbsoluteValueOfInt');
for Index := 1 to Cases do begin
Result := AbsoluteValueOfInt (NewInts[Index]);
Write ('abs (');
WriteInt (Output, NewInts[Index]);
Write (') = ');
WriteInt (Output, Result);
WriteLn;
DeallocateInt (Result);
end;
WriteLn;
WriteLn ('Test #4: AddInt');
for Outer := 1 to Cases do
for Inner := 1 to Cases do begin
Result := AddInt (NewInts[Outer], NewInts[Inner]);
WriteInt (Output, NewInts[Outer]);
Write (' + ');
WriteInt (Output, NewInts[Inner]);
Write (' = ');
WriteInt (Output, Result);
WriteLn;
DeallocateInt (Result)
end;
WriteLn;
WriteLn ('Test #5: SubtractInt');
for Outer := 1 to Cases do
for Inner := 1 to Cases do begin
Result := SubtractInt (NewInts[Outer], NewInts[Inner]);
WriteInt (Output, NewInts[Outer]);
Write (' - ');
WriteInt (Output, NewInts[Inner]);
Write (' = ');
WriteInt (Output, Result);
WriteLn;
DeallocateInt (Result)
end;
WriteLn;
WriteLn ('Test #6: MultiplyInt');
for Outer := 1 to Cases do
for Inner := 1 to Cases do begin
Result := MultiplyInt (NewInts[Outer], NewInts[Inner]);
WriteInt (Output, NewInts[Outer]);
Write (' * ');
WriteInt (Output, NewInts[Inner]);
Write (' = ');
WriteInt (Output, Result);
WriteLn;
DeallocateInt (Result)
end;
WriteLn;
WriteLn ('Test #7: DivideInt');
for Outer := 1 to Cases do
for Inner := 2 to Cases do begin
{ lower bound 2 to avoid division by zero }
DivideInt (NewInts[Outer], NewInts[Inner], Quot, Rem);
WriteInt (Output, NewInts[Outer]);
Write (' / ');
WriteInt (Output, NewInts[Inner]);
Write (' = ');
WriteInt (Output, Quot);
Write (' r ');
WriteInt (Output, Rem);
WriteLn;
DeallocateInt (Quot);
DeallocateInt (Rem)
end;
WriteLn;
WriteLn ('Test #8: QuotientInt');
for Outer := 1 to Cases do
for Inner := 2 to Cases do begin
{ lower bound 2 to avoid division by zero }
Result := QuotientInt (NewInts[Outer], NewInts[Inner]);
WriteInt (Output, NewInts[Outer]);
Write (' div ');
WriteInt (Output, NewInts[Inner]);
Write (' = ');
WriteInt (Output, Result);
WriteLn;
DeallocateInt (Result)
end;
WriteLn;
WriteLn ('Test #9: RemainderInt');
for Outer := 1 to Cases do
for Inner := 2 to Cases do begin
{ lower bound 2 to avoid division by zero }
Result := RemainderInt (NewInts[Outer], NewInts[Inner]);
WriteInt (Output, NewInts[Outer]);
Write (' % ');
WriteInt (Output, NewInts[Inner]);
Write (' = ');
WriteInt (Output, Result);
WriteLn;
DeallocateInt (Result)
end;
WriteLn;
WriteLn ('Test #10: ModuloInt');
for Outer := 1 to Cases do
for Inner := 2 to Cases do begin
{ lower bound 2 to avoid zero modulus }
Result := ModuloInt (NewInts[Outer], NewInts[Inner]);
WriteInt (Output, NewInts[Outer]);
Write (' mod ');
WriteInt (Output, NewInts[Inner]);
Write (' = ');
WriteInt (Output, Result);
WriteLn;
DeallocateInt (Result)
end;
WriteLn;
WriteLn ('Test #11: RaiseInt');
for Index := 1 to Cases do begin
TempNat := PascalIntegerToNatural (0);
Result := RaiseInt (NewInts[Index], TempNat);
DeallocateNatural (TempNat);
WriteInt (Output, NewInts[Index]);
Write (' ^ 0 = ');
WriteInt (Output, Result);
WriteLn;
DeallocateInt (Result);
TempNat := PascalIntegerToNatural (1);
Result := RaiseInt (NewInts[Index], TempNat);
DeallocateNatural (TempNat);
WriteInt (Output, NewInts[Index]);
Write (' ^ 1 = ');
WriteInt (Output, Result);
WriteLn;
DeallocateInt (Result);
TempNat := PascalIntegerToNatural (2);
Result := RaiseInt (NewInts[Index], TempNat);
DeallocateNatural (TempNat);
WriteInt (Output, NewInts[Index]);
Write (' ^ 2 = ');
WriteInt (Output, Result);
WriteLn;
DeallocateInt (Result);
TempNat := PascalIntegerToNatural (12);
Result := RaiseInt (NewInts[Index], TempNat);
DeallocateNatural (TempNat);
WriteInt (Output, NewInts[Index]);
Write (' ^ 12 = ');
WriteInt (Output, Result);
WriteLn;
DeallocateInt (Result)
end;
WriteLn;
WriteLn ('Test #12: TwiceInt');
for Index := 1 to Cases do begin
Result := TwiceInt (NewInts[Index]);
WriteInt (Output, NewInts[Index]);
Write (' * 2 = ');
WriteInt (Output, Result);
WriteLn;
DeallocateInt (Result)
end;
WriteLn;
WriteLn ('Test #13: SquareInt');
for Index := 1 to Cases do begin
Result := SquareInt (NewInts[Index]);
WriteInt (Output, NewInts[Index]);
Write (' ^ 2 = ');
WriteInt (Output, Result);
WriteLn;
DeallocateInt (Result)
end;
WriteLn;
WriteLn ('Test #14: CubeInt');
for Index := 1 to Cases do begin
Result := CubeInt (NewInts[Index]);
WriteInt (Output, NewInts[Index]);
Write (' ^ 3 = ');
WriteInt (Output, Result);
WriteLn;
DeallocateInt (Result)
end;
WriteLn;
WriteLn ('Test #15: EqualInts');
for Outer := 1 to Cases do
for Inner := 1 to Cases do begin
WriteInt (Output, NewInts[Outer]);
Write (' = ');
WriteInt (Output, NewInts[Inner]);
WriteLn (' = ', EqualInts (NewInts[Outer], NewInts[Inner]))
end;
WriteLn;
WriteLn ('Test #16: UnequalInts');
for Outer := 1 to Cases do
for Inner := 1 to Cases do begin
WriteInt (Output, NewInts[Outer]);
Write (' <> ');
WriteInt (Output, NewInts[Inner]);
WriteLn (' = ', UnequalInts (NewInts[Outer], NewInts[Inner]))
end;
WriteLn;
WriteLn ('Test #17: LessInt');
for Outer := 1 to Cases do
for Inner := 1 to Cases do begin
WriteInt (Output, NewInts[Outer]);
Write (' < ');
WriteInt (Output, NewInts[Inner]);
WriteLn (' = ', LessInt (NewInts[Outer], NewInts[Inner]))
end;
WriteLn;
WriteLn ('Test #18: LessOrEqualInt');
for Outer := 1 to Cases do
for Inner := 1 to Cases do begin
WriteInt (Output, NewInts[Outer]);
Write (' <= ');
WriteInt (Output, NewInts[Inner]);
WriteLn (' = ', LessOrEqualInt (NewInts[Outer], NewInts[Inner]))
end;
WriteLn;
WriteLn ('Test #19: GreaterInt');
for Outer := 1 to Cases do
for Inner := 1 to Cases do begin
WriteInt (Output, NewInts[Outer]);
Write (' > ');
WriteInt (Output, NewInts[Inner]);
WriteLn (' = ', GreaterInt (NewInts[Outer], NewInts[Inner]))
end;
WriteLn;
WriteLn ('Test #20: GreaterOrEqualInt');
for Outer := 1 to Cases do
for Inner := 1 to Cases do begin
WriteInt (Output, NewInts[Outer]);
Write (' >= ');
WriteInt (Output, NewInts[Inner]);
WriteLn (' = ', GreaterOrEqualInt (NewInts[Outer], NewInts[Inner]))
end;
WriteLn;
WriteLn ('Test #21: MajorInt');
for Outer := 1 to Cases do
for Inner := 1 to Cases do begin
Result := MajorInt (NewInts[Outer], NewInts[Inner]);
Write ('max (');
WriteInt (Output, NewInts[Outer]);
Write (', ');
WriteInt (Output, NewInts[Inner]);
Write (') = ');
WriteInt (Output, Result);
WriteLn
end;
WriteLn;
WriteLn ('Test #22: MinorInt');
for Outer := 1 to Cases do
for Inner := 1 to Cases do begin
Result := MinorInt (NewInts[Outer], NewInts[Inner]);
Write ('min (');
WriteInt (Output, NewInts[Outer]);
Write (', ');
WriteInt (Output, NewInts[Inner]);
Write (') = ');
WriteInt (Output, Result);
WriteLn
end;
WriteLn;
WriteLn ('Test #23: ZeroInt');
for Index := 1 to Cases do begin
WriteInt (Output, NewInts[Index]);
if ZeroInt (NewInts[Index]) then
Write (' is ')
else
Write (' is not ');
WriteLn ('zero.')
end;
WriteLn;
WriteLn ('Test #24: NegativeInt');
for Index := 1 to Cases do begin
WriteInt (Output, NewInts[Index]);
if NegativeInt (NewInts[Index]) then
Write (' is ')
else
Write (' is not ');
WriteLn ('negative.')
end;
WriteLn;
WriteLn ('Test #25: PositiveInt');
for Index := 1 to Cases do begin
WriteInt (Output, NewInts[Index]);
if PositiveInt (NewInts[Index]) then
Write (' is ')
else
Write (' is not ');
WriteLn ('positive.')
end;
WriteLn;
WriteLn ('Test #26: MultipleInt');
for Outer := 1 to Cases do
for Inner := 1 to Cases do begin
WriteInt (Output, NewInts[Outer]);
Write (' is ');
if not MultipleInt (NewInts[Outer], NewInts[Inner]) then
Write ('not ');
Write ('an integer multiple of ');
WriteInt (Output, NewInts[Inner]);
WriteLn ('.')
end;
WriteLn;
WriteLn ('Test #27: EvenInt');
for Index := 1 to Cases do begin
WriteInt (Output, NewInts[Index]);
if EvenInt (NewInts[Index]) then
Write (' is ')
else
Write (' is not ');
WriteLn ('even.')
end;
WriteLn;
WriteLn ('Test #28: OddInt');
for Index := 1 to Cases do begin
WriteInt (Output, NewInts[Index]);
if OddInt (NewInts[Index]) then
Write (' is ')
else
Write (' is not ');
WriteLn ('odd.')
end;
WriteLn;
WriteLn ('Test #29: WriteInt, ReadInt');
Rewrite (Scratch);
for Index := 1 to Cases do begin
WriteInt (Scratch, NewInts[Index]);
WriteLn (Scratch)
end;
Close (Scratch);
Reset (Scratch);
Index := 1;
while not eof (Scratch) do begin
ReadInt (Scratch, Result, Success);
ReadLn (Scratch);
if Success then begin
Write ('ReadInt succeeded: ');
WriteInt (Output, NewInts[Index]);
Write (' = ');
WriteInt (Output, Result);
WriteLn;
DeallocateInt (Result);
Index := Index + 1
end
else
WriteLn ('ReadInt failed!')
end;
Close (Scratch);
WriteLn;
WriteLn ('Test #30: IntToPascalInteger');
for Index := 1 to Cases - 2 do begin
{ upper bound Cases - 2 to avoid out-of-range values }
WriteInt (Output, NewInts[Index]);
WriteLn (' = ', IntToPascalInteger (NewInts[Index]) : 1)
end;
WriteLn;
WriteLn ('Test #31: AssignInt');
AssignInt (Result, NewInts[Cases]);
WriteInt (Output, Result);
Write (' = ');
WriteInt (Output, NewInts[Cases]);
WriteLn;
WriteLn;
WriteLn ('Test #32: DeallocateInt');
for Index := 1 to Cases do begin
DeallocateInt (NewInts[Index]);
if NewInts[Index] = nil then
WriteLn ('Int #', Index : 1, ' successfully deallocated.')
end
end.