aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/library/lux/control/parser/synthesis.lux
blob: d6c6fbecad06c6636fc222471b022597a160a7c8 (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
(.module:
  [library
   [lux (#- Tuple Variant function loop i64 local)
    [abstract
     [monad (#+ do)]]
    [control
     ["." try (#+ Try)]
     ["." exception (#+ exception:)]]
    [data
     ["." bit]
     ["." name]
     ["." text
      ["%" format (#+ format)]]]
    [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
  (//.Parser (List Synthesis)))

(def: .public (result parser input)
  (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
  (Parser Synthesis)
  (.function (_ input)
    (case input
      #.End
      (exception.except ..empty_input [])
      
      (#.Item [head tail])
      (#try.Success [tail head]))))

(def: .public end!
  (Parser Any)
  (.function (_ tokens)
    (case tokens
      #.End (#try.Success [tokens []])
      _     (exception.except ..expected_empty_input [tokens]))))

(def: .public end?
  (Parser Bit)
  (.function (_ tokens)
    (#try.Success [tokens (case tokens
                            #.End true
                            _     false)])))

(template [<query> <assertion> <tag> <type> <eq>]
  [(`` (def: .public <query>
         (Parser <type>)
         (.function (_ input)
           (case input
             (^ (list& (<tag> x) input'))
             (#try.Success [input' x])

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

   (`` (def: .public (<assertion> expected)
         (-> <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)
  (All [a] (-> (Parser a) (Parser a)))
  (.function (_ input)
    (case input
      (^ (list& (/.tuple head) tail))
      (do try.monad
        [output (..result parser head)]
        (#try.Success [tail output]))

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

(def: .public (function expected parser)
  (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 (..result 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)
  (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 (..result init_parsers inits)
         iteration (..result iteration_parser (list iteration))]
        (#try.Success [tail [start inits iteration]]))

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