card.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>  <--------------


partial class CARD_COMMON{XTP < $CARDINAL{XTP}}

partial class CARD_COMMON{XTP < $CARDINAL{XTP}} is -- This partial class contains those constants and routines which are -- common to both the CARD class and the FIELD class of exact numbers. -- Version 1.1 Sep 98. Copyright K Hopper, U of Waikato -- Development History -- ------------------- -- Date Who By Detail -- ---- ------ ------ -- 20 Dec 96 kh Original from standard distribution -- 28 Sep 98 kh Factored out conversions to WHOLE_STR. include NUM_CODE ; -- simple non-arithmetic ops. 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 := false ; private const Max_Power : SAME := 19 ; -- temporary fixed value -- Creation of values from other numeric types create(val : INT) : SAME pre val.is_non_neg post result.int = val is return create(val.card) end ; create(val : INTI) : SAME pre (val.is_non_neg)and(val <= maxval.card.inti) is return create(val.card) end ; create(val : RAT) : SAME pre val.is_exact is return create(val.inti) end ; create(val : FLT) : SAME pre (val = val.truncate) and (val <= maxval.flt) post result.flt = val is return create(val.card) end ; create(val : FLTD) : SAME pre (val = val.truncate) and (val <= maxval.fltd) post result.fltd = val is return create(val.card) end ; inti : INTI pre true post true -- create(result) = self !circular! is -- This routine returns an infinite precision version of self. return INTI::create(self) end ; rat : RAT pre true post true -- create(result) = self !circular! is -- This routine returns an infinite precision version of self. return RAT::create(self) end ; flt : FLT pre true post true -- create(result) = self !circular! is -- This routine returns a floating point version of self. -- Built-in to this implementation. builtin CARD_FLT end ; fltd : FLTD pre true post true -- create(result) = self !circular! is -- This routine returns a double floating point version of self. It is -- an error if the value cannot be held in a FLTD (although this is -- unlikely. Built-in to this implementation. builtin CARD_FLTD end ; -- Properties of self is_even : BOOL is -- This predicate returns true if and only if self is an even valued number. builtin CARD_IS_EVEN end ; is_odd : BOOL is -- This predicate returns true if and only if self is an odd valued number. builtin CARD_IS_ODD end ; is_pos : BOOL is -- This predicate returns true if and only if self is greater than zero. return self /= zero end ; is_zero : BOOL is -- This predicate returns true if and only if self is zero. return self = zero end ; nil : SAME is -- This routine returns the value to be used to represent nil. -- This is the value maxval in this implementation. return maxval end ; is_nil : BOOL is -- This predicate returns true if and only if self is nil. return self = maxval end ; sign : NUM_SIGNS pre true post ((self > zero) and (result = NUM_SIGNS::Positive)) or (result = NUM_SIGNS::Zero) is -- Although a cardinal number is never negative, this three-valued -- routine returns 0 if self is zero and 1 otherwise (since self is never -- negative). if self > zero then return NUM_SIGNS::Positive else return NUM_SIGNS::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 CARD_IS_BETWEEN end ; in_range(rng : $RANGE{XTP}) : 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) and ((self - val) >= tolerance)) or ((self < val) and ((val - self) >= tolerance)) end ; is_exp2 : BOOL is -- This predicate returns true if and only if self is a power of two. return NUM_BITS::create(card).lowest = NUM_BITS::create(card).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_to(other : SAME) : BOOL is -- This predicate returns true if and only if self is relatively prime to other. return gcd(other) = one end ; max(other : SAME) : SAME pre true post ((other > self) and (result = other)) or (result = self) is -- This routine returns the larger of self and other. -- Built-in to this implementation. builtin CARD_MAX end ; min(other : SAME) : SAME pre true post ((other > self) and (result = self)) or (result = other) is -- This routine returns the lesser of self and other. -- Built-in to this implementation. builtin CARD_MIN end ; middle(first, second : SAME) : SAME pre true post ((self > first) and (first > second) and (result = first)) or ((self < first) and (self > second) and (result = self)) or (result = second) is -- This routine returns the result of min(second) being applied to max(first). return max(first).min(second) end ; square : SAME pre maxval.sqrt > self post result.sqrt = self is -- This routine returns the square of self. -- Built-in to this implementation. builtin CARD_SQUARE end ; cube : SAME pre (maxval / self) > square post (result / self) = square is -- This routine returns the cube of self. return square * self end ; pow(power : SAME) : SAME -- pre (power < (maxval / self)) -- post true -- better one?? is -- This routine returns the result of raising self to the parameter power. -- 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 else val : SAME := self ; res := one ; loop -- res * val^power = self ^ power0 if power.is_odd then res := res * val; end ; power := power / #SAME(2) ; -- Should optimise to a shift! while!(power > SAME::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 self. val : FLTD := fltd ; res : SAME ; if self = create(val.floor) then return create(val.sqrt.floor) else quotient : SAME := 1 ; res := self ; loop while!(quotient <= res) ; quotient := create(4) * quotient end ; loop while!(quotient /= create(1)) ; quotient := quotient / create(4) ; loc_temp : SAME := res + quotient ; res := res / create(2) ; if loc_temp <= res then res := res - loc_temp ; res := res + quotient end end end ; return res end ; exp2 : SAME pre (self < create(asize)) post (result.log2 = self) is -- This routine returns the number which is 2^self providing that this -- is representable, otherwise void is returned. if self >= create(asize) then return SAME::zero else return create(NUM_BITS::create.alter(card,setbit).card) end end ; exp10 : SAME pre ((maxval.log2 + create(10).log2) > 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 lookup for speed. if (asize > 32) and (self < Max_Power) then return create(10).pow(self) else return SAME::zero 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.card)).hash end ; ceiling(other : SAME) : SAME pre (maxval - self) < (other - one) post result >= self is -- This routine returns the smallest whole number value greater than -- or equal to self which is also a multiple of other. return ((self + other - create(1)) / other) * other 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. p. 34. me : SAME := self ; num : SAME := other ; loop until!(num = zero) ; res : SAME := me.mod(num) ; me := num ; num := res end ; return me end ; extended_gcd(other : SAME, out self_factor, out i_factor : SAME) : SAME pre true post ((result % self) = zero) and ((result % other) = zero) and (((self_factor * self) + (i_factor * other)) = result) is -- This routine returns the result of applying the extended Euclidean -- algorithm (Geddes et al, p36) to self and other. The three parts of -- the return value `g', `g1', and `g2' are such that `g' is the greatest -- common divisor of self and other and `g1 * self + g2 * other = g'. me : SAME := self ; val : SAME := other ; c1 : SAME := one ; d1 : SAME := zero ; c2 : SAME := zero ; d2 : SAME := one ; loop until!(val = zero) ; quotient : SAME := me / val ; res : SAME := me - quotient * val ; r1 : SAME := c1 - quotient * d1 ; r2 : SAME := c2 - quotient * d2 ; me := val ; c1 := d1 ; c2 := d2 ; val := res ; d1 := r1 ; d2 := r2 end ; self_factor := c1 / (self * me) ; i_factor := c2 / (self * me) ; return me end ; lcm(other : SAME) : SAME pre (maxval / other) < self post (result * gcd(other)) = (self * other) is -- This routine returns the least common multiple of self and other. return (self * other) / gcd(other) end ; factorial : SAME pre (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 := 1 ; loop res := res * create(2.upto!(card)) end ; return res end ; num_chars : CARD pre true post ((result - CARD::one).exp10 < self.card) -- (result.exp10 >= self) -- might not be representable!! is -- This routine returns the number of decimal digits in self. It uses -- binary search so that small values take only 3 comparisons. if self < create(10000) then if self < create(100) then if self < create(10) then return 1 else return 2 end else if self < create(1000) then return 3 else return 4 end end else if self < create(1000000) then if self < create(100000) then return 5 else return 6 end else return (self / create(10000)).num_chars + 4 end end end ; aelt! : BOOL is -- This iter is effectively a predicate which yields true or false -- depending upon whether the indicated bit of self was 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 CARD_TIMESB end ; times! : SAME pre true post (result < self) -- and (result = 0.up!) is -- This iter yields successive numbers from zero up to self - 1. -- Built-in to this implementation. builtin CARD_TIMESB_CARD end ; for!(once cnt : SAME) : SAME pre (maxval - self) <= (cnt - one) post (result >= self) and (result < cnt + self) -- and ((result = self) or (result = self.up!)) is -- This routine yields cnt successive integers starting with self. -- Built-in to this implementation. builtin CARD_FORB end ; up! : SAME pre true post result >= self is -- This iter yields successive numbers from self upwards. -- Built-in to this implementation. builtin CARD_UPB end ; upto!(once limit : SAME) : SAME is -- This iter yields successive numbers from self up to limit. -- "NOT" Built-in to this implementation. --builtin CARD_UPTOB; i::=self; if i>limit then quit; end; loop yield i; if i>=limit then quit; end; i:=i+#(1); end; end ; downto!(once limit : SAME) : SAME is -- This iter yields successively smaller numbers from self down to limit. -- "NOT" Built-in to this implementation. --builtin CARD_DOWNTOB; i::=self; if i<limit then quit; end; loop yield i; if i<=limit then quit; end; i:=i-#(1); end; end ; step!(once cnt : CARD, once step : INT) : SAME pre ((step > INT::zero) and (((maxval - self) / create(step)) >= create(cnt))) or ((step < INT::zero) and ((self / create(step.abs)) >= create(cnt))) post true is -- This iter yields cnt numbers starting with self and stepping by step. res : SAME := self ; if step.is_pos then loop cnt.times! ; yield res ; res := res + create(step) end else loop cnt.times! ; yield res ; res := res - create(step.abs) end end end ; stepto!(once to : SAME, once by : INT) : SAME pre by.is_non_zero is -- This iter yields succeeding integers from self to to by step by. -- It might quit immediately if self is aleady `beyond' to. res : SAME := self ; if by.is_pos then if (res > to) then quit; end; bc:SAME:=#(by); if to>=bc then t2:SAME:=to-bc; loop yield res ; if res > t2 then quit; end; res := res + bc; end else yield res; quit; end; else if (res < to) then quit; end; bc:SAME:=#(-by); t2:SAME:=to+bc; loop yield res ; if res < t2 then quit; end; res := res-bc; end end ; end ; sum!(other : SAME) : SAME pre true post (result >= other) 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 (result >= other) 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 ; binary!(once limit : SAME) : SAME pre limit >= one post (result >= one) and (result <= limit) is -- This iter yields successive doublings of the initial value (1) up to -- the given limit. res : SAME := one ; loc_limit : SAME := limit ; loop if res > loc_limit then quit end ; yield res ; if res > (XTP::maxval / XTP::two) then -- gone as far as possible quit else res := res + res end end end ; end ; -- CARD_COMMON

immutable class CARD < $CARDINAL{CARD}, $OPTION, $EXACT_FMT

immutable class CARD < $CARDINAL{CARD}, $OPTION, $EXACT_FMT is -- This immutable class is one of the most fundamental exact number -- classes. It has the value domain from 0 to some maximum value determined -- by the machine representation provided. All arithmetic on values of this -- class is unsigned, whether involving overflow detection or modular -- operations. This class inherits from AVAL{BIT}. The number of bits -- in the representation is identical to NUM_BITS::Num_Bits. -- -- NOTE The Sather language requires that Num_Bits be at least 32 to ensure -- portability of INT literals up to this size. -- -- Many of the operations are specified to raise exceptions on overflow. -- 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.1 Jun 2001. Copyright K Hopper, U of Waikato -- Development History -- ------------------- -- Date Who By Detail -- ---- ------ ------ -- 20 Dec 96 kh Original adapted from ICSI Sather dist. -- 3 Jun 01 kh Revised inclusion clauses include CARD_COMMON{CARD} ; include WHOLE_STR{CARD} Hexadecimal_Base -> private Hexadecimal_Base, Octal_Base -> private Octal_Base, Decimal_Base -> private Decimal_Base, is_whole -> private is_whole ; private p_str:STR is case self when 0 then return "0"; when 1 then return "1"; when 2 then return "2"; when 3 then return "3"; when 4 then return "4"; when 5 then return "5"; when 6 then return "6"; when 7 then return "7"; when 8 then return "8"; when 9 then return "9"; when 10 then return "10"; when 11 then return "11"; when 12 then return "12"; when 13 then return "13"; when 14 then return "14"; when 15 then return "15"; else return "x"; end; end; str_base(b:SAME):STR is -- str in base b for debug if void(self) then return "v"; end; s:STR:=""; i:SAME:=self; loop q:SAME:=i/b; r:SAME:=i-q*b; i:=q; s:=(r.p_str)+s; if i=0 then break!; end; end; return s end; create(val : QUADBITS) : SAME is -- This returns a cardinal value from the given bit-pattern. return val.card end ; create(val : CARD) : SAME is return val end ; create(val : FIELD) : SAME is return val.card end ; oct_create(str : STR) : SAME pre (is_whole(str) = CONVERSION_RESULTS::All_Right) post true is -- This routine creates the whole number corresponding to the textual -- representation contained in str in the given repertoire and encoding. return build_based(str.cursor,Octal_Base) end ; hex_create(str : STR) : SAME pre (is_whole(str) = CONVERSION_RESULTS::All_Right) post true is -- This routine creates the whole number corresponding to the textual -- representation contained in str in the given repertoire and encoding. return build_based(str.cursor,Hexadecimal_Base) end ; card : SAME is -- This routine returns a copy of self. Built-in to this implementation. builtin CARD_CARD end ; field : FIELD is -- This routine returns a copy of self. Built-in to this implementation. builtin CARD_CARD end ; int : INT pre (self < INT::maxval.card) post true -- (result.card = self) !circular! is -- This routine returns a copy of self as an integer provided that -- self has a value in the domain of integers, otherwise raising an -- exception. Built-in to this implementation. builtin CARD_INT end ; -- Arithmetic operations. plus(other : SAME) : SAME pre (maxval - other) >= self post (result - other) = self is -- This routine returns the unsigned sum of self and other. It raises -- an exception on overflow, when enabled. Built-in to this implementation. builtin CARD_PLUS end ; minus(other : SAME) : SAME pre self >= other post (result + other) = self is -- This routine returns the unsigned difference between self and other. -- It raises an exception on overflow or if the result would be negative, -- when enabled. Built-in to this implementation. builtin CARD_MINUS end ; times(other : SAME) : SAME pre (maxval / other) <= self post (result / other) = self is -- This routine returns the unsigned product of self and other. It -- raises an exception if the product can't be held in the result, when -- enabled. Built-in to this implementation. builtin CARD_TIMES end ; div(other : SAME) : SAME pre other /= 0 post (result * other) <= self is -- This routine returns the unsigned quotient of self and other. It -- raises an exception when other is 0, when enabled. Built-in to this -- implementation. builtin CARD_DIV end ; mod(other : SAME) : SAME pre other /= 0 post (result + ((self / other) * other)) = self is -- This routine returns the unsigned remainder of self divided by other. -- It raises an exception when other is 0, when enabled. Built-in to this -- implementation. builtin CARD_MOD end ; abs : SAME pre true post result = self is -- This routine is included for compatibility with the requirements -- of $NUMBER. It merely returns self. return card end ; log2 : SAME pre (self > 0) post true is -- This returns the value of log(self) to the base 2 as the nearest -- whole number value. return NUM_BITS::create(card).highest end ; next_exp2 : SAME pre (self <= (maxval / 2)) post result.is_exp2 and (result >= self) and (self > (result / 2)) is -- This routine returns the value res such that the following holds : -- res.is_pow_of_2 and res >= self > (res / 2) bit : SAME := NUM_BITS::create(card).highest ; if ~self.is_exp2 then bit := bit + one end ; return (NUM_BITS::create.alter(bit.card,setbit)).card end ; is_card(str : STR) : BOOL is -- This predicate returns true if and only if str represents a cardinal -- number in decimal notation. return is_whole(str) = CONVERSION_RESULTS::All_Right end ; is_prime : BOOL 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 := create(3).step!((create(sqrt) + two) / two, INT::two) ; if temp = self then return true elsif temp.evenly_divides(self) then return false end end ; return true end ; uptoward!(once limit : SAME) : SAME is -- This iter yields successive numbers self<=result<limit. i::=self; loop if i>=limit then quit; end; yield i; i:=i+#(1); end; end ; end ; -- CARD

immutable class FIELD < $CARDINAL{FIELD}, $OPTION, $EXACT_FMT

immutable class FIELD < $CARDINAL{FIELD}, $OPTION, $EXACT_FMT is -- This immutable class is one of the most fundamental exact number classes. -- It has the value domain from 0 to some maximum value determined -- by the machine representation provided. All arithmetic on values of this -- class is modular in the field zero to 2^asize. This class inherits from -- AVAL{BIT}. The number of bits in the representation is identical to -- NUM_BITS::Num_Bits. -- -- NOTE The Sather language requires that Num_Bits be at least 32 to ensure -- portability of INT literals up to this size. -- -- No operation results in an out of range value so no checking -- is required. -- -- References : -- Keith O. Geddes, Stephen R. Czapor, and George Labahn, "Algorithms -- for Computer Algebra", Kluwer Academic Publishers, Boston, 1992. -- Version 1.1 Jun 2001. Copyright K Hopper, U of Waikato -- Development History -- ------------------- -- Date Who By Detail -- ---- ------ ------ -- 20 Dec 96 kh Original -- 1 Jun 01 kh Hid octal/hexadecimal conversions include CARD_COMMON{FIELD}; include WHOLE_STR{FIELD} is_whole -> private is_whole, oct_str ->, hex_str -> ; create(val : QUADBITS) : SAME is -- This returns a field value from the given bit-pattern. return val.field end ; create(val : CARD) : SAME is return val.field end ; create(val : FIELD) : SAME is return val end ; is_lt(other : SAME) : BOOL is -- This predicate returns true if and only if self is less than other -- using the closed field arithmetic relation (ie the value with all bits set -- is less than the next value which has all bits clear!). if other = maxval then -- the special case return false else return card < other.card end end ; card : CARD is -- This routine returns a copy of self. Built-in to this implementation. builtin CARD_CARD end ; field : SAME is -- This routine returns a copy of self. Built-in to this implementation. builtin CARD_CARD end ; int : INT pre (self < INT::maxval.field) post true -- create(result) = self !circular! is -- This routine returns a copy of self as an integer provided that -- self has a value in the domain of integers. Built-in to this implementation. builtin CARD_INT end ; -- Arithmetic operations. plus(other : SAME) : SAME pre (maxval - other) >= self post (result - other) = self is -- This routine returns the sum of self and other modulo 2^asize. -- It never raises an exception. Built-in to this implementation. builtin FIELD_PLUS end ; minus(other : SAME) : SAME pre self >= other post (result + other) = self is -- This routine returns the difference between self and other modulo -- 2^asize. It never raises an exception. Built-in to this implementation. builtin FIELD_MINUS end ; times(other : SAME) : SAME pre (maxval / other) <= self post (result / other) = self is -- This routine returns the product of self and other modulo 2^asize. -- It never raises an exception. Built-in to this implementation. builtin FIELD_TIMES end ; div(other : SAME) : SAME pre other.is_zero.not post (result * other) <= self is -- This routine returns the unsigned quotient of self and other. Raises -- an exception when other is 0, when enabled. Built-in to this -- implementation. builtin FIELD_DIV end ; mod(other : SAME) : SAME pre other.is_zero.not post (result + ((self / other) * other)) = self is -- This routine returns the unsigned remainder of self divided by other. -- It raises an exception when other is 0, when enabled. Built-in to this -- implementation. builtin FIELD_MOD end ; abs : SAME pre true post result = self is -- This routine is included for compatibility with the requirements -- of $NUMBER. It merely returns self. return self 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(card).highest.field end ; next_exp2 : SAME pre (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 : SAME := (NUM_BITS::create(card).highest).field ; if ~self.is_exp2 then bit := bit + one end ; return (NUM_BITS::create.alter(bit.card,setbit)).card.field end ; is_field(str : STR) : BOOL is -- This predicate returns true if and only if str represents a field number. return is_whole(str) = CONVERSION_RESULTS::All_Right end ; is_prime : BOOL 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 ; loc_cnt : CARD := (card.sqrt + CARD::two) / CARD::two ; loop temp : SAME := create(3).step!(loc_cnt, INT::two) ; if temp = self then return true elsif temp.evenly_divides(self) then return false end end ; return true end ; end ; -- FIELD