blob: 8422bb4e1cdfd6d3e37231a0a7682a66ba93912d (
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
152
153
154
155
156
157
|
(.module:
[lux #*
data/text/format
[abstract/monad (#+ do)]
["r" math/random (#+ Random)]
["_" test (#+ Test)]
[abstract
[equivalence (#+ Equivalence)]]
[control
["p" parser
["s" code (#+ Parser)]]]
[data
["." bit]
["." name]
["." error (#+ Error)]
["." text]
[number
["." nat]
["." int]
["." rev]
["." frac]]]
["." macro
["." code]]]
{1
["." / (#+ syntax:)]})
(def: (enforced? parser input)
(-> (Parser []) (List Code) Bit)
(case (p.run input parser)
(#.Right [_ []])
#1
_
#0))
(def: (found? parser input)
(-> (Parser Bit) (List Code) Bit)
(case (p.run input parser)
(#.Right [_ #1])
#1
_
#0))
(def: (equals? Equivalence<a> reference parser input)
(All [a] (-> (Equivalence a) a (Parser a) (List Code) Bit))
(case (p.run input parser)
(#.Right [_ output])
(:: Equivalence<a> = reference output)
_
#0))
(def: (fails? input)
(All [a] (-> (Error a) Bit))
(case input
(#.Left _)
#1
_
#0))
(syntax: (match pattern input)
(wrap (list (` (case (~ input)
(^ (#.Right [(~' _) (~ pattern)]))
#1
(~' _)
#0)))))
(def: simple-values
Test
(`` ($_ _.and
(~~ (template [<assertion> <value> <ctor> <Equivalence> <get>]
[(_.test <assertion>
(and (equals? <Equivalence> <value> <get> (list (<ctor> <value>)))
(found? (s.this? (<ctor> <value>)) (list (<ctor> <value>)))
(enforced? (s.this (<ctor> <value>)) (list (<ctor> <value>)))))]
["Can parse Bit syntax." #1 code.bit bit.equivalence s.bit]
["Can parse Nat syntax." 123 code.nat nat.equivalence s.nat]
["Can parse Int syntax." +123 code.int int.equivalence s.int]
["Can parse Rev syntax." .123 code.rev rev.equivalence s.rev]
["Can parse Frac syntax." +123.0 code.frac frac.equivalence s.frac]
["Can parse Text syntax." text.new-line code.text text.equivalence s.text]
["Can parse Identifier syntax." ["yolo" "lol"] code.identifier name.equivalence s.identifier]
["Can parse Tag syntax." ["yolo" "lol"] code.tag name.equivalence s.tag]
))
(_.test "Can parse identifiers belonging to the current namespace."
(and (match "yolo"
(p.run (list (code.local-identifier "yolo"))
s.local-identifier))
(fails? (p.run (list (code.identifier ["yolo" "lol"]))
s.local-identifier))))
(_.test "Can parse tags belonging to the current namespace."
(and (match "yolo"
(p.run (list (code.local-tag "yolo"))
s.local-tag))
(fails? (p.run (list (code.tag ["yolo" "lol"]))
s.local-tag))))
)))
(def: complex-values
Test
(`` ($_ _.and
(~~ (template [<type> <parser> <ctor>]
[(_.test (format "Can parse " <type> " syntax.")
(and (match [#1 +123]
(p.run (list (<ctor> (list (code.bit #1) (code.int +123))))
(<parser> (p.and s.bit s.int))))
(match #1
(p.run (list (<ctor> (list (code.bit #1))))
(<parser> s.bit)))
(fails? (p.run (list (<ctor> (list (code.bit #1) (code.int +123))))
(<parser> s.bit)))
(match (#.Left #1)
(p.run (list (<ctor> (list (code.bit #1))))
(<parser> (p.or s.bit s.int))))
(match (#.Right +123)
(p.run (list (<ctor> (list (code.int +123))))
(<parser> (p.or s.bit s.int))))
(fails? (p.run (list (<ctor> (list (code.frac +123.0))))
(<parser> (p.or s.bit s.int))))))]
["form" s.form code.form]
["tuple" s.tuple code.tuple]))
(_.test "Can parse record syntax."
(match [#1 +123]
(p.run (list (code.record (list [(code.bit #1) (code.int +123)])))
(s.record (p.and s.bit s.int)))))
)))
(def: #export test
Test
(<| (_.context (name.module (name-of /._)))
($_ _.and
..simple-values
..complex-values
($_ _.and
(_.test "Can parse any Code."
(match [_ (#.Bit #1)]
(p.run (list (code.bit #1) (code.int +123))
s.any)))
(_.test "Can check whether the end has been reached."
(and (match #1
(p.run (list)
s.end?))
(match #0
(p.run (list (code.bit #1))
s.end?))))
(_.test "Can ensure the end has been reached."
(and (match []
(p.run (list)
s.end!))
(fails? (p.run (list (code.bit #1))
s.end!))))
))))
|
