collection.egi

;;
;; Collection.egi
;;

(define $list
  (lambda [$a]
    (matcher
      {[,$val []
        {[$tgt (match [val tgt] [(list a) (list a)]
                 {[[<nil> <nil>] {[]}]
                  [[<cons $x $xs> <cons ,x ,xs>] {[]}]
                  [[_ _] {}]})]}]
       [<nil> []
        {[{} {[]}]
         [_ {}]}]
       [<cons $ $> [a (list a)]
        {[{$x @$xs} {[x xs]}]
         [_ {}]}]
       [<snoc $ $> [a (list a)]
        {[{@$xs $x} {[x xs]}]
         [_ {}]}]
       [<join ,$pxs $> [(list a)]
        {[$tgt (letrec {[$helper (lambda [$pxs $tgt]
                                   (match [pxs tgt] [(list a) (list a)]
                                     {[[<nil> _] {tgt}]
                                      [[<cons $x $xs> <cons ,x $ys>] (helper xs ys)]
                                      [[_ _] {}]}))]}
                 (helper pxs tgt))]}]
       [<join $ $> [(list a) (list a)]
        {[$tgt (letrec {[$helper (lambda [$xs $ys]
                                   (match ys (list a)
                                     {[<nil> {[xs {}]}]
                                      [<cons $z $zs> {[xs ys] @(helper {@xs z} zs)}]}))]}
                 (helper {} tgt))]}]
       [<nioj ,$pxs $> [(list a)]
        {[$tgt (letrec {[$helper (lambda [$pxs $tgt]
                                   (match [pxs tgt] [(list a) (list a)]
                                     {[[<nil> _] {tgt}]
                                      [[<snoc $x $xs> <snoc ,x $ys>] (helper xs ys)]
                                      [[_ _] {}]}))]}
                 (helper pxs tgt))]}]
       [<nioj $ $> [(list a) (list a)]
        {[$tgt (letrec {[$helper (lambda [$xs $ys]
                                   (match ys (list a)
                                     {[<nil> {[{} xs]}]
                                      [<cons $z $zs> {[ys xs] @(helper {@xs z} zs)}]}))]}
                 (helper {} tgt))]}]
       [$ [something]
        {[$tgt {tgt}]}]
       })))

(define $map
  (lambda [$fn $ls]
    (match ls (list something)
      {[<nil> {}]
       [<cons $x $xs> {(fn x) @(map fn xs)}]})))

(define $map-and-concat
  (lambda [$fn $ls]
    (match ls (list something)
      {[<nil> {}]
       [<cons $x $xs> {@(fn x) @(map-and-concat fn xs)}]})))

(define $foldr
  (lambda [$fn $init $ls]
    (match ls (list something)
      {[<nil> init]
       [<cons $x $xs> (fn x (foldr fn init xs))]})))

(define $foldl
  (lambda [$fn $init $ls]
    (match ls (list something)
      {[<nil> init]
       [<cons $x $xs> (let {[$y (fn init x)]}
                        (foldl fn y xs))]})))

(define $filter
  (lambda [$pred $ls]
    (match ls (list something)
      {[<nil> {}]
       [<cons $x $xs>
        (if (pred x)
            {x @(filter pred xs)}
            (filter pred xs))]})))

(define $split
  (lambda [$pred $ls]
    (letrec {[$helper (lambda [$ls $xs $ys]
                        (match ls (list something)
                          {[<nil> [xs ys]]
                           [<cons (& ?pred $l) $rs> (helper rs {l @xs} ys)]
                           [<cons $l $rs> (helper rs xs {l @ys})]}))]}
      (helper ls {} {}))))

(define $remove
  (lambda [$a]
    (lambda [$xs $x]
      (match xs (list a)
        {[<nil> {}]
         [<cons ,x $rs> rs]
         [<cons $y $rs> {y @((remove a) rs x)}]}))))

(define $remove-all
  (lambda [$a]
    (lambda [$xs $x]
      (match xs (list a)
        {[<nil> {}]
         [<cons ,x $rs> ((remove-all a) rs x)]
         [<cons $y $rs> {y @((remove-all a) rs x)}]}))))

(define $remove-collection
  (lambda [$a]
    (lambda [$xs $ys]
      (match ys (list a)
        {[<nil> xs]
         [<cons $y $rs> ((remove-collection a) ((remove a) xs y) rs)]}))))

(define $add
  (lambda [$a]
    (lambda [$xs $x]
      (if ((member? a) x xs)
          xs
          {@xs x}))))

(define $union
  (lambda [$a]
    (lambda [$xs $ys]
      (match ys (list something)
        {[<nil> xs]
         [<cons $y $rs> ((union a) ((add a) xs y) rs)]}))))

(define $occurrence
  (lambda [$a]
    (lambda [$xs]
      (letrec {[$remove-and-count
                (lambda [$x $xs]
                  (match xs (list a)
                    {[<nil> [{} 1]]
                     [<cons ,x $ys> (let {[[$r $i] (remove-and-count x ys)]}
                                      [r (+ i 1)])]
                     [<cons $y $ys> (let {[[$r $i] (remove-and-count x ys)]}
                                      [{y @r} i])]}))]}
        (match xs (list something)
          {[<nil> {}]
           [<cons $x $ys> (let {[[$rs $i] (remove-and-count x ys)]}
                            {[x i] @((occurrence a) rs)})]})))))

#|
(define $subcollections
  (lambda [$xs]
    (foldr (lambda [$x $rs]
             (let {[[$y $i] x]} 
               (map-and-concat (lambda [$sub] 
                                 (match-all (index-loop $l $j (between 1 i) {y @l} {}) (list something)
                                   [<join $ys _> {@ys @sub}]))
                               rs)))
           {{}}
           ((occurrence a) xs))))
|#

(define $size
  (lambda [$xs]
    (match xs (list something)
      {[<nil> 0]
       [<cons _ $rs> (+ 1 (size rs))]})))

(define $car
  (lambda [$xs]
    (match xs (list something)
      {[<cons $x _> x]})))

(define $cdr
  (lambda [$xs]
    (match xs (list something)
      {[<cons _ $ys> ys]})))

(define $rac
  (lambda [$xs]
    (match xs (list something)
      {[<snoc $x _> x]})))

(define $rdc
  (lambda [$xs]
    (match xs (list something)
      {[<snoc _ $ys> ys]})))

(define $nth
  (lambda [$i $l]
    (match l (list something)
      {[<cons $x $xs> (if (eq? i 0) x (nth (- i 1) xs))]})))

(define $take
  (lambda [$n $xs]
    (if (eq? n 0)
        {}
        (match xs (list something)
          {[<cons $x $xs> {x @(take (- n 1) xs)}]
           [<nil> {}]}))))

(define $drop
  (lambda [$n $xs]
    (if (eq? n 0)
        xs
        (match xs (list something)
          {[<cons _ $xs> (drop (- n 1) xs)]
           [<nil> {}]}))))

(define $reverse
  (lambda [$xs]
    (match xs (list something)
      {[<nil> {}]
       [<cons $x $rs>
        {@(reverse rs) x}]})))

(define $member?
  (lambda [$a]
    (lambda [$x $ys]
      (match ys (list a)
        {[<nil> #f]
         [<cons ,x $ys> #t]
         [<cons $y $ys> ((member? a) x ys)]}))))

(define $unique
  (lambda [$a]
    (lambda [$xs]
      (letrec {[$loop-fn
                (lambda [$xs $ys]
                  (match xs (list something)
                    {[<nil> ys]
                     [<cons $x $rs>
                      (if ((member? a) x ys)
                          (loop-fn rs ys)
                          (loop-fn rs {@ys x}))]}))]}
        (loop-fn xs {})))))

(define $subcollection?
  (lambda [$a]
    (lambda [$xs $ys]
      (match xs (list something)
        {[<nil> #t]
         [<cons $x $rest>
          (if ((member? a) x ys)
              ((subcollection? a) rest ys)
              #f)]}))))

(define $concat
  (lambda [$xs]
    (match xs (list something)
      {[<nil> {}]
       [<cons $x $rs> {@x @(concat rs)}]})))

(define $empty?
  (match-lambda (list something)
   {[<nil>      #t]
    [<cons _ _> #f]}))

(define $multiset
  (lambda [$a]
    (matcher
      {[,$val []
        {[$tgt (match [val tgt] [(list a) (multiset a)]
                 {[[<nil> <nil>] {[]}]
                  [[<cons $x $xs> <cons ,x ,xs>] {[]}]
                  [[_ _] {}]})]}]
       [<nil> []
        {[{} {[]}]
         [_ {}]}]
       [<cons ,$px $> [(multiset a)]
        {[$tgt (match tgt (list a)
                 {[<join $hs <cons ,px $ts>> {{@hs @ts}}]
                  [_ {}]})]}]
       [<cons $ $> [a (multiset a)]
        {[$tgt (match-all tgt (list a)
                 [<join $hs <cons $x $ts>> [x {@hs @ts}]])]}]
       [<join ,$pxs $> [(multiset a)]
        {[$tgt {((remove-collection a) tgt pxs)}]}]
       [$ [something]
        {[$tgt {tgt}]}]
       })))

(define $set
  (lambda [$a]
    (matcher
      {
       [<nil> []
        {[{} {[]}]
         [_ {}]}]
       [<cons ,$px $> [(set a)]
        {[$tgt (match tgt (list a)
                 {[<join _ <cons ,px _>> {tgt}]
                  [_ {}]})]}]
       [<cons $ $> [a (set a)]
        {[$tgt (match-all tgt (list a)
                 [<join _ <cons $x _>> [x tgt]])]}]
       [$ [something]
        {[$tgt {tgt}]}]
       })))