blob: 7ccc0c451723b02aee8da4ed874be81732a00db5 (
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
|
(;module:
lux
(lux [io]
(control monad
pipe)
(data [char]
[text "T/" Eq<Text>]
(text format
["l" lexer])
[number])
["R" math/random "R/" Monad<Random>]
(macro [ast])
test)
(luxc ["&" parser]))
(def: default-cursor
Cursor
{#;module ""
#;line +0
#;column +0})
(def: ident-part^
(R;Random Text)
(do R;Monad<Random>
[#let [digits "0123456789"
delimiters "()[]{}#;"
space "\t\v \n\r\f"
invalid-range (format digits delimiters space)
char-gen (|> R;char
(R;filter (function [sample]
(not (text;contains? (char;as-text sample)
invalid-range)))))]
size (|> R;nat (:: @ map (n.% +20)))]
(R;text' char-gen size)))
(def: ident^
(R;Random Ident)
(R;seq ident-part^ ident-part^))
(def: ast^
(R;Random AST)
(let [simple^ (: (R;Random AST)
($_ R;either
(|> R;bool (R/map (|>. #;BoolS [default-cursor])))
(|> R;nat (R/map (|>. #;NatS [default-cursor])))
(|> R;int (R/map (|>. #;IntS [default-cursor])))
(|> R;deg (R/map (|>. #;DegS [default-cursor])))
(|> R;real (R/map (|>. #;RealS [default-cursor])))
(|> R;char (R/map (|>. #;CharS [default-cursor])))
(do R;Monad<Random>
[size (|> R;nat (R/map (n.% +20)))]
(|> (R;text size) (R/map (|>. #;TextS [default-cursor]))))
(|> ident^ (R/map (|>. #;SymbolS [default-cursor])))
(|> ident^ (R/map (|>. #;TagS [default-cursor])))))]
(R;rec
(function [ast^]
(let [multi^ (do R;Monad<Random>
[size (|> R;nat (R/map (n.% +2)))]
(R;list size ast^))
composite^ (: (R;Random AST)
($_ R;either
(|> multi^ (R/map (|>. #;FormS [default-cursor])))
(|> multi^ (R/map (|>. #;TupleS [default-cursor])))
(do R;Monad<Random>
[size (|> R;nat (R/map (n.% +2)))]
(|> (R;list size (R;seq ast^ ast^))
(R/map (|>. #;RecordS [default-cursor]))))))]
(R;either simple^
composite^))))))
(test: "Lux code parser."
[sample ast^]
(assert "Can parse Lux code."
(|> &;ast^
(l;run (ast;to-text sample))
(case> (#;Left error)
false
(#;Right parsed)
(:: ast;Eq<AST> = parsed sample))
)))
|
