## tagged-int-guts.pkg
#
# Tagged ints have a 1 in the low bit, to let the
# heapcleaner ("garbage collector") distinguish them
# from pointers (which always have 2-3 zero bits at
# the low end due to heap objects being word-aligned).
#
# Because the low bit is fixed to 1, tagged ints
# have one less usable bit than untagged ints:
# 31 useful bits on 32-bit implementations,
# 63 useful bits on 64-bit implementations.
# Compiled by:
# src/lib/std/src/standard-core.sublib# The following packages must be without apis so that inlining
# can take place: bits, vector, rw_vector, rw_float_vector, int, real
### "Lord, give us the wisdom to utter
### words that are gentle and tender,
### for tomorrow we may have to eat them."
###
### -- Morris K. Udall
package tagged_int_guts: (weak) Int { # Int is from src/lib/std/src/int.api # # inline_t is from src/lib/core/init/built-in.pkg package ti = inline_t::ti; # "ti" == "tagged_int".
package i32 = inline_t::i1; # "i1" == "one-word int" (i.e., 32-bit int on 32-bit architectures, 64-bit int on 64-bit architectures).
exception DIVIDE_BY_ZERO = runtime::DIVIDE_BY_ZERO;
exception OVERFLOW = runtime::OVERFLOW;
# for runtime see
# src/lib/core/init/core.pkg # src/lib/core/init/runtime.pkg # src/c/machine-dependent/prim.intel32.asm
Int = Int;
precision = THE 31; # 64-bit issue -- this needs to be 63 on 64-bit implementations.
min_int_val = -1073741824; # 64-bit issue -- this is probably -2**30 or such, and probably needs to be -2**62 or such on 64-bit implementations.
min_int = THE min_int_val;
max_int = THE 1073741823; # 64-bit issue -- this is probably 2**30-1 or such, and probably needs to be 2**62-1 or such on 64-bit implementations.
my to_multiword_int: Int -> multiword_int::Int = ti::to_large;
my from_multiword_int: multiword_int::Int -> Int = ti::from_large;
to_int = ti::to_int;
from_int = ti::from_int;
my (-_) : Int -> Int = ti::neg;
my neg : Int -> Int = ti::neg;
my (*) : (Int, Int) -> Int = ti::(*);
my (+) : (Int, Int) -> Int = ti::(+);
my (-) : (Int, Int) -> Int = ti::(-);
my (/) : (Int, Int) -> Int = ti::div ;
my (%) : (Int, Int) -> Int = ti::mod ;
my (quot): (Int, Int) -> Int = ti::quot ;
my (rem): (Int, Int) -> Int = ti::rem ;
my min: (Int, Int) -> Int = ti::min ;
my max: (Int, Int) -> Int = ti::max ;
my abs: Int -> Int = ti::abs ;
fun sign 0 => 0;
sign i => if (ti::(<) (i, 0)) -1;
else 1;
fi;
end;
fun 0! => 1;
n! => n * (n - 1)! ;
end;
fun same_sign (i, j)
=
(ti::bitwise_and (ti::bitwise_xor (i, j), min_int_val) == 0);
fun compare (i, j)
=
if (ti::(<) (i, j)) exceptions_guts::LESS; # exceptions_guts is from src/lib/std/src/exceptions-guts.pkg elif (ti::(>) (i, j)) exceptions_guts::GREATER;
else exceptions_guts::EQUAL;
fi;
my (>) : (Int, Int) -> Bool = ti::(>);
my (>=) : (Int, Int) -> Bool = ti::(>=);
my (<) : (Int, Int) -> Bool = ti::(<);
my (<=) : (Int, Int) -> Bool = ti::(<=);
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;
fun format radix
=
(number_format::format_int radix) # number_format is from src/lib/std/src/number-format.pkg o
one_word_int_guts::from_int; # one_word_int_guts is from src/lib/std/src/one-word-int-guts.pkg fun scan radix
=
{ scan_large
=
number_scan::scan_int radix; # number_scan is from src/lib/std/src/number-scan.pkg fun f getc cs
=
case (scan_large getc cs)
#
NULL => NULL;
#
THE (i, cs')
=>
THE (one_word_int_guts::to_int i, cs');
# This check is redundant because one_word_int::to_int does it already:
# if i32.>(i, 0x3fffffff) or i32.<(i, -0x40000000) then
# raise exception OVERFLOW
# else
esac;
f;
};
to_string
=
format number_string::DECIMAL; # number_string is from src/lib/std/src/number-string.pkg# from_string = PreBasis::scan_string (scan number_string::DEC)
stipulate # inline_t is from src/lib/core/init/built-in.pkg package w31 = inline_t::tu; # "tu" == "tagged unsigned int": 31-bit on 32-bit architectures, 63-bit on 64-bit architectures.
package cv = inline_t::vector_of_chars;
herein
# Optimized version of from_string.
# It is about 2x as fast as using scan_string:
fun from_string s
=
{ n = size s;
z = char::to_int '0';
sub = cv::get;
infix my +++;
fun x +++ y
=
w31::to_int_x (w31::(+) (w31::from_int x, w31::from_int y));
fun num (i, a)
=
if (i >= n)
#
a;
else
c = char::to_int (sub (s, i)) - z;
if (c < 0 or c > 9)
a;
else
num (i +++ 1, 10 * a - c);
fi;
fi;
# Do the arithmetic using the negated absolute to avoid
# premature overflow on min_int.
fun negabs i
=
if (i >= n)
#
NULL;
else
c = z - char::to_int (sub (s, i));
if (c > 0 or c < -9)
#
NULL;
else
THE (num (i +++ 1, c));
fi;
fi;
fun skipwhite i
=
if (i >= n)
#
NULL;
else
c = sub (s, i);
if (char::is_space c)
#
skipwhite (i +++ 1);
else
if (c == '-')
#
negabs (i +++ 1);
else
null_or::map (-_) (negabs i); # null_or is from src/lib/std/src/null-or.pkg fi;
fi;
fi;
skipwhite 0;
};
end; # stipulate
}; # package tagged_int