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

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

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

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

(type: #export Parser
  (//.Parser (List Analysis)))

(def: #export (run parser input)
  (All [a] (-> (Parser a) (List Analysis) (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 Analysis)
  (function (_ input)
    (case input
      #.Nil
      (exception.throw ..cannot-parse 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]
  [nat nat! /.nat Nat nat.equivalence]
  [int int! /.int Int int.equivalence]
  [rev rev! /.rev Rev rev.equivalence]
  [frac frac! /.frac Frac frac.equivalence]
  [text text! /.text Text text.equivalence]
  [local local! /.variable/local Nat nat.equivalence]
  [foreign foreign! /.variable/foreign Nat nat.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))))