Initial data commit
This commit is contained in:
Ingy döt Net
parent
72d218235f
commit
f23f22d71c
199087 changed files with 3378941 additions and 0 deletions
|
|
@ -0,0 +1,86 @@
|
|||
#include "share/atspre_staload.hats"
|
||||
|
||||
(*------------------------------------------------------------------*)
|
||||
(* Interface *)
|
||||
|
||||
extern fn {a : t@ype} (* The "less than" template. *)
|
||||
insertion_sort$lt : (a, a) -<> bool (* Arguments by value. *)
|
||||
|
||||
extern fn {a : t@ype}
|
||||
insertion_sort
|
||||
{n : int}
|
||||
(arr : &array (a, n) >> _,
|
||||
n : size_t n)
|
||||
:<!wrt> void
|
||||
|
||||
(*------------------------------------------------------------------*)
|
||||
(* Implementation *)
|
||||
|
||||
implement {a}
|
||||
insertion_sort {n} (arr, n) =
|
||||
let
|
||||
macdef lt = insertion_sort$lt<a>
|
||||
|
||||
fun
|
||||
sort {i : int | 1 <= i; i <= n}
|
||||
.<n - i>.
|
||||
(arr : &array (a, n) >> _,
|
||||
i : size_t i)
|
||||
:<!wrt> void =
|
||||
if i <> n then
|
||||
let
|
||||
fun
|
||||
find_new_position
|
||||
{j : nat | j <= i}
|
||||
.<j>.
|
||||
(arr : &array (a, n) >> _,
|
||||
elem : a,
|
||||
j : size_t j)
|
||||
:<> [j : nat | j <= i] size_t j =
|
||||
if j = i2sz 0 then
|
||||
j
|
||||
else if ~(elem \lt arr[pred j]) then
|
||||
j
|
||||
else
|
||||
find_new_position (arr, elem, pred j)
|
||||
|
||||
val j = find_new_position (arr, arr[i], i)
|
||||
in
|
||||
if j < i then
|
||||
array_subcirculate<a> (arr, j, i);
|
||||
sort (arr, succ i)
|
||||
end
|
||||
|
||||
prval () = lemma_array_param arr
|
||||
in
|
||||
if n <> i2sz 0 then
|
||||
sort (arr, i2sz 1)
|
||||
end
|
||||
|
||||
(*------------------------------------------------------------------*)
|
||||
|
||||
implement
|
||||
insertion_sort$lt<int> (x, y) =
|
||||
x < y
|
||||
|
||||
implement
|
||||
main0 () =
|
||||
let
|
||||
#define SIZE 30
|
||||
var i : [i : nat] int i
|
||||
var arr : array (int, SIZE)
|
||||
in
|
||||
array_initize_elt<int> (arr, i2sz SIZE, 0);
|
||||
for (i := 0; i < SIZE; i := succ i)
|
||||
arr[i] := $extfcall (int, "rand") % 10;
|
||||
|
||||
for (i := 0; i < SIZE; i := succ i)
|
||||
print! (" ", arr[i]);
|
||||
println! ();
|
||||
|
||||
insertion_sort<int> (arr, i2sz SIZE);
|
||||
|
||||
for (i := 0; i < SIZE; i := succ i)
|
||||
print! (" ", arr[i]);
|
||||
println! ()
|
||||
end
|
||||
|
|
@ -0,0 +1,162 @@
|
|||
#include "share/atspre_staload.hats"
|
||||
|
||||
(*------------------------------------------------------------------*)
|
||||
(* Interface *)
|
||||
|
||||
extern fn {a : vt@ype} (* The "less than" template. *)
|
||||
insertion_sort$lt : (&a, &a) -<> bool (* Arguments by reference. *)
|
||||
|
||||
extern fn {a : vt@ype}
|
||||
insertion_sort
|
||||
{n : int}
|
||||
(arr : &array (a, n) >> _,
|
||||
n : size_t n)
|
||||
:<!wrt> void
|
||||
|
||||
(*------------------------------------------------------------------*)
|
||||
(* Implementation *)
|
||||
|
||||
implement {a}
|
||||
insertion_sort {n} (arr, n) =
|
||||
let
|
||||
macdef lt = insertion_sort$lt<a>
|
||||
|
||||
fun
|
||||
sort {i : int | 1 <= i; i <= n}
|
||||
{p_arr : addr}
|
||||
.<n - i>.
|
||||
(pf_arr : !array_v (a, p_arr, n) >> _ |
|
||||
p_arr : ptr p_arr,
|
||||
i : size_t i)
|
||||
:<!wrt> void =
|
||||
if i <> n then
|
||||
let
|
||||
val pi = ptr_add<a> (p_arr, i)
|
||||
|
||||
fun
|
||||
find_new_position
|
||||
{j : nat | j <= i}
|
||||
.<j>.
|
||||
(pf_left : !array_v (a, p_arr, j) >> _,
|
||||
pf_i : !a @ (p_arr + (i * sizeof a)) |
|
||||
j : size_t j)
|
||||
:<> [j : nat | j <= i] size_t j =
|
||||
if j = i2sz 0 then
|
||||
j
|
||||
else
|
||||
let
|
||||
prval @(pf_left1, pf_k) = array_v_unextend pf_left
|
||||
|
||||
val k = pred j
|
||||
val pk = ptr_add<a> (p_arr, k)
|
||||
in
|
||||
if ~((!pi) \lt (!pk)) then
|
||||
let
|
||||
prval () = pf_left :=
|
||||
array_v_extend (pf_left1, pf_k)
|
||||
in
|
||||
j
|
||||
end
|
||||
else
|
||||
let
|
||||
val new_pos =
|
||||
find_new_position (pf_left1, pf_i | k)
|
||||
prval () = pf_left :=
|
||||
array_v_extend (pf_left1, pf_k)
|
||||
in
|
||||
new_pos
|
||||
end
|
||||
end
|
||||
|
||||
prval @(pf_left, pf_right) =
|
||||
array_v_split {a} {p_arr} {n} {i} pf_arr
|
||||
prval @(pf_i, pf_rest) = array_v_uncons pf_right
|
||||
|
||||
val j = find_new_position (pf_left, pf_i | i)
|
||||
|
||||
prval () = pf_arr :=
|
||||
array_v_unsplit (pf_left, array_v_cons (pf_i, pf_rest))
|
||||
in
|
||||
if j < i then
|
||||
array_subcirculate<a> (!p_arr, j, i);
|
||||
sort (pf_arr | p_arr, succ i)
|
||||
end
|
||||
|
||||
prval () = lemma_array_param arr
|
||||
in
|
||||
if n <> i2sz 0 then
|
||||
sort (view@ arr | addr@ arr, i2sz 1)
|
||||
end
|
||||
|
||||
(*------------------------------------------------------------------*)
|
||||
|
||||
(* The demonstration converts random numbers to linear strings, then
|
||||
sorts the elements by their first character. Thus here is a simple
|
||||
demonstration that the sort can handle elements of linear type, and
|
||||
also that the sort is stable. *)
|
||||
|
||||
implement
|
||||
main0 () =
|
||||
let
|
||||
implement
|
||||
insertion_sort$lt<Strptr1> (x, y) =
|
||||
let
|
||||
val sx = $UNSAFE.castvwtp1{string} x
|
||||
and sy = $UNSAFE.castvwtp1{string} y
|
||||
val cx = $effmask_all $UNSAFE.string_get_at (sx, 0)
|
||||
and cy = $effmask_all $UNSAFE.string_get_at (sy, 0)
|
||||
in
|
||||
cx < cy
|
||||
end
|
||||
|
||||
implement
|
||||
array_initize$init<Strptr1> (i, x) =
|
||||
let
|
||||
#define BUFSIZE 10
|
||||
var buffer : array (char, BUFSIZE)
|
||||
|
||||
val () = array_initize_elt<char> (buffer, i2sz BUFSIZE, '\0')
|
||||
val _ = $extfcall (int, "snprintf", addr@ buffer,
|
||||
i2sz BUFSIZE, "%d",
|
||||
$extfcall (int, "rand") % 100)
|
||||
val () = buffer[BUFSIZE - 1] := '\0'
|
||||
in
|
||||
x := string0_copy ($UNSAFE.cast{string} buffer)
|
||||
end
|
||||
|
||||
implement
|
||||
array_uninitize$clear<Strptr1> (i, x) =
|
||||
strptr_free x
|
||||
|
||||
#define SIZE 30
|
||||
val @(pf_arr, pfgc_arr | p_arr) =
|
||||
array_ptr_alloc<Strptr1> (i2sz SIZE)
|
||||
macdef arr = !p_arr
|
||||
|
||||
var i : [i : nat] int i
|
||||
in
|
||||
array_initize<Strptr1> (arr, i2sz SIZE);
|
||||
|
||||
for (i := 0; i < SIZE; i := succ i)
|
||||
let
|
||||
val p = ptr_add<Strptr1> (p_arr, i)
|
||||
val s = $UNSAFE.ptr0_get<string> p
|
||||
in
|
||||
print! (" ", s)
|
||||
end;
|
||||
println! ();
|
||||
|
||||
insertion_sort<Strptr1> (arr, i2sz SIZE);
|
||||
|
||||
for (i := 0; i < SIZE; i := succ i)
|
||||
let
|
||||
val p = ptr_add<Strptr1> (p_arr, i)
|
||||
val s = $UNSAFE.ptr0_get<string> p
|
||||
in
|
||||
print! (" ", s)
|
||||
end;
|
||||
println! ();
|
||||
|
||||
array_uninitize<Strptr1> (arr, i2sz SIZE);
|
||||
array_ptr_free (pf_arr, pfgc_arr | p_arr)
|
||||
end
|
||||
|
|
@ -0,0 +1,186 @@
|
|||
#include "share/atspre_staload.hats"
|
||||
|
||||
(*------------------------------------------------------------------*)
|
||||
(* Interface *)
|
||||
|
||||
extern fn {a : vt@ype} (* The "less than" template. *)
|
||||
insertion_sort$lt : (&a, &a) -<> bool (* Arguments by reference. *)
|
||||
|
||||
extern fn {a : vt@ype}
|
||||
insertion_sort
|
||||
{n : int}
|
||||
(lst : list_vt (a, n))
|
||||
:<!wrt> list_vt (a, n)
|
||||
|
||||
(*------------------------------------------------------------------*)
|
||||
(* Implementation *)
|
||||
|
||||
(* This implementation is based on the insertion-sort part of the
|
||||
mergesort code of the ATS prelude.
|
||||
|
||||
Unlike the prelude, however, I build the sorted list in reverse
|
||||
order. Building the list in reverse order actually makes the
|
||||
implementation more like that for an array. *)
|
||||
|
||||
(* Some convenient shorthands. *)
|
||||
#define NIL list_vt_nil ()
|
||||
#define :: list_vt_cons
|
||||
|
||||
(* Inserting in reverse order minimizes the work for a list already
|
||||
nearly sorted, or for stably sorting a list whose entries often
|
||||
have equal keys. *)
|
||||
fun {a : vt@ype}
|
||||
insert_reverse
|
||||
{m : nat}
|
||||
{p_xnode : addr}
|
||||
{p_x : addr}
|
||||
{p_xs : addr}
|
||||
.<m>.
|
||||
(pf_x : a @ p_x,
|
||||
pf_xs : list_vt (a, 0)? @ p_xs |
|
||||
dst : &list_vt (a, m) >> list_vt (a, m + 1),
|
||||
(* list_vt_cons_unfold is a viewtype created by the
|
||||
unfolding of a list_vt_cons (our :: operator). *)
|
||||
xnode : list_vt_cons_unfold (p_xnode, p_x, p_xs),
|
||||
p_x : ptr p_x,
|
||||
p_xs : ptr p_xs)
|
||||
:<!wrt> void =
|
||||
(* dst is some tail of the current (reverse-order) destination list.
|
||||
xnode is a viewtype for the current node in the source list.
|
||||
p_x points to the node's CAR.
|
||||
p_xs points to the node's CDR. *)
|
||||
case+ dst of
|
||||
| @ (y :: ys) =>
|
||||
if insertion_sort$lt<a> (!p_x, y) then
|
||||
let (* Move to the next destination node. *)
|
||||
val () = insert_reverse (pf_x, pf_xs | ys, xnode, p_x, p_xs)
|
||||
prval () = fold@ dst
|
||||
in
|
||||
end
|
||||
else
|
||||
let (* Insert xnode here. *)
|
||||
prval () = fold@ dst
|
||||
val () = !p_xs := dst
|
||||
val () = dst := xnode
|
||||
prval () = fold@ dst
|
||||
in
|
||||
end
|
||||
| ~ NIL =>
|
||||
let (* Put xnode at the end. *)
|
||||
val () = dst := xnode
|
||||
val () = !p_xs := NIL
|
||||
prval () = fold@ dst
|
||||
in
|
||||
end
|
||||
|
||||
implement {a}
|
||||
insertion_sort {n} lst =
|
||||
let
|
||||
fun (* Create a list sorted in reverse. *)
|
||||
loop {i : nat | i <= n}
|
||||
.<n - i>.
|
||||
(dst : &list_vt (a, i) >> list_vt (a, n),
|
||||
src : list_vt (a, n - i))
|
||||
:<!wrt> void =
|
||||
case+ src of
|
||||
| @ (x :: xs) =>
|
||||
let
|
||||
val tail = xs
|
||||
in
|
||||
insert_reverse<a> (view@ x, view@ xs |
|
||||
dst, src, addr@ x, addr@ xs);
|
||||
loop (dst, tail)
|
||||
end
|
||||
| ~ NIL => () (* We are done. *)
|
||||
|
||||
prval () = lemma_list_vt_param lst
|
||||
|
||||
var dst : List_vt a = NIL
|
||||
in
|
||||
loop (dst, lst);
|
||||
|
||||
(* Reversing a linear list is an in-place operation. *)
|
||||
list_vt_reverse<a> dst
|
||||
end
|
||||
|
||||
(*------------------------------------------------------------------*)
|
||||
|
||||
(* The demonstration converts random numbers to linear strings, then
|
||||
sorts the elements by their first character. Thus here is a simple
|
||||
demonstration that the sort can handle elements of linear type, and
|
||||
also that the sort is stable. *)
|
||||
|
||||
implement
|
||||
main0 () =
|
||||
let
|
||||
implement
|
||||
insertion_sort$lt<Strptr1> (x, y) =
|
||||
let
|
||||
val sx = $UNSAFE.castvwtp1{string} x
|
||||
and sy = $UNSAFE.castvwtp1{string} y
|
||||
val cx = $effmask_all $UNSAFE.string_get_at (sx, 0)
|
||||
and cy = $effmask_all $UNSAFE.string_get_at (sy, 0)
|
||||
in
|
||||
cx < cy
|
||||
end
|
||||
|
||||
implement
|
||||
list_vt_freelin$clear<Strptr1> x =
|
||||
strptr_free x
|
||||
|
||||
#define SIZE 30
|
||||
|
||||
fn
|
||||
create_the_list ()
|
||||
:<!wrt> list_vt (Strptr1, SIZE) =
|
||||
let
|
||||
fun
|
||||
loop {i : nat | i <= SIZE}
|
||||
.<SIZE - i>.
|
||||
(lst : list_vt (Strptr1, i),
|
||||
i : size_t i)
|
||||
:<!wrt> list_vt (Strptr1, SIZE) =
|
||||
if i = i2sz SIZE then
|
||||
list_vt_reverse lst
|
||||
else
|
||||
let
|
||||
#define BUFSIZE 10
|
||||
var buffer : array (char, BUFSIZE)
|
||||
|
||||
val () =
|
||||
array_initize_elt<char> (buffer, i2sz BUFSIZE, '\0')
|
||||
val _ = $extfcall (int, "snprintf", addr@ buffer,
|
||||
i2sz BUFSIZE, "%d",
|
||||
$extfcall (int, "rand") % 100)
|
||||
val () = buffer[BUFSIZE - 1] := '\0'
|
||||
val s = string0_copy ($UNSAFE.cast{string} buffer)
|
||||
in
|
||||
loop (s :: lst, succ i)
|
||||
end
|
||||
in
|
||||
loop (NIL, i2sz 0)
|
||||
end
|
||||
|
||||
var p : List string
|
||||
|
||||
val lst = create_the_list ()
|
||||
|
||||
val () =
|
||||
for (p := $UNSAFE.castvwtp1{List string} lst;
|
||||
isneqz p;
|
||||
p := list_tail p)
|
||||
print! (" ", list_head p)
|
||||
val () = println! ()
|
||||
|
||||
val lst = insertion_sort<Strptr1> lst
|
||||
|
||||
val () =
|
||||
for (p := $UNSAFE.castvwtp1{List string} lst;
|
||||
isneqz p;
|
||||
p := list_tail p)
|
||||
print! (" ", list_head p)
|
||||
val () = println! ()
|
||||
|
||||
val () = list_vt_freelin lst
|
||||
in
|
||||
end
|
||||
Loading…
Add table
Add a link
Reference in a new issue