## built-in.pkg
#
# Interfaces to the compiler built-ins, infixes, etc.
# Compiled by:
# src/lib/core/init/init.cmi
# Here we basically define package inline_t containing subpackages
#
# float64
# multword_int
# one_word_unt
# two_word_unt
# one_word_int
# tagged_unt
# tagged_int
# two_word_int
# one_byte_unt
# char
#
# poly_rw_vector
# poly_vector
#
# rw_vector_of_eight_byte_floats
# vector_of_eight_byte_floats
#
# rw_vector_of_one_byte_unts
# vector_of_one_byte_unts
#
# rw_vector_of_chars
# vector_of_chars
#
# and populate them with appropriate funs drawm from the 'inline' package defined in
#
# src/lib/compiler/front/semantic/symbolmapstack/base-types-and-ops.pkg#
# For the arithmetic-type packages those funs are add, divide, shift ...
# For the vector-type packages those funs are fetch, store ...
#
# We also define the package synonyms
#
# package default_int = tagged_int;
# package default_unt = tagged_unt;
# package default_float = float64;
### "I was gratified to be able
### to answer promptly and I did.
###
### "I said I didn't know."
###
### -- Mark Twain,
### Life on the Mississippi
package base_types {
#
include package base_types; # base_types is from src/lib/compiler/front/semantic/symbolmapstack/base-types-and-ops.pkg};
# This silliness is to prevent elabstr.sml
# from sticking a NO_ACCESS in the wrong place
stipulate
include package base_types;
#
package rt = core::runtime; # Private abbreviation.
herein
package runtime # This name gets used many places, starting with src/lib/core/init/proto-pervasive.pkg and src/lib/core/init/pervasive.pkg =
core::runtime; # core is from src/lib/core/init/core.pkg # The following code was used to create a type-safe version of the inline
# package while preserving the inline property of the functions.
# Since everything in inline is now properly typed already, the code
# should now be seen as:
# - organizing things a bit better
# - confirming the type information
#
# For the origin of the type info in inline_t see
#
# src/lib/compiler/front/semantic/symbolmapstack/base-types-and-ops.pkg #
# (Blume, 1/2001)
#
package inline_t {
Control_Fate(X) = Control_Fate(X);
callcc = inline::callcc: (Fate(X) -> X) -> X;
throw = inline::throw: Fate(X) -> X -> Y;
call_with_current_control_fate = inline::call_with_current_control_fate: (Control_Fate(X) -> X) -> X;
switch_to_control_fate = inline::switch_to_control_fate: Control_Fate(X) -> X -> Y;
make_isolated_fate = inline::make_isolated_fate: (X -> Void) -> Fate(X);
(*_) = inline::deref: Ref(X) -> X;
deref = inline::deref: Ref(X) -> X;
(:=) = inline::(:=) : (Ref(X), X) -> Void;
makeref = inline::makeref: X -> Ref(X);
(==) = inline::(==) : (_X, _X) -> Bool;
(!=) = inline::(!=) : (_X, _X) -> Bool;
boxed = inline::boxed: X -> Bool;
unboxed = inline::unboxed: X -> Bool;
cast = inline::cast: X -> Y;
identity = inline::cast: X -> X;
chunklength = inline::chunklength: X -> Int;
make_special = inline::make_special: (Int, X) -> Y;
getspecial = inline::getspecial: X -> Int;
setspecial = inline::setspecial: (X, Int) -> Void;
getpseudo = inline::getpseudo: Int -> X;
setpseudo = inline::setpseudo: (X, Int) -> Void;
gethandler = inline::gethandler: Void -> Fate(X);
sethandler = inline::sethandler: Fate(X) -> Void;
# We have one "register" used by threadkit
# to hold the currently running microthread. This is
# a real register on RISC architectures but a memory
# location on the register-starved intel32 architecture:
#
get_current_microthread_register= inline::get_current_microthread_register: Void -> X; # Get reserved 'current_thread' register -- see src/lib/compiler/back/low/main/intel32/backend-lowhalf-intel32-g.pkg set_current_microthread_register= inline::set_current_microthread_register: X -> Void; # Set reserved 'current_thread' register -- see src/lib/compiler/back/low/main/intel32/backend-lowhalf-intel32-g.pkg compose = inline::compose : (Y -> Z, X -> Y) -> (X -> Z);
(then) = inline::then : (X, Y) -> X; # Evaluate two expressions in sequence, return result of the first.
ignore = inline::ignore : X -> Void;
gettag = inline::gettag : X -> Int;
setmark = inline::setmark : X -> Void;
dispose = inline::dispose : X -> Void;
(!_) = inline::not_macro : Bool -> Bool;
inlnot = inline::not_macro : Bool -> Bool;
record_get = inline::record_get : (X, Int) -> Y;
raw64get = inline::raw64_get : (X, Int) -> Float;
ptreql = inline::ptreql : (X, X) -> Bool;
package f64 { # "f64" == "64-bit float".
#
(+) = inline::f64_add : (Float, Float) -> Float ;
(-) = inline::f64_subtract : (Float, Float) -> Float ;
(/) = inline::f64_div : (Float, Float) -> Float ;
(*) = inline::f64_mul : (Float, Float) -> Float ;
(====) = inline::f64_eq : (Float, Float) -> Bool ;
(!=) = inline::f64_ne : (Float, Float) -> Bool ;
(>=) = inline::f64_ge : (Float, Float) -> Bool ;
(>) = inline::f64_gt : (Float, Float) -> Bool ;
(<=) = inline::f64_le : (Float, Float) -> Bool ;
(<) = inline::f64_lt : (Float, Float) -> Bool ;
(-_) = inline::f64_negate : Float -> Float ;
neg = inline::f64_negate : Float -> Float ;
abs = inline::f64_abs : Float -> Float ;
min = inline::f64_min : (Float, Float) -> Float ;
max = inline::f64_max : (Float, Float) -> Float ;
from_tagged_int = inline::tagged_int_to_float64 : Int -> Float ;
from_int1 = inline::int1_to_float64 : Int1 -> Float ;
};
package in { # "in" == "indefinite-precision integer" (implemented as list of ints).
#
test_tagged_int = inline::test_i0_31 : Multiword_Int -> Int ;
test_int1 = inline::test_i0_32 : Multiword_Int -> Int1 ;
trunc_unt8 = inline::trunc_i0_8 : Multiword_Int -> Unt8 ;
trunc_tagged_unt = inline::trunc_i0_31 : Multiword_Int -> Unt ;
trunc_unt1 = inline::trunc_i0_32 : Multiword_Int -> Unt1 ;
copy_unt8 = inline::copy_8_inf : Unt8 -> Multiword_Int ;
copy_tagged_int = inline::copy_31_i0_i : Int -> Multiword_Int ;
copy_tagged_unt = inline::copy_31_i0_u : Unt -> Multiword_Int ;
copy_int1 = inline::copy_32_i0_i : Int1 -> Multiword_Int ;
copy_unt1 = inline::copy_32_i0_u : Unt1 -> Multiword_Int ;
extend_unt8 = inline::extend_8_inf : Unt8 -> Multiword_Int ;
extend_tagged_int = inline::extend_31_i0_i : Int -> Multiword_Int ;
extend_tagged_unt = inline::extend_31_i0_u : Unt -> Multiword_Int ;
extend_int1 = inline::extend_32_i0_i : Int1 -> Multiword_Int ;
extend_unt1 = inline::extend_32_i0_u : Unt1 -> Multiword_Int ;
to_int = test_tagged_int;
from_int = extend_tagged_int;
to_large = inline::identity : Multiword_Int -> Multiword_Int;
from_large = inline::identity : Multiword_Int -> Multiword_Int;
};
package u1 {
#
test_tagged_int = inline::test_32_31_u : Unt1 -> Int;
testu_tagged_int = inline::testu_32_31 : Unt1 -> Int;
testu_int1 = inline::testu_32_32 : Unt1 -> Int1;
trunc_tagged_unt = inline::trunc_32_31_u : Unt1 -> Unt;
trunc_unt8 = inline::trunc_32_8_u : Unt1 -> Unt8;
copy_unt8 = inline::copy_8_32_u : Unt8 -> Unt1;
copy_tagged_unt = inline::copy_31_32_u : Unt -> Unt1;
copyf_int1 = inline::copy_32_32_iu : Int1 -> Unt1;
copyt_int1 = inline::copy_32_32_ui : Unt1 -> Int1;
copy_unt1 = inline::copy_32_32_uu : Unt1 -> Unt1;
extend_unt8 = inline::extend_8_32_u : Unt8 -> Unt1;
extend_tagged_int = inline::extend_31_32_iu : Int -> Unt1;
extend_tagged_unt = inline::extend_31_32_uu : Unt -> Unt1;
to_large_unt = copy_unt1;
to_large_unt_x = copy_unt1;
from_large_unt = copy_unt1;
to_large_int = in::copy_unt1;
to_large_int_x = in::extend_unt1;
from_large_int = in::trunc_unt1;
to_int = testu_tagged_int;
to_int_x = test_tagged_int;
from_int = extend_tagged_int;
bitwise_or = inline::u1_bitwise_or : (Unt1, Unt1) -> Unt1;
bitwise_xor = inline::u1_bitwise_xor : (Unt1, Unt1) -> Unt1;
bitwise_and = inline::u1_bitwise_and : (Unt1, Unt1) -> Unt1;
bitwise_not = inline::u1_bitwise_not : Unt1 -> Unt1 ;
(*) = inline::u1_mul : (Unt1, Unt1) -> Unt1;
(+) = inline::u1_add : (Unt1, Unt1) -> Unt1;
(-) = inline::u1_subtract : (Unt1, Unt1) -> Unt1;
(-_) = inline::u1_negate : Unt1 -> Unt1 ;
neg = inline::u1_negate : Unt1 -> Unt1 ;
(div) = inline::u1_div : (Unt1, Unt1) -> Unt1; # NB: w32div does round-to-zero division -- this is the native instruction on Intel32.
(mod) = inline::u1_mod : (Unt1, Unt1) -> Unt1; # NB: w32mod does round-to-zero division -- this is the native instruction on Intel32. (Yes, this is called "rem" most other places in the code -- bug?)
(>) = inline::u1_gt : (Unt1, Unt1) -> Bool;
(>=) = inline::u1_ge : (Unt1, Unt1) -> Bool;
(<) = inline::u1_lt : (Unt1, Unt1) -> Bool;
(<=) = inline::u1_le : (Unt1, Unt1) -> Bool;
rshift = inline::u1_rshift : (Unt1, Unt) -> Unt1 ;
rshiftl = inline::u1_rshiftl : (Unt1, Unt) -> Unt1 ;
lshift = inline::u1_lshift : (Unt1, Unt) -> Unt1 ;
check_lshift = inline::u1_check_lshift : (Unt1, Unt) -> Unt1 ;
check_rshift = inline::u1_check_rshift : (Unt1, Unt) -> Unt1 ;
check_rshiftl = inline::u1_check_rshiftl: (Unt1, Unt) -> Unt1 ;
min = inline::u1_min : (Unt1, Unt1) -> Unt1 ;
max = inline::u1_max : (Unt1, Unt1) -> Unt1 ;
};
package u2 {
extern = inline::u64p : Unt2 -> (Unt1, Unt1) ;
intern = inline::p64u : (Unt1, Unt1) -> Unt2 ;
};
package i1 {
#
test_tagged_int = inline::test_32_31_i : Int1 -> Int ;
trunc_unt8 = inline::trunc_32_8_i : Int1 -> Unt8 ;
trunc_tagged_unt = inline::trunc_32_31_i : Int1 -> Unt ;
copy_unt8 = inline::copy_8_32_i : Unt8 -> Int1 ;
copy_tagged_unt = inline::copy_31_32_i : Unt -> Int1 ;
copy_int1 = inline::copy_32_32_ii : Int1 -> Int1 ;
extend_unt8 = inline::extend_8_32_i : Unt8 -> Int1 ;
extend_tagged_int = inline::extend_31_32_ii : Int -> Int1 ;
extend_tagged_unt = inline::extend_31_32_ui : Unt -> Int1 ;
to_int = test_tagged_int;
from_int = extend_tagged_int;
to_large = in::extend_int1;
from_large = in::test_int1;
(*) = inline::i1_mul : (Int1, Int1) -> Int1 ;
(quot) = inline::i1_quot : (Int1, Int1) -> Int1 ; # NB: i32quot does round-to-zero division -- this is the native instruction on Intel32.
(rem) = inline::i1_rem : (Int1, Int1) -> Int1 ; # NB: i32rem does round-to-zero division -- this is the native instruction on Intel32.
(div) = inline::i1_div : (Int1, Int1) -> Int1 ; # NB: i32div does round-to-negative-infinity division -- this will be much slower on Intel32, has to be faked.
(mod) = inline::i1_mod : (Int1, Int1) -> Int1 ; # NB: i32mod does round-to-negative-infinity division -- this will be much slower on Intel32, has to be faked.
(+) = inline::i1_add : (Int1, Int1) -> Int1 ;
(-) = inline::i1_subtract : (Int1, Int1) -> Int1 ;
(-_) = inline::i1_negate : Int1 -> Int1 ;
neg = inline::i1_negate : Int1 -> Int1 ;
bitwise_and = inline::i1_bitwise_and : (Int1, Int1) -> Int1 ;
bitwise_or = inline::i1_bitwise_or : (Int1, Int1) -> Int1 ;
bitwise_xor = inline::i1_bitwise_xor : (Int1, Int1) -> Int1 ;
rshift = inline::i1_rshift : (Int1, Int1) -> Int1 ;
lshift = inline::i1_lshift : (Int1, Int1) -> Int1 ;
(<) = inline::i1_lt : (Int1, Int1) -> Bool ;
(<=) = inline::i1_le : (Int1, Int1) -> Bool ;
(>) = inline::i1_gt : (Int1, Int1) -> Bool ;
(>=) = inline::i1_ge : (Int1, Int1) -> Bool ;
(==) = inline::i1_eq : (Int1, Int1) -> Bool ;
(<>) = inline::i1_ne : (Int1, Int1) -> Bool ;
min = inline::i1_min : (Int1, Int1) -> Int1 ;
max = inline::i1_max : (Int1, Int1) -> Int1 ;
abs = inline::i1_abs : Int1 -> Int1 ;
};
package tu { # "tu" == "tagged unt": 31-bit on 32-bit archtectures, 63-bit on 64-bit architectures.
#
testu_tagged_int = inline::testu_31_31 : Unt -> Int ;
copyt_tagged_int = inline::copy_31_31_ui : Unt -> Int ;
copyf_tagged_int = inline::copy_31_31_iu : Int -> Unt ;
to_large_unt = u1::copy_tagged_unt;
to_large_unt_x = u1::extend_tagged_unt;
from_large_unt = u1::trunc_tagged_unt;
to_large_int = in::copy_tagged_unt;
to_large_int_x = in::extend_tagged_unt;
from_large_int = in::trunc_tagged_unt;
to_int = testu_tagged_int;
to_int_x = copyt_tagged_int;
from_int = copyf_tagged_int;
bitwise_or = inline::tu1_bitwise_or : (Unt, Unt) -> Unt ;
bitwise_xor = inline::tu1_bitwise_xor : (Unt, Unt) -> Unt ;
bitwise_and = inline::tu1_bitwise_and : (Unt, Unt) -> Unt ;
(*) = inline::tu1_mul : (Unt, Unt) -> Unt ;
(+) = inline::tu1_add : (Unt, Unt) -> Unt ;
(-) = inline::tu1_subtract : (Unt, Unt) -> Unt ;
(-_) = inline::tu1_negate : Unt -> Unt ;
neg = inline::tu1_negate : Unt -> Unt ;
(div) = inline::tu1_div : (Unt, Unt) -> Unt ; # NB: w31dev does round-to-zero division -- this is the native instruction on Intel32.
(mod) = inline::tu1_mod : (Unt, Unt) -> Unt ; # NB: w31mod does round-to-zero division -- this is the native instruction on Intel32. (Called "rem" in most of the code -- bug?)
(>) = inline::tu1_gt : (Unt, Unt) -> Bool ;
(>=) = inline::tu1_ge : (Unt, Unt) -> Bool ;
(<) = inline::tu1_lt : (Unt, Unt) -> Bool ;
(<=) = inline::tu1_le : (Unt, Unt) -> Bool ;
rshift = inline::tu1_rshift : (Unt, Unt) -> Unt ;
rshiftl = inline::tu1_rshiftl : (Unt, Unt) -> Unt ;
lshift = inline::tu1_lshift : (Unt, Unt) -> Unt ;
check_lshift = inline::tu1_check_lshift : (Unt, Unt) -> Unt ;
check_rshift = inline::tu1_check_rshift : (Unt, Unt) -> Unt ;
check_rshiftl = inline::tu1_check_rshiftl : (Unt, Unt) -> Unt ;
bitwise_not = inline::tu1_bitwise_not : Unt -> Unt ;
min = inline::tu1_min : (Unt, Unt) -> Unt ;
max = inline::tu1_max : (Unt, Unt) -> Unt ;
};
package ti { # "ti" == "tagged_int": 31-bit on 32-bit archtectures, 63-bit on 64-bit architectures.
#
trunc_unt8 = inline::trunc_31_8 : Int -> Unt8 ;
copy_tagged_int = inline::copy_31_31_ii : Int -> Int ;
copy_unt8 = inline::copy_8_31 : Unt8 -> Int ;
extend_unt8 = inline::extend_8_31 : Unt8 -> Int ;
to_int = copy_tagged_int;
from_int = copy_tagged_int;
to_large = in::extend_tagged_int;
from_large = in::test_tagged_int;
(*) = inline::ti1_mul : (Int, Int) -> Int ;
(quot) = inline::ti1_quot : (Int, Int) -> Int ; # NB: i32quot does round-to-zero division -- this is the native instruction on Intel32.
(rem) = inline::ti1_rem : (Int, Int) -> Int ; # NB: i31rem does round-to-zero division -- this is the native instruction on Intel32.
(div) = inline::ti1_div : (Int, Int) -> Int ; # NB: i31div does round-to-negative-infinity division -- this will be much slower on Intel32, has to be faked.
(mod) = inline::ti1_mod : (Int, Int) -> Int ; # NB: i31mod does round-to-negative-infinity division -- this will be much slower on Intel32, has to be faked.
(+) = inline::ti1_add : (Int, Int) -> Int ;
(-) = inline::ti1_subtract : (Int, Int) -> Int ;
(-_) = inline::ti1_negate : Int -> Int ;
neg = inline::ti1_negate : Int -> Int ;
bitwise_and = inline::ti1_bitwise_and : (Int, Int) -> Int ;
bitwise_or = inline::ti1_bitwise_or : (Int, Int) -> Int ;
bitwise_xor = inline::ti1_bitwise_xor : (Int, Int) -> Int ;
rshift = inline::ti1_rshift : (Int, Int) -> Int ;
lshift = inline::ti1_lshift : (Int, Int) -> Int ;
bitwise_not = inline::ti1_bitwise_not : Int -> Int ;
(<) = inline::ti1_lt : (Int, Int) -> Bool ;
(<=) = inline::ti1_le : (Int, Int) -> Bool ;
(>) = inline::ti1_gt : (Int, Int) -> Bool ;
(>=) = inline::ti1_ge : (Int, Int) -> Bool ;
(==) = inline::ti1_eq : (Int, Int) -> Bool ;
(<>) = inline::ti1_ne : (Int, Int) -> Bool ;
ltu = inline::ti1_ltu : (Int, Int) -> Bool ;
geu = inline::ti1_geu : (Int, Int) -> Bool ;
min = inline::ti1_min : (Int, Int) -> Int ;
max = inline::ti1_max : (Int, Int) -> Int ;
abs = inline::ti1_abs : Int -> Int ;
};
package i2 {
#
extern = inline::i64p : Int2 -> (Unt1, Unt1) ;
intern = inline::p64i : (Unt1, Unt1) -> Int2 ;
};
package u8 { # "u8" == "8-bit unsigned int".
#
# large_int is still 32 bit:
#
to_large_unt = u1::copy_unt8;
to_large_unt_x = u1::extend_unt8;
from_large_unt = u1::trunc_unt8;
#
to_large_int = in::copy_unt8;
to_large_int_x = in::extend_unt8;
from_large_int = in::trunc_unt8;
#
to_int = ti::copy_unt8;
to_int_x = ti::extend_unt8;
from_int = ti::trunc_unt8;
# Temporary framework because the actual
# one_byte_unt operators are not implemented:
# WARNING! some of the following operators
# don't get the high-order bits right XXX BUGGO FIXME
#
bitwise_or = inline::tu1_bitwise_or_8 : (Unt8, Unt8) -> Unt8 ;
bitwise_xor = inline::tu1_bitwise_xor_8 : (Unt8, Unt8) -> Unt8 ;
bitwise_and = inline::tu1_bitwise_and_8 : (Unt8, Unt8) -> Unt8 ;
#
(*) = inline::tu1_mul_8 : (Unt8, Unt8) -> Unt8 ;
(+) = inline::tu1_add_8 : (Unt8, Unt8) -> Unt8 ;
(-) = inline::tu1_subtract_8 : (Unt8, Unt8) -> Unt8 ;
#
(-_) = inline::tu1_negate_8 : Unt8 -> Unt8 ;
neg = inline::tu1_negate_8 : Unt8 -> Unt8 ;
#
(div) = inline::tu1_div_8 : (Unt8, Unt8) -> Unt8 ; # NB: u31div_8 does round-to-zero division -- this is the native instruction on Intel32.
(mod) = inline::tu1_mod_8 : (Unt8, Unt8) -> Unt8 ; # NB: u31mod_8 does round-to-zero division -- this is the native instruction on Intel32. (Called "rem" in much of the code -- bug?)
#
(>) = inline::tu1_gt_8 : (Unt8, Unt8) -> Bool ;
(>=) = inline::tu1_ge_8 : (Unt8, Unt8) -> Bool ;
(<) = inline::tu1_lt_8 : (Unt8, Unt8) -> Bool ;
(<=) = inline::tu1_le_8 : (Unt8, Unt8) -> Bool ;
#
rshift = inline::tu1_rshift_8 : (Unt8, Unt) -> Unt8 ;
rshiftl = inline::tu1_rshift_8 : (Unt8, Unt) -> Unt8 ;
lshift = inline::tu1_lshift_8 : (Unt8, Unt) -> Unt8 ;
#
bitwise_not = inline::tu1_bitwise_not_8 : Unt8 -> Unt8 ;
#
check_lshift = inline::tu1_check_lshift_8 : (Unt8, Unt) -> Unt8 ;
check_rshift = inline::tu1_check_rshift_8 : (Unt8, Unt) -> Unt8 ;
check_rshiftl = inline::tu1_check_rshiftl_8 : (Unt8, Unt) -> Unt8 ;
min = inline::tu1_min_8 : (Unt8, Unt8) -> Unt8 ;
max = inline::tu1_max_8 : (Unt8, Unt8) -> Unt8 ;
};
package char {
#
max_ord = 255;
#
exception BAD_CHAR;
# The following should be an inline operator: XXX BUGGO FIXME
#
fun chr i
=
if (ti::geu (i, (ti::(+))(max_ord, 1)))
raise exception BAD_CHAR;
else ((inline::cast i) : Char);
fi;
ord = inline::cast : Char -> Int ;
(<) = inline::ti1_lt_c : (Char, Char) -> Bool ;
(<=) = inline::ti1_le_c : (Char, Char) -> Bool ;
(>) = inline::ti1_gt_c : (Char, Char) -> Bool ;
(>=) = inline::ti1_ge_c : (Char, Char) -> Bool ;
};
package poly_rw_vector {
#
make_zero_length_vector = inline::make_zero_length_vector : Void -> Rw_Vector(X) ;
make_nonempty_rw_vector = inline::make_nonempty_rw_vector : (Int, X) -> Rw_Vector(X) ;
length = inline::length : Rw_Vector(X) -> Int ;
#
get = inline::rw_vector_get : (Rw_Vector(X), Int) -> X ;
get_with_boundscheck = inline::rw_vector_get_with_boundscheck : (Rw_Vector(X), Int) -> X ;
#
set = inline::rw_vector_set : (Rw_Vector(X), Int, X) -> Void ;
set_with_boundscheck = inline::rw_vector_set_with_boundscheck : (Rw_Vector(X), Int, X) -> Void ;
#
get_vector_datachunk = inline::get_vector_datachunk : Rw_Vector(X) -> Y ;
};
package poly_rw_matrix {
#
Rw_Matrix(X)
=
{ rw_vector: Rw_Vector(X),
rows: Int,
cols: Int
};
stipulate
infix my 80 * ;
infix my 70 + ;
(+) = ti::(+); # The regular definitions of '*' and '+' don't get established until src/lib/core/init/pervasive.pkg (*) = ti::(*);
fun unsafe_index ( { rows, cols, ... }: Rw_Matrix(X), i, j) # Compute the index of an matrix element
=
(i * cols) + j;
fun index (rw_matrix: Rw_Matrix(X), i, j)
=
if ((ti::ltu (i, rw_matrix.rows) and ti::ltu (j, rw_matrix.cols)))
#
unsafe_index (rw_matrix, i, j);
else
raise exception core::INDEX_OUT_OF_BOUNDS; #
fi;
unsafe_set = poly_rw_vector::set;
unsafe_get = poly_rw_vector::get;
herein
fun get (rw_matrix: Rw_Matrix(X), (i: Int, j: Int)) = unsafe_get (rw_matrix.rw_vector, index (rw_matrix, i, j)); # This fn is duplicated in src/lib/std/src/rw-matrix.pkg fun set (rw_matrix: Rw_Matrix(X), (i: Int, j: Int), v) = unsafe_set (rw_matrix.rw_vector, index (rw_matrix, i, j), v); # This fn is duplicated in src/lib/std/src/rw-matrix.pkg end;
};
package poly_vector {
#
length = inline::length : Vector(X) -> Int ;
#
get = inline::ro_vector_get : (Vector(X), Int) -> X ;
get_with_boundscheck = inline::ro_vector_get_with_boundscheck : (Vector(X), Int) -> X ;
#
get_vector_datachunk = inline::get_vector_datachunk : Vector(X) -> Y ;
};
# The type of this ought to be float64array:
#
stipulate
Vec = rt::asm::Float64_Rw_Vector;
herein
package rw_vector_of_eight_byte_floats {
#
make_zero_length_vector = inline::make_zero_length_vector : Void -> Vec ;
length = inline::length : Vec -> Int ;
#
get = inline::rw_f64_vector_get : (Vec, Int) -> Float ;
get_with_boundscheck = inline::rw_f64_vector_get_with_boundscheck : (Vec, Int) -> Float ;
#
set = inline::rw_f64_vector_set : (Vec, Int, Float) -> Void ;
set_with_boundscheck = inline::rw_f64_vector_set_with_boundscheck : (Vec, Int, Float) -> Void ;
#
get_vector_datachunk = inline::get_vector_datachunk : Vec -> Y ;
};
end;
# NOTE: we are currently using typeagnostic vectors
# to implement the vector_of_eight_byte_floats package. XXX SUCKO FIXME
#
package vector_of_eight_byte_floats {
#
length = inline::length : Vector( Float ) -> Int ;
#
get = inline::ro_vector_get : (Vector( Float ), Int) -> Float ;
get_with_boundscheck = inline::ro_vector_get_with_boundscheck : (Vector( Float ), Int) -> Float ;
#
get_vector_datachunk = inline::get_vector_datachunk : Vector( Float ) -> Y ;
};
stipulate
Rw_Vector = rt::asm::Float64_Rw_Vector;
herein
package rw_matrix_of_eight_byte_floats {
#
Rw_Matrix
=
{ rw_vector: Rw_Vector,
rows: Int,
cols: Int
};
stipulate
infix my 80 * ;
infix my 70 + ;
(+) = ti::(+); # The regular definitions of '*' and '+' don't get established until src/lib/core/init/pervasive.pkg (*) = ti::(*);
fun unsafe_index ( { rows, cols, ... }: Rw_Matrix, i, j) # Compute the index of an matrix element
=
(i * cols) + j;
fun index (rw_matrix: Rw_Matrix, i, j)
=
if ((ti::ltu (i, rw_matrix.rows) and ti::ltu (j, rw_matrix.cols)))
#
unsafe_index (rw_matrix, i, j);
else
raise exception core::INDEX_OUT_OF_BOUNDS; #
fi;
unsafe_set = inline::rw_f64_vector_set : (Rw_Vector, Int, Float) -> Void ;
unsafe_get = inline::rw_f64_vector_get : (Rw_Vector, Int) -> Float ;
herein
fun get (rw_matrix: Rw_Matrix, (i: Int, j: Int)) = unsafe_get (rw_matrix.rw_vector, index (rw_matrix, i, j)); # This fn is duplicated in src/lib/std/src/rw-matrix-of-eight-byte-floats.pkg fun set (rw_matrix: Rw_Matrix, (i: Int, j: Int), v) = unsafe_set (rw_matrix.rw_vector, index (rw_matrix, i, j), v); # This fn is duplicated in src/lib/std/src/rw-matrix-of-eight-byte-floats.pkg end;
};
end;
package rw_vector_of_one_byte_unts {
#
Rw_Vector = rt::asm::Unt8_Rw_Vector;
#
make_zero_length_vector = inline::make_zero_length_vector : Void -> Rw_Vector ;
length = inline::length : Rw_Vector -> Int ;
#
get_vector_datachunk = inline::get_vector_datachunk : Rw_Vector -> X ;
#
set = inline::rw_int8_vector_set : (Rw_Vector, Int, Unt8) -> Void ;
set_with_boundscheck = inline::rw_int8_vector_set_with_boundscheck : (Rw_Vector, Int, Unt8) -> Void ;
#
get = inline::ro_int8_vector_get : (Rw_Vector, Int) -> Unt8 ;
get_with_boundscheck = inline::rw_int8_vector_get_with_boundscheck : (Rw_Vector, Int) -> Unt8 ;
#
# BUG: using "ro_int8_vec_get" for "get" is dangerous, because ro_int8_vec_get
# is (technically) fetching from immutable things. A fancy optimizer might
# someday be confused. XXX BUGGO FIXME
#
};
stipulate
Rw_Vector = rt::asm::Unt8_Rw_Vector;
herein
package rw_matrix_of_one_byte_unts {
#
Rw_Matrix
=
{ rw_vector: Rw_Vector,
rows: Int,
cols: Int
};
stipulate
infix my 80 * ;
infix my 70 + ;
(+) = ti::(+); # The regular definitions of '*' and '+' don't get established until src/lib/core/init/pervasive.pkg (*) = ti::(*);
fun unsafe_index ( { rows, cols, ... }: Rw_Matrix, i, j) # Compute the index of an matrix element
=
(i * cols) + j;
fun index (rw_matrix: Rw_Matrix, i, j)
=
if ((ti::ltu (i, rw_matrix.rows) and ti::ltu (j, rw_matrix.cols)))
#
unsafe_index (rw_matrix, i, j);
else
raise exception core::INDEX_OUT_OF_BOUNDS; #
fi;
unsafe_set = inline::rw_int8_vector_set : (Rw_Vector, Int, Unt8) -> Void ;
unsafe_get = inline::ro_int8_vector_get : (Rw_Vector, Int) -> Unt8 ;
herein
fun get (rw_matrix: Rw_Matrix, (i: Int, j: Int)) = unsafe_get (rw_matrix.rw_vector, index (rw_matrix, i, j)); # This fn is duplicated in src/lib/std/src/rw-matrix-of-one-byte-unts.pkg fun set (rw_matrix: Rw_Matrix, (i: Int, j: Int), v) = unsafe_set (rw_matrix.rw_vector, index (rw_matrix, i, j), v); # This fn is duplicated in src/lib/std/src/rw-matrix-of-one-byte-unts.pkg end;
};
end;
# Preliminary version with just the type:
#
package vector_of_one_byte_unts : api { eqtype Vector;
make_vector_of_one_byte_unts: Int -> Vector;
}
{ Vector = String;
make_vector_of_one_byte_unts = rt::asm::make_string;
};
# Now the real version with all values:
#
package vector_of_one_byte_unts {
#
include package vector_of_one_byte_unts;
#
length = inline::length : Vector -> Int ;
#
get = inline::ro_int8_vector_get : (Vector, Int) -> Unt8 ;
get_with_boundscheck = inline::ro_int8_vector_get_with_boundscheck : (Vector, Int) -> Unt8 ;
#
set = inline::rw_int8_vector_set : (Vector, Int, Unt8) -> Void ;
#
get_vector_datachunk = inline::get_vector_datachunk : Vector -> X ;
};
package rw_vector_of_chars : api { # Preliminary version of package.
eqtype Rw_Vector;
#
make_zero_length_vector : Void -> Rw_Vector;
make_nonempty_rw_vector_of_chars : Int -> Rw_Vector;
}
{
Rw_Vector = rt::asm::Unt8_Rw_Vector;
#
make_zero_length_vector = inline::make_zero_length_vector : Void -> Rw_Vector ;
#
make_nonempty_rw_vector_of_chars = rt::asm::make_unt8_rw_vector;
};
package rw_vector_of_chars { # Full version of package.
#
include package rw_vector_of_chars;
#
length = inline::length : Rw_Vector -> Int ;
#
get = inline::ro_int8_vector_get : (Rw_Vector, Int) -> Char ;
get_with_boundscheck = inline::ro_int8_vector_get_with_boundscheck : (Rw_Vector, Int) -> Char ;
#
set = inline::rw_int8_vector_set : (Rw_Vector, Int, Char) -> Void ;
set_with_boundscheck = inline::rw_int8_vector_set_with_boundscheck : (Rw_Vector, Int, Char) -> Void ;
#
get_vector_datachunk = inline::get_vector_datachunk : Rw_Vector -> X ;
};
package vector_of_chars {
#
length = inline::length : String -> Int ;
#
get_byte_as_char = inline::ro_int8_vector_get : (String, Int) -> Char ;
get_byte_as_char_with_boundscheck = inline::ro_int8_vector_get_with_boundscheck : (String, Int) -> Char ;
get_byte = inline::ro_int8_vector_get : (String, Int) -> Int ;
get_byte_with_boundscheck = inline::ro_int8_vector_get_with_boundscheck : (String, Int) -> Int ;
#
set_char_as_byte = inline::rw_int8_vector_set : (String, Int, Char) -> Void ;
set_byte = inline::rw_int8_vector_set : (String, Int, Int) -> Void ;
#
get_vector_datachunk = inline::get_vector_datachunk : String -> X ;
};
package default_int = ti;
package default_unt = tu;
package default_float = f64;
}; # package inline_t
end; # stipulate