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