aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/lux/abstract/predicate.lux
blob: 841865c103cc8ee1b75ffb6ff64066cc574b9e9a (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
48
49
50
51
52
53
54
55
56
57
58
59
60
(.module:
  [lux #*
   [control
    ["." function]]]
  [//
   [monoid (#+ Monoid)]
   [functor
    ["." contravariant]]])

(type: #export (Predicate a)
  (-> a Bit))

(template [<identity_name> <identity_value> <composition_name> <composition>]
  [(def: #export <identity_name>
     Predicate
     (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 unite     or]
  [all  #1 intersect and]
  )

(template [<name> <identity> <composition>]
  [(implementation: #export <name>
     (All [a] (Monoid (Predicate a)))
     
     (def: identity <identity>)
     (def: compose <composition>))]

  [union        ..none ..unite]
  [intersection ..all  ..intersect]
  )

(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)))
  (function (recur input)
    (predicate recur input)))

(implementation: #export functor
  (contravariant.Functor Predicate)
  
  (def: (map f fb)
    (|>> f fb)))