## rw-vector-of-one-byte-unts.pkg
# Compiled by:
#
src/lib/std/src/standard-core.sublib### "The motto stated a lie. If this nation has ever trusted in God,
### that time has gone by; for nearly half a century almost its
### entire trust has been in the Republican party and the dollar --
### mainly the dollar.
###
### "I recognize that I am only making an assertion and furnishing no proof;
### I am sorry, but this is a habit of mine; sorry also that I am not alone in it;
### everybody seems to have this disease."
###
### -- Mark Twain in Eruption
stipulate
package inl = inline_t; # inline_t is from
src/lib/core/init/built-in.pkg package rt = runtime; # runtime is from src/lib/core/init/built-in.pkg.
package u1b = one_byte_unt; # one_byte_unt is from
src/lib/std/types-only/basis-structs.pkg package v1b = vector_of_one_byte_unts; # vector_of_one_byte_unts is from
src/lib/std/src/vector-of-one-byte-unts.pkg #
package rwv = inl::rw_vector_of_one_byte_unts; #
package rov = inl::vector_of_one_byte_unts;
herein
package rw_vector_of_one_byte_unts
: (weak) Typelocked_Rw_Vector # Typelocked_Rw_Vector is from
src/lib/std/src/typelocked-rw-vector.api {
# Fast add/subtract avoiding
# the overflow test:
#
infix my --- +++ ;
#
fun x --- y = inl::tu::copyt_tagged_int (inl::tu::copyf_tagged_int x - inl::tu::copyf_tagged_int y);
fun x +++ y = inl::tu::copyt_tagged_int (inl::tu::copyf_tagged_int x + inl::tu::copyf_tagged_int y);
# Unchecked access operations
#
unsafe_set = rwv::set;
unsafe_get = rwv::get;
#
ro_unsafe_set = rov::set;
ro_unsafe_get = rov::get;
ro_length = rov::length;
Rw_Vector = rwv::Rw_Vector;
Element = u1b::Unt;
Vector = v1b::Vector;
empty_v = inl::cast "": Vector;
maximum_vector_length = core::maximum_vector_length;
fun make_rw_vector (0, _)
=>
rwv::make_zero_length_vector();
make_rw_vector (len, initial_value)
=>
if (inl::default_int::ltu (maximum_vector_length, len))
#
raise exception exceptions_guts::SIZE; # exceptions_guts is from
src/lib/std/src/exceptions-guts.pkg else
v = rt::asm::make_unt8_rw_vector len;
init 0
where
fun init i
=
if (i < len)
#
unsafe_set (v, i, initial_value);
init (i+1);
fi;
end;
v;
fi;
end;
fun from_fn (0, _) => rwv::make_zero_length_vector ();
#
from_fn (len, f)
=>
v
where
if (inl::default_int::ltu (maximum_vector_length, len)) raise exception exceptions_guts::SIZE; fi;
v = rt::asm::make_unt8_rw_vector len;
fun init i
=
if (i < len)
#
unsafe_set (v, i, f i);
init (i+1);
fi;
init 0;
end;
end;
fun from_list [] => rwv::make_zero_length_vector();
#
from_list l
=>
v
where
fun length ([], n) => n;
length (_ ! r, n) => length (r, n+1);
end;
len = length (l, 0);
if (len > maximum_vector_length) raise exception exceptions_guts::SIZE; fi;
v = rt::asm::make_unt8_rw_vector len;
fun init ([], _) => ();
init (c ! r, i) => { unsafe_set (v, i, c); init (r, i+1); };
end;
init (l, 0);
end;
end;
# Note: The (_[]) enables 'vec[index]' notation;
# The (_[]:=) enables 'vec[index] := value' notation;
length = rwv::length;
get = rwv::get_with_boundscheck;
(_[]) = rwv::get_with_boundscheck;
set = rwv::set_with_boundscheck;
(_[]:=) = rwv::set_with_boundscheck;
fun to_vector a
=
case (length a)
#
0 => empty_v;
#
len => v
where
(inl::cast (rt::asm::make_string len))
->
v: v1b::Vector;
fun fill i
=
if (i < len)
#
ro_unsafe_set (v, i, unsafe_get (a, i));
fill (i +++ 1);
fi;
fill 0;
end;
esac;
fun copy { from, into, at }
=
{ if (at < 0 or de > length into) raise exception INDEX_OUT_OF_BOUNDS; fi;
#
copy_dn (sl --- 1, de --- 1);
}
where
sl = length from;
de = at + sl ;
fun copy_dn (s, d)
=
if (s >= 0)
#
unsafe_set (into, d, unsafe_get (from, s));
copy_dn (s --- 1, d --- 1);
fi;
end;
fun copy_vector { from, into, at }
=
{ sl = ro_length from;
de = at + sl;
fun copy_dn (s, d)
=
if (s >= 0)
#
unsafe_set (into, d, ro_unsafe_get (from, s));
copy_dn (s --- 1, d --- 1);
fi;
if (at < 0 or de > length into)
#
raise exception INDEX_OUT_OF_BOUNDS;
else
copy_dn (sl --- 1, de --- 1);
fi;
};
fun keyed_apply f v
=
apply 0
where
len = length v;
fun apply i
=
if (i < len)
#
f (i, unsafe_get (v, i));
apply (i +++ 1);
fi;
end;
fun apply f v
=
apply 0
where
len = length v;
fun apply i
=
if (i < len)
#
f (unsafe_get (v, i));
apply (i +++ 1);
fi;
end;
fun keyed_map_in_place f v
=
mdf 0
where
len = length v;
fun mdf i
=
if (i < len)
#
unsafe_set (v, i, f (i, unsafe_get (v, i)));
mdf (i +++ 1);
fi;
end;
fun map_in_place f v
=
mdf 0
where
len = length v;
fun mdf i
=
if (i < len)
#
unsafe_set (v, i, f (unsafe_get (v, i)));
mdf (i +++ 1);
fi;
end;
fun keyed_fold_forward f init v
=
fold (0, init)
where
len = length v;
fun fold (i, a)
=
if (i >= len) a;
else fold (i +++ 1, f (i, unsafe_get (v, i), a));
fi;
end;
fun fold_forward f init v
=
fold (0, init)
where
len = length v;
fun fold (i, a)
=
if (i >= len)
#
a;
else
fold (i +++ 1, f (unsafe_get (v, i), a));
fi;
end;
fun keyed_fold_backward f init v
=
fold (length v --- 1, init)
where
fun fold (i, a)
=
if (i < 0)
#
a;
else
fold (i --- 1, f (i, unsafe_get (v, i), a));
fi;
end;
fun fold_backward f init v
=
fold (length v --- 1, init)
where
fun fold (i, a)
=
if (i < 0)
#
a;
else
fold (i --- 1, f (unsafe_get (v, i), a));
fi;
end;
fun keyed_find p v
=
fnd 0
where
len = length v;
fun fnd i
=
if (i >= len)
#
NULL;
else
x = unsafe_get (v, i);
#
if (p (i, x)) THE (i, x);
else fnd (i +++ 1);
fi;
fi;
end;
fun find p v
=
fnd 0
where
len = length v;
fun fnd i
=
if (i >= len)
#
NULL;
else
x = unsafe_get (v, i);
#
if (p x) THE x;
else fnd (i +++ 1);
fi;
fi;
end;
fun exists p v
=
ex 0
where
len = length v;
fun ex i
=
i < len
and
( p (unsafe_get (v, i))
or
ex (i +++ 1)
);
end;
fun all p v
=
al 0
where
len = length v;
fun al i
=
i >= len
or
( p (unsafe_get (v, i))
and
al (i +++ 1)
);
end;
fun compare_sequences c (a1, a2)
=
coll 0
where
l1 = length a1;
l2 = length a2;
l12 = inl::ti::min (l1, l2);
fun coll i
=
if (i >= l12)
#
int_guts::compare (l1, l2);
else
case (c (unsafe_get (a1, i), unsafe_get (a2, i)))
#
EQUAL => coll (i +++ 1);
unequal => unequal;
esac;
fi;
end;
}; # package rw_vector_of_one_byte_unts
end;