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