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

--DOC Small integers (`int') are the main representation of integers.


-- implementation of fast, fixed-precision integers;
-- 31 bits in current implementation

extend int isa integer;

-- arithmetic

method = (l@:int, r@:int):bool {
    prim
      rtl: "if l =_int_log r goto l1;
            return false;
        label l1;
            return true;"
}

method < (l@:int, r@:int):bool {
    prim
      rtl: "if l <_int_log r goto l1;
            return false;
        label l1;
            return true;"
}
method <_unsigned (l@:int, r@:int):bool {
    prim
      rtl: "if l <_unsigned_log r goto l1;
            return false;
        label l1;
            return true;"
}

method <= (l@:int, r@:int):bool {
    prim
      rtl: "if l <=_int_log r goto l1;
            return false;
        label l1;
            return true;"
}

method <=_unsigned (l@:int, r@:int):bool {
    prim
      rtl: "if l <=_unsigned_log r goto l1;
            return false;
        label l1;
            return true;"
}

method > (l@:int, r@:int):bool {
    prim
      rtl: "if l >_int_log r goto l1;
            return false;
        label l1;
            return true;"
}

method >_unsigned (l@:int, r@:int):bool {
    prim
      rtl: "if l >_unsigned_log r goto l1;
            return false;
        label l1;
            return true;"
}

method >= (l@:int, r@:int):bool {
    prim
      rtl: "if l >=_int_log r goto l1;
            return false;
        label l1;
            return true;"
}

method >=_unsigned (l@:int, r@:int):bool {
    prim
      rtl: "if l >=_unsigned_log r goto l1;
            return false;
        label l1;
            return true;"
}

method != (l@:int, r@:int):bool {
    prim
      rtl: "if l =_int_log r goto l1;
            return true;
        label l1;
            return false;"
}

implementation + (l@:int, r@:int):int {
    prim
      rtl: "decl OOP ans := l +_int r;
            return ans;"
}

implementation - (l@:int, r@:int):int {
    prim
      rtl: "decl OOP ans := l -_int r;
            return ans;"
}

implementation * (l@:int, r@:int):int {
    prim
    -- avoids an unnecessary unboxing and reboxing
     rtl: "decl wordInt r_unbox := unbox_int r;
           decl OOP ans := l *_int r_unbox;
           return ans;"
}

-- rounds towards zero
implementation / (l@:int, r@:int):int {
    prim
    -- avoids two unnecessary unboxings
      rtl: "decl wordInt t1 := l /_int r;
            decl OOP ans := box_int t1;
            return ans;"
}

-- returns abs(l) % abs(r), with the sign of l;
-- the identity  ((X / Y) * Y + X % Y) = X  holds
implementation % (l@:int, r@:int):int {
    prim
      rtl: "decl OOP ans := l %_int r;
            return ans;"
}


-- versions that catch overflow (this would be easier in asm...)

method negate_ov (l@:int, if_overflow:&():`T):int|T {
    if(l = min_int, if_overflow, { -l }) }

method add_ov (l@:int, r@:int, if_overflow:&():`T):int|T {
    -- overflows if both operands big positive numbers or big negative numbers
    let result := l + r;
    if(sign(l) = sign(r) & { sign(result) != sign(l) },
       if_overflow, { result }) }

method sub_ov (l@:int, r@:int, if_overflow:&():`T):int|T {
    -- overflows if negating min_int
    -- or if subtracting big negative from big positive or vice versa
    if(l = 0 & { r = min_int }, { ^ eval(if_overflow) });
    let result := l - r;
    if(sign(l) = -sign(r) & { sign(result) != sign(l) },
       if_overflow, { result }) }

method mul_ov (l@:int, r@:int, if_overflow:&():`T):int|T {
    -- first convert operands to absolute value, if possible
    if(l = min_int, {
	^ if(r = 0 | { r = 1 }, { l * r }, if_overflow);
    });
    if(r = min_int, {
	^ if(l = 0 | { l = 1 }, { l * r }, if_overflow);
    });

    let l_p:int := abs(l);
    let r_p:int := abs(r);

    -- treat l * r as lh:ll * rh:rl, of n/2 bit values
    let num_low_bits := num_int_bits / 2;
    let num_high_bits := num_int_bits - num_low_bits;

    let lh := l_p >> num_low_bits;
    let ll := l_p _bit_and ((1 << num_low_bits) - 1);
    let rh := r_p >> num_low_bits;
    let rl := r_p _bit_and ((1 << num_low_bits) - 1);

    let result := ll * rl + ((lh * rl + ll * rh) << num_low_bits);

    let carry := (((ll * rl) >> num_low_bits) + lh * rl + ll * rh)
		 >> num_low_bits;

    let overflow := lh * rh + ((lh * rl + ll * rh) >> num_low_bits) + carry;

    if(overflow != 0, { ^ eval(if_overflow) });

    let signed_result := if(sign(l) = sign(r), { result }, { -result });

    assert(signed_result = l*r, "mul_ov didn't work");

    signed_result }

method div_ov (l@:int, r@:int, if_overflow:&():`T):int|T {
    -- only overflows on min_int / -1
    if(l = min_int & { r = -1 }, { ^ eval(if_overflow) });
    l / r }

method mod_ov (l@:int, r@:int, if_overflow:&():`T):int|T {
    -- never overflows
    l % r }


-- versions that implicitly coerce to big_ints on overflow
method -_ov(l@:int):integer {
    negate_ov(l, { - l.as_big_int }) }
method +_ov (l@:int, r@:int):integer {
    add_ov(l, r, { l.as_big_int + r.as_big_int }) }
method -_ov (l@:int, r@:int):integer {
    sub_ov(l, r, { l.as_big_int - r.as_big_int }) }
method *_ov (l@:int, r@:int):integer {
    mul_ov(l, r, { l.as_big_int * r.as_big_int }) }
method /_ov (l@:int, r@:int):integer {
    div_ov(l, r, { l.as_big_int / r.as_big_int }) }
method %_ov (l@:int, r@:int):integer {
    mod_ov(l, r, { l.as_big_int % r.as_big_int }) }


method as_single_float(l@:int):single_float {
    prim
      rtl: "decl wordInt left := unbox_int l;
            decl wordFloat t1 := convert_int_to_float left;
            decl OOP ans := box_float t1;
            return ans;"
}

method as_double_float(l@:int):double_float {
    prim
      rtl: "decl wordInt left := unbox_int l;
            decl doubleWordFloat t1 := convert_int_to_double left;
            decl OOP ans := box_double t1;
            return ans;"
}


method bit_and (l@:int, r@:int):int {
    prim
      rtl: "decl OOP ans := l &_int r;
            return ans;"
}

method bit_or (l@:int, r@:int):int {
    prim
      rtl: "decl OOP ans := l |_int r;
            return ans;"
}

method bit_xor (l@:int, r@:int):int {
    prim
      rtl: "decl OOP ans := l ^_int r;
            return ans;"
}

method bit_not(l@:int):int {
    prim
      rtl: "decl wordInt left := unbox_int l;
            decl wordInt t1 := ~_int left;
            decl OOP ans := box_int t1;
            return ans;"
}


method << (l@:int, r@:int):int {
    prim
      rtl: "decl wordInt right := unbox_int r;
            decl OOP ans := l <<_int right;
            return ans;"
}

method >> (l@:int, r@:int):int {
    prim
      rtl: "decl wordInt left := unbox_int l;
            decl wordInt right := unbox_int r;
            decl wordInt t1 := left >>_int right;
            decl OOP ans := box_int t1;
            return ans;"
}

--DOCSHORT right logical shift (no sign-extension)
method >>_logical (l@:int, r@:int):int {
    -- we need to unbox by right-shifting in *unsigned* fashion,
    -- so that >>_logical works properly on negative inputs.
    -- do this by combining the unbox with the right-shift.
    prim
      rtl: "decl wordInt right := unbox_int r;
	    decl wordInt unbox_and_right := right +_int num_tag_bits;
            decl wordInt t1 := l >>_logical_int unbox_and_right;
            decl OOP ans := box_int t1;
            return ans;"
}

precedence >>_logical with >>;


method get_bit(i@:int, bit@:int):int (** inline **) {
  if((i _bit_and (1 << bit)) != 0, { 1 }, { 0 }) }

method set_bit(i@:int, bit@:int):int (** inline **) {
  i _bit_or (1 << bit) }

method clear_bit(i@:int, bit@:int):int (** inline **) {
  let mask:int := bit_not(1 << bit);
  i _bit_and mask }


method is_even(i@:int):bool { (i _bit_and 1) = 0 }


prim c_++: "
#include <math.h>
";

-- This doesn't look right to me; don't round when calling sqrt on int. -MDE
method sqrt(x@:int):int (** return_type(int), sends(), formals_escape(f) **) {
    prim c_++: "
#ifdef DISPATCHERS
	RETURN(asTaggedInt((wordInt)sqrt((wordFloat)x->asInt())));
#else
	BP(asTaggedInt((wordInt)sqrt((wordFloat)x->asInt())));
#endif
"
}


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


-- coercions

method as_small_int(l@:int, if_overflow:&():`T):int { l }


-- fast iterating; no overflow check on increment

--DOC `do' on integers is a simple kind of for-loop. Expression
--DOC `n.do(&(i:int){...})' invokes the argument closure `n' times,
--DOC binding `i' to each of the numbers from `0' to `n-1' in turn; it
--DOC does not return a value.

method do(count@:int, c:&(int):void):void (** inline **) {
    let var i:int := 0;
    loop({
	if(i >= count, {^});
	eval(c, i);
	i := i.succ;
    });
}

-- printing behavior

method print_string(i@:int):string {
    -- this goes a lot faster, but someday basic_print_string might go away
    i.basic_print_string
}


-- system implementation behavior

--DOCSHORT number of bits in small int representation
let num_int_bits:int := 31;  -- if you change num_int_bits, fix the c_++ string
                             -- hash function in specialized.cecil
--DOCSHORT maximum small int
let max_int:int := 16_3fffffff;  (--   2^30-1 --)
--DOCSHORT minimum small int
let min_int:int := -max_int - 1; (-- - 2^30   --)  -- weird to avoid an overflow