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

(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 input parser)
  (All [a] (-> ..Input (Parser a) (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]))))

(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 head parser)]
        (#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 (list body) parser)]
          (#try.Success [tail [environment output]]))
        (exception.throw ..wrong-arity [expected actual]))

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