Sort using a custom comparator: Difference between revisions
Content added Content deleted
Line 905: | Line 905: | ||
{{output}} |
{{output}} |
||
<pre>{"party", "come", "good", "time", "aid", "all", "for", "men", "now", "the", "the", "the", "is", "of", "to", "to"}</pre> |
<pre>{"party", "come", "good", "time", "aid", "all", "for", "men", "now", "the", "the", "the", "is", "of", "to", "to"}</pre> |
||
=={{header|ATS}}== |
|||
<lang ATS>(* The following demonstrates a few ways to customize the |
|||
comparator. *) |
|||
#include "share/atspre_staload.hats" |
|||
staload UN = "prelude/SATS/unsafe.sats" |
|||
%{^ |
|||
#include <strings.h> |
|||
%} |
|||
extern fn |
|||
strcasecmp : (string, string) -<> int = "mac#strcasecmp" |
|||
fn |
|||
sort_strings_1 (lst : List string, |
|||
cmp : (string, string) -<> int) |
|||
:<!wrt> List string = |
|||
list_vt2t (list_mergesort_fun<string> (lst, cmp)) |
|||
fn |
|||
sort_strings_2 (lst : List string, |
|||
cmp : (string, string) -<cloref> int) |
|||
:<!wrt> List string = |
|||
list_vt2t (list_mergesort_cloref<string> (lst, cmp)) |
|||
var one = 1 |
|||
val p_one = addr@ one |
|||
fn |
|||
sort_using_a_template_function (lst : List string) |
|||
:<!wrt> List string = |
|||
(* There is no actual callback here. The comparison code is expanded |
|||
directly into the sort code. *) |
|||
let |
|||
implement |
|||
list_mergesort$cmp<string> (x, y) = |
|||
let |
|||
val m = length x |
|||
and n = length y |
|||
in |
|||
if m < n then |
|||
1 |
|||
else if n < m then |
|||
~1 |
|||
else |
|||
strcasecmp (x, y) |
|||
end |
|||
in |
|||
(* The list mergesort template functions in the ATS prelude return |
|||
_linear_ lists. Thus the call to list_vt2t to cast that result |
|||
to an ordinary list. *) |
|||
list_vt2t (list_mergesort<string> lst) |
|||
end |
|||
fn |
|||
sort_using_an_ordinary_function (lst : List string) |
|||
:<!wrt> List string = |
|||
(* Rather than expand the comparison code, incorporate a function |
|||
call into the sort implementation. *) |
|||
let |
|||
fn |
|||
cmp (x : string, |
|||
y : string) |
|||
:<> int = |
|||
let |
|||
val m = length x |
|||
and n = length y |
|||
in |
|||
if m < n then |
|||
1 |
|||
else if n < m then |
|||
~1 |
|||
else |
|||
strcasecmp (x, y) |
|||
end |
|||
in |
|||
list_vt2t (list_mergesort_fun<string> (lst, cmp)) |
|||
end |
|||
fn |
|||
sort_the_way_it_works_for_qsort_in_C (lst : List string) |
|||
:<!wrt> List string = |
|||
(* Here we have a true callback to an ordinary function. *) |
|||
let |
|||
fn |
|||
cmp (x : string, |
|||
y : string) |
|||
:<> int = |
|||
let |
|||
val m = length x |
|||
and n = length y |
|||
in |
|||
if m < n then |
|||
1 |
|||
else if n < m then |
|||
~1 |
|||
else |
|||
strcasecmp (x, y) |
|||
end |
|||
in |
|||
sort_strings_1 (lst, cmp) |
|||
end |
|||
fn |
|||
sort_using_a_closure (lst : List string) |
|||
:<!wrt> List string = |
|||
(* Incorporate a closure into the sort implementation. (Standard C |
|||
does not have closures.) *) |
|||
let |
|||
fn |
|||
cmp (x : string, |
|||
y : string) |
|||
:<cloref> int = |
|||
let |
|||
(* Merely to demonstrate this is a closure instead of regular |
|||
function, get the value of "one" from a global variable. *) |
|||
val @(pf, fpf | p) = $UN.ptr_vtake{int} p_one |
|||
val one = !p |
|||
prval () = fpf pf |
|||
val m = length x |
|||
and n = length y |
|||
in |
|||
if m < n then |
|||
one |
|||
else if n < m then |
|||
~one |
|||
else |
|||
strcasecmp (x, y) |
|||
end |
|||
in |
|||
list_vt2t (list_mergesort_cloref<string> (lst, cmp)) |
|||
end |
|||
fn |
|||
sort_by_calling_back_to_a_closure (lst : List string) |
|||
:<!wrt> List string = |
|||
(* Incorporate a closure into the sort implementation. (Standard C |
|||
does not have closures.) *) |
|||
let |
|||
fn |
|||
cmp (x : string, |
|||
y : string) |
|||
:<cloref> int = |
|||
let |
|||
(* Merely to demonstrate this is a closure instead of regular |
|||
function, get the value of "one" from a global variable. *) |
|||
val @(pf, fpf | p) = $UN.ptr_vtake{int} p_one |
|||
val one = !p |
|||
prval () = fpf pf |
|||
val m = length x |
|||
and n = length y |
|||
in |
|||
if m < n then |
|||
one |
|||
else if n < m then |
|||
~one |
|||
else |
|||
strcasecmp (x, y) |
|||
end |
|||
in |
|||
sort_strings_2 (lst, cmp) |
|||
end |
|||
implement |
|||
main0 () = |
|||
let |
|||
val unsorted = |
|||
$list{string} |
|||
("Here", "are", "some", "sample", "strings", |
|||
"to", "be", "sorted") |
|||
val sorted1 = sort_using_a_template_function unsorted |
|||
val sorted2 = sort_using_an_ordinary_function unsorted |
|||
val sorted3 = sort_the_way_it_works_for_qsort_in_C unsorted |
|||
val sorted4 = sort_using_a_closure unsorted |
|||
val sorted5 = sort_by_calling_back_to_a_closure unsorted |
|||
in |
|||
println! unsorted; |
|||
println! sorted1; |
|||
println! sorted2; |
|||
println! sorted3; |
|||
println! sorted4; |
|||
println! sorted5 |
|||
end</lang> |
|||
{{out}} |
|||
<pre>$ patscc -DATS_MEMALLOC_GCBDW -O3 sort_using_custom_comparator.dats -lgc && ./a.out |
|||
Here, are, some, sample, strings, to, be, sorted |
|||
strings, sample, sorted, Here, some, are, be, to |
|||
strings, sample, sorted, Here, some, are, be, to |
|||
strings, sample, sorted, Here, some, are, be, to |
|||
strings, sample, sorted, Here, some, are, be, to |
|||
strings, sample, sorted, Here, some, are, be, to</pre> |
|||
=={{header|AutoHotkey}}== |
=={{header|AutoHotkey}}== |