## one-word-unt-guts.pkg
#
# One-word unt ("unsigned int") -- 32-bit unt on 32-bit architectures, 64-bit unt on 64-bit architectures.
# Compiled by:
# src/lib/std/src/standard-core.sublib### "Words, words. They're all we have to go on."
###
### -- Tom Stoppard, "Rosencrantz and Guildenstern Are Dead"
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 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 w32 = it::u1; # "u1" == "one-word unsigned int" -- 32 bits on 32-bit architectures, 64 bits on 64-bit architectures.
herein
package one_word_unt_guts: (weak) Unt { # Unt is from src/lib/std/src/unt.api #
Unt = u1w::Unt;
unt_size = 32; # 64-bit issue.
to_large_unt = w32::to_large_unt : Unt -> large_unt::Unt;
to_large_unt_x = w32::to_large_unt_x: Unt -> large_unt::Unt;
from_large_unt = w32::from_large_unt: large_unt::Unt -> Unt;
to_multiword_int = w32::to_large_int;
to_multiword_int_x = w32::to_large_int_x;
from_multiword_int = w32::from_large_int;
to_int = w32::to_int : Unt -> Int;
to_int_x = w32::to_int_x: Unt -> Int;
from_int = w32::from_int: Int -> Unt;
bitwise_or = w32::bitwise_or : (Unt, Unt) -> Unt;
bitwise_xor = w32::bitwise_xor: (Unt, Unt) -> Unt;
bitwise_and = w32::bitwise_and: (Unt, Unt) -> Unt;
bitwise_not = w32::bitwise_not: Unt -> Unt;
(*) = w32::(*) : (Unt, Unt) -> Unt;
(+) = w32::(+) : (Unt, Unt) -> Unt;
(-) = w32::(-) : (Unt, Unt) -> Unt;
(/) = w32::div : (Unt, Unt) -> Unt;
(%) = w32::mod : (Unt, Unt) -> Unt;
fun compare (w1, w2)
=
if (w32::(<) (w1, w2)) LESS;
elif (w32::(>) (w1, w2)) GREATER;
else EQUAL;
fi;
(>) = w32::(>) : (Unt, Unt) -> Bool;
(>=) = w32::(>=) : (Unt, Unt) -> Bool;
(<) = w32::(<) : (Unt, Unt) -> Bool;
(<=) = w32::(<=) : (Unt, Unt) -> Bool;
(<<) = w32::check_lshift;
(>>) = w32::check_rshiftl;
(>>>) = w32::check_rshift;
(-_) = (-_): Unt -> Unt;
min = w32::min: (Unt, Unt) -> Unt;
max = w32::max: (Unt, Unt) -> Unt;
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;
format = nf::format_unt;
to_string = format nst::HEX;
scan = ns::scan_word;
from_string = pb::scan_string (scan nst::HEX);
}; # package one_word_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.