## vector-slice-of-one-byte-unts.pkg
## Author: Matthias Blume (blume@tti-c.org)
# Compiled by:
# src/lib/std/src/standard-core.sublib### "Probably there is an imperceptible touch of
### something permanent that one feels instinctively
### to adhere to true humour, whereas wit may be
### the mere conversational shooting up of "smartness" --
### a bright feather, to be blown into space the
### second after it is launched...
###
### "Wit seems to be counted a very poor relation to Humour...
###
### "Humour is never artificial."
###
### -- Mark Twain
### quoted in Sydney Morning Herald,
### September 17, 1895,, pp. 5-6.
package vector_slice_of_one_byte_unts : Typelocked_Vector_Slice # Typelocked_Vector_Slice is from src/lib/std/src/typelocked-vector-slice.api where Element == one_byte_unt::Unt
where Vector == vector_of_one_byte_unts::Vector
=
package {
# inline_t is from src/lib/core/init/built-in.pkg # 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);
Element = one_byte_unt::Unt;
Vector = vector_of_one_byte_unts::Vector;
Slice = SLICE { base: Vector,
start: Int,
stop: Int
};
unsafe_get = inline_t::vector_of_one_byte_unts::get;
vlength = inline_t::vector_of_one_byte_unts::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 SUBSCRIPT;
else unsafe_get (base, i');
fi;
};
fun make_full_slice vec
=
SLICE { base => vec, start => 0, stop => vlength vec };
fun make_slice (vec, start, olen)
=
{ vl = vlength vec;
SLICE
{ base => vec,
start => if (start < 0 or vl < start) raise exception SUBSCRIPT;
else start;
fi,
stop => case olen
#
NULL => vl;
#
THE len => { stop = start +++ len;
if (stop < start or vl < stop) raise exception SUBSCRIPT;
else stop;
fi;
};
esac
};
};
fun make_subslice (SLICE { base, start, stop }, i, olen)
=
{ start' = if (i < 0 or stop < i) raise exception SUBSCRIPT;
else start +++ i;
fi;
stop' = case olen
#
NULL => stop;
#
THE len =>
{ stop' = start' +++ len;
#
if (stop' < start' or stop < stop') raise exception SUBSCRIPT;
else stop';
fi;
};
esac;
SLICE { base, start => start', stop => stop' };
};
fun base (SLICE { base, start, stop } )
=
(base, start, stop --- start);
fun to_vector (SLICE { base, start, stop } )
=
vector_of_one_byte_unts::tabulate (stop --- start, fn i = unsafe_get (base, start +++ i) );
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_fold_left 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_left 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_right 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_right 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 cat sll
=
vector_of_one_byte_unts::from_list (
reverse (
list::fold_left
(fn (sl, l) = fold_left (!) l sl)
[]
sll
)
);
fun keyed_map f sl
=
vector_of_one_byte_unts::from_list (
reverse (
keyed_fold_left
(fn (i, x, a) = f (i, x) ! a)
[]
sl
)
);
fun map f sl
=
vector_of_one_byte_unts::from_list (
reverse (
fold_left
(fn (x, a) = f x ! a)
[]
sl
)
);
fun findi 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 collate 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;
else
if (i2 >= e2) GREATER;
else
case (c (unsafe_get (b1, i1), unsafe_get (b2, i2)))
#
EQUAL => col (i1 +++ 1, i2 +++ 1);
unequal => unequal;
esac;
fi;
fi;
end;
};