## int64.pkg
## Author: Matthias Blume (blume@tti-c.org)
# Compiled by:
# src/lib/std/src/standard-core.sublib# 64-bit integers
### "The difference between the right word
### and the almost right word is the difference
### between lightning and a lightning bug."
###
### -- Mark Twain
package int64: (weak) Int { # Int is from src/lib/std/src/int.api # inline_t is from src/lib/core/init/built-in.pkg Int = int64::Int;
extern = inline_t::int64::extern;
intern = inline_t::int64::intern;
precision = THE 64;
my min_int_val: Int = -0x8000000000000000;
my min_int: Null_Or( Int ) = THE min_int_val;
my max_int: Null_Or( Int ) = THE 0x7fffffffffffffff;
to_large = core_integer::extend_inf64 o core_int64::extern;
from_large = core_int64::intern o core_integer::test_inf64;
fun negbit hi = unt32_guts::bitwise_and (hi, 0ux80000000);
fun isneg hi = negbit hi != 0u0;
fun to_int i
=
{ mask = 0uxc0000000;
#
case (extern i)
#
(0u0, lo)
=>
if (unt32_guts::bitwise_and (lo, mask) == 0u0)
#
unt32_guts::to_int lo;
else
raise exception runtime::OVERFLOW;
fi;
#
(0uxffffffff, lo)
=>
if (unt32_guts::bitwise_and (lo, mask) == mask)
#
unt32_guts::to_int_x lo;
else
raise exception runtime::OVERFLOW;
fi;
_ => raise exception runtime::OVERFLOW;
esac;
};
fun from_int i31
=
{ i32 = int32_guts::from_int i31;
hi = if (i32 < 0 ) 0uxffffffff; else 0u0;fi;
intern (hi, inline_t::unt32::copyf_int32 i32);
};
fun quot (x, y)
=
from_large (integer_guts::quot (to_large x, to_large y));
fun rem (x, y)
=
x - quot (x, y) * y;
fun sign 0 => 0;
sign i => if (isneg (#1 (extern i)) ) -1;
else 1;
fi;
end;
fun same_sign (x, y)
=
sign x == sign y;
fun min (x: Int, y) = if (x < y) x; else y; fi;
fun max (x: Int, y) = if (x > y) x; else y; fi;
fun compare (x, y)
=
{ my (hi1, lo1) = extern x;
my (hi2, lo2) = extern y;
fun normal () # same-sign case
=
if (hi1 < hi2) LESS;
elif (hi1 > hi2) GREATER;
elif (lo1 < lo2) LESS;
elif (lo1 > lo2) GREATER;
else EQUAL;
fi;
if (isneg hi1)
if (isneg hi2 ) normal ();
else LESS;
fi;
elif (isneg hi2 ) GREATER;
else normal ();
fi;
};
fun format rdx i
=
integer_guts::format rdx (to_large i);
to_string = format number_string::DECIMAL;
fun scan rdx rdr s
=
case (integer_guts::scan rdx rdr s)
#
THE (i, s')
=>
if (i < -0x80000000 or i > 0x7fffffff)
#
raise exception runtime::OVERFLOW;
else
THE (intern (core_integer::trunc_inf64 i), s');
fi;
NULL => NULL;
esac;
from_string
=
pre_basis::scan_string (scan number_string::HEX);
my (-_) : Int -> Int = (-_);
my neg : Int -> Int = (-_);
my (+) : (Int, Int) -> Int = (+);
my (-) : (Int, Int) -> Int = (-);
my (*) : (Int, Int) -> Int = (*);
my (/) : (Int, Int) -> Int = (/);
my (%) : (Int, Int) -> Int = (%);
my abs : Int -> Int = abs;
my (<) : (Int, Int) -> Bool = (<);
my (<=) : (Int, Int) -> Bool = (<=);
my (>) : (Int, Int) -> Bool = (>);
my (>=) : (Int, Int) -> Bool = (>=);
fun 0! => 1;
n! => n * (n - 1)! ;
end;
fun is_prime p # A very simple and naive primality tester. 2009-09-02 CrT.
=
{ p = abs(p); # Try to do something reasonable with negative numbers.
if (p < 4) TRUE; # Call zero prime.
elif (p % 2 == 0) FALSE; # Special-case even numbers to halve our loop time.
else
# Test all odd numbers less than sqrt(p):
loop 3
where
fun loop i
=
if (p % i == 0) FALSE;
elif (i*i >= p) TRUE;
else loop (i + 2);
fi;
end;
fi;
};
fun factors n
=
factors' (n, 2, [])
where
fun factors' (n, p, results)
=
if (p*p > n)
reverse (n ! results);
elif (n % p == 0)
factors' (n/p, p, p ! results);
else
factors' (n, p+1, results);
fi;
end;
fun sum ints
=
sum' (ints, 0)
where
fun sum' ( [], result) => result;
sum' (i ! rest, result) => sum' (rest, i + result);
end;
end;
fun product ints
=
product' (ints, 1)
where
fun product' ( [], result) => result;
product' (i ! rest, result) => product' (rest, i * result);
end;
end;
};