blob: dd33129b8a264bb59ae0cabc9b387d3be1e8f57d (
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
|
(ns lux.parser
(:require [clojure.template :refer [do-template]]
clojure.core.match
clojure.core.match.array
(lux [base :as & :refer [|do return |case]]
[lexer :as &lexer])))
;; [Utils]
(def ^:private base-uneven-record-error
"[Parser Error] Records must have an even number of elements.")
(defn ^:private repeat% [action]
(fn [state]
(|case (action state)
(&/$Left ^String error)
(if (or (.contains error base-uneven-record-error)
(not (.contains error "[Parser Error]")))
(&/$Left error)
(&/$Right (&/T [state &/$Nil])))
(&/$Right state* head)
((|do [tail (repeat% action)]
(return (&/$Cons head tail)))
state*))))
(do-template [<name> <close-tag> <description> <tag>]
(defn <name> [parse]
(|do [elems (repeat% parse)
token &lexer/lex]
(|case token
[meta (<close-tag> _)]
(return (<tag> (&/fold &/|++ &/$Nil elems)))
_
(&/fail-with-loc (str "[Parser Error] Unbalanced " <description> "."))
)))
^:private parse-form &lexer/$Close_Paren "parantheses" &/$Form
^:private parse-tuple &lexer/$Close_Bracket "brackets" &/$Tuple
)
(defn ^:private parse-record [parse]
(|do [elems* (repeat% parse)
token &lexer/lex
:let [elems (&/fold &/|++ &/$Nil elems*)]]
(|case token
[meta (&lexer/$Close_Brace _)]
(|do [_ (&/assert! (even? (&/|length elems))
(&/fail-with-loc base-uneven-record-error))]
(return (&/$Record (&/|as-pairs elems))))
_
(&/fail-with-loc "[Parser Error] Unbalanced braces.")
)))
;; [Interface]
(def parse
(|do [token &lexer/lex
:let [[meta token*] token]]
(|case token*
(&lexer/$White_Space _)
(return &/$Nil)
(&lexer/$Comment _)
(return &/$Nil)
(&lexer/$Bit ?value)
(return (&/|list (&/T [meta (&/$Bit (.equals ^String ?value "#1"))])))
(&lexer/$Nat ?value)
(return (&/|list (&/T [meta (&/$Nat (Long/parseUnsignedLong ?value))])))
(&lexer/$Int ?value)
(return (&/|list (&/T [meta (&/$Int (Long/parseLong ?value))])))
(&lexer/$Rev ?value)
(return (&/|list (&/T [meta (&/$Rev (&/decode-rev ?value))])))
(&lexer/$Frac ?value)
(return (&/|list (&/T [meta (&/$Frac (Double/parseDouble ?value))])))
(&lexer/$Text ?value)
(return (&/|list (&/T [meta (&/$Text ?value)])))
(&lexer/$Identifier ?ident)
(return (&/|list (&/T [meta (&/$Identifier ?ident)])))
(&lexer/$Tag ?ident)
(return (&/|list (&/T [meta (&/$Tag ?ident)])))
(&lexer/$Open_Paren _)
(|do [syntax (parse-form parse)]
(return (&/|list (&/T [meta syntax]))))
(&lexer/$Open_Bracket _)
(|do [syntax (parse-tuple parse)]
(return (&/|list (&/T [meta syntax]))))
(&lexer/$Open_Brace _)
(|do [syntax (parse-record parse)]
(return (&/|list (&/T [meta syntax]))))
_
(&/fail-with-loc "[Parser Error] Unknown lexer token.")
)))
|
