collection.egi

;;
;; Collection.egi
;;

(define $List
  (lambda [$a]
    (type
      {[,$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 {[$loop-fn
                         (lambda [$ts]
                           (match ts (List a)
                             {[<nil> {[{} {}]}]
                              [<cons $x $xs>
                               {[{} ts]
                                @(map (lambda [$as $bs] [{x @as} bs])
                                      (loop-fn xs))}]}))]}
                 (loop-fn tgt))]}]
       [<nioj _ _> [(List a) (List a)]
        {[$tgt (letrec {[$loop-fn
                         (lambda [$ts]
                           (match ts (List a)
                             {[<nil> {[{} {}]}]
                              [<snoc $x $xs>
                               {[{} ts]
                                @(map (lambda [$as $bs] [{@as x} bs])
                                      (loop-fn xs))}]}))]}
                 (loop-fn tgt))]}]
       [_ [Something]
        {[$tgt {tgt}]}]
       })))
  
(define $map
  (lambda [$fn $ls]
    (match ls (List Something)
      {[<nil> {}]
       [<cons $x $xs> {(fn x) @(map 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 $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? Integer) x xs)
          xs
          {@xs x}))))

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

(define $subcollections
  (lambda [$xs]
    (match xs (List Something)
      {[<nil> {{}}]
       [<cons $x $rs>
        (let {[$subs (subcollections rs)]}
          {@subs @(map (lambda [$sub] {x @sub})
                       subs)})]})))

(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 [$n $ls]
    (if (eq-n? n 1)
        (car ls)
        (nth (- n 1) (cdr ls)))))

(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 a)
                             {[<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 a)
        {[<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 $Multiset
  (lambda [$a]
    (type
      {[,$val []
        {[$tgt (match [val tgt] [(List a) (Multiset a)]
                 {[[<nil> <nil>] {[]}]
                  [[<cons $x $xs> <cons ,x ,xs>] {[]}]
                  [[_ _] {}]})]}]
       [<nil> []
        {[{} {[]}]
         [_ {}]}]
       [<cons ,$px _> [(Multiset a)]
        {[$tgt (if ((member? a) px tgt)
                   {((remove a) tgt px)}
                   {})]}]
       [<cons _ _> [a (Multiset a)]
        {[$tgt (map (lambda [$t] [t ((remove a) tgt t)])
                    ((unique a) tgt))]}]
       [<join ,$pxs _> [(Multiset a)]
        {[$tgt (if ((subcollection? a) pxs tgt)
                   {((remove-collection a) tgt pxs)}
                   {})]}]
       [<join _ _> [(Multiset a) (Multiset a)]
        {[$tgt (map (lambda [$ts] [ts ((remove-collection a) tgt ts)])
                    (subcollections tgt))]}]
       [_ [Something]
        {[$tgt {tgt}]}]
       })))

(define $Set
  (lambda [$a]
    (type
      {[,$val []
        {[$tgt (if (and ((subcollection? a) val tgt)
                        ((subcollection? a) tgt val))
                   {[]}
                   {})]}]
       [<nil> []
        {[{} {[]}]
         [_ {}]}]
       [<cons _ _> [a (Set a)]
        {[$tgt (let {[$tgt2 ((unique a) tgt)]}
                 {@(match-all tgt2 (Multiset a) [<cons $x $xs> [x xs]])
                  @(match-all tgt2 (Multiset a) [<cons $x $xs> [x {@xs x}]])})]}]
       [<join _ _> [(Set a) (Set a)]
        {[$tgt (let {[$tgt2 ((unique a) tgt)]}
                 (concat (map (lambda [$xs $ys] (map (lambda [$sxs] [xs {@ys @sxs}])
                                                     (subcollections xs)))
                              (match-all tgt2 (Multiset a) [<join $xs $ys> [xs ys]]))))]}]
       [_ [Something]
        {[$tgt {tgt}]}]
       })))