-- Copyright 1993-1998, by the Cecil Project
-- Department of Computer Science and Engineering, University of Washington
-- See the LICENSE file for license information.

(--DOC
  Integers are numbers, supporting all the operations of numbers. The
  normal  `+', `-', `*', and `/' operations do not trap overflow; the
  `+_ov', etc. functions transparently coerce to arbitrary-precision
  integers if overflow happens. The bitwise operations assume two's
  complement representation.
--)

-- an abstract integer;
-- small-int.cecil and big-int.cecil contain implementations

abstract object integer isa num;

-- mixed small_int/big_int arithmetic behavior => coerce to big_ints and retry
method =(l@:integer,r@:integer):bool { l.as_big_int = r.as_big_int }
method <(l@:integer,r@:integer):bool { l.as_big_int < r.as_big_int }

implementation +(l@:integer,r@:integer):integer  { l.as_big_int + r.as_big_int }
implementation -(l@:integer,r@:integer):integer  { l.as_big_int - r.as_big_int }
implementation *(l@:integer,r@:integer):integer  { l.as_big_int * r.as_big_int }
implementation /(l@:integer,r@:integer):integer  { l.as_big_int / r.as_big_int }

--DOCSHORT modulus
method mod(l@:integer,r@integer:`T <= integer):T { l % r }
--DOCSHORT same as `mod'
signature %(integer, `T <= integer):T;
implementation %(l@:integer,r@:integer):integer { l.as_big_int % r.as_big_int }

--DOCSHORT remainder
signature rem(integer, `T <= integer):T;
implementation rem(l@:integer,r@:integer):integer { l - r * (l % r) }

precedence % with *, /;

method -_ov(l@:integer):integer { - l.as_big_int }
method +_ov(l@:integer,r@:integer):integer  { l.as_big_int + r.as_big_int }
method -_ov(l@:integer,r@:integer):integer  { l.as_big_int - r.as_big_int }
method *_ov(l@:integer,r@:integer):integer  { l.as_big_int * r.as_big_int }
method /_ov(l@:integer,r@:integer):integer  { l.as_big_int / r.as_big_int }
method %_ov(l@:integer,r@:integer):integer  { l.as_big_int % r.as_big_int }

precedence +_ov, -_ov with +, -;
precedence *_ov, /_ov with *, /;


--DOCSHORT left shift
method <<(l@:integer,r@:integer):integer  { l.as_big_int << r }
--DOCSHORT right arithmetic shift (extends sign)
method >>(l@:integer,r@:integer):integer  { l.as_big_int >> r }

precedence <<, >> left_associative above =;

method <<_ov(l@:integer,r@:integer):integer  { l.as_big_int << r }
method >>_ov(l@:integer,r@:integer):integer  {
    -- doesn't overflow
    l >> r }

precedence <<_ov, >>_ov with <<, >>;

method bit_and (l@:integer, r@:integer):integer {
    error("Error: not yet implemented for big_int."); }
method bit_or (l@:integer, r@:integer):integer {
    error("Error: not yet implemented for big_int."); }
method bit_xor (l@:integer, r@:integer):integer {
    error("Error: not yet implemented for big_int."); }
method bit_xnor (l@:integer, r@:integer):integer {
    l _bit_xor _bit_not r }
method bit_not(l@:integer):integer {
    error("Error: not yet implemented for big_int."); }

precedence _bit_and left_associative above _bit_or;
precedence _bit_or  left_associative above =;
precedence _bit_xor left_associative above =;
precedence _bit_xnor left_associative above =;

--DOCSHORT extract `i'th bit (0 or 1)
method get_bit(i@:integer, bit@:integer):integer {
    error("Error: not yet implemented for big_int."); }
--DOCSHORT set `i'th bit to 1
method set_bit(i@:integer, bit@:integer):integer {
    error("Error: not yet implemented for big_int."); }
--DOCSHORT set `i'th bit to 0
method clear_bit(i@:integer, bit@:integer):integer {
    error("Error: not yet implemented for big_int."); }

method as_int(l@integer:`T <= integer):T { l }

method as_small_int(l@:integer):int {
    l.as_small_int({ error("overflow") }) }
signature as_small_int(integer, if_overflow:&():`T):int|T;
method as_small_int_if_possible(l@:integer):integer {
    as_small_int(l, { l }) }


-- pre-compute largest and smallest int8.
-- note that we're being weak here and merging signed and unsigned
-- ranges, so we're looking for numbers in the range [-2^63..2^64-1]
private shared field max_int8(@:integer):integer :=
	(let var x:integer := 1;
	 64.do(&(:int){ x := x *_ov 2; });
	 x -_ov 1);
private shared field min_int8(@:integer):integer :=
	(let var x:integer := -1;
	 63.do(&(:int){ x := x *_ov 2; });
	 x);
method is_int8(val@:integer):bool {
    val <= val.max_int8 & { val >= val.min_int8 } }
method as_int8(val@:integer, if_overflow:&():integer):integer {
    if(val.is_int8, { val }, if_overflow) }
    

--DOCSHORT compute logarithm to nearest integer; rounds up
method log_base(x@:integer, base@:integer):int {
    let var log_value:int := 0;
    let var val:integer := 1;
    while({ val < x }, {
	log_value := log_value + 1;
	val := val *_ov base;
    });
    log_value }
--DOCSHORT compute logarithm, but invoke closure if integer result not exact
method exact_log_base(x@:integer, base@:integer,
		      if_not_exact:&():int):int {
    let var log_value:int := 0;
    let var val:integer := 1;
    while({ val < x }, {
	log_value := log_value + 1;
	val := val *_ov base;
    });
    if(val = x, { log_value }, if_not_exact) }


--DOCSHORT test parity
method is_even(i@:integer):bool { i % 2 = 0 }
method is_odd(i@:integer):bool { not(is_even(i)) }

method hash(i@:integer, range:`T <= integer):S
    where signature %(integer, T):`Q, signature abs(Q):`S { abs(i % range) }

-- override num signature to provide better info about result
signature average(integer,integer):integer;


--DOC `round_up' rounds toward positive infinity, while `round_down' rounds
--DOC toward negative infinity.  Both ignore the sign of their second
--DOC argument.
-- (these next two don't deal gracefully with overflows, yet)

method round_up(i:integer, nearest:integer):integer {
    round_down(i + abs(nearest).pred, nearest) }
signature round_up(int, int):int;

method round_down(i:integer, nearest:integer):integer {
    if(i >= 0, { i / nearest * nearest }, { -round_up(-i, nearest) }) }
signature round_down(int, int):int;


-- some standard mathematical functions
method factorial(n:integer):integer {
    if(n <= 1, { 1 }, { n *_ov factorial(n-1) }) }

method fibonacci(n:integer):integer {
    if(n <= 0, { ^ 0 });
    if(n = 1, { ^ 1 });
    let var i:integer := 2;
    let var fib_i:integer := 1;
    let var fib_i_-_1:integer := 1;
    let var fib_i_-_2:integer := 0;
    while({ i < n }, {
	i := i +_ov 1;
	fib_i_-_2 := fib_i_-_1;
	fib_i_-_1 := fib_i;
	fib_i := fib_i_-_2 +_ov fib_i_-_1;
    });
    fib_i }

method fibonacci_recursive(n:integer):integer {
    if(n <= 0, { ^ 0 });
    if(n = 1, { ^ 1 });
    fibonacci(n-1) +_ov fibonacci(n-2) }

-- iterating behavior

--DOC `do_digits_increasing' calls its closure on each digit from least to
--DOC most significant; the `position' argument indicates the digit's
--DOC significance and starts at zero.

method do_digits_increasing(i@:integer, c:&(digit:int,position:int):void):void {
    do_digits_increasing_base(i, 10, c);
}

method do_digits_increasing_base(i@:integer, base:int,
				 c:&(digit:int,position:int):void):void{
    let var x:integer := i;
    let var position:int := 0;
    until_true({
	eval(c, x % base, position);
	x := x / base;
	position := position.succ;
    }, {x = 0});
}

-- printing behavior

method print_string(i@:integer):string {
    print_string_base(i, 10)
}

method print_string_base(i@:integer, base:int):string {
    let var str:string := "";
    do_digits_increasing_base(abs(i), base, &(d:int,:int){
	let sd:char := if(d < 10,
			 { from_ascii('0'.ascii_code + d) },
			 { from_ascii('a'.ascii_code + d - 10) });
	str := as_string(sd) || str;
    });
    if(i < 0, {"-"}, {""}) || str
}
method print_string_base(i@:int, base:int):string {
    if(i = min_int, {
	-- watch out for overflow!
	"-" || print_string_base(-_ov min_int, base)
    }, {
	resend
    }) }

method print_string(i@:integer, len:int):string {
    pad_left(i.print_string, len) }


--DOC The `parse_as_int' methods try to convert a string
--DOC representation of an integer into the integer representation,
--DOC calling the optional if_error closure if the string doesn't contain
--DOC an integer.

method parse_as_int(s@:string):integer {
    s.parse_as_int(10) }
method parse_as_int(s@:string, base@:int):integer {
    s.parse_as_int(base, { error("expecting an integer") }) }
method parse_as_int(s@:string, fail@closure:&():integer):integer {
    s.parse_as_int(10, fail) }
method parse_as_int(s@:string, base@:int, fail:&():integer):integer {
    let var pos:int := 0;
    let var val:integer := 0;
    let var negative:bool := false;

    -- skip leading white space
    while({ pos < s.length & { s!pos = ' ' } }, { pos := pos.succ; });

    -- check for negative number
    if(pos < s.length & { s!pos = '-' }, {
	negative := true; pos := pos.succ;
    });

    -- check if it starts with a number
    if(pos = s.length | { not(is_digit(s!pos, base)) }, { ^ eval(fail) });

    -- read digits
    while({ pos < s.length & { is_digit(s!pos, base) } }, {
	let new_val := val *_ov base +_ov parse_as_int(s!pos, base);
	val := new_val;
	pos := pos.succ;
    });

    -- skip trailing white space
    while({ pos < s.length }, {
	-- check that there's nothing after the number
	if(s!pos != ' ', { ^ eval(fail) });
	pos := pos.succ;
    });

    -- return result
    if(negative, { val := -_ov val; });

    val.as_small_int_if_possible }

method parse_as_small_int(s@:string):int {
    s.parse_as_int.as_small_int }
method parse_as_small_int(s@:string, base@:int):int {
    s.parse_as_int(base).as_small_int }
method parse_as_small_int(s@:string, fail@closure:&():int):int {
    s.parse_as_int(fail).as_small_int(fail) }
method parse_as_small_int(s@:string, base@:int, fail:&():int):int {
    s.parse_as_int(base, fail).as_small_int(fail) }