## rw-vector.pkg
# Compiled by:
# src/lib/std/src/standard-core.sublibstipulate
package bt = base_types; # base_types is from src/lib/core/init/built-in.pkg package ig = int_guts; # int_guts is from src/lib/std/src/int-guts.pkg package it = inline_t; # inline_t is from src/lib/core/init/built-in.pkg package rt = runtime; # runtime is from src/lib/core/init/runtime.pkgherein
package rw_vector
: (weak) Rw_Vector # Rw_Vector is from src/lib/std/src/rw-vector.api {
Rw_Vector(X) = bt::Rw_Vector(X);
Vector(X) = bt::Vector(X);
# Fast add/subtract avoiding
# the overflow test:
#
infix my --- +++ ;
#
fun x --- y = it::tu::copyt_tagged_int (it::tu::copyf_tagged_int x - it::tu::copyf_tagged_int y);
fun x +++ y = it::tu::copyt_tagged_int (it::tu::copyf_tagged_int x + it::tu::copyf_tagged_int y);
maximum_vector_length = core::maximum_vector_length;
make_rw_vector = it::poly_rw_vector::make_nonempty_rw_vector : (Int, X) -> Rw_Vector(X);
# fun make_rw_vector (0, _) => it::poly_rw_vector::newArray0()
#
# make_rw_vector (n, init)
# =>
# if it::DfltInt::ltu (maxLen, n) then
# raise exception core::SIZE ;
# else
# rt::asm::rw_vector (n, init);
# fi;
# end;
fun from_list []
=>
it::poly_rw_vector::make_zero_length_vector();
from_list (l as (first ! rest))
=>
fill (1, rest)
where
fun len (_ ! _ ! r, i) => len (r, i +++ 2);
len([x], i) => i +++ 1;
len([], i) => i;
end;
n = len (l, 0);
a = make_rw_vector (n, first);
fun fill (i, [])
=>
a;
fill (i, x ! r)
=>
{ it::poly_rw_vector::set (a, i, x);
fill (i +++ 1, r);
};
end;
end;
end;
fun from_fn (0, _)
=>
it::poly_rw_vector::make_zero_length_vector();
from_fn (n, f: Int -> X) : Rw_Vector(X)
=>
tab 1
where
a = make_rw_vector (n, f 0);
fun tab i
=
if (i < n)
#
it::poly_rw_vector::set (a, i, f i);
tab (i +++ 1);
else
a;
fi;
end;
end;
length = it::poly_rw_vector::length : Rw_Vector(X) -> Int;
# Note: The (_[]) enables 'vec[index]' notation;
# The (_[]:=) enables 'vec[index] := value' notation;
get = it::poly_rw_vector::get_with_boundscheck : (Rw_Vector(X), Int) -> X;
(_[]) = it::poly_rw_vector::get_with_boundscheck : (Rw_Vector(X), Int) -> X;
set = it::poly_rw_vector::set_with_boundscheck : (Rw_Vector(X), Int, X) -> Void;
(_[]:=) = it::poly_rw_vector::set_with_boundscheck : (Rw_Vector(X), Int, X) -> Void;
unsafe_get = it::poly_rw_vector::get;
unsafe_set = it::poly_rw_vector::set;
ro_unsafe_get = it::poly_vector::get;
ro_length = it::poly_vector::length;
fun copy { from, into, at } # Copy contents of rw_vector 'from' into rw_vector 'into' starting at offset index 'at'.
=
{ if (at < 0 or at > length into) raise exception INDEX_OUT_OF_BOUNDS; fi;
#
copy_dn (sl --- 1, de --- 1);
}
where
sl = length from;
de = at + sl; # "de" == "destination end" -- one greater than last slot to write.
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; # "de" == "destination end".
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
=
modify' 0
where
len = length v;
fun modify' i
=
if (i < len)
#
unsafe_set (v, i, f (unsafe_get (v, i)));
modify' (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) fold (i +++ 1, f (i, unsafe_get (v, i), a));
else a;
fi;
end;
fun fold_forward f init v
=
fold (0, init)
where
len = length v;
fun fold (i, a)
=
if (i < len) fold (i +++ 1, f (unsafe_get (v, i), a));
else 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 = it::ti::min (l1, l2);
fun coll i
=
if (i >= l12)
#
ig::compare (l1, l2);
else
case (c (unsafe_get (a1, i), unsafe_get (a2, i)))
#
EQUAL => coll (i +++ 1);
unequal => unequal;
esac;
fi;
end;
# XXX BUGGO FIXME: this is inefficient (going through intermediate list):
#
fun to_vector v
=
case (length v)
#
0 => rt::zero_length_vector__global;
#
len => rt::asm::make_typeagnostic_ro_vector (len, fold_backward (!) [] v);
esac;
}; # package rw_vector
end;