;;;;; ;;;;; ;;;;; Order ;;;;; ;;;;; (define $ordering (algebraic-data-matcher {<less> <equal> <greater>})) (define $compare (lambda [$m $n] (if (collection? m) (compare-c m n) (if (lt? m n) <Less> (if (eq? m n) <Equal> <Greater>))))) (define $compare-c (lambda [$c1 $c2] (match [c1 c2] [(list something) (list something)] {[[<nil> <nil>] <Equal>] [[<nil> _] <Less>] [[_ <nil>] <Greater>] [[<cons $x $xs> <cons ,x $ys>] (compare-c xs ys)] [[<cons $x _> <cons $y _>] (compare x y)]}))) (define $b.min (lambda [$x $y] (if (lt? x y) x y))) (define $b.max (lambda [$x $y] (if (gt? x y) x y))) (define $min/fn (lambda [$compare $x $y] (if (eq? (compare x y) <Less>) x y))) (define $max/fn (lambda [$compare $x $y] (if (eq? (compare x y) <Greater>) x y))) (define $min (cambda $xs (foldl b.min (car xs) (cdr xs)))) (define $max (cambda $xs (foldl b.max (car xs) (cdr xs)))) (define $split-by-ordering (split-by-ordering/fn compare $ $)) (define $split-by-ordering/fn (lambda [$f $p $xs] (match xs (list something) {[<nil> [{} {} {}]] [<cons $x $rs> (let {[[$ys1 $ys2 $ys3] (split-by-ordering/fn f p rs)]} (match (f x p) ordering {[<less> [{x @ys1} ys2 ys3]] [<equal> [ys1 {x @ys2} ys3]] [<greater> [ys1 ys2 {x @ys3}]]}))]}))) (define $sort (sort/fn compare $)) (define $sort/fn (lambda [$f $xs] (match xs (list something) {[<nil> {}] [<cons $x <nil>> {x}] [_ (let* {[$n (length xs)] [$p (nth (quotient n 2) xs)] [[$ys1 $ys2 $ys3] (split-by-ordering/fn f p xs)]} {@(sort/fn f ys1) @ys2 @(sort/fn f ys3)})]}))) (define $sort-strings (lambda [$xs] (sort/fn 2#(compare-c (map ctoi (unpack %1)) (map ctoi (unpack %2))) xs))) (define $merge (lambda [$xs $ys] (match [xs ys] [(list something) (list something)] {[[<nil> _] ys] [[_ <nil>] xs] [[<cons $x $txs> <cons ?(gte? $ x) _>] {x @(merge txs ys)}] [[_ <cons $y $tys>] {y @(merge xs tys)}]}))) (define $merge/fn (lambda [$f $xs $ys] (match [xs ys] [(list something) (list something)] {[[<nil> _] ys] [[_ <nil>] xs] [[<cons $x $txs> <cons ?1#(eq? (f %1 x) <Greater>) _>] {x @(merge txs ys)}] [[_ <cons $y $tys>] {y @(merge xs tys)}]})))