## rw-vector-of-chars.pkg
# Compiled by:
# src/lib/std/src/standard-core.sublibstipulate
package string = string_guts; # string_guts is from src/lib/std/src/string-guts.pkg package rwv = inline_t::rw_vector_of_chars; # inline_t is from src/lib/core/init/built-in.pkgherein
package rw_vector_of_chars: (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 val --- +++;
#
fun x --- y = inline_t::tu::copyt_tagged_int (inline_t::tu::copyf_tagged_int x - inline_t::tu::copyf_tagged_int y);
fun x +++ y = inline_t::tu::copyt_tagged_int (inline_t::tu::copyf_tagged_int x + inline_t::tu::copyf_tagged_int y);
# Unchecked access operations
#
unsafe_set = rwv::set;
unsafe_get = rwv::get;
#
ro_unsafe_set = inline_t::vector_of_chars::set;
ro_unsafe_get = inline_t::vector_of_chars::get;
#
ro_length = inline_t::vector_of_chars::length;
Element = Char;
Vector = String;
Rw_Vector = rwv::Rw_Vector;
max_len = core::max_length;
fun make_rw_vector (0, c)
=>
rwv::new_array0 ();
make_rw_vector (len, c)
=>
if (inline_t::default_int::ltu (max_len, len))
#
raise exception exceptions_guts::SIZE; # exceptions_guts is from src/lib/std/src/exceptions-guts.pkg else
vec = rwv::create len;
for (i = 0; i < len; ++i) {
#
unsafe_set (vec, i, c);
};
vec;
fi;
end;
fun tabulate (0, _)
=>
rwv::new_array0();
tabulate (len, f)
=>
if (inline_t::default_int::ltu (max_len, len))
#
raise exception exceptions_guts::SIZE; # exceptions_guts is from src/lib/std/src/exceptions-guts.pkg else
vec = rwv::create len;
for (i = 0; i < len; ++i) {
#
unsafe_set (vec, i, f i);
};
vec;
fi;
end;
fun from_list []
=>
rwv::new_array0 ();
from_list l
=>
arr
where
fun length ([], n) => n;
length (_ ! r, n) => length (r, n+1);
end;
len = length (l, 0);
if (len > max_len) raise exception exceptions_guts::SIZE; fi; # exceptions_guts is from src/lib/std/src/exceptions-guts.pkg arr = rwv::create len;
fun init ([], _) => ();
init (c ! r, i) => { unsafe_set (arr, i, c); init (r, i+1); };
end;
init (l, 0);
end;
end;
# Note: The (_[]) enables 'vec[index]' notation;
# The (_[]:=) enables 'vec[index] := value' notation;
my length: Rw_Vector -> Int = inline_t::rw_vector_of_chars::length;
my get: ((Rw_Vector, Int)) -> Element = inline_t::rw_vector_of_chars::check_sub;
my (_[]): ((Rw_Vector, Int)) -> Element = inline_t::rw_vector_of_chars::check_sub;
my set: ((Rw_Vector, Int, Element)) -> Void = inline_t::rw_vector_of_chars::check_set;
my (_[]:=): ((Rw_Vector, Int, Element)) -> Void = inline_t::rw_vector_of_chars::check_set;
fun to_vector a
=
case (length a)
#
0 => "";
len =>
{ s = runtime::asm::make_string len;
fun fill i
=
if (i < len)
#
ro_unsafe_set (s, i, unsafe_get (a, i));
fill (i +++ 1);
fi;
fill 0;
s;
};
esac;
fun copy { from, to, di }
=
{ sl = length from;
de = sl + di;
fun copy_dn (s, d)
=
if (s >= 0)
#
unsafe_set (to, d, unsafe_get (from, s));
copy_dn (s --- 1, d --- 1);
fi;
if (di < 0 or de > length to) raise exception SUBSCRIPT;
else copy_dn (sl --- 1, de --- 1);
fi;
};
fun copy_vec { from, to, di }
=
{ sl = ro_length from;
de = sl + di;
fun copy_dn (s, d)
=
if (s >= 0)
#
unsafe_set (to, d, ro_unsafe_get (from, s));
copy_dn (s --- 1, d --- 1);
fi;
if (di < 0 or de > length to) raise exception SUBSCRIPT;
else copy_dn (sl --- 1, de --- 1);
fi;
};
fun keyed_apply f arr
=
apply 0
where
len = length arr;
fun apply i
=
if (i < len)
#
f (i, unsafe_get (arr, i));
apply (i +++ 1);
fi;
end;
fun apply f arr
=
apply 0
where
len = length arr;
fun apply i
=
if (i < len)
#
f (unsafe_get (arr, i));
apply (i +++ 1);
fi;
end;
fun modifyi f arr
=
mdf 0
where
len = length arr;
fun mdf i
=
if (i < len)
#
unsafe_set (arr, i, f (i, unsafe_get (arr, i)));
mdf (i +++ 1);
fi;
end;
fun modify f arr
=
mdf 0
where
len = length arr;
fun mdf i
=
if (i < len)
#
unsafe_set (arr, i, f (unsafe_get (arr, i)));
mdf (i +++ 1);
fi;
end;
fun keyed_fold_left f init arr
=
fold (0, init)
where
len = length arr;
fun fold (i, a)
=
if (i >= len) a;
else fold (i +++ 1, f (i, unsafe_get (arr, i), a));
fi;
end;
fun fold_left f init arr
=
fold (0, init)
where
len = length arr;
fun fold (i, a)
=
if (i >= len) a;
else fold (i +++ 1, f (unsafe_get (arr, i), a));
fi;
end;
fun keyed_fold_right f init arr
=
fold (length arr --- 1, init)
where
fun fold (i, a)
=
if (i < 0) a;
else fold (i --- 1, f (i, unsafe_get (arr, i), a));
fi;
end;
fun fold_right f init arr
=
fold (length arr --- 1, init)
where
fun fold (i, a)
=
if (i < 0) a;
else fold (i --- 1, f (unsafe_get (arr, i), a));
fi;
end;
fun findi p arr
=
fnd 0
where
len = length arr;
fun fnd i
=
if (i >= len)
#
NULL;
else
x = unsafe_get (arr, i);
#
if (p (i, x)) THE (i, x);
else fnd (i +++ 1);
fi;
fi;
end;
fun find p arr
=
fnd 0
where
len = length arr;
fun fnd i
=
if (i >= len)
#
NULL;
else
x = unsafe_get (arr, i);
#
if (p x) THE x;
else fnd (i +++ 1);
fi;
fi;
end;
fun exists p arr
=
ex 0
where
len = length arr;
fun ex i
=
i < len
and
( p (unsafe_get (arr, i))
or
ex (i +++ 1)
);
end;
fun all p arr
=
al 0
where
len = length arr;
fun al i
=
i >= len
or
( p (unsafe_get (arr, i))
and
al (i +++ 1)
);
end;
fun collate c (a1, a2)
=
coll 0
where
l1 = length a1;
l2 = length a2;
l12 = inline_t::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_chars
end;