## tagged-unt-guts.pkg
# Compiled by:
# src/lib/std/src/standard-core.sublib### "Silence is better than unmeaning words."
###
### -- Pythagoras
stipulate
package it = inline_t; # inline_t is from src/lib/core/init/built-in.pkg package lms = list_mergesort; # list_mergesort is from src/lib/src/list-mergesort.pkg package mwi = multiword_int; # multiword_int is from src/lib/std/types-only/basis-structs.pkg package nf = number_format; # number_format is from src/lib/std/src/number-format.pkg package ns = number_scan; # number_scan is from src/lib/std/src/number-scan.pkg package nst = number_string; # number_string is from src/lib/std/src/number-string.pkg package pb = proto_basis; # proto_basis is from src/lib/std/src/proto-basis.pkg# package u1w = one_word_unt; # one_word_unt is from src/lib/std/types-only/basis-structs.pkg #
package w31 = inline_t::tu; # "tu" == "tagged unsigned int": 31-bits on 32-bit architectures, 63-bits on 64-bit architectures.
herein
package tagged_unt_guts: (weak) Unt { # Unt is from src/lib/std/src/unt.api # # inline_t is from src/lib/core/init/built-in.pkg #
Unt = Unt;
unt_size = 31; # 64-bit issue: This will be 63 on 64-bit architectures.
to_large_unt = w31::to_large_unt: Unt -> large_unt::Unt;
to_large_unt_x = w31::to_large_unt_x: Unt -> large_unt::Unt;
from_large_unt = w31::from_large_unt: large_unt::Unt -> Unt;
to_multiword_int = w31::to_large_int: Unt -> mwi::Int;
to_multiword_int_x = w31::to_large_int_x: Unt -> mwi::Int;
from_multiword_int = w31::from_large_int: mwi::Int -> Unt;
to_int = w31::to_int: Unt -> Int;
to_int_x = w31::to_int_x: Unt -> Int;
from_int = w31::from_int: Int -> Unt;
bitwise_or = w31::bitwise_or : (Unt, Unt) -> Unt;
bitwise_xor = w31::bitwise_xor: (Unt, Unt) -> Unt;
bitwise_and = w31::bitwise_and: (Unt, Unt) -> Unt;
bitwise_not = w31::bitwise_not: Unt -> Unt;
(*) = w31::(*) : (Unt, Unt) -> Unt;
(+) = w31::(+) : (Unt, Unt) -> Unt;
(-) = w31::(-) : (Unt, Unt) -> Unt;
(/) = w31::div : (Unt, Unt) -> Unt;
(%) = w31::mod : (Unt, Unt) -> Unt;
(<<) = w31::check_lshift : (Unt, Unt) -> Unt;
(>>) = w31::check_rshiftl : (Unt, Unt) -> Unt;
(>>>) = w31::check_rshift : (Unt, Unt) -> Unt;
fun compare (w1, w2)
=
if (w31::(<) (w1, w2)) LESS;
elif (w31::(>) (w1, w2)) GREATER;
else EQUAL;
fi;
(>) = w31::(>) : (Unt, Unt) -> Bool;
(>=) = w31::(>=) : (Unt, Unt) -> Bool;
(<) = w31::(<) : (Unt, Unt) -> Bool;
(<=) = w31::(<=) : (Unt, Unt) -> Bool;
(-_) = (-_): Unt -> Unt;
min = w31::min: (Unt, Unt) -> Unt;
max = w31::max: (Unt, Unt) -> Unt;
fun format radix
=
(nf::format_unt radix) o w31::to_large_unt;
to_string = format nst::HEX;
fun scan radix
=
scan'
where
scan_large = ns::scan_word radix;
#
fun scan' getc cs
=
case (scan_large getc cs)
#
NULL => NULL;
THE (w, cs')
=>
if (it::u1::(>) (w, 0ux7FFFFFFF)) # 64-bit issue.
#
raise exception OVERFLOW;
else
THE (w31::from_large_unt w, cs');
fi;
esac;
end;
from_string
=
pb::scan_string (scan nst::HEX);
fun sum unts
=
sum' (unts, 0u0)
where
fun sum' ( [], result) => result;
sum' (u ! rest, result) => sum' (rest, u + result);
end;
end;
fun product unts
=
product' (unts, 0u1)
where
fun product' ( [], result) => result;
product' (u ! rest, result) => product' (rest, u * result);
end;
end;
fun list_min [] => raise exception DIE "Cannot do list_min on empty list";
#
list_min (u ! unts)
=>
min' (unts, u: Unt)
where
fun min' ( [], result) => result;
min' (u ! rest, result) => min' (rest, u < result ?? u :: result);
end;
end;
end;
fun list_max [] => raise exception DIE "Cannot do list_max on empty list";
#
list_max (u ! unts)
=>
min' (unts, u: Unt)
where
fun min' ( [], result) => result;
min' (u ! rest, result) => min' (rest, u > result ?? u :: result);
end;
end;
end;
fun sort unts
=
lms::sort_list (>) unts;
fun sort_and_drop_duplicates unts
=
lms::sort_list_and_drop_duplicates compare unts;
}; # package tagged_unt_guts
end;
## COPYRIGHT (c) 1995 AT&T Bell Laboratories.
## Subsequent changes by Jeff Prothero Copyright (c) 2010-2015,
## released per terms of SMLNJ-COPYRIGHT.