blob: 1d683bf5a84f9f17830c04ba0d01fd3a77d99a8d (
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
47
|
(.module:
[lux #*
[control [monoid (#+ Monoid)]]
[function]])
(type: #export (Predicate a)
(-> a Bit))
(do-template [<identity-name> <identity-value> <composition-name> <composition>]
[(def: #export <identity-name>
(All [a] (Predicate a))
(function.constant <identity-value>))
(def: #export (<composition-name> left right)
(All [a] (-> (Predicate a) (Predicate a) (Predicate a)))
(function (_ value)
(<composition> (left value)
(right value))))]
[none #0 union or]
[all #1 intersection and]
)
(do-template [<name> <identity> <composition>]
[(structure: #export <name> (All [a] (Monoid (Predicate a)))
(def: identity <identity>)
(def: compose <composition>))]
[Union@Monoid none union]
[Intersection@Monoid all intersection]
)
(def: #export (complement predicate)
(All [a] (-> (Predicate a) (Predicate a)))
(|>> predicate not))
(def: #export (difference sub base)
(All [a] (-> (Predicate a) (Predicate a) (Predicate a)))
(function (_ value)
(and (base value)
(not (sub value)))))
(def: #export (rec predicate)
(All [a]
(-> (-> (Predicate a) (Predicate a))
(Predicate a)))
(|>> (predicate (rec predicate))))
|
