order.egi

;;;;;
;;;;;
;;;;; Order
;;;;;
;;;;;

(define $ordering
  (algebraic-data-matcher 
    {<less> <equal> <greater>}))

(define $compare
  (lambda [$m $n]
    (if (lt? m n)
        <Less>
        (if (eq? m n)
            <Equal>
            <Greater>))))

(define $min
  (lambda [$ns]
    (foldl 2#(if (lt? %1 %2) %1 %2) (car ns) (cdr ns))))

(define $max
  (lambda [$ns]
    (foldl 2#(if (gt? %1 %2) %1 %2) (car ns) (cdr ns))))

(define $min-and-max
  (lambda [$ns]
    (foldl (lambda [$ret $x]
             (match ret [integer integer]
               {[[$min $max] (if (lt? x min) [x max]
                               (if (gt? x min) [min x]
                                 [min max]))]}))
           [(car ns) (car ns)]
           (cdr ns))))

(define $min/fn
  (lambda [$compare $ns]
    (foldl 2#(if (eq? (compare %1 %2) <Less>) %1 %2) (car ns) (cdr ns))))

(define $max/fn
  (lambda [$compare $ns]
    (foldl 2#(if (eq? (compare %1 %2) <Greater>) %1 %2) (car ns) (cdr ns))))

(define $min-and-max/fn
  (lambda [$compare $ns]
    (foldl (lambda [$ret $x]
             (match ret [integer integer]
               {[[$min $max] (if (eq? (compare x min) <Less>) [x max]
                               (if (eq? (compare x min) <Greater>) [min x]
                                 [min max]))]}))
           [(car ns) (car ns)]
           (cdr ns))))

(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 $qsort (qsort/fn compare $))

(define $qsort/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)]}
            {@(qsort/fn f ys1) @ys2 @(qsort/fn f ys3)})]})))