egison-2.4.0: lib/core/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 _ ,$pys> [(List a)]
{[$tgt (letrec {[$helper (lambda [$pys $tgt]
(match [pys tgt] [(List a) (List a)]
{[[<nil> _] {tgt}]
[[<snoc $x $xs> <snoc ,x $ys>] (helper xs ys)]
[[_ _] {}]}))]}
(helper pys 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 {[xs ys]})}]}))]}
(helper {} tgt))]}]
[<nioj ,$pxs _> [(List a)]
{[$tgt (match-all tgt (List a) [<join $ys ,pxs> ys])]}]
[<nioj _ ,$pys> [(List a)]
{[$tgt (match-all tgt (List a) [<join ,pys $xs> xs])]}]
[<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 $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 [$i $l]
(match l (List Something) {[<cons $x $xs> (if (eq? i 0) x (nth (- i 1) xs))]})))
(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 (letrec {[$helper (lambda [$xs $ys]
(match xs (List a)
{[<nil> {}]
[<cons ,px $zs> {{@ys @zs}}]
[<cons $z $zs> (helper zs {@ys z})]}))]}
(helper tgt {}))]}]
[<cons _ _> [a (Multiset a)]
{[$tgt (letrec {[$helper (lambda [$xs $ys]
(match ys (List a)
{[<nil> {}]
[<cons $z $zs> (if ((member? a) z xs)
(helper {@xs z} zs)
{[z {@xs @zs}] @(helper {@xs z} zs)})]}))]}
(helper {} tgt))]}]
[<join ,$pxs _> [(Multiset a)]
{[$tgt (if ((subcollection? a) pxs tgt)
{((remove-collection a) tgt pxs)}
{})]}]
[<join _ ,$pys> [(Multiset a)]
{[$tgt (match-all tgt (Multiset a) [<join ,pys $xs> xs])]}]
[<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 ,$px _> [(Set a)]
{[$tgt (letrec {[$helper (lambda [$xs $ys]
(match xs (List a)
{[<nil> {}]
[<cons ,px $zs> {{@ys @zs} tgt}]
[<cons $z $zs> (helper zs {@ys z})]}))]}
(helper ((unique a) tgt) {}))]}]
[<cons _ _> [a (Set a)]
{[$tgt (let {[$tgt2 ((unique a) tgt)]}
(letrec {[$helper (lambda [$xs $ys]
(match xs (List a)
{[<nil> {}]
[<cons $z $zs>
{[z {@ys @zs}] [z tgt2] @(helper zs {@ys z})}]}))]}
(helper tgt2 {})))]}]
[<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}]}]
})))