egison-2.4.2: 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)}]}))]}
(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 $map&concat
(lambda [$fn $ls]
(match ls (List Something)
{[<nil> {}]
[<cons $x $xs> {@(fn x) @(map&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 $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 $occurrence
(lambda [$a]
(lambda [$xs]
(letrec
{[$remove&count (lambda [$x $xs]
(match xs (List a)
{[<nil> [{} 1]]
[<cons ,x $ys> (let {[[$r $i] (remove&count x ys)]}
[r (+ i 1)])]
[<cons $y $ys> (let {[[$r $i] (remove&count x ys)]}
[{y @r} i])]}))]}
(match xs (List Something)
{[<nil> {}]
[<cons $x $ys> (let {[[$rs $i] (remove&count x ys)]}
{[x i] @((occurrence a) rs)})]})))))
(define $subcollections
(lambda [$a]
(lambda [$xs]
(foldr
(lambda [$x $rs]
(let {[[$y $i] x]}
(map&concat (lambda [$sub]
(match-all (loop $l $j (between 1 i) {y @l} {}) (List a) [<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 $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 (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 (letrec {[$helper (lambda [$xs $ys]
(match xs (List Something)
{[<nil> ys]
[<cons $z $zs> (if ((member? a) z ys)
(helper zs ((remove a) ys z))
{})]}))]}
{(helper pxs tgt)})]}]
;; [<join _ ,$pys> [(Multiset a)]
;; {[$tgt (match-all tgt (Multiset a) [<join ,pys $xs> xs])]}]
[<join _ _> [(Multiset a) (Multiset a)]
{[$tgt
(foldr
(lambda [$xi $xs]
(let {[[$x $i] xi]}
(map&concat
(lambda [$sub]
(do {[[$ys $zs] sub]
[$zs ((remove-all a) zs x)]}
(match-all (loop $l $j (between 1 i) {x @l} {}) (List a) [<join $us $vs> [{@us @ys} {@zs @vs}]])))
xs)))
{[{} tgt]}
((occurrence a) tgt))]}]
[_ [Something]
{[$tgt {tgt}]}]
})))
(define $Set
(lambda [$a]
(type
{[,$val []
{[$tgt (if ((= (Multiset a)) ((unique a) val) ((unique a) tgt))
{[]}
{})]}]
[<nil> []
{[{} {[]}]
[_ {}]}]
[<cons ,$px _> [(Set2 a)]
{[$tgt (let {[$tgt2 ((unique a) tgt)]}
(if ((member? a) px tgt)
{tgt}
{}))]}]
[<cons _ _> [a (Set2 a)]
{[$tgt (let {[$tgt2 ((unique a) tgt)]}
(match-all tgt2 (Multiset a)
[<cons $x _> [x tgt2]]))]}]
[<join _ _> [(Set2 a) (Set2 a)]
{[$tgt (let {[$tgt2 ((unique a) tgt)]}
(match-all tgt2 (Multiset a)
[<join $xs _> [xs tgt2]]))]}]
[_ [Something]
{[$tgt {tgt}]}]
})))
(define $Set2 ; handle already uniqued target collection
(lambda [$a]
(type
{[,$val []
{[$tgt (if ((= (Multiset a)) ((unique a) val) tgt)
{[]}
{})]}]
[<nil> []
{[{} {[]}]
[_ {}]}]
[<cons ,$px _> [(Set a)]
{[$tgt (if ((member? a) px tgt)
{tgt}
{})]}]
[<cons _ _> [a (Set a)]
{[$tgt (match-all tgt (Multiset a)
[<cons $x _> [x tgt]])]}]
[<join _ _> [(Set a) (Set a)]
{[$tgt (match-all tgt (Multiset a)
[<join $xs _> [xs tgt]])]}]
[_ [Something]
{[$tgt {tgt}]}]
})))