int.sa
Generated by gen_html_sa_files from ICSI. Contact gomes@icsi.berkeley.edu for details
-------------------------> GNU Sather - sourcefile <-------------------------
-- Copyright (C) 2000 by K Hopper, University of Waikato, New Zealand --
-- This file is part of the GNU Sather library. It is free software; you may --
-- redistribute and/or modify it under the terms of the GNU Library General --
-- Public License (LGPL) as published by the Free Software Foundation; --
-- either version 2 of the license, or (at your option) any later version. --
-- This library is distributed in the hope that it will be useful, but --
-- WITHOUT ANY WARRANTY without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. See Doc/LGPL for more details. --
-- The license text is also available from: Free Software Foundation, Inc., --
-- 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA --
--------------> Please email comments to <bug-sather@gnu.org> <--------------
immutable class INT < $INTEGER{INT}, $OPTION, $EXACT_FMT
immutable class INT < $INTEGER{INT}, $OPTION, $EXACT_FMT is
-- This immutable class is one of the most fundamental exact number
-- classes. It has the value domain from an implementation specified minimum
-- to some maximum value also determined by the machine representation
-- provided. All arithmetic on values of this class is signed. This class
-- inherits from AVAL{BIT}. The number of bits in the representation is
-- identical to NUM_BITS::Num_Bits.
--
-- NOTE 1. The Sather language requires that Num_Bits be at least 32
-- to ensure portability of exact numeric literals up to this size.
--
-- 2. This implementation is provided for machines which carry out
-- twos complement exact arithmetic. Pre-conditions will need to be
-- modified in many cases where other representations are used.
--
-- 3. Some of the operations raise an exception on overflow or through
-- divide by zero! They are, however, only guaranteed to do this if
-- checking is enabled! Enabling checking, however, may affect
-- performance. Certain machines with appropriate hardware may perform
-- these checks even when checking is not enabled.
-- References :
-- Keith O. Geddes, Stephen R. Czapor, and George Labahn, "Algorithms
-- for Computer Algebra", Kluwer Academic Publishers, Boston, 1992.
-- Version 1.2 Sep 98. Copyright K Hopper, U of Waikato
-- Development History
-- -------------------
-- Date Who By Detail
-- ---- ------ ------
-- 20 Dec 96 kh Original adapted from standard distribution.
-- 5 Jan 97 kh Take into account $SIGNED
-- 29 Sep 98 kh Factored conversions out to INT_STR
include AVAL{BIT} asize -> ;
include COMPARABLE;
include BINARY ;
include INT_STR ;
const asize : CARD := 32 ;
--const asize : CARD := NUM_BITS::Num_Bits ;
-- This is a portable (for this class) definition of the size in bits.
const zero : SAME := 0 ; -- See $NFE.
const one : SAME := 1 ;
const two : SAME := 2 ;
const is_exact : BOOL := true ;
const is_limited : BOOL := true ;
const is_signed : BOOL := true ;
private const Max_Power := 19 ; -- temporarily constant!!!
-- four routines giving max and min values (see $NFE).
maxint : SAME
pre true
post true -- result + minint = - one
is
builtin INT_MAXINT
end ;
minint : SAME
pre true
post true -- result + maxint = - one
is
builtin INT_MININT
end ;
maxval : SAME
pre true
post result + minint = - one -- based on 2's complement arith.
is
return maxint
end ;
minval : SAME
pre true
post result + maxint = - one -- based on 2's complement arith.
is
return minint
end ;
create(val : QUADBITS ) : SAME is
-- This private routine creates a new code using the implementation
-- defined built-in facilities. The built-in merely returns the bit
-- pattern as a number without checking for overflow - not needed in
-- this bit pattern conversion operation.
builtin CARD_QUAD
end ;
build(cursor : BIN_CURSOR) : SAME
pre ~void(cursor) and (cursor.remaining > 0)
post true
is
-- This routine takes up to four octets from the string attached to
-- the cursor and returns the code value indicated.
return create(QUADBITS::build(cursor))
end ;
create(bits : BINSTR) : SAME
pre (bits.size = (NUM_BITS::Num_Bits / OCTET::Octet_Bits))
post true
is
-- This is the 'raw' creation operation from a storage pattern to an
-- integer number.
return create(QUADBITS::build(bits.cursor))
end ;
-- The following group of routines provides for conversion from
-- other numeric types, an exception being raised if not possible.
create(val : INT) : SAME is
return val
end ;
create(val : CARD) : SAME is
return val.int
end ;
create(val : FIELD) : SAME is
return val.int
end ;
create(val : INTI) : SAME is
return val.int
end ;
create(val : RAT) : SAME is
return val.int
end ;
create(val : FLT) : SAME is
return val.int
end ;
create(val : FLTD) : SAME is
return val.int
end ;
-- Now a group of conversion routines.
int : INT
pre true
post result = self
is
-- This routine returns a copy of itself.
builtin INT_INT
end ;
card : CARD
pre true
post true -- result.int = self !circular!
is
-- This routine returns a cardinal number which has the same value as
-- self - unless self is negative when an exception is raised.
builtin INT_CARD
end ;
field : FIELD
pre true
post true -- result.int = self !circular!
is
-- This routine returns a field (cardinal) number which has the same
-- value as self -- unless self is negative when an exception is raised.
builtin INT_FIELD
end ;
inti : INTI
pre true
post true -- result.int = self !circular!
is
-- This routine returns an infinite precision version of itself.
return INTI::create(self)
end ;
rat : RAT
pre true
post true -- result.int = self !circular!
is
-- This routine returns an infinite precision version of itself.
return RAT::create(self)
end ;
flt : FLT
pre true
post true -- result.int = self !circular!
is
-- This routine returns the value of itself as an approximate number.
-- Built-in to this implementation.
builtin INT_FLT
end ;
fltd : FLTD
pre true
post true -- result.int = self !circular!
is
-- This routine returns the value of itself as of itself as a double
-- length approximate number. Built-in to this implementation.
builtin INT_FLTD
end ;
binstr : BINSTR
pre true
post result.size = NUM_BITS::asize / OCTET::Octet_Bits
is
-- This routine is provided to convert from an integer number to
-- its binary string version.
return QUADBITS::create(self).binstr
end ;
-- Signed operations
plus(other : SAME) : SAME
pre ((self >= one)and (other < (maxint - self)))
or ((other >= one)and (self < (maxint - other)))
or (self.sign /= other.sign)
post true
is
-- This routine returns the signed sum of self and other provided that
-- the result is representable in the implementation-dependent value domain.
-- If not then an exception is raised. Built-in to this implementation.
builtin INT_PLUS
end ;
minus(other : SAME) : SAME
pre ((self > - one)and (other <= maxint))
or ((other > - one)and (self <= maxint))
or (self.sign = other.sign)
post true
is
-- This routine returns the signed difference between self and other
-- provided that the result is representable in the implementation-dependent
-- value domain. If not then an exception is raised. Built-in to this
-- implementation.
builtin INT_MINUS
end ;
times(other : SAME) : SAME
pre ((self.sign = other.sign)and ((maxint / other.abs) <= self.abs))
or ((minint / other).abs <= self.abs)
post true
is
-- This routine returns the signed product of self and other provided
-- that the result is representable in the implementation-dependent value
-- domain. If not then an exception is raised. Built-in to this
-- implementation.
builtin INT_TIMES
end ;
div(other : SAME) : SAME
pre (other /= zero)
post true
is
-- Providing that other is non-zero then this routine returns the signed
-- quotient of self and other. If not then an exception is raised.
-- Built-in to this implementation.
--
-- This routine and the modulus routine below have the property that
-- for non-zero value of other, then
--
-- self = self.div(other) * other + self.mod(other)
builtin INT_DIV
end ;
mod(other : SAME) : SAME
pre (other /= zero)
post true
is
-- Providing that other is non-zero then this routine returns the signed
-- remainder of self divided by other. If not then an exception is raised.
-- Built-in to this implementation.
--
-- This routine and the modulus routine below have the property that
-- for non-zero value of other, then
--
-- self = self.div(other) * other + self.mod(other)
-- and
-- 0 <= self.mod(other) < other.abs
builtin INT_MOD
end ;
negate : SAME
pre self > minint
post true
is
-- This routine returns the signed negation of self if the result is
-- representable in the implelmentation-dependent value domain, otherwise
-- an exception is raised. Built-in to this implementation.
builtin INT_NEGATE
end ;
plus(other:CARD): SAME is return self+(#SAME(other)); end;
minus(other:CARD): SAME is return self-(#SAME(other)); end;
times(other:CARD): SAME is return self*(#SAME(other)); end;
div(other:CARD): SAME is return self/(#SAME(other)); end;
mod(other:CARD): SAME is return self.mod(#SAME(other)); end;
pow(other:CARD): SAME is return self.pow(#SAME(other)); end;
negatable : BOOL is
-- This predicate returns true if and only if the implementation-
-- dependent value domain for this class contains a representation of
-- the negation of self, otherwise false. Built-in to this implementation.
builtin INT_NEG_POSSIBLE
end ;
-- Relational predicates.
is_eq(other : SAME) : BOOL is
-- This predicate returns true if and only if self and other represent
-- the same value.
builtin INT_IS_EQ
end ;
is_lt(other : SAME) : BOOL is
-- This predicate returns true if and only if self is less than other.
-- Built-in to this implementation.
builtin INT_IS_LT
end ;
-- Integer properties:
is_even : BOOL is
-- This predicate returns true if and only if self is an even valued number.
builtin INT_IS_EVEN
end ;
is_odd : BOOL is
-- This predicate returns true if and only if self is an odd valued number.
builtin INT_IS_ODD
end ;
is_pos : BOOL is
-- self>0
return self > zero
end ;
is_non_pos:BOOL is
-- self<=0
return self<=zero;
end;
is_neg : BOOL is
-- self<0
return self < zero
end ;
is_non_neg:BOOL is
-- self>=0
return self>=zero;
end;
is_zero : BOOL is
-- self=0
return self = zero
end ;
is_non_zero : BOOL is
-- self/=0
return self /= zero
end ;
is_one: BOOL is
return self=one;
end;
nil : SAME
pre true
post result = minval
is
-- This routine returns the value to be used to represent nil. This
-- is the largest negative value.
return minval
end ;
is_nil : BOOL is
-- This predicate returns true if and only if self is nil.
return self = minval
end ;
sign : NUM_SIGNS
pre true
post ((self > zero) and (result = NUM_SIGNS::Positive))
or ((self = zero) and (result = NUM_SIGNS::Zero))
or ((self < zero) and (result = NUM_SIGNS::Negative))
is
-- This three-valued routine returns 0 if self is zero, -1 if it is less
-- than zero and 1 otherwise.
if self > zero then
return NUM_SIGNS::Positive
elsif self < zero then
return NUM_SIGNS::Negative
else
return NUM_SIGNS::Zero
end
end ;
sgn:SAME is
-- return 1/0/-1
if is_pos then return one;
elsif is_neg then return -one;
else return zero;
end;
end;
in_range(lower, upper : SAME) : BOOL is
-- This predicate returns true if and only if self has a value between
-- lower and upper inclusive. Built-in to this implementation.
builtin INT_IS_BETWEEN
end ;
in_range(rng : $RANGE{INT}) : BOOL is
-- This predicate returns true if and only if self has a value within
-- the given range.
return rng.contains(self)
end ;
in_tolerance(tolerance, val : SAME) : BOOL is
-- This predicate returns true if and only if self is within the given
-- tolerance of val.
return (self - val).abs <= tolerance
end ;
is_exp2 : BOOL is
-- This predicate returns true if and only if self is a power of two.
return NUM_BITS::create(self).lowest = NUM_BITS::create(self).highest
end ;
evenly_divides(other : SAME) : BOOL is
-- This predicate returns true if and only if self is an exact divisor
-- of other.
return (other % self) = zero
end ;
is_prime : BOOL
pre (self > zero)
post true
is
-- This predicate returns true if and only if self is a prime number.
if self <= two then
return true
end ;
if two.evenly_divides(self) then
return false
end ;
loop
temp : SAME := 3.int.step!(((self.sqrt + two) / two).card, two) ;
if temp = self then
return true
elsif temp.evenly_divides(self) then
return false
end
end ;
return true
end ;
is_prime_to(other : SAME) : BOOL is
-- This predicate returns true if and only if self is relatively prime to other.
return gcd(other) = one
end ;
-- Other computation routines
max(other : SAME) : SAME
pre true
post ((self > other)and (result = self))
or (result = other)
is
-- This routine returns the greater of self and other. Built-in to
-- this implementation.
builtin INT_MAX
end ;
min(other : SAME) : SAME
pre true
post ((self > other) and (result = other)) or (result = self)
is
-- This routine returns the lesser of self and other. Built-in to this
-- implementation.
builtin INT_MIN
end ;
middle(first, second : SAME ) : SAME
pre true
post ((first >= self)
and (second <= self)
and (result = self))
or ((self > first)
and (second < first)
and (result = first))
or ((self > second)
and (first < second)
and (result = second))
is
-- This routine returns the value of the three numbers which lies between
-- the other two.
return max(first).min(second)
end ;
abs : SAME
pre (self > minint)
post ((self > zero) and (result = self)) or (result = -self)
is
-- This routine returns the absolute value of self provided that this
-- is representable in the implementation-dependent value domain, otherwise
-- an exception is raised. Built-in to this implementation.
-- NOTE Where it is desired to test for success before attempting to use
-- this routine the negatable routine will yield true if this routine
-- will succeed.
builtin INT_ABS
end ;
square : SAME
pre (maxint / abs) < abs
post (result / self) = self
is
-- This routine yields the square of self providing that the result is
-- representable in the implementation-dependent value domain, otherwise an
-- exception is raised.
builtin INT_SQUARE
end ;
cube : SAME
pre (maxint / abs) < square
post (result / self).abs = square
is
-- This routine yields the cube of self providing that the reult is
-- representable in the implementation-dependent value domain, otherwise an
-- exception is raised.
return self * self * self
end ;
pow(power : SAME) : SAME
pre (power >= zero)
post (result.abs).log(self.abs) = initial(power)
is
-- This routine returns the result of raising self to the given power
-- provided that the answer is representable, otherwise an exception is
-- raised. A short-cut case statement is provided for some common values.
res : SAME ;
case power
when zero then return one
when one then return self
when 2.int then return square
when 3.int then return square * self
when 4.int then res := square ; return res.square
when 5.int then res := square ; return self * res.square
when 6.int then res := square ; return res * res.square
when 7.int then res := square.square ; return self * square * res
when 8.int then res := square ; res := res.square ; return res.square
when 9.int then res := square ; res := res.square ; return self * res.square
when 10.int then res := square ; res := res.square ; return square * res.square
else
val : INT := self ;
res := one ;
loop
if power.is_odd then
res := res * val
end ;
power := power / two ; -- Should optimise to a shift!
while!(power > zero) ;
val := val.square
end ;
return res
end
end ;
sqrt : SAME
pre (self >= zero)
post (result.square <= self)
is
-- This routine returns the largest integer whose square is smaller
-- than or equal to self.
-- post ((result + 1).square > self) -- but this may not be representable!!
val : FLTD := fltd ;
res : SAME ;
if self = val.floor.int then
return val.sqrt.floor.int
else
quotient : SAME := one ;
res := self ;
loop
while!(quotient <= res) ;
quotient := 4.int * quotient
end ;
loop
while!(quotient /= one) ;
quotient := quotient / 4.int ;
loc_temp : SAME := res + quotient ;
res := res / two ;
if loc_temp <= res then
res := res - loc_temp ;
res := res + quotient
end
end
end ;
return res
end ;
exp2 : SAME
pre (self >= zero) and (self < asize.int)
post (result.log2 = self)
is
-- This routine returns the number which is 2^self if the pre-condition
-- is satisfied!
return NUM_BITS::create.alter(card,setbit).card.int
end ;
exp10 : SAME
pre (self >= zero) and (maxval.log(create(10)) >= self)
post true --------- ???????? a better one?
is
-- This routine returns 10^self provided that this is representable in
-- the value domain. The more usual small values use table lookup for speed.
case self
when zero then return one
when one then return 10
when 2.int then return 100
when 3.int then return 1000
when 4.int then return 10000
when 5.int then return 100000
when 6.int then return 1000000
when 7.int then return 10000000
when 8.int then return 100000000
when 9.int then return 1000000000
else return 10.int.pow(self)
end
end ;
hash : CARD
pre true -- no matter what self is
post true -- no matter what result is
is
-- This routine returns a hash value computed from self by successive
-- shifts and xors of the bit-pattern forming the numeric value.
return (NUM_BITS::create(self)).hash
end ;
ceiling(other : SAME) : SAME
pre (other > zero)
and ((self >= zero)
and ((maxint - self) < (other - one)))
or (self < zero)
post result >= self
is
-- This routine returns the smallest whole number value greater than
-- or equal to self which is a multiple of other. Notice the asymmetry
-- about zero!
if self < zero then return (self / other) * other
else
return ((self + (other - one)) / other) * other
end
end ;
gcd(other : SAME) : SAME
pre true
post ((self % result) = zero) and ((other % result) = zero)
is
-- This routine returns the greatest common divisor of self and other.
-- The result is positive and `other.gcd(0) = other.abs'. Uses Euclid's
-- algorithm. Geddes, et. al. p34.
a : SAME := self.abs ;
b : SAME := other.abs ;
loop
if a.is_zero then return b; end;
b:=b.mod(a);
if b.is_zero then return a; end;
a:=a.mod(b);
end;
end ;
extended_gcd(other:SAME, out f1, out f2:SAME):SAME
pre true
post ((result % self) = zero)
and ((result % other) = zero)
and (((f1 * self) + (f2 * other)) = result)
is
-- gcd = self*f1 + other*f2
a,b,q:SAME;
x:SAME:=one; y:SAME:=zero; u:SAME:=zero; v:SAME:=one;
if self.is_neg then x:=-x; a:=-self; else a:=self; end;
if other.is_neg then y:=-y; b:=-other; else b:=other; end;
loop
if b.is_zero then f1:=x; f2:=y; return a; end;
q:=a/b; a:=a-q*b; x:=x-q*u; y:=y-q*v; -- a.divmod(b,out q, out a);
if a.is_zero then f1:=u; f2:=v; return b; end;
q:=b/a; b:=b-q*a; u:=u-q*x; v:=v-q*y; -- b.divmod(a,out q, out b);
end;
end;
lcm(other : SAME) : SAME is
-- This routine returns the least common multiple of self and other.
-- pre ((self.sign = other.sign) and ((self.sign = NUM_SIGNS::Negative)and ((minint / other) > self))
--or ((self.sign /= NUM_SIGNS::Negative)and ((maxint / other) < self)))
--or ((self.sign /= NUM_SIGNS::Negative)and ((minint / self) > other))
--or ((self.sign = NUM_SIGNS::Negative)and ((minint / other) > self))
--post (result * gcd(other)) = (self * other).abs
return ((self/ gcd(other)) * other).abs
end ;
factorial : SAME
pre (self >= zero)
and ((self = zero) or ((maxval / (self - one).factorial) < (self - one).factorial))
post (result <= one) or ((result / self) = (self - one).factorial)
is
-- This routine returns the factorial of self.
res : SAME := one ;
loop
res := res * two.upto!(self)
end ;
return res
end ;
log(base : SAME) : SAME
pre (self > zero) and (base > zero)
post true
is
-- This returns the value of log(self) to the given base as the nearest
-- whole number value.
res : SAME := zero ;
val : SAME := self ;
loop
val := val / base ;
if val > zero then
res := res + one
else
break!
end
end ;
return res
end ;
log2 : SAME
pre (self > zero)
post true
is
-- This returns the value of log(self) to the base 2 as the nearest
-- whole number value.
return NUM_BITS::create(self).highest.int
end ;
next_exp2 : SAME
pre (self > zero) and (self <= (maxval / two))
post result.is_exp2 and (result >= self) and (self > (result / two))
is
-- This routine returns the value res such that the following holds :
-- res.is_pow_of_2 and res >= self > (res / 2)
res : SAME := zero ;
bit : CARD := NUM_BITS::create(self).highest ;
if ~self.is_exp2 then
bit := bit + CARD::one
end ;
return NUM_BITS::create.alter(bit,setbit).card.int
end ;
aelt! : BOOL is
-- This iter is effectively a predicate which yields true or false
-- depending upon whether the successive bits of self are set or not.
loop
yield [asize.times!].set
end
end ;
times!
pre (self >= zero)
post true -- all side-effect!!
is
-- This iter yields self times without returning a value. Built-in to
-- this implementation.
builtin INT_TIMESB
end ;
times! : SAME
pre (self >= zero)
post (result < self)
is
-- This iter yields successive numbers from zero up to self - 1. Built-in
-- to this implementation.
builtin INT_TIMESB_INT
end ;
for!(once cnt : SAME) : SAME
pre (cnt >= zero) and ((maxval - self) <= (cnt - one))
post (result < cnt + self)
is
-- This routine yields cnt successive integers starting with self.
-- Built-in to this implementation.
builtin INT_FORB
end ;
up! : SAME
pre true
post result >= self
is
-- This iter yields successive numbers from self upwards. This will
-- result in the raising of an exception for an out of range value if allowed
-- to continue indefinitely! Built-in to this implementation.
builtin INT_UPB
end ;
upto!( once limit : SAME) : SAME
post (result <= limit)
is
-- This iter yields successive integers from self to limit. Built-in
-- to this implementation.
--pre (limit >= self) -- otherwise does not make sense!
res : SAME := self ;
loop
until!(res > limit) ;
yield res ;
res := res + one
end
-- builtin INT_UPTOB
end ;
downto!(once limit : SAME) : SAME
post (result >= limit)
is
-- This iter yields successively smaller numbers from self down to
-- limit. Built-in to this implementation.
--pre (limit <= self) -- otherwise does not make sense!
res : SAME := self ;
loop
until!(res < limit) ;
yield res ;
res := res - one
end
--builtin INT_DOWNTOB
end ;
step!(once cnt : CARD, once step : SAME ) : SAME
pre (((step > zero)
and (((self >= zero)
and (((maxval - self) / step).card >= cnt))
or ((self < zero)
and (((maxval.card + self.abs.card) /
step.card) >= cnt))))
or ((step < zero)
and (((self >= zero)
and (self.card / step.card) >= cnt)
or ((self < zero)
and (((minval - self) / step).card >= cnt)))))
post true
is
-- This iter yields cnt numbers starting with self stepping by
-- the given step value
res : SAME := self ;
loop
cnt.times! ;
yield res ;
res := res + step
end
end ;
stepto!( once to, once by : SAME ) : SAME
pre by.is_non_zero
post ((by < zero) and (result < self))
or ((by > zero) and (result > self ))
is
-- This iter yields succeeding integers from self to to by the given step.
--pre ((by > zero)and (to > self)) or ((by < zero) and (to <= self))
res : SAME := self ;
if by > zero then
loop
until!(res > to) ;
yield res ;
res := res + by
end
else
loop
until!(res < to) ;
yield res ;
res := res + by
end
end
end ;
sum!(other : SAME) : SAME
pre true
post true
is
-- This iter yields the sum of all previous values of other. Note that
-- other is re-evaluated on each re-entry of the iter. Dependent on the
-- value provided this iter may result in an out of bounds value arising which
-- will cause an exception to be raised.
res : SAME := zero ;
loop
res := res + other ;
yield res
end
end ;
product!(other : SAME) : SAME
pre true
post true
is
-- This iter yields the product of all previous values of other. Note
-- that other is re-evaluated on each re-entry of the iter. Dependent on the
-- value provided this iter may therefore result in an out of bounds value
-- arising causing an exception to be raised.
res : SAME := one ;
loop
res := res * other ;
yield res
end
end ;
end ; -- INT