order.egi

;;;;;
;;;;;
;;;;; 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)}]})))