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


class INTI < $WHOLE_NUM{INTI}, $SIGNED{INTI}, $VALUE_ITERS{INTI}, $EXACT_FMT

class INTI < $WHOLE_NUM{INTI}, $SIGNED{INTI}, $VALUE_ITERS{INTI}, $EXACT_FMT is -- This class implements arbitrarily large integers. An integer is -- represented by n digits to a base B, ie, where array element zero is -- written first - -- -- x = sign * (x[0] + x[1]*B + ... + x[n-2]*B^(n-2) + x[n-1]*B^(n-1)) -- -- The n digits x[i] of x are held in an array with asize >= n. The -- sign and n are encoded in a private feature len, with the following -- semantics -- -- -- n = |len|, sign = sign(len) -- -- the value 0 is represented by len = 0 -- -- The operations div (/) and mod (%) obey the following rules -- -- x = (x/y)*y + x%y and 0 <= x%y < |y| -- -- NOTE 1. Objects of this class behave like an immutable class object. -- -- 2. WARNING The possibility of an infinite integer reaching -- the memory limit boundary is not considered in setting any pre -- and post condition!! -- Version 1.5 January 2001. Copyright K Hopper, U of Waikato -- Development History -- ------------------- -- Date Who By Detail -- ---- ------ ------ -- 20 Oct 93 rg Original -- 1 Jul 94 kh Modified for Sather 1.0 -- 17 Apr 97 kh Modified for portability. -- 28 Sep 98 kh Factored out conversions and added binary -- 15 Nov 99 kh Simplified structure -- 26 Jan 01 kk New is_prime from kdm@kobe-kosen.ac.jp include AREF{CARD} ; include COMPARABLE ; include BINARY ; include INTI_STR ; const is_exact : BOOL := true ; const is_limited : BOOL := false ; const is_signed : BOOL := true ; private const log2B : CARD := 15 ; private const Bin : CARD := 2 ^ log2B ; -- binary base private const Bin2 : CARD := Bin*Bin; private attr len : INT ; zero : SAME is -- This is a 'constant' of the value 0! return create(0) end ; one : SAME is -- This is a 'constant' of the value 1! return create(1) end ; two : SAME is -- This routine returns the value two. return create(2) end ; nil : SAME is -- This routine returns a nil value which may not be used in arithmetic. me : SAME := new(0) ; me.len := INT::zero ; return me end ; build(cursor : BIN_CURSOR) : SAME pre ~void(cursor) and (cursor.remaining >= 2) post true is -- This routine builds an INTI object from the given binary string, -- the first octet of which is deemed to be a digit count of the following -- octets which contain the value as a sequence of cardinal binary strings, -- the first being the LS value in the array being created (although, of -- course, individual cardinal values are in the binary string MS octet first!). loc_length : INT := cursor.int ; -- negative if sign is negative! assert(loc_length > INT::minval) ; -- shouldn't be this! loc_size : CARD := loc_length.abs.card ; me : SAME := new(loc_size + 1) ; me.len := loc_length ; if loc_size /= CARD::zero then loop index : CARD := CARD::zero.upto!(loc_size - 1) ; me[index] := cursor.card end end ; return me end ; create(val : CARD) : SAME is -- This routine creates an INTI from the given cardinal value. me : SAME ; if val = 0 then -- special case me := new(1) ; me.len := INT::zero else index : CARD := CARD::zero ; me := new(NUM_BITS::create(val).highest / log2B + CARD::one) ; loop while!(val /= CARD::zero) ; me[index] := val % Bin ; val := val / Bin ; index := index + CARD::one end ; me.len := index.int end ; return me end ; create(val : FIELD) : SAME is -- This routine creates an INTI from the given field value. return create(val.card) end ; create(val : INT) : SAME is -- This routine creates an INTI from the given integer value. me : SAME ; if val.is_nil then -- prevent overflow me := -(two ^ (INT::asize.int - INT::one)) elsif val.is_zero then -- special case me := new(1) ; me.len := INT::zero else abs_val : CARD := val.abs.card ; index : CARD := CARD::zero ; me := new(NUM_BITS::create(abs_val).highest / log2B + CARD::one) ; loop while!(abs_val /= CARD::zero) ; me[index] := abs_val % Bin ; abs_val := abs_val / Bin ; index := index + CARD::one end ; if val < INT::zero then me.len := -index.int else me.len := index.int end end ; return me end ; create(val : INTI) : SAME is -- This routine returns the argument -- a vacuous routine. return val end ; create(val : RAT) : SAME is -- This routine creates an INTI from the given rational value, -- using the value rounded to the nearest whole number. return val.round.inti end ; create(val : FLT) : SAME is -- Provided that val is an integer value, this routine creates -- an equivalent valued INTI object. if val = FLT::zero then return zero elsif val.abs < FLT::one then return zero; --SYS_ERROR::create.error(self,SYS_EXCEPT::Range_Error,val.str) end ; neg : BOOL ; loc_exp : INT ; loc_mantissa : INT ; val.get_representation(out neg,out loc_exp,out loc_mantissa) ; mantissa:SAME:=create(loc_mantissa)+two.pow(FLT::mantissa_bits-1); loc_exp:=loc_exp-FLT::max_exp-FLT::mantissa_bits.int+2; me:SAME; if loc_exp.is_neg then me := mantissa / two.pow(-loc_exp) ; else me := mantissa * two.pow(loc_exp) ; end; if neg then return -me; else return me; end; end ; create(val : FLTD) : SAME is -- Provided that val is an integer value, this routine creates -- an equivalent valued INTI object. if val = FLTD::zero then return zero elsif val.abs < FLTD::one then return zero; --SYS_ERROR::create.error(self,SYS_EXCEPT::Range_Error,val.str) end ; neg : BOOL ; loc_exp : INT ; loc_mantissa_lo : CARD ; loc_mantissa_hi : CARD ; val.get_representation(out neg,out loc_exp, out loc_mantissa_lo, out loc_mantissa_hi) ; mantissa:SAME:=two.pow(FLTD::mantissa_bits-1) +create(loc_mantissa_hi)*two.pow(CARD::Num_Bits) +create(loc_mantissa_lo); loc_exp:=loc_exp-FLTD::max_exp-FLTD::mantissa_bits.int+2; me:SAME; if loc_exp.is_neg then me := mantissa / two.pow(-loc_exp) ; else me := mantissa * two.pow(loc_exp); end; if neg then return -me; else return me; end; end ; binstr : BINSTR pre ~void(self) and (len.abs.card <= asize) post create(result) = self is -- This routine returns the binary string form of the value represented -- by self with a leading integer for len. if len.is_zero then return len.binstr else loc_length : CARD := len.abs.card ; res : FBINSTR := FBINSTR::create(loc_length) + len.binstr ; loop index : CARD := 0.upto!(loc_length - 1) ; res := res + [index].binstr end ; return res.binstr end end ; private u_plus( left, right : SAME ) : SAME pre ~void(left) and ~void(right) post true is -- This routine implements unsigned addition for two infinite integers. first_length : CARD := left.len.abs.card ; second_length : CARD := right.len.abs.card ; length : CARD := first_length.min(second_length) ; index : CARD := CARD::zero ; digit : CARD := CARD::zero ; res : SAME ; res := new(first_length.max(second_length) + CARD::one) ; loop -- over elements in common while!(index < length) ; digit := digit + left[index] + right[index] ; res[index] := digit % Bin ; digit := digit / Bin ; index := index + CARD::one end ; loop -- over extras in left (if any) while!(index < first_length) ; digit := digit + left[index] ; res[index] := digit % Bin ; digit := digit / Bin ; index := index + CARD::one end ; loop -- over extras in right (if any) while!(index < second_length) ; digit := digit + right[index] ; res[index] := digit % Bin ; digit := digit / Bin ; index := index + CARD::one end ; if digit /= CARD::zero then res[index] := digit ; index := index + CARD::one end ; res.len := index.int ; return res end ; private u_minus( first, second : SAME ) : SAME pre ~void(first) and ~void(second) post true is -- This routine implements unsigned subtraction of second from first. -- Assume that first.abs >= second.abs. first_length : CARD := first.len.abs.card ; second_length : CARD := second.len.abs.card ; index : CARD := CARD::zero ; digit : CARD := CARD::zero ; res : SAME ; B1::=Bin-1; res := new(first_length) ; digit:=Bin; loop while!(index < second_length) ; digit := digit + first[index] - second[index] ; res[index] := digit % Bin ; digit := digit / Bin + B1; index := index + CARD::one end ; loop while!(index < first_length) ; digit := digit + first[index] ; res[index] := digit % Bin ; digit := digit / Bin + B1; index := index + CARD::one end ; loop -- index = first_length here! while!((index > CARD::zero) and (res[index - CARD::one] = CARD::zero)) ; index := index - CARD::one end ; res.len := index.int ; return res end ; private u_times( first, second : SAME ) : SAME pre ~void(first) and ~void(second) post true is -- This routine implements unsigned arithmetic multiplication of infinite numbers. first_length : CARD := first.len.abs.card ; second_length : CARD := second.len.abs.card ; index, twodex, threedex : CARD ; digit, product : CARD ; index := first_length + second_length ; res : SAME := new(index) ; loop -- initialise all elements! while!(index > CARD::zero) ; index := index - CARD::one ; res[index] := CARD::zero end ; -- Index is zero here! loop -- over 'first' array while!(index < first_length) ; digit := first[index] ; if digit /= CARD::zero then twodex := CARD::zero ; threedex := index ; product := CARD::zero ; loop -- over second array while!(twodex < second_length) ; product := product + res[threedex] + digit * second[twodex] ; res[threedex] := product % Bin ; product := product / Bin ; twodex := twodex + CARD::one ; threedex := threedex + CARD::one end ; if product /= CARD::zero then -- something left over! res[threedex] := product ; threedex := threedex + CARD::one end end ; index := index + CARD::one end ; res.len := threedex.int ; return res end ; private copy : SAME pre ~void(self) post result = self is -- This private routine returns an identical infinit integere to self. index : CARD := len.abs.card ; res : SAME := new(index + CARD::one) ; res.len := len ; loop while!(index > CARD::zero) ; index := index - CARD::one ; res[index] := [index] end ; return res end ; private u_div_mod(first, second : SAME ) : SAME pre ~void(first) and ~void(second) post true is -- This routine implements unsigned division/modulus for infinite integers. first_length : CARD := first.len.abs.card ; second_length : CARD := second.len.abs.card ; index,twodex,threedex : CARD ; dividend,digit,quotient,second_1,second_2 : CARD ; first := first.copy ; if second_length = CARD::one then index := first_length - CARD::one ; dividend := CARD::zero ; digit := second[CARD::zero] ; loop dividend := dividend * Bin + first[index] ; first[index + CARD::one] := dividend / digit ; dividend := dividend % digit ; if index = CARD::zero then break!; end ; index := index - CARD::one end ; first[CARD::zero] := dividend elsif first_length >= second_length then first[first_length] := CARD::zero ; digit := ((Bin / CARD::two) - CARD::one) / second[second_length - CARD::one] + CARD::one ; if digit /= CARD::one then second := second.copy ; index := CARD::zero ; dividend := CARD::zero ; loop while!(index < first_length) ; dividend := dividend + digit * first[index] ; first[index] := dividend % Bin ; dividend := dividend / Bin ; index := index + CARD::one end ; first[index] := dividend ; index := CARD::zero ; dividend := CARD::zero ; loop while!(index < second_length) ; dividend := dividend + digit * second[index] ; second[index] := dividend % Bin ; dividend := dividend / Bin ; index := index + CARD::one end ; assert dividend = CARD::zero end ; second_1 := second[second_length - CARD::one] ; second_2 := second[second_length - CARD::two] ; index := first_length ; loop while! (index >= second_length) ; if first[index] /= second_1 then quotient := (first[index] * Bin + first[index - 1]) / second_1 else quotient := Bin - CARD::one end ; loop while!((second_2 * quotient) > (first[index] * Bin + first[index - CARD::one] - second_1 * quotient) * Bin + first[index - CARD::two]) ; quotient := quotient - CARD::one end ; twodex := index - second_length ; threedex := CARD::zero ; dividend := CARD::zero + Bin; loop while!(threedex < second_length) ; dividend :=(Bin2+ dividend + first[twodex]) - Bin - quotient * second[threedex] ; -- shift by Bin2 first[twodex] := dividend % Bin ; dividend := dividend / Bin ; twodex := twodex + CARD::one ; threedex := threedex + CARD::one end ; -- if dividend+first[index]-Bin /= CARD::zero then if dividend+first[index] /= Bin then -- kdm twodex := index - second_length ; threedex := CARD::zero ; dividend := CARD::zero ; loop while!(threedex < second_length) ; dividend := dividend + first[twodex] + second[threedex] ; first[twodex] := dividend % Bin ; dividend := dividend / Bin ; twodex := twodex + CARD::one ; threedex := threedex + CARD::one end ; first[index] := quotient - CARD::one else first[index] := quotient end ; index := index - CARD::one end ; if digit /= CARD::one then index := second_length ; dividend := CARD::zero ; loop while!(index > CARD::zero) ; index := index - CARD::one ; dividend := dividend * Bin + first[index] ; first[index] := dividend / digit ; dividend := dividend % digit end end end ; return first end ; private get_u_div(first, second, quotient : SAME ) : SAME pre ~void(first) and ~void(second) and ~void(quotient) post true is -- This routine provides the implementation of unsigned division from the given quotient. index : CARD := first.len.abs.card ; second_length : CARD := second.len.abs.card ; loop while!((index >= second_length) and (quotient[index] = CARD::zero)) ; index := index - CARD::one end ; res : SAME := new(index + CARD::one - second_length) ; res.len := index.int - second_length.int + INT::one ; loop while!(index >= second_length) ; res[index - second_length] := quotient[index] ; index := index - CARD::one end ; return res end ; private get_u_mod( first, second, quotient : SAME ) : SAME pre ~void(first) and ~void(second) and ~void(quotient) post true is -- This routine implements unsigned modulus, taking the result from the given quotient. index : CARD := first.len.abs.min(second.len.abs).card ; loop if (index = CARD::zero) or (quotient[index - 1] /= CARD::zero) then break! else index := index - CARD::one end end ; res : SAME := new(index) ; res.len := (index).int ; loop if index = CARD::zero then break! else index := index - CARD::one end ; res[index] := quotient[index] end ; return res end ; private u_cmp( first, second : SAME ) : INT pre ~void(first) and ~void(second) post true is -- This routine implements unsigned comparison returning a negative -- number if first < second, zero if they are equal and a positive number -- if first is greater than second. index : CARD := first.len.abs.card ; -- originally a length second_length : CARD := second.len.abs.card ; res : INT ; if (index = second_length) and (index > CARD::zero) then index := index - CARD::one ; -- it is now an index! loop while!((index > CARD::zero) and (first[index] = second[index])) ; index := index - CARD::one end ; res := first[index].int - second[index].int else res := index.int - second_length.int end ; return res end ; private u_times_plus( val : SAME, factor, coeff : CARD ) : SAME pre ~void(val) and ~(factor = CARD::zero) and (factor < Bin) and ~(coeff = CARD::zero) and (coeff < Bin) post true is -- This routine returns the product of val by factor to the given decimal coefficient val_length : CARD := val.len.abs.card ; index : CARD := CARD::zero ; res : SAME := new(val_length + CARD::one) ; loop while!(index < val_length) ; coeff := coeff + val[index] * factor ; res[index] := coeff % Bin ; coeff := coeff / Bin ; index := index + CARD::one end ; if coeff /= CARD::zero then res[index] := coeff ; index := index + CARD::one end ; res.len := index.int ; return res end ; private u_mod( val : SAME, divisor : CARD ) : CARD pre ~void(val) and (divisor >= CARD::one) and (divisor < Bin) post true is -- This routine implements unsigned modulus for an integer divisor. -- Val is modified. val_length : CARD := val.len.abs.card ; index : CARD := val_length ; coeff : CARD := CARD::zero ; loop while!(index > CARD::zero) ; index := index - CARD::one ; coeff := coeff * Bin + val[index] ; val[index] := coeff/divisor ; coeff := coeff % divisor end ; if val[val_length - CARD::one] = CARD::zero then val.len := (val_length - CARD::one).int end ; return coeff end ; plus( other : SAME ) : SAME pre ~void(self) and ~void(other) post true is -- This routine implements signed arithmetic addition for infinite integers. res : SAME ; if (len < INT::zero) = (other.len < INT::zero) then res := u_plus(self, other) elsif u_cmp(self, other) < INT::zero then res := u_minus(other, self) ; res.len := -res.len else res := u_minus(self, other) end ; if len < INT::zero then res.len := -res.len; end ; return res end ; minus( other : SAME ) : SAME pre ~void(self) and ~void(other) post true is -- This routine implements signed arithmetic subtraction of other from -- self fo infinite integers. res : SAME ; if (len < INT::zero) /= (other.len < INT::zero) then res := u_plus(self, other) elsif u_cmp(self, other) < INT::zero then res := u_minus(other, self) ; res.len := -res.len else res := u_minus(self, other) end ; if len < INT::zero then res.len := -res.len end ; return res end ; times( other : SAME ) : SAME pre ~void(self) and ~void(other) post true is -- This routine implements the signed product operation for infinite integers. -- Note that the calls to u_times ensure that the first argument is shorter. res : SAME ; if (len = INT::zero) or (other.len = INT::zero) then -- short-cut zero res := zero elsif (len.abs = INT::one) and (other.len.abs = INT::one) then -- simple short-cut res := create([CARD::zero] * other[CARD::zero]) else -- need to work it out if (len.abs < other.len.abs) then res := u_times(self, other) else res := u_times(other, self) end end ; if (len < INT::zero) /= (other.len < INT::zero) then res.len := -res.len end ; return res end ; div(other : SAME) : SAME pre ~void(self) and ~void(other) and (other /= zero) post true is -- This routine implements integer division for infinite integers. res : SAME ; if len.abs < other.len.abs then -- special short-cut! res := zero else quotient_result : SAME := u_div_mod(self, other) ; res := get_u_div(self, other, quotient_result) ; if (len < INT::zero) and (get_u_mod(self,other, quotient_result).len /= INT::zero) then res := u_times_plus(res, CARD::one, CARD::one) end ; if (len < INT::zero) /= (other.len < INT::zero) then res.len := -res.len end end ; return res end ; mod(other : SAME) : SAME pre ~void(self) and ~void(other) and (other /= zero) post true is -- This routine implements the integer modulus operation for infinite integers. res : SAME ; if (len.abs < other.len.abs) then -- special case short-cut res := self else res := get_u_mod(self, other, u_div_mod(self, other)) ; if (len < INT::zero) and (res.len /= INT::zero) then res := u_minus(other, res) end end ; return res end ; pow(exp : SAME ) : SAME pre ~void(self) and ~void(exp) and (exp.is_non_neg) and (exp <= Max_Int) post true is -- This routine returns self to the power exp. temp : SAME := self ; res : SAME := one ; t::=two; loop while!(exp.is_pos) ; -- Only for positive exponent if exp.is_odd then res := res * temp; end ; temp := temp.square ; exp := exp / t; end ; return res; end ; plus(other:INT): SAME is return self+(#SAME(other)); end; minus(other:INT): SAME is return self-(#SAME(other)); end; times(other:INT): SAME is return self*(#SAME(other)); end; div(other:INT): SAME is return self/(#SAME(other)); end; mod(other:INT): SAME is return self.mod(#SAME(other)); end; pow(other:INT): SAME is return self.pow(#SAME(other)); 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; private const Default : CARD := 289201 ; -- for an 'empty' number private const Prime : FIELD := 19 ; -- Hashing constant hash : CARD pre ~void(self) post true is -- This routine implements a hash function on an infinite integer. res : FIELD := FIELD::zero ; index : CARD := CARD::zero ; loop res := (res + [index].field + index.field) * Prime ; index := index + CARD::one ; until!(index >= asize) end ; return res.card end ; cmp(other : SAME) : INT pre ~void(self) and ~void(other) post true is -- This routine implements infinite number comparison, returning -- a negative number if self is less than other, zero if they are the same -- number and a positive value if self is greater than other. if (len = INT::zero) then return -other.len elsif (len < INT::zero) /= (other.len < INT::zero) then return len elsif (len < INT::zero) then -- need to compare values! return u_cmp(other, self) else return u_cmp(self, other) end end ; is_eq(other : SAME) : BOOL is -- This predicate returns true if and only if self and other have the same value. return SYS::ob_eq(self, other) or (cmp(other) = INT::zero) end ; is_lt(other : SAME) : BOOL is -- This predicate returns true if and only if self is less than other. return cmp(other) < INT::zero end ; is_even : BOOL is -- This predicate returns true if and only if self is an even number. assert Bin.is_even ; return (len = INT::zero) or [CARD::zero].is_even end ; is_odd : BOOL is -- This predicate returns true if and only if self is an odd number. assert Bin.is_even ; return (len /= INT::zero) and [CARD::zero].is_odd end ; is_pos : BOOL is -- This predicate returns true if and only if self is greater than zero. return len > INT::zero end ; is_non_pos : BOOL is return is_pos.not end ; is_neg : BOOL is -- This predicate returns true if and only if self is less than zero. return len < INT::zero end ; is_non_neg : BOOL is return is_neg.not; end ; is_zero : BOOL is -- This predicate returns true if and only if self is zero. return (len = INT::zero) -- and (asize > 0) end ; is_non_zero : BOOL is return is_zero.not; end; is_one:BOOL is return self=one; end; is_exp2 : BOOL pre ~ void(self) and (self >= zero) post true is -- This predicate returns true if and only if self is an exact power of two! loc_val : SAME := zero ; loop tmp : SAME := loc_val.exp2 ; if tmp > self then break! elsif tmp = self then return true else loc_val := loc_val + one end end ; return false end ; is_nil : BOOL is -- This predicate returns true if and only if self has the value nil. return self = nil end ; in_range(lower, upper : SAME) : BOOL is -- true if and only if lower<= self <= upper. return (lower <= self and self <= upper) end ; in_range(rng : $RANGE{INTI} ) : 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 ; private const Max_Int : SAME := create(INT::maxval) ; private const Min_Int : SAME := create(INT::minval) ; private const Max_Card : SAME := create(CARD::maxval) ; private const Max_Float : SAME := create(FLT::maxval.truncate) ; private const Max_Double : SAME := create(FLTD::maxval.truncate) ; card : CARD pre ~void(self) and (self <= Max_Card) post create(result) = self is -- This routine attempts to convert the infinite integer which is self -- into a cardinal value. index : CARD := len.abs.card ; res : CARD := CARD::zero ; loop while!(index > CARD::zero) ; index := index - CARD::one ; res := res * Bin + [index] end ; return res end ; field : FIELD pre ~void(self) post (create(result) = self % FIELD::maxval.inti) is -- This routine attempts to convert the infinite integer which is self -- into a field value provided that self is in range, otherwise an exception -- is raised. Note that the result will always exist given the properties -- of field arithmetic! return FIELD::create((self % FIELD::maxval.inti).card) end ; int : INT pre ~void(self) and (self <= Max_Int) and (self >= Min_Int) post true -- ||| RECURSIVE||| create(result) = self is -- This routine attempts to convert the infinite integer which is self -- into an ordinary integer value, provided that it is within range, -- otherwise an exception is raised on self. index : CARD := len.abs.card ; res : CARD := CARD::zero ; loop while!(index > CARD::zero) ; index := index - CARD::one ; res := res * Bin + [index] end ; if len < INT::zero then return -res.int else return res.int end end ; inti : INTI pre ~void(self) post result = self is -- This routine merely returns self! return self end ; rat : RAT pre ~void(self) post result.inti = self is -- This routine merely returns self! return RAT::create(self) end ; flt : FLT pre (~void(self) and (self <= Max_Float) and (self >= -Max_Float)) post true -- (result.inti = self) is -- This routine returns the floating point number representing self -- provided that it is within range. index : CARD := len.abs.card ; res : FLT := FLT::zero ; loop while!(index > CARD::zero) ; index := index - CARD::one ; res := res * Bin.flt + [index].flt end ; if len < INT::zero then res := -res end ; return res end ; fltd : FLTD pre ~void(self) and (self <= Max_Double) and (self >= -Max_Double) post true -- (result.inti = self) is -- This routine returns the double length floating point number -- representing self provided that it is within range, otherwise an exception -- is raised. index : CARD := len.abs.card ; res : FLTD := FLTD::zero ; loop while!(index > CARD::zero) ; index := index - CARD::one ; res := res * Bin.fltd + [index].fltd end ; if len < INT::zero then res := -res end ; return res end ; abs : SAME pre ~void(self) post ((self < zero)and (result = -self)) or ((self >= zero) and (result = self)) is -- This routine returns the absolute value of self. if len < INT::zero then res : SAME := copy ; res.len := -len ; return res else return self end end ; negate : SAME pre ~void(self) post (result.len = - len) is -- This routine returns the negated value of self. if len /= INT::zero then res : SAME := copy ; res.len := -len ; return res else return self end end ; negatable : BOOL is -- This predicate returns true if and only if this class is numeric and -- negatable -- trivially true! return true end ; sign : NUM_SIGNS pre ~void(self) post ((self > zero)and (result = NUM_SIGNS::Positive)) or ((self = zero) and (result = NUM_SIGNS::Zero)) or (result = NUM_SIGNS::Negative) is -- This routine returns the sign state of self. if self = zero then return NUM_SIGNS::Zero elsif self < zero then return NUM_SIGNS::Negative else return NUM_SIGNS::Positive end end ; sgn:SAME is -- return int value of 1/0/-1 if is_pos then return one; elsif is_neg then return -one; else return zero; end; end; square : SAME pre ~void(self) post result = self * self is -- This routine returns the result of squaring self. return self * self end ; cube : SAME pre ~void(self) post result = self * self * self is -- This routine returns the result of cubing self (by multiplication!) return self * self * self end ; log2 : INTI pre ~void(self) and (len > INT::zero) post (result.exp2 <= self) and ((result + one).exp2 > self) is -- This routine returns the largest integer whose power of two is not -- less than self. res : INT := (len - INT::zero) * log2B.int + NUM_BITS::create([(len - INT::one).card]).highest.int ; return create(res) end ; exp2 : SAME pre ~ void(self) and (self >= zero) post true is -- This routine returns the result of raising 2 to the power self! return two.pow(self) end ; exp10 : SAME pre ~ void(self) and (self >= zero) post true is -- This routine returns the result of raising 10 to the power self! return create(10).pow(self) end ; sqrt : SAME pre ~void(self) and (self >= zero) post (result.square <= self) and ((result + one).square > self) is -- This routine returns the square root of self which is calculated by -- iteration until the value is constant or oscillating. if len = INT::zero then return zero end ; temp : SAME := self ; res : SAME ; loop res := temp ; temp := (temp + self / temp)/two ; until!(temp >= res) end ; return res end ; factorial : SAME pre ~void(self) and (self >= zero) post true is -- self!. -- This routine calculates the factorial of self. Since this is an -- infinite integer 'type' then this will always work unless limited by -- processor memory or self is not convertible to an integer! i::=self; r:INTI:=one; loop while!(i.is_pos); r:=r*i; i:=i-one; end; return r; end ; is_fpsp(base : INTI) : BOOL is -- This routine returns true if and only if self is either prime or -- Fermat's pseudo-prime of the given base. one_less : SAME := self - one ; -- This starts out as even! base_num : SAME := base ; base_denom : SAME := one ; loop while!(one_less.is_pos) ; if one_less.is_odd then base_denom := (base_denom * base_num) % self end ; one_less :=one_less / two ; base_num := (base_num * base_num) % self end ; return base_denom = one end ; is_prime : BOOL is -- This predicate returns true if and only if self is a prime number. -- This is not a fast implementation! if is_even then if self = two then return true else return false end elsif 3.inti.evenly_divides(self) then if self = 3.inti then return true else return false end elsif 5.inti.evenly_divides(self) then if self = 5.inti then return true else return false end elsif 7.inti.evenly_divides(self) then if self = 7.inti then return true else return false end elsif 11.inti.evenly_divides(self) then if self = 11.inti then return true else return false end elsif 13.inti.evenly_divides(self) then if self = 13.inti then return true else return false end elsif self < two then return false end ; -- At this point the number is odd and greater than 13 -- Check if spsp or fpsp. if (self > 1000000000.inti) and ~is_fpsp(13.inti) then -- the last prime tested return false end ; sqrt_self : SAME := self.sqrt ; -- answer must be less than this r1 : SAME := 17.inti ; -- next two primes as temps r2 : SAME := 19.inti ; loop while!(r1 <= sqrt_self) ; if r1.evenly_divides(self) then return false elsif r2.evenly_divides(self) then return false end ; r1 := r1 + 6.inti ; r2 := r2 + 6.inti 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 ; max(other : SAME) : SAME pre ~void(self) and ~void(other) post ((self > other) and (result = self)) or (result = other) is -- This routine returns the greater of self and other. if cmp(other) > INT::zero then return self else return other end end ; min(other : SAME) : SAME pre ~void(self)and ~void(other) post ((self > other)and (result = other)) or (result = self) is -- This routine returns the lesser of self and other. if cmp(other) < INT::zero then return self else return other end end ; evenly_divides(val : SAME) : BOOL is -- This predicate returns true if and only if there is no remainder when -- dividing self by val. return (val % self).len = INT::zero end ; ceiling(val : SAME) : SAME pre ~void(self) and ~void(val) and (val > zero) post result >= self is -- This routine returns the smallest whole number greater than or equal -- to self which is also a multiple of val. return ((self + val - one) / val) * val 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 ; gcd(other : SAME) : SAME pre ~void(self) and ~void(other) post ((self % result) = zero) and ((other % result) = zero) is -- This routine implements the greatest common divisor operation for -- self and other. The result is always non-negative. Uses Euclid's -- algorithm. a : SAME := self.abs ; b : SAME := other.abs ; loop if a.is_zero then return b; end; b:=b % a; if b.is_zero then return a; end; a:=a % b; end; end; extended_gcd(other:SAME, out f1, out f2:SAME):SAME pre ~void(self) and ~void(other) 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 pre ~void(self) and ~void(other) post ((result * gcd(other)) = (self * other).abs) is -- This routine returns the least common multiple of self and other. return ((self/gcd(other)) * other).abs end ; times! pre self >= zero post true is -- This iter merely yields self times. loc_val : SAME := self ; loop until!(loc_val <= zero) ; yield ; loc_val := loc_val - one end end ; times! : SAME pre (self >= zero) post (result < self) is -- This iter yields successive integers from zero up to self - 1. res : SAME := zero ; loop until!(res >= self) ; yield res ; res := res + one end end ; for!( once cnt : SAME ) : SAME pre ~void(self) and ~void(cnt) and (cnt >= zero) post (result < cnt + self) is -- This iter yields cnt successive integers starting with self. res : SAME := self ; loop_end : SAME := self + cnt ; loop until!(res >= loop_end) ; yield res ; res := res + one end end ; up! : SAME pre ~void(self) post result >= self is -- This iter yields successive integers from self upwards! Note that -- eventual lack of memory space will cause this iter to raise an exception! res : SAME := self ; loop yield res ; res := res + one end end ; upto!( once limit : SAME) : SAME pre ~void(self) and ~void(limit) -- and (limit >= self) post (result <= limit) is -- This iter yields successive integers from self upwards to limit inclusive. res : SAME := self ; loop until!(res > limit) ; yield res ; res := res + one end end ; downto!(once limit : SAME) : SAME pre ~void(self) and ~void(limit) -- and (limit <= self) post (result >= limit) is -- This iter yields successive integers from self down to and including limit. res : SAME := self ; loop until!(res < limit) ; yield res ; res := res - one end end ; step!(once cnt : CARD, once step : INT ) : SAME pre (step /= INT::zero) post ((step > INT::zero) and (result < (self + (cnt.inti * create(step))))) or ((step < INT::zero) and (result > (self + (cnt.inti * create(step))))) is -- This iter yields num integers starting with self and stepping each time by step. loc_step : SAME := create(step) ; res : SAME := self.copy ; loop cnt.times! ; yield res ; res := res + loc_step end end ; stepto!(once to : SAME, once by : INT) : SAME pre by.is_non_zero post true is -- This iter yields succeeding integers from self to to by step by. -- It might quit immediately if self is aleady `beyond' to. --pre ((by > INT::zero) and (to > self)) or ((by < INT::zero) --and (to < self)) res : SAME := self ; loc_by : SAME := create(by) ; if loc_by > zero then if (res > to) then quit end else if (res < to) then quit end end ; loop yield res ; if loc_by > zero then if (res + loc_by) > to then quit end else if (res < (to + loc_by.abs)) then quit end end ; res := res + loc_by end end ; sum!(other : SAME) : SAME pre ~void(self) and ~void(other) post true is -- This iter yields the sum of all previous values of val. Dependent -- on the value provided this iter may result in a value arising which -- would exceed memory capacity and thereby cause an exception to be raised. res : SAME := zero ; loop res := res + other ; yield res end end ; product!(other : SAME) : SAME pre ~void(self) and ~void(other) post true is -- This iter yields the product of all previous values of val. Dependent -- on the value provided this iter may result in a value arising which -- would exceed memory capacity and thereby cause an exception to be raised. res : SAME := one ; loop res := res * other ; yield res end end ; end ; -- INTI