aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/library/lux/type/refinement.lux
blob: 93d962ae3ad2d509b38a4ae700027c8ea9dbc889 (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
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
(.module:
  [library
   [lux (#- type)
    [abstract
     [predicate (#+ Predicate)]]
    [control
     [parser
      ["<.>" code]]]
    ["." macro
     [syntax (#+ syntax:)]]
    ["." type
     abstract]]])

(abstract: .public (Refined t %)
  {}

  (Record
   [#value t
    #predicate (Predicate t)])

  (type: .public (Refiner t %)
    (-> t (Maybe (Refined t %))))

  (def: .public (refiner predicate)
    (All (_ t)
      (Ex (_ %)
        (-> (Predicate t) (Refiner t %))))
    (function (_ value)
      (if (predicate value)
        (#.Some (:abstraction [#value value
                               #predicate predicate]))
        #.None)))

  (template [<name> <output> <slot>]
    [(def: .public <name>
       (All (_ t %) (-> (Refined t %) <output>))
       (|>> :representation (value@ <slot>)))]

    [value     t             #value]
    [predicate (Predicate t) #predicate]
    )

  (def: .public (lifted transform)
    (All (_ t %)
      (-> (-> t t)
          (-> (Refined t %) (Maybe (Refined t %)))))
    (function (_ refined)
      (let [(^slots [#value #predicate]) (:representation refined)
            value' (transform value)]
        (if (predicate value')
          (#.Some (:abstraction [#value value'
                                 #predicate predicate]))
          #.None))))
  )

(def: .public (only refiner values)
  (All (_ t %)
    (-> (Refiner t %) (List t) (List (Refined t %))))
  (case values
    #.End
    #.End

    (#.Item head tail)
    (case (refiner head)
      (#.Some refined)
      (#.Item refined (only refiner tail))
      
      #.None
      (only refiner tail))))

(def: .public (partition refiner values)
  (All (_ t %)
    (-> (Refiner t %) (List t) [(List (Refined t %)) (List t)]))
  (case values
    #.End
    [#.End #.End]

    (#.Item head tail)
    (let [[yes no] (partition refiner tail)]
      (case (refiner head)
        (#.Some refined)
        [(#.Item refined yes)
         no]
        
        #.None
        [yes
         (#.Item head no)]))))

(syntax: .public (type [refiner <code>.any])
  (macro.with_identifiers [g!t g!%]
    (in (list (` ((~! type.:by_example) [(~ g!t) (~ g!%)]
                  (..Refiner (~ g!t) (~ g!%))
                  (~ refiner)
                  
                  (..Refined (~ g!t) (~ g!%))))))))