Data commit
This commit is contained in:
Ingy döt Net
parent
7387c8f97b
commit
cb5bb5e222
199093 changed files with 3378972 additions and 0 deletions
|
|
@ -0,0 +1,90 @@
|
|||
(* Remove duplicate elements.
|
||||
|
||||
This implementation is for elements that have an "equals" (or
|
||||
"equivalence") predicate. It runs O(n*n) in the number of
|
||||
elements. *)
|
||||
|
||||
#include "share/atspre_staload.hats"
|
||||
|
||||
(* How the remove_dups template function will be called. *)
|
||||
extern fn {a : t@ype}
|
||||
remove_dups
|
||||
{n : int}
|
||||
(eq : (a, a) -<cloref> bool,
|
||||
src : arrayref (a, n),
|
||||
n : size_t n,
|
||||
dst : arrayref (a, n),
|
||||
m : &size_t? >> size_t m)
|
||||
:<!refwrt> #[m : nat | m <= n]
|
||||
void
|
||||
|
||||
(* An implementation of the remove_dups template function. *)
|
||||
implement {a}
|
||||
remove_dups {n} (eq, src, n, dst, m) =
|
||||
if n = i2sz 0 then
|
||||
m := i2sz 0
|
||||
else
|
||||
let
|
||||
fun
|
||||
peruse_src
|
||||
{i : int | 1 <= i; i <= n}
|
||||
{j : int | 1 <= j; j <= i}
|
||||
.<n - i>.
|
||||
(i : size_t i,
|
||||
j : size_t j)
|
||||
:<!refwrt> [m : int | 1 <= m; m <= n]
|
||||
size_t m =
|
||||
let
|
||||
fun
|
||||
already_seen
|
||||
{k : int | 0 <= k; k <= j}
|
||||
.<j - k>.
|
||||
(x : a,
|
||||
k : size_t k)
|
||||
:<!ref> bool =
|
||||
if k = j then
|
||||
false
|
||||
else if eq (x, dst[k]) then
|
||||
true
|
||||
else
|
||||
already_seen (x, succ k)
|
||||
in
|
||||
if i = n then
|
||||
j
|
||||
else if already_seen (src[i], i2sz 0) then
|
||||
peruse_src (succ i, j)
|
||||
else
|
||||
begin
|
||||
dst[j] := src[i];
|
||||
peruse_src (succ i, succ j)
|
||||
end
|
||||
end
|
||||
|
||||
prval () = lemma_arrayref_param src (* Prove 0 <= n. *)
|
||||
in
|
||||
dst[0] := src[0];
|
||||
m := peruse_src (i2sz 1, i2sz 1)
|
||||
end
|
||||
|
||||
implement (* A demonstration with strings. *)
|
||||
main0 () =
|
||||
let
|
||||
val eq = lam (x : string, y : string) : bool =<cloref> (x = y)
|
||||
|
||||
val src =
|
||||
arrayref_make_list<string>
|
||||
(10, $list ("a", "c", "b", "e", "a",
|
||||
"a", "d", "d", "b", "c"))
|
||||
val dst = arrayref_make_elt<string> (i2sz 10, "?")
|
||||
var m : size_t
|
||||
in
|
||||
remove_dups<string> (eq, src, i2sz 10, dst, m);
|
||||
let
|
||||
prval [m : int] EQINT () = eqint_make_guint m
|
||||
var i : natLte m
|
||||
in
|
||||
for (i := 0; i2sz i <> m; i := succ i)
|
||||
print! (" ", dst[i] : string);
|
||||
println! ()
|
||||
end
|
||||
end
|
||||
|
|
@ -0,0 +1,198 @@
|
|||
(* Remove duplicate elements.
|
||||
|
||||
This implementation is for elements that have an "equals" (or
|
||||
"equivalence") predicate. It runs O(n*n) in the number of
|
||||
elements. It uses a linked list and supports linear types.
|
||||
|
||||
The equality predicate is implemented as a template function. *)
|
||||
|
||||
#include "share/atspre_staload.hats"
|
||||
staload UN = "prelude/SATS/unsafe.sats"
|
||||
|
||||
#define NIL list_vt_nil ()
|
||||
#define :: list_vt_cons
|
||||
|
||||
(*------------------------------------------------------------------*)
|
||||
(* Interfaces *)
|
||||
|
||||
extern fn {a : vt@ype}
|
||||
array_remove_dups
|
||||
{n : int}
|
||||
{p_arr : addr}
|
||||
(pf_arr : array_v (a, p_arr, n) |
|
||||
p_arr : ptr p_arr,
|
||||
n : size_t n)
|
||||
:<!wrt> [m : nat | m <= n]
|
||||
@(array_v (a, p_arr, m),
|
||||
array_v (a?, p_arr + (m * sizeof a), n - m) |
|
||||
size_t m)
|
||||
|
||||
extern fn {a : vt@ype}
|
||||
list_vt_remove_dups
|
||||
{n : int}
|
||||
(lst : list_vt (a, n))
|
||||
:<!wrt> [m : nat | m <= n]
|
||||
list_vt (a, m)
|
||||
|
||||
extern fn {a : vt@ype}
|
||||
remove_dups$eq :
|
||||
(&a, &a) -<> bool
|
||||
|
||||
extern fn {a : vt@ype}
|
||||
remove_dups$clear :
|
||||
(&a >> a?) -< !wrt > void
|
||||
|
||||
(*------------------------------------------------------------------*)
|
||||
(* Implementation of array_remove_dups *)
|
||||
|
||||
(* The implementation for arrays converts to a list_vt, does the
|
||||
removal duplicates, and then writes the data back into the original
|
||||
array. *)
|
||||
implement {a}
|
||||
array_remove_dups {n} {p_arr} (pf_arr | p_arr, n) =
|
||||
let
|
||||
var lst = array_copy_to_list_vt<a> (!p_arr, n)
|
||||
var m : int
|
||||
val lst = list_vt_remove_dups<a> lst
|
||||
val m = list_vt_length lst
|
||||
prval [m : int] EQINT () = eqint_make_gint m
|
||||
prval @(pf_uniq, pf_rest) =
|
||||
array_v_split {a?} {p_arr} {n} {m} pf_arr
|
||||
val () = array_copy_from_list_vt<a> (!p_arr, lst)
|
||||
in
|
||||
@(pf_uniq, pf_rest | i2sz m)
|
||||
end
|
||||
|
||||
(*------------------------------------------------------------------*)
|
||||
(* Implementation of list_vt_remove_dups *)
|
||||
|
||||
(* The list is worked on "in place". That is, no nodes are copied or
|
||||
moved to new locations, except those that are removed and freed. *)
|
||||
|
||||
fn {a : vt@ype}
|
||||
remove_equal_elements
|
||||
{n : int}
|
||||
(x : &a,
|
||||
lst : &list_vt (a, n) >> list_vt (a, m))
|
||||
:<!wrt> #[m : nat | m <= n]
|
||||
void =
|
||||
let
|
||||
fun {a : vt@ype}
|
||||
remove_elements
|
||||
{n : nat}
|
||||
.<n>.
|
||||
(x : &a,
|
||||
lst : &list_vt (a, n) >> list_vt (a, m))
|
||||
:<!wrt> #[m : nat | m <= n]
|
||||
void =
|
||||
case+ lst of
|
||||
| NIL => ()
|
||||
| @ (head :: tail) =>
|
||||
if remove_dups$eq (head, x) then
|
||||
let
|
||||
val new_lst = tail
|
||||
val () = remove_dups$clear<a> head
|
||||
val () = free@{a}{0} lst
|
||||
val () = lst := new_lst
|
||||
in
|
||||
remove_elements {n - 1} (x, lst)
|
||||
end
|
||||
else
|
||||
let
|
||||
val () = remove_elements {n - 1} (x, tail)
|
||||
prval () = fold@ lst
|
||||
in
|
||||
end
|
||||
|
||||
prval () = lemma_list_vt_param lst
|
||||
in
|
||||
remove_elements {n} (x, lst)
|
||||
end
|
||||
|
||||
fn {a : vt@ype}
|
||||
remove_dups
|
||||
{n : int}
|
||||
(lst : &list_vt (a, n) >> list_vt (a, m))
|
||||
:<!wrt> #[m : nat | m <= n]
|
||||
void =
|
||||
let
|
||||
fun
|
||||
rmv_dups {n : nat}
|
||||
.<n>.
|
||||
(lst : &list_vt (a, n) >> list_vt (a, m))
|
||||
:<!wrt> #[m : nat | m <= n]
|
||||
void =
|
||||
case+ lst of
|
||||
| NIL => ()
|
||||
| head :: NIL => ()
|
||||
| @ head :: tail =>
|
||||
let
|
||||
val () = remove_equal_elements (head, tail)
|
||||
val () = rmv_dups tail
|
||||
prval () = fold@ lst
|
||||
in
|
||||
end
|
||||
|
||||
prval () = lemma_list_vt_param lst
|
||||
in
|
||||
rmv_dups {n} lst
|
||||
end
|
||||
|
||||
implement {a}
|
||||
list_vt_remove_dups {n} lst =
|
||||
let
|
||||
var lst = lst
|
||||
in
|
||||
remove_dups {n} lst;
|
||||
lst
|
||||
end
|
||||
|
||||
(*------------------------------------------------------------------*)
|
||||
|
||||
implement
|
||||
remove_dups$eq<Strptr1> (s, t) =
|
||||
($UN.strptr2string s = $UN.strptr2string t)
|
||||
|
||||
implement
|
||||
remove_dups$clear<Strptr1> s =
|
||||
strptr_free s
|
||||
|
||||
implement
|
||||
array_uninitize$clear<Strptr1> (i, s) =
|
||||
strptr_free s
|
||||
|
||||
implement
|
||||
fprint_ref<Strptr1> (outf, s) =
|
||||
fprint! (outf, $UN.strptr2string s)
|
||||
|
||||
implement (* A demonstration with linear strings. *)
|
||||
main0 () =
|
||||
let
|
||||
#define N 10
|
||||
|
||||
val data =
|
||||
$list_vt{Strptr1}
|
||||
(string0_copy "a", string0_copy "c", string0_copy "b",
|
||||
string0_copy "e", string0_copy "a", string0_copy "a",
|
||||
string0_copy "d", string0_copy "d", string0_copy "b",
|
||||
string0_copy "c")
|
||||
var arr : @[Strptr1][N]
|
||||
val () = array_copy_from_list_vt<Strptr1> (arr, data)
|
||||
|
||||
prval pf_arr = view@ arr
|
||||
val p_arr = addr@ arr
|
||||
|
||||
val [m : int]
|
||||
@(pf_uniq, pf_abandoned | m) =
|
||||
array_remove_dups<Strptr1> (pf_arr | p_arr, i2sz N)
|
||||
|
||||
val () = fprint_array_sep<Strptr1> (stdout_ref, !p_arr, m, " ")
|
||||
val () = println! ()
|
||||
|
||||
val () = array_uninitize<Strptr1> (!p_arr, m)
|
||||
prval () = view@ arr :=
|
||||
array_v_unsplit (pf_uniq, pf_abandoned)
|
||||
in
|
||||
end
|
||||
|
||||
(*------------------------------------------------------------------*)
|
||||
|
|
@ -0,0 +1,79 @@
|
|||
(* Remove duplicate elements.
|
||||
|
||||
The elements are sorted and then only unique values are kept. *)
|
||||
|
||||
|
||||
#include "share/atspre_staload.hats"
|
||||
|
||||
(* How the remove_dups template function will be called. *)
|
||||
extern fn {a : t@ype}
|
||||
remove_dups
|
||||
{n : int}
|
||||
(lt : (a, a) -<cloref> bool, (* "less than" *)
|
||||
eq : (a, a) -<cloref> bool, (* "equals" *)
|
||||
src : arrayref (a, n),
|
||||
n : size_t n,
|
||||
dst : arrayref (a, n),
|
||||
m : &size_t? >> size_t m)
|
||||
: #[m : nat | m <= n]
|
||||
void
|
||||
|
||||
implement {a}
|
||||
remove_dups {n} (lt, eq, src, n, dst, m) =
|
||||
if n = i2sz 0 then
|
||||
m := i2sz 0
|
||||
else
|
||||
let
|
||||
prval () = lemma_arrayref_param src (* Prove 0 <= n. *)
|
||||
|
||||
(* Sort a copy of src. *)
|
||||
val arr = arrayptr_refize (arrayref_copy (src, n))
|
||||
implement array_quicksort$cmp<a> (x, y) =
|
||||
if x \lt y then ~1 else 1
|
||||
val () = arrayref_quicksort<a> (arr, n)
|
||||
|
||||
(* Copy only the first element of each run of equal elements. *)
|
||||
val () = dst[0] := arr[0]
|
||||
fun
|
||||
loop {i : int | 1 <= i; i <= n}
|
||||
{j : int | 1 <= j; j <= i}
|
||||
.<n - i>.
|
||||
(i : size_t i,
|
||||
j : size_t j)
|
||||
: [m : int | 1 <= m; m <= n]
|
||||
size_t m =
|
||||
if i = n then
|
||||
j
|
||||
else if arr[pred i] \eq arr[i] then
|
||||
loop (succ i, j)
|
||||
else
|
||||
begin
|
||||
dst[j] := arr[i];
|
||||
loop (succ i, succ j)
|
||||
end
|
||||
val () = m := loop (i2sz 1, i2sz 1)
|
||||
in
|
||||
end
|
||||
|
||||
implement (* A demonstration. *)
|
||||
main0 () =
|
||||
let
|
||||
val src =
|
||||
arrayref_make_list<string>
|
||||
(10, $list ("a", "c", "b", "e", "a",
|
||||
"a", "d", "d", "b", "c"))
|
||||
val dst = arrayref_make_elt<string> (i2sz 10, "?")
|
||||
var m : size_t
|
||||
in
|
||||
remove_dups<string> (lam (x, y) => x < y,
|
||||
lam (x, y) => x = y,
|
||||
src, i2sz 10, dst, m);
|
||||
let
|
||||
prval [m : int] EQINT () = eqint_make_guint m
|
||||
var i : natLte m
|
||||
in
|
||||
for (i := 0; i2sz i <> m; i := succ i)
|
||||
print! (" ", dst[i]);
|
||||
println! ()
|
||||
end
|
||||
end
|
||||
|
|
@ -0,0 +1,363 @@
|
|||
(* Remove duplicate elements.
|
||||
|
||||
The best sorting algorithms, it is said, are O(n log n) and require
|
||||
an order predicate.
|
||||
|
||||
But this is true only for a general sorting routine. A radix sort
|
||||
for fixed-size integers is O(n), and requires no order predicate.
|
||||
Here I use such a radix sort. *)
|
||||
|
||||
#include "share/atspre_staload.hats"
|
||||
staload UN = "prelude/SATS/unsafe.sats"
|
||||
|
||||
(* How the remove_dups template function will be called. *)
|
||||
extern fn {tk : tkind}
|
||||
remove_dups
|
||||
{n : int}
|
||||
(src : arrayref (g0uint tk, n),
|
||||
n : size_t n,
|
||||
dst : arrayref (g0uint tk, n),
|
||||
m : &size_t? >> size_t m)
|
||||
: #[m : nat | m <= n]
|
||||
void
|
||||
|
||||
(*------------------------------------------------------------------*)
|
||||
(* A radix sort for unsigned integers, copied from my contribution to
|
||||
the radix sort task. *)
|
||||
|
||||
extern fn {a : vt@ype}
|
||||
{tk : tkind}
|
||||
g0uint_radix_sort
|
||||
{n : int}
|
||||
(arr : &array (a, n) >> _,
|
||||
n : size_t n)
|
||||
:<!wrt> void
|
||||
|
||||
extern fn {a : vt@ype}
|
||||
{tk : tkind}
|
||||
g0uint_radix_sort$key
|
||||
{n : int}
|
||||
{i : nat | i < n}
|
||||
(arr : &RD(array (a, n)),
|
||||
i : size_t i)
|
||||
:<> g0uint tk
|
||||
|
||||
fn {}
|
||||
bin_sizes_to_indices
|
||||
(bin_indices : &array (size_t, 256) >> _)
|
||||
:<!wrt> void =
|
||||
let
|
||||
fun
|
||||
loop {i : int | i <= 256}
|
||||
{accum : int}
|
||||
.<256 - i>.
|
||||
(bin_indices : &array (size_t, 256) >> _,
|
||||
i : size_t i,
|
||||
accum : size_t accum)
|
||||
:<!wrt> void =
|
||||
if i <> i2sz 256 then
|
||||
let
|
||||
prval () = lemma_g1uint_param i
|
||||
val elem = bin_indices[i]
|
||||
in
|
||||
if elem = i2sz 0 then
|
||||
loop (bin_indices, succ i, accum)
|
||||
else
|
||||
begin
|
||||
bin_indices[i] := accum;
|
||||
loop (bin_indices, succ i, accum + g1ofg0 elem)
|
||||
end
|
||||
end
|
||||
in
|
||||
loop (bin_indices, i2sz 0, i2sz 0)
|
||||
end
|
||||
|
||||
fn {a : vt@ype}
|
||||
{tk : tkind}
|
||||
count_entries
|
||||
{n : int}
|
||||
{shift : nat}
|
||||
(arr : &RD(array (a, n)),
|
||||
n : size_t n,
|
||||
bin_indices : &array (size_t?, 256)
|
||||
>> array (size_t, 256),
|
||||
all_expended : &bool? >> bool,
|
||||
shift : int shift)
|
||||
:<!wrt> void =
|
||||
let
|
||||
fun
|
||||
loop {i : int | i <= n}
|
||||
.<n - i>.
|
||||
(arr : &RD(array (a, n)),
|
||||
bin_indices : &array (size_t, 256) >> _,
|
||||
all_expended : &bool >> bool,
|
||||
i : size_t i)
|
||||
:<!wrt> void =
|
||||
if i <> n then
|
||||
let
|
||||
prval () = lemma_g1uint_param i
|
||||
val key : g0uint tk = g0uint_radix_sort$key<a><tk> (arr, i)
|
||||
val key_shifted = key >> shift
|
||||
val digit = ($UN.cast{uint} key_shifted) land 255U
|
||||
val [digit : int] digit = g1ofg0 digit
|
||||
extern praxi set_range :
|
||||
() -<prf> [0 <= digit; digit <= 255] void
|
||||
prval () = set_range ()
|
||||
val count = bin_indices[digit]
|
||||
val () = bin_indices[digit] := succ count
|
||||
in
|
||||
all_expended := all_expended * iseqz key_shifted;
|
||||
loop (arr, bin_indices, all_expended, succ i)
|
||||
end
|
||||
|
||||
prval () = lemma_array_param arr
|
||||
in
|
||||
array_initize_elt<size_t> (bin_indices, i2sz 256, i2sz 0);
|
||||
all_expended := true;
|
||||
loop (arr, bin_indices, all_expended, i2sz 0)
|
||||
end
|
||||
|
||||
fn {a : vt@ype}
|
||||
{tk : tkind}
|
||||
sort_by_digit
|
||||
{n : int}
|
||||
{shift : nat}
|
||||
(arr1 : &RD(array (a, n)),
|
||||
arr2 : &array (a, n) >> _,
|
||||
n : size_t n,
|
||||
all_expended : &bool? >> bool,
|
||||
shift : int shift)
|
||||
:<!wrt> void =
|
||||
let
|
||||
var bin_indices : array (size_t, 256)
|
||||
in
|
||||
count_entries<a><tk> (arr1, n, bin_indices, all_expended, shift);
|
||||
if all_expended then
|
||||
()
|
||||
else
|
||||
let
|
||||
fun
|
||||
rearrange {i : int | i <= n}
|
||||
.<n - i>.
|
||||
(arr1 : &RD(array (a, n)),
|
||||
arr2 : &array (a, n) >> _,
|
||||
bin_indices : &array (size_t, 256) >> _,
|
||||
i : size_t i)
|
||||
:<!wrt> void =
|
||||
if i <> n then
|
||||
let
|
||||
prval () = lemma_g1uint_param i
|
||||
val key = g0uint_radix_sort$key<a><tk> (arr1, i)
|
||||
val key_shifted = key >> shift
|
||||
val digit = ($UN.cast{uint} key_shifted) land 255U
|
||||
val [digit : int] digit = g1ofg0 digit
|
||||
extern praxi set_range :
|
||||
() -<prf> [0 <= digit; digit <= 255] void
|
||||
prval () = set_range ()
|
||||
val [j : int] j = g1ofg0 bin_indices[digit]
|
||||
|
||||
(* One might wish to get rid of this assertion somehow,
|
||||
to eliminate the branch, should it prove a
|
||||
problem. *)
|
||||
val () = $effmask_exn assertloc (j < n)
|
||||
|
||||
val p_dst = ptr_add<a> (addr@ arr2, j)
|
||||
and p_src = ptr_add<a> (addr@ arr1, i)
|
||||
val _ = $extfcall (ptr, "memcpy", p_dst, p_src,
|
||||
sizeof<a>)
|
||||
val () = bin_indices[digit] := succ (g0ofg1 j)
|
||||
in
|
||||
rearrange (arr1, arr2, bin_indices, succ i)
|
||||
end
|
||||
|
||||
prval () = lemma_array_param arr1
|
||||
in
|
||||
bin_sizes_to_indices<> bin_indices;
|
||||
rearrange (arr1, arr2, bin_indices, i2sz 0)
|
||||
end
|
||||
end
|
||||
|
||||
fn {a : vt@ype}
|
||||
{tk : tkind}
|
||||
g0uint_sort {n : pos}
|
||||
(arr1 : &array (a, n) >> _,
|
||||
arr2 : &array (a, n) >> _,
|
||||
n : size_t n)
|
||||
:<!wrt> void =
|
||||
let
|
||||
fun
|
||||
loop {idigit_max, idigit : nat | idigit <= idigit_max}
|
||||
.<idigit_max - idigit>.
|
||||
(arr1 : &array (a, n) >> _,
|
||||
arr2 : &array (a, n) >> _,
|
||||
from1to2 : bool,
|
||||
idigit_max : int idigit_max,
|
||||
idigit : int idigit)
|
||||
:<!wrt> void =
|
||||
if idigit = idigit_max then
|
||||
begin
|
||||
if ~from1to2 then
|
||||
let
|
||||
val _ =
|
||||
$extfcall (ptr, "memcpy", addr@ arr1, addr@ arr2,
|
||||
sizeof<a> * n)
|
||||
in
|
||||
end
|
||||
end
|
||||
else if from1to2 then
|
||||
let
|
||||
var all_expended : bool
|
||||
in
|
||||
sort_by_digit<a><tk> (arr1, arr2, n, all_expended,
|
||||
8 * idigit);
|
||||
if all_expended then
|
||||
()
|
||||
else
|
||||
loop (arr1, arr2, false, idigit_max, succ idigit)
|
||||
end
|
||||
else
|
||||
let
|
||||
var all_expended : bool
|
||||
in
|
||||
sort_by_digit<a><tk> (arr2, arr1, n, all_expended,
|
||||
8 * idigit);
|
||||
if all_expended then
|
||||
let
|
||||
val _ =
|
||||
$extfcall (ptr, "memcpy", addr@ arr1, addr@ arr2,
|
||||
sizeof<a> * n)
|
||||
in
|
||||
end
|
||||
else
|
||||
loop (arr1, arr2, true, idigit_max, succ idigit)
|
||||
end
|
||||
in
|
||||
loop (arr1, arr2, true, sz2i sizeof<g1uint tk>, 0)
|
||||
end
|
||||
|
||||
#define SIZE_THRESHOLD 256
|
||||
|
||||
extern praxi
|
||||
unsafe_cast_array
|
||||
{a : vt@ype}
|
||||
{b : vt@ype}
|
||||
{n : int}
|
||||
(arr : &array (b, n) >> array (a, n))
|
||||
:<prf> void
|
||||
|
||||
implement {a} {tk}
|
||||
g0uint_radix_sort {n} (arr, n) =
|
||||
if n <> 0 then
|
||||
let
|
||||
prval () = lemma_array_param arr
|
||||
|
||||
fn
|
||||
sort {n : pos}
|
||||
(arr1 : &array (a, n) >> _,
|
||||
arr2 : &array (a, n) >> _,
|
||||
n : size_t n)
|
||||
:<!wrt> void =
|
||||
g0uint_sort<a><tk> (arr1, arr2, n)
|
||||
in
|
||||
if n <= SIZE_THRESHOLD then
|
||||
let
|
||||
var arr2 : array (a, SIZE_THRESHOLD)
|
||||
prval @(pf_left, pf_right) =
|
||||
array_v_split {a?} {..} {SIZE_THRESHOLD} {n} (view@ arr2)
|
||||
prval () = view@ arr2 := pf_left
|
||||
prval () = unsafe_cast_array{a} arr2
|
||||
|
||||
val () = sort (arr, arr2, n)
|
||||
|
||||
prval () = unsafe_cast_array{a?} arr2
|
||||
prval () = view@ arr2 :=
|
||||
array_v_unsplit (view@ arr2, pf_right)
|
||||
in
|
||||
end
|
||||
else
|
||||
let
|
||||
val @(pf_arr2, pfgc_arr2 | p_arr2) = array_ptr_alloc<a> n
|
||||
macdef arr2 = !p_arr2
|
||||
prval () = unsafe_cast_array{a} arr2
|
||||
|
||||
val () = sort (arr, arr2, n)
|
||||
|
||||
prval () = unsafe_cast_array{a?} arr2
|
||||
val () = array_ptr_free (pf_arr2, pfgc_arr2 | p_arr2)
|
||||
in
|
||||
end
|
||||
end
|
||||
|
||||
(*------------------------------------------------------------------*)
|
||||
(* An implementation of the remove_dups template function, which also
|
||||
sorts the elements. *)
|
||||
|
||||
implement {tk}
|
||||
remove_dups {n} (src, n, dst, m) =
|
||||
if n = i2sz 0 then
|
||||
m := i2sz 0
|
||||
else
|
||||
let
|
||||
prval () = lemma_arrayref_param src (* Prove 0 <= n. *)
|
||||
|
||||
(* Sort a copy of src. *)
|
||||
val arrptr = arrayref_copy (src, n)
|
||||
val @(pf_arr | p_arr) = arrayptr_takeout_viewptr arrptr
|
||||
val () = g0uint_radix_sort<g0uint tk><tk> (!p_arr, n)
|
||||
prval () = arrayptr_addback (pf_arr | arrptr)
|
||||
|
||||
(* Copy only the first element of each run of equals. *)
|
||||
val () = dst[0] := arrptr[0]
|
||||
fun
|
||||
loop {i : int | 1 <= i; i <= n}
|
||||
{j : int | 1 <= j; j <= i}
|
||||
.<n - i>.
|
||||
(arrptr : !arrayptr (g0uint tk, n),
|
||||
i : size_t i,
|
||||
j : size_t j)
|
||||
: [m : int | 1 <= m; m <= n]
|
||||
size_t m =
|
||||
if i = n then
|
||||
j
|
||||
else if arrptr[pred i] = arrptr[i] then
|
||||
loop (arrptr, succ i, j)
|
||||
else
|
||||
begin
|
||||
dst[j] := arrptr[i];
|
||||
loop (arrptr, succ i, succ j)
|
||||
end
|
||||
val () = m := loop (arrptr, i2sz 1, i2sz 1)
|
||||
|
||||
val () = arrayptr_free arrptr
|
||||
in
|
||||
end
|
||||
|
||||
(*------------------------------------------------------------------*)
|
||||
(* A demonstration. *)
|
||||
|
||||
implement
|
||||
main0 () =
|
||||
let
|
||||
implement
|
||||
g0uint_radix_sort$key<uint><uintknd> (arr, i) =
|
||||
arr[i]
|
||||
|
||||
val src =
|
||||
arrayref_make_list<uint>
|
||||
(10, $list (1U, 3U, 2U, 5U, 1U, 1U, 4U, 4U, 2U, 3U))
|
||||
|
||||
val dst = arrayref_make_elt<uint> (i2sz 10, 123456789U)
|
||||
var m : size_t
|
||||
in
|
||||
remove_dups<uintknd> (src, i2sz 10, dst, m);
|
||||
let
|
||||
prval [m : int] EQINT () = eqint_make_guint m
|
||||
var i : natLte m
|
||||
in
|
||||
for (i := 0; i2sz i <> m; i := succ i)
|
||||
print! (" ", dst[i]);
|
||||
println! ()
|
||||
end
|
||||
end
|
||||
|
||||
(*------------------------------------------------------------------*)
|
||||
|
|
@ -0,0 +1,86 @@
|
|||
(* Remove duplicate elements.
|
||||
|
||||
Elements already seen are put into a hash table. *)
|
||||
|
||||
#include "share/atspre_staload.hats"
|
||||
|
||||
(* Use hash tables from the libats/ML library. *)
|
||||
staload "libats/ML/SATS/hashtblref.sats"
|
||||
staload _ = "libats/ML/DATS/hashtblref.dats"
|
||||
staload _ = "libats/DATS/hashfun.dats"
|
||||
staload _ = "libats/DATS/hashtbl_chain.dats"
|
||||
staload _ = "libats/DATS/linmap_list.dats"
|
||||
|
||||
(* How the remove_dups template function will be called. *)
|
||||
extern fn {key, a : t@ype}
|
||||
remove_dups
|
||||
{n : int}
|
||||
(key : a -<cloref> key,
|
||||
src : arrayref (a, n),
|
||||
n : size_t n,
|
||||
dst : arrayref (a, n),
|
||||
m : &size_t? >> size_t m)
|
||||
: #[m : nat | m <= n]
|
||||
void
|
||||
|
||||
implement {key, a}
|
||||
remove_dups {n} (key, src, n, dst, m) =
|
||||
if n = i2sz 0 then
|
||||
m := i2sz 0
|
||||
else
|
||||
let
|
||||
prval () = lemma_arrayref_param src (* Prove 0 <= n. *)
|
||||
|
||||
fun
|
||||
loop {i : nat | i <= n}
|
||||
{j : nat | j <= i}
|
||||
.<n - i>.
|
||||
(ht : hashtbl (key, a),
|
||||
i : size_t i,
|
||||
j : size_t j)
|
||||
: [m : nat | m <= n]
|
||||
size_t m =
|
||||
if i = n then
|
||||
j
|
||||
else
|
||||
let
|
||||
val x = src[i]
|
||||
val k = key x
|
||||
in
|
||||
case+ hashtbl_search<key, a> (ht, k) of
|
||||
| ~ None_vt () =>
|
||||
begin (* An element not yet encountered. Copy it. *)
|
||||
hashtbl_insert_any<key, a> (ht, k, x);
|
||||
dst[j] := x;
|
||||
loop (ht, succ i, succ j)
|
||||
end
|
||||
| ~ Some_vt _ =>
|
||||
begin (* An element already encountered. Skip it. *)
|
||||
loop (ht, succ i, j)
|
||||
end
|
||||
end;
|
||||
in
|
||||
m := loop (hashtbl_make_nil<key, a> (i2sz 1024),
|
||||
i2sz 0, i2sz 0)
|
||||
end
|
||||
|
||||
implement (* A demonstration. *)
|
||||
main0 () =
|
||||
let
|
||||
val src =
|
||||
arrayref_make_list<string>
|
||||
(10, $list ("a", "c", "b", "e", "a",
|
||||
"a", "d", "d", "b", "c"))
|
||||
val dst = arrayref_make_elt<string> (i2sz 10, "?")
|
||||
var m : size_t
|
||||
in
|
||||
remove_dups<string, string> (lam s => s, src, i2sz 10, dst, m);
|
||||
let
|
||||
prval [m : int] EQINT () = eqint_make_guint m
|
||||
var i : natLte m
|
||||
in
|
||||
for (i := 0; i2sz i <> m; i := succ i)
|
||||
print! (" ", dst[i]);
|
||||
println! ()
|
||||
end
|
||||
end
|
||||
|
|
@ -0,0 +1,77 @@
|
|||
(* Remove duplicate elements.
|
||||
|
||||
This implementation is for elements that contain a "this has been
|
||||
seen" flag. It is O(n) in the number of elements.
|
||||
|
||||
Also, this implementation demonstrates that imperative programming,
|
||||
without dependent types or proofs, is possible in ATS. *)
|
||||
|
||||
#include "share/atspre_staload.hats"
|
||||
|
||||
(* A tuple in the heap. *)
|
||||
typedef seen_or_not (a : t@ype+) = '(a, ref bool)
|
||||
|
||||
(* How the remove_dups function will be called. *)
|
||||
extern fn {a : t@ype}
|
||||
remove_dups
|
||||
(given_data : arrszref (seen_or_not a),
|
||||
space_for_result : arrszref (seen_or_not a),
|
||||
num_of_unique_elems : &size_t? >> size_t)
|
||||
: void
|
||||
|
||||
implement {a}
|
||||
remove_dups (given_data, space_for_result, num_of_unique_elems) =
|
||||
let
|
||||
macdef seen (i) = given_data[,(i)].1
|
||||
|
||||
var i : size_t
|
||||
var j : size_t
|
||||
in
|
||||
(* Clear all the "seen" flags. *)
|
||||
for (i := i2sz 0; i <> size given_data; i := succ i)
|
||||
!(seen i) := false;
|
||||
|
||||
(* Loop through given_data, copying (pointers to) any values that
|
||||
have not yet been seen. *)
|
||||
j := i2sz 0;
|
||||
for (i := i2sz 0; i <> size given_data; i := succ i)
|
||||
if !(seen i) then
|
||||
() (* Skip any element that has already been seen. *)
|
||||
else
|
||||
begin
|
||||
!(seen i) := true; (* Mark the element as seen. *)
|
||||
space_for_result[j] := given_data[i];
|
||||
j := succ j
|
||||
end;
|
||||
|
||||
num_of_unique_elems := j
|
||||
end
|
||||
|
||||
implement (* A demonstration. *)
|
||||
main0 () =
|
||||
let
|
||||
(* Define some values. *)
|
||||
val a = '("a", ref<bool> false)
|
||||
val b = '("b", ref<bool> false)
|
||||
val c = '("c", ref<bool> false)
|
||||
val d = '("d", ref<bool> false)
|
||||
val e = '("e", ref<bool> false)
|
||||
|
||||
(* Fill an array with values. *)
|
||||
val data =
|
||||
arrszref_make_list ($list (a, c, b, e, a, a, d, d, b, c))
|
||||
|
||||
(* Allocate storage for the result. *)
|
||||
val unique_elems = arrszref_make_elt (i2sz 10, a)
|
||||
var num_of_unique_elems : size_t
|
||||
|
||||
var i : size_t
|
||||
in
|
||||
(* Remove duplicates. *)
|
||||
remove_dups<string> (data, unique_elems, num_of_unique_elems);
|
||||
|
||||
(* Print the results. *)
|
||||
for (i := i2sz 0; i <> num_of_unique_elems; i := succ i)
|
||||
print! (" ", unique_elems[i].0);
|
||||
println! ()
|
||||
end
|
||||
Loading…
Add table
Add a link
Reference in a new issue