## rw-vector-slice-of-chars.pkg
# Compiled by:
# src/lib/std/src/standard-core.sublib### "Any fool can know. The
### point is to understand."
###
### -- Albert Einstein
package rw_vector_slice_of_chars : Typelocked_Rw_Vector_Slice # Typelocked_Rw_Vector_Slice is from src/lib/std/src/typelocked-rw-vector-slice.api where Element == Char
where Rw_Vector == rw_vector_of_chars::Rw_Vector
where Vector == vector_of_chars::Vector
where Vector_Slice == vector_slice_of_chars::Slice
= package {
# inline_t is from src/lib/core/init/built-in.pkg Element = Char;
Rw_Vector = rw_vector_of_chars::Rw_Vector;
Vector = vector_of_chars::Vector;
Vector_Slice = vector_slice_of_chars::Slice;
Slice = SLICE { base: Rw_Vector,
start: Int,
stop: Int
};
# Fast add/subtract avoiding
# the overflow test:
#
infix my --- +++;
#
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);
unsafe_get = inline_t::rw_vector_of_chars::get;
unsafe_set = inline_t::rw_vector_of_chars::set;
ro_unsafe_get = inline_t::vector_of_chars::get_byte_as_char;
ro_unsafe_set = inline_t::vector_of_chars::set_char_as_byte;
rw_length = inline_t::rw_vector_of_chars::length;
ro_length = inline_t::vector_of_chars::length;
fun length (SLICE { start, stop, ... } )
=
stop --- start;
fun get (SLICE { base, start, stop }, i)
=
{ i' = start + i;
#
if (i' < start or i' >= stop) raise exception INDEX_OUT_OF_BOUNDS;
else unsafe_get (base, i');
fi;
};
fun set (SLICE { base, start, stop }, i, x)
=
{ i' = start + i;
#
if (i' < start
or i' >= stop
) raise exception INDEX_OUT_OF_BOUNDS;
else unsafe_set (base, i', x);
fi;
};
(_[]) = get; # Enables 'vec[index]' notation;
(_[]:=) = set; # Enables 'vec[index] := value' notation;
fun make_full_slice rw_vector
=
SLICE
{ base => rw_vector,
start => 0,
stop => rw_length rw_vector
};
fun make_slice (rw_vector, start, olen)
=
{ al = rw_length rw_vector;
#
SLICE
{ base => rw_vector,
#
start => if (start < 0 or al < start) raise exception INDEX_OUT_OF_BOUNDS;
else start;
fi,
stop => case olen
#
NULL => al;
#
THE len =>
{ stop = start +++ len;
#
if (stop < start or al < stop) raise exception INDEX_OUT_OF_BOUNDS;
else stop;
fi;
};
esac
};
};
fun make_subslice (SLICE { base, start, stop }, i, olen)
=
{ start' = if (i < 0 or stop < i) raise exception INDEX_OUT_OF_BOUNDS;
else start +++ i;
fi;
stop' = case olen
#
NULL => stop;
#
THE len =>
{ stop' = start' +++ len;
#
if (stop' < start' or stop < stop') raise exception INDEX_OUT_OF_BOUNDS;
else stop';
fi;
};
esac;
SLICE { base, start => start', stop => stop' };
};
fun burst_slice (SLICE { base, start, stop } )
=
(base, start, stop --- start);
fun to_vector (SLICE { base, start, stop } )
=
case (stop --- start)
#
0 => "";
#
len => { s = runtime::asm::make_string len;
#
fun fill (i, j)
=
if (i < len)
#
ro_unsafe_set (s, i, unsafe_get (base, j));
#
fill (i +++ 1, j +++ 1);
fi;
fill (0, start); s;
};
esac;
fun copy { from => SLICE { base, start, stop }, into, at }
=
{ sl = stop --- start;
de = at + sl;
fun copy_dn (s, d)
=
if (s >= start)
#
unsafe_set (into, d, unsafe_get (base, s));
#
copy_dn (s --- 1, d --- 1);
fi;
fun copy_up (s, d)
=
if (s < stop)
#
unsafe_set (into, d, unsafe_get (base, s));
#
copy_up (s +++ 1, d +++ 1);
fi;
if (at < 0 or de > rw_length into) raise exception INDEX_OUT_OF_BOUNDS;
elif (at >= start ) copy_dn (stop --- 1, de --- 1);
else copy_up (start, at);
fi;
};
fun copy_vector { from => vsl, into, at }
=
{ (vector_slice_of_chars::burst_slice vsl)
->
(base, start, vlen);
de = at + vlen;
fun copy_up (s, d)
=
if (d < de)
#
unsafe_set (into, d, ro_unsafe_get (base, s));
copy_up (s +++ 1, d +++ 1);
fi;
if (at < 0 or de > rw_length into)
#
raise exception INDEX_OUT_OF_BOUNDS;
else
copy_up (start, at); # Assume vector and rw_vector are disjoint
fi;
};
fun is_empty (SLICE { start, stop, ... } )
=
start == stop;
fun get_item (SLICE { base, start, stop } )
=
if (start >= stop)
#
NULL;
else
THE (unsafe_get (base, start),
SLICE { base, start => start +++ 1, stop } );
fi;
fun keyed_apply f (SLICE { base, start, stop } )
=
apply start
where
fun apply i
=
if (i < stop)
#
f (i --- start, unsafe_get (base, i));
apply (i +++ 1);
fi;
end;
fun apply f (SLICE { base, start, stop } )
=
apply start
where
fun apply i
=
if (i < stop)
#
f (unsafe_get (base, i));
apply (i +++ 1);
fi;
end;
fun keyed_map_in_place f (SLICE { base, start, stop } )
=
mdf start
where
fun mdf i
=
if (i < stop)
#
unsafe_set (base, i, f (i --- start, unsafe_get (base, i)));
mdf (i +++ 1);
fi;
end;
fun map_in_place f (SLICE { base, start, stop } )
=
mdf start
where
fun mdf i
=
if (i < stop)
#
unsafe_set (base, i, f (unsafe_get (base, i)));
mdf (i +++ 1);
fi;
end;
fun keyed_fold_forward f init (SLICE { base, start, stop } )
=
fold (start, init)
where
fun fold (i, a)
=
if (i >= stop) a;
else fold (i +++ 1, f (i --- start, unsafe_get (base, i), a));
fi;
end;
fun fold_forward f init (SLICE { base, start, stop } )
=
fold (start, init)
where
fun fold (i, a)
=
if (i >= stop) a;
else fold (i +++ 1, f (unsafe_get (base, i), a));
fi;
end;
fun keyed_fold_backward f init (SLICE { base, start, stop } )
=
fold (stop --- 1, init)
where
fun fold (i, a)
=
if (i < start) a;
else fold (i --- 1, f (i --- start, unsafe_get (base, i), a));
fi;
end;
fun fold_backward f init (SLICE { base, start, stop } )
=
fold (stop --- 1, init)
where
fun fold (i, a)
=
if (i < start) a;
else fold (i --- 1, f (unsafe_get (base, i), a));
fi;
end;
fun keyed_find p (SLICE { base, start, stop } )
=
fnd start
where
fun fnd i
=
if (i >= stop)
#
NULL;
else
x = unsafe_get (base, i);
#
if (p (i, x)) THE (i --- start, x);
else fnd (i +++ 1);
fi;
fi;
end;
fun find p (SLICE { base, start, stop } )
=
fnd start
where
fun fnd i
=
if (i >= stop)
#
NULL;
else
x = unsafe_get (base, i);
#
if (p x) THE x;
else fnd (i +++ 1);
fi;
fi;
end;
fun exists p (SLICE { base, start, stop } )
=
ex start
where
fun ex i
=
i < stop and (p (unsafe_get (base, i)) or ex (i +++ 1));
end;
fun all p (SLICE { base, start, stop } )
=
al start
where
fun al i
=
i >= stop
or
( p (unsafe_get (base, i))
and
al (i +++ 1)
);
end;
fun compare_sequences c (SLICE { base => b1, start => s1, stop => e1 },
SLICE { base => b2, start => s2, stop => e2 } )
=
col (s1, s2)
where
fun col (i1, i2)
=
if (i1 >= e1)
#
if (i2 >= e2) EQUAL;
else LESS;
fi;
#
elif (i2 >= e2)
#
GREATER;
else
case (c (unsafe_get (b1, i1), unsafe_get (b2, i2)))
#
EQUAL => col (i1 +++ 1, i2 +++ 2);
unequal => unequal;
esac;
fi;
end;
};