aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/lux/control/parser/synthesis.lux
blob: 0c52b878c4278c5e8b5eedc91af7a6b835c82640 (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
(.module:
  [lux (#- function i64)
   [abstract
    [monad (#+ do)]]
   [control
    ["." try (#+ Try)]
    ["." exception (#+ exception:)]]
   [data
    ["." bit]
    ["." name]
    [number
     ["." i64]
     ["n" nat]
     ["." frac]]
    ["." text
     ["%" format (#+ format)]]
    [collection
     ["." list ("#@." functor)]]]
   [tool
    [compiler
     [reference (#+)]
     [arity (#+ Arity)]
     [analysis (#+ Variant Tuple Environment)]
     ["/" synthesis (#+ Synthesis Abstraction)]]]]
  ["." //])

(def: (remaining-inputs asts)
  (-> (List Synthesis) Text)
  (format text.new-line "Remaining input: "
          (|> asts
              (list@map /.%synthesis)
              (list.interpose " ")
              (text.join-with ""))))

## TODO: Use "type:" ASAP.
(def: Input Type (type (List Synthesis)))

(exception: #export (cannot-parse {input ..Input})
  (exception.report
   ["Input" (exception.enumerate /.%synthesis input)]))

(exception: #export (unconsumed-input {input ..Input})
  (exception.report
   ["Input" (exception.enumerate /.%synthesis input)]))

(exception: #export (wrong-arity {expected Arity} {actual Arity})
  (exception.report
   ["Expected" (%.nat expected)]
   ["Actual" (%.nat actual)]))

(exception: #export empty-input)

(type: #export Parser
  (//.Parser ..Input))

(def: #export (run parser input)
  (All [a] (-> (Parser a) ..Input (Try a)))
  (case (parser input)
    (#try.Failure error)
    (#try.Failure error)

    (#try.Success [#.Nil value])
    (#try.Success value)
    
    (#try.Success [unconsumed _])
    (exception.throw ..unconsumed-input unconsumed)))

(def: #export any
  (Parser Synthesis)
  (.function (_ input)
    (case input
      #.Nil
      (exception.throw ..empty-input [])
      
      (#.Cons [head tail])
      (#try.Success [tail head]))))

(def: #export end!
  {#.doc "Ensures there are no more inputs."}
  (Parser Any)
  (.function (_ tokens)
    (case tokens
      #.Nil (#try.Success [tokens []])
      _     (#try.Failure (format "Expected list of tokens to be empty!"
                                  (remaining-inputs tokens))))))

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

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

         _
         (exception.throw ..cannot-parse input))))

   (def: #export (<assertion> expected)
     (-> <type> (Parser Any))
     (.function (_ input)
       (case input
         (^ (list& (<tag> actual) input'))
         (if (:: <eq> = expected actual)
           (#try.Success [input' []])
           (exception.throw ..cannot-parse input))

         _
         (exception.throw ..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: #export (tuple parser)
  (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.throw ..cannot-parse input))))

(def: #export (function expected parser)
  (All [a] (-> Arity (Parser a) (Parser [Environment 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.throw ..wrong-arity [expected actual]))

      _
      (exception.throw ..cannot-parse input))))