blob: 9fec0d5010e3fe43cfdbabbb5887ba45bc7398d9 (
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
|
(;module:
lux
(lux [io]
(control [monad #+ do]
pipe)
(data text/format
[product]
["R" result]
[bool "B/" Eq<Bool>]
[text "T/" Eq<Text>]
(coll ["a" array]
[list "L/" Functor<List>]
["S" set]))
["r" math/random "r/" Monad<Random>]
[macro #+ Monad<Lux>]
(macro [code])
[host]
test)
(luxc (lang ["ls" synthesis])
[analyser]
[synthesizer]
(generator ["@" case]
["@;" eval]
["@;" runtime]
["@;" common]))
(test/luxc common))
(def: struct-limit Nat +10)
(def: (tail? size idx)
(-> Nat Nat Bool)
(n.= (n.dec size) idx))
(def: gen-case
(r;Random [ls;Synthesis ls;Path])
(<| r;rec (function [gen-case])
(with-expansions [<simple> (do-template [<gen> <synth> <path>]
[(do r;Monad<Random>
[value <gen>]
(wrap [(<synth> value) (<path> value)]))]
[r;bool #ls;Bool #ls;BoolP]
[r;nat #ls;Nat #ls;NatP]
[r;int #ls;Int #ls;IntP]
[r;deg #ls;Deg #ls;DegP]
[r;frac #ls;Frac #ls;FracP]
[(r;text +5) #ls;Text #ls;TextP])]
($_ r;either
(r/wrap [#ls;Unit #ls;UnitP])
<simple>
(do r;Monad<Random>
[size (|> r;nat (:: @ map (|>. (n.% struct-limit) (n.max +2))))
idx (|> r;nat (:: @ map (n.% size)))
[subS subP] gen-case
#let [dummyS (list;repeat (n.dec size) #ls;Unit)
caseS (#ls;Tuple (list;concat (list (list;take idx dummyS)
(list subS)
(list;drop idx dummyS))))
caseP (#ls;TupleP (if (tail? idx idx)
(#;Right idx)
(#;Left idx))
subP)]]
(wrap [caseS caseP]))
(do r;Monad<Random>
[size (|> r;nat (:: @ map (|>. (n.% struct-limit) (n.max +2))))
idx (|> r;nat (:: @ map (n.% size)))
[subS subP] gen-case
#let [caseS (#ls;Variant idx (tail? idx idx) subS)
caseP (#ls;VariantP (if (tail? idx idx)
(#;Right idx)
(#;Left idx))
subP)]]
(wrap [caseS caseP]))
))))
(context: "Pattern-matching."
[[valueS path] gen-case
to-bind r;nat]
($_ seq
(test "Can generate pattern-matching."
(|> (do Monad<Lux>
[runtime-bytecode @runtime;generate
sampleI (@;generate valueS
(#ls;AltP (#ls;SeqP path (#ls;ExecP (#ls;Bool true)))
(#ls;SeqP (#ls;BindP +0) (#ls;ExecP (#ls;Bool false)))))]
(@eval;eval sampleI))
(macro;run (init-compiler []))
(case> (#R;Success valueG)
(:! Bool valueG)
_
false)))
(test "Can bind values."
(|> (do Monad<Lux>
[runtime-bytecode @runtime;generate
sampleI (@;generate (#ls;Nat to-bind)
(#ls;SeqP (#ls;BindP +1) (#ls;ExecP (#ls;Variable 1))))]
(@eval;eval sampleI))
(macro;run (init-compiler []))
(case> (#R;Success valueG)
(n.= to-bind (:! Nat valueG))
_
false)))))
|
