aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/library/lux/control/parser/analysis.lux
blob: 60b8edb635a1d597e00639762ddab7d61e0d9b18 (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
(.using
 [library
  [lux (.except nat int rev local)
   [abstract
    [monad (.only do)]]
   [control
    ["[0]" try (.only Try)]
    ["[0]" exception (.only exception:)]]
   [data
    ["[0]" bit]
    ["[0]" text (.only)
     ["%" format (.only format)]]
    [collection
     ["[0]" list (.open: "[1]#[0]" functor)]]]
   [macro
    ["[0]" template]]
   [math
    [number
     ["[0]" i64]
     ["[0]" nat]
     ["[0]" int]
     ["[0]" rev]
     ["[0]" frac]]]
   [meta
    ["[0]" symbol]]
   [tool
    [compiler
     [arity (.only Arity)]
     [reference (.only)
      [variable (.only)]]
     [language
      [lux
       ["/" analysis (.only Environment Analysis)]]]]]]]
 ["[0]" //])

(def: (remaining_inputs asts)
  (-> (List Analysis) Text)
  (format text.new_line "Remaining input: "
          (|> asts
              (list#each /.format)
              (text.interposed " "))))

(exception: .public (cannot_parse [input (List Analysis)])
  (exception.report
   "Input" (exception.listing /.format input)))

(exception: .public (unconsumed_input [input (List Analysis)])
  (exception.report
   "Input" (exception.listing /.format input)))

(type: .public Parser
  (//.Parser (List Analysis)))

(def: .public (result parser input)
  (All (_ a) (-> (Parser a) (List Analysis) (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 Analysis)
  (function (_ input)
    (case input
      {.#End}
      (exception.except ..cannot_parse input)
      
      {.#Item [head tail]}
      {try.#Success [tail head]})))

(def: .public end
  (Parser Any)
  (function (_ tokens)
    (case tokens
      {.#End} {try.#Success [tokens []]}
      _       {try.#Failure (format "Expected list of tokens to be empty!"
                                    (remaining_inputs tokens))})))

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

(template [<query> <assertion> <tag> <type> <eq>]
  [(`` (these (def: .public <query>
                (Parser <type>)
                (function (_ input)
                  (case input
                    (pattern (partial_list (<tag> x) input'))
                    {try.#Success [input' x]}

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

              (def: .public (<assertion> expected)
                (-> <type> (Parser Any))
                (function (_ input)
                  (case input
                    (pattern (partial_list (<tag> actual) input'))
                    (if (# <eq> = expected actual)
                      {try.#Success [input' []]}
                      (exception.except ..cannot_parse input))

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

  [bit this_bit /.bit Bit bit.equivalence]
  [nat this_nat /.nat Nat nat.equivalence]
  [int this_int /.int Int int.equivalence]
  [rev this_rev /.rev Rev rev.equivalence]
  [frac this_frac /.frac Frac frac.equivalence]
  [text this_text /.text Text text.equivalence]
  [local this_local /.local Nat nat.equivalence]
  [foreign this_foreign /.foreign Nat nat.equivalence]
  [constant this_constant /.constant Symbol symbol.equivalence]
  )

(def: .public (tuple parser)
  (All (_ a) (-> (Parser a) (Parser a)))
  (function (_ input)
    (case input
      (pattern (partial_list (/.tuple head) tail))
      (do try.monad
        [output (..result parser head)]
        {try.#Success [tail output]})

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