aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/library/lux/control/parser/synthesis.lux
blob: cde50518e5b7f412a063cb362b9194c176f6ab94 (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
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
(.module:
  [library
   [lux (#- Variant Tuple function loop i64 local)
    [abstract
     [monad (#+ do)]]
    [control
     ["." try (#+ Try)]
     ["." exception (#+ exception:)]]
    [data
     ["." bit]
     ["." name]
     ["." text
      ["%" format (#+ format)]]]
    [macro
     ["." template]]
    [math
     [number
      ["n" nat]
      ["." i64]
      ["." frac]]]
    [tool
     [compiler
      [reference (#+)
       [variable (#+ Register)]]
      [arity (#+ Arity)]
      [language
       [lux
        [analysis (#+ Variant Tuple Environment)]
        ["/" synthesis (#+ Synthesis Abstraction)]]]]]]]
  ["." //])

(exception: .public (cannot_parse {input (List Synthesis)})
  (exception.report
   ["Input" (exception.listing /.%synthesis input)]))

(exception: .public (unconsumed_input {input (List Synthesis)})
  (exception.report
   ["Input" (exception.listing /.%synthesis input)]))

(exception: .public (expected_empty_input {input (List Synthesis)})
  (exception.report
   ["Input" (exception.listing /.%synthesis input)]))

(exception: .public (wrong_arity {expected Arity} {actual Arity})
  (exception.report
   ["Expected" (%.nat expected)]
   ["Actual" (%.nat actual)]))

(exception: .public empty_input)

(type: .public Parser
  {#.doc (doc "A parser for the Lux compiler's synthesis nodes using during optimization.")}
  (//.Parser (List Synthesis)))

(def: .public (run parser input)
  {#.doc (doc "Executes the parser against the inputs."
              "Ensures all inputs are consumed by the parser.")}
  (All [a] (-> (Parser a) (List Synthesis) (Try a)))
  (case (parser input)
    (#try.Failure error)
    (#try.Failure error)

    (#try.Success [#.End value])
    (#try.Success value)
    
    (#try.Success [unconsumed _])
    (exception.except ..unconsumed_input unconsumed)))

(def: .public any
  {#.doc (doc "Yields a synthesis node without subjecting it to any analysis.")}
  (Parser Synthesis)
  (.function (_ input)
    (case input
      #.End
      (exception.except ..empty_input [])
      
      (#.Item [head tail])
      (#try.Success [tail head]))))

(def: .public end!
  {#.doc "Ensures there are no more inputs."}
  (Parser Any)
  (.function (_ tokens)
    (case tokens
      #.End (#try.Success [tokens []])
      _     (exception.except ..expected_empty_input [tokens]))))

(def: .public end?
  {#.doc "Checks whether there are no more inputs."}
  (Parser Bit)
  (.function (_ tokens)
    (#try.Success [tokens (case tokens
                            #.End true
                            _     false)])))

(template [<query> <assertion> <tag> <type> <eq>]
  [(`` (def: .public <query>
         {#.doc (doc (~~ (template.text ["Queries for a " <query> " synthesis node."])))}
         (Parser <type>)
         (.function (_ input)
           (case input
             (^ (list& (<tag> x) input'))
             (#try.Success [input' x])

             _
             (exception.except ..cannot_parse input)))))

   (`` (def: .public (<assertion> expected)
         {#.doc (doc (~~ (template.text ["Checks for a specific " <query> " synthesis node."])))}
         (-> <type> (Parser Any))
         (.function (_ input)
           (case input
             (^ (list& (<tag> actual) input'))
             (if (\ <eq> = expected actual)
               (#try.Success [input' []])
               (exception.except ..cannot_parse input))

             _
             (exception.except ..cannot_parse input)))))]

  [bit bit! /.bit Bit bit.equivalence]
  [i64 i64! /.i64 (I64 Any) i64.equivalence]
  [f64 f64! /.f64 Frac frac.equivalence]
  [text text! /.text Text text.equivalence]
  [local local! /.variable/local Nat n.equivalence]
  [foreign foreign! /.variable/foreign Nat n.equivalence]
  [constant constant! /.constant Name name.equivalence]
  )

(def: .public (tuple parser)
  {#.doc (doc "Parses the contents of a tuple.")}
  (All [a] (-> (Parser a) (Parser a)))
  (.function (_ input)
    (case input
      (^ (list& (/.tuple head) tail))
      (do try.monad
        [output (..run parser head)]
        (#try.Success [tail output]))

      _
      (exception.except ..cannot_parse input))))

(def: .public (function expected parser)
  {#.doc (doc "Parses the body of a function with the 'expected' arity.")}
  (All [a] (-> Arity (Parser a) (Parser [(Environment Synthesis) a])))
  (.function (_ input)
    (case input
      (^ (list& (/.function/abstraction [environment actual body]) tail))
      (if (n.= expected actual)
        (do try.monad
          [output (..run parser (list body))]
          (#try.Success [tail [environment output]]))
        (exception.except ..wrong_arity [expected actual]))

      _
      (exception.except ..cannot_parse input))))

(def: .public (loop init_parsers iteration_parser)
  {#.doc (doc "Parses the initial values and the body of a loop.")}
  (All [a b] (-> (Parser a) (Parser b) (Parser [Register a b])))
  (.function (_ input)
    (case input
      (^ (list& (/.loop/scope [start inits iteration]) tail))
      (do try.monad
        [inits (..run init_parsers inits)
         iteration (..run iteration_parser (list iteration))]
        (#try.Success [tail [start inits iteration]]))

      _
      (exception.except ..cannot_parse input))))