blob: 7166688b52345dfd4239b529754fc44d23508b5f (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
|
## Copyright (c) Eduardo Julian. All rights reserved.
## The use and distribution terms for this software are covered by the
## Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
## which can be found in the file epl-v10.html at the root of this distribution.
## By using this software in any fashion, you are agreeing to be bound by
## the terms of this license.
## You must not remove this notice, or any other, from this software.
(;import lux
(lux/data (list #refer (#except partition))))
## [Types]
## (deftype (Either l r)
## (| (#;Left l)
## (#;Right r)))
## [Functions]
(def #export (either f g e)
(All [a b c] (-> (-> a c) (-> b c) (Either a b) c))
(case e
(#;Left x) (f x)
(#;Right x) (g x)))
(do-template [<name> <side> <tag>]
[(def #export (<name> es)
(All [a b] (-> (List (Either a b)) (List <side>)))
(case es
#;Nil #;Nil
(#;Cons [(<tag> x) es']) (#;Cons [x (<name> es')])
(#;Cons [_ es']) (<name> es')))]
[lefts a #;Left]
[rights b #;Right]
)
(def #export (partition es)
(All [a b] (-> (List (Either a b)) (, (List a) (List b))))
(foldL (: (All [a b]
(-> (, (List a) (List b)) (Either a b) (, (List a) (List b))))
(lambda [tails e]
(let [[ltail rtail] tails]
(case e
(#;Left x) [(#;Cons [x ltail]) rtail]
(#;Right x) [ltail (#;Cons [x rtail])]))))
[(list) (list)]
(reverse es)))
|
