## one-byte-unt-guts.pkg
# Compiled by:
# src/lib/std/src/standard-core.sublib### "Short words are best
### and the old words when
### short are best of all."
###
### -- Winston Churchill
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 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 u1b = one_byte_unt; # one_byte_unt is from src/lib/std/types-only/basis-structs.pkg package u1w = one_word_unt_guts; # one_word_unt_guts is from src/lib/std/src/one-word-unt-guts.pkg package w8 = inline_t::u8; # "u8" == "8-bit unsigned int".
package w31 = inline_t::tu; # "tu" == "tagged unsigned int": 31-bits on 32-bit architectures, 63-bit on 64-bit architectures.
herein
package one_byte_unt_guts: (weak) Unt { # Unt is from src/lib/std/src/unt.api #
Unt = u1b::Unt; # 31 bits
unt_size = 8; # 64-bit issue ?
unt_size_w = 0u8; # 64-bit issue ?
unt_shift = it::tu::(-) (0u31, unt_size_w); # 64-bit issue -- this will be 63 on 64-bit architectures.
fun adapt op args
=
w8::bitwise_and (op args, 0uxFF);
to_int = w8::to_int : Unt -> Int;
to_int_x = w8::to_int_x : Unt -> Int;
from_int = w8::from_int : Int -> Unt;
to_large_unt = w8::to_large_unt: Unt -> large_unt::Unt;
to_large_unt_x = w8::to_large_unt_x;
from_large_unt = w8::from_large_unt;
to_multiword_int = u1w::to_multiword_int o to_large_unt: Unt -> mwi::Int;
to_multiword_int_x = w8::to_large_int_x: Unt -> mwi::Int;
from_multiword_int = w8::from_large_int: mwi::Int -> Unt;
# These should be inline functions XXX SUCKO FIXME
fun (<<) (w: Unt, k)
=
if (it::default_unt::(<=) (unt_size_w, k))
#
0u0;
else
adapt w8::lshift (w, k);
fi;
fun (>>) (w: Unt, k)
=
if (it::default_unt::(<=) (unt_size_w, k))
#
0u0;
else
w8::rshiftl (w, k);
fi;
fun (>>>) (w: Unt, k)
=
if (it::default_unt::(<=) (unt_size_w, k))
#
adapt w8::rshift (w8::lshift (w, unt_shift), 0u31);
else
adapt w8::rshift (w8::lshift (w, unt_shift), it::default_unt::(+) (unt_shift, k));
fi;
bitwise_or = w8::bitwise_or : (Unt, Unt) -> Unt;
bitwise_xor = w8::bitwise_xor : (Unt, Unt) -> Unt;
bitwise_and = w8::bitwise_and : (Unt, Unt) -> Unt;
bitwise_not = adapt w8::bitwise_not : Unt -> Unt;
(*) = (*) : (Unt, Unt) -> Unt;
(+) = (+) : (Unt, Unt) -> Unt;
(-) = (-) : (Unt, Unt) -> Unt;
(/) = (/) : (Unt, Unt) -> Unt;
(%) = (%) : (Unt, Unt) -> Unt;
fun compare (w1, w2)
=
if (w8::(<) (w1, w2)) LESS;
elif (w8::(>) (w1, w2)) GREATER;
else EQUAL;
fi;
(>) = (>) : (Unt, Unt) -> Bool;
(>=) = (>=) : (Unt, Unt) -> Bool;
(<) = (<) : (Unt, Unt) -> Bool;
(<=) = (<=) : (Unt, Unt) -> Bool;
(-_) = (-_) : Unt -> Unt;
min = w8::min : (Unt, Unt) -> Unt;
max = w8::max : (Unt, Unt) -> Unt;
fun format radix
=
(nf::format_unt radix) o to_large_unt;
to_string = format nst::HEX;
fun scan radix
=
scan
where
scan_large = number_scan::scan_word radix;
fun scan getc cs
=
case (scan_large getc cs)
#
THE (w, cs')
=>
if (it::u1::(>) (w, 0u255)) raise exception OVERFLOW;
else THE (from_large_unt w, cs');
fi;
NULL => NULL;
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 one_byte_unt_guts
end;