blob: 34846a9886d9a94df206a7f5ba924d383ae684be (
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
|
(;module:
lux
(lux [io]
(control [monad #+ do]
pipe)
(data ["e" error]
(coll [list]))
["r" math/random "r/" Monad<Random>]
[meta]
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])
(`` ($_ r;either
(r/wrap [#ls;Unit #ls;UnitP])
(~~ (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]))
(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;Tuple (list;concat (list (list;repeat idx #ls;Unit)
(list subS)
(list;repeat (|> size n.dec (n.- idx)) #ls;Unit))))
caseP (#ls;TupleP (if (tail? size 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."
(<| (times +100)
(do @
[[valueS path] gen-case
to-bind r;nat]
($_ seq
(test "Can generate pattern-matching."
(|> (do meta;Monad<Meta>
[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))
(meta;run (init-compiler []))
(case> (#e;Success valueG)
(:! Bool valueG)
_
false)))
(test "Can bind values."
(|> (do meta;Monad<Meta>
[runtime-bytecode @runtime;generate
sampleI (@;generate (#ls;Nat to-bind)
(#ls;SeqP (#ls;BindP +1) (#ls;ExecP (#ls;Variable 1))))]
(@eval;eval sampleI))
(meta;run (init-compiler []))
(case> (#e;Success valueG)
(n.= to-bind (:! Nat valueG))
_
false)))))))
|
