blob: 801d9f1d7a4c4972d30fb27f46988033421e8167 (
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
158
159
160
|
(.module:
[lux (#- case)
[control
[monad (#+ do)]
pipe]
[data
[collection
["." list]]]
[math
["r" random (#+ Random)]]
[compiler
[default
["." reference]
[phase
["." analysis]
["." synthesis (#+ Path Synthesis)]]]]
test]
[test
[luxc
["." common (#+ Runner)]]]
[//
["&" function]])
(def: limit Nat 10)
(def: size
(Random Nat)
(|> r.nat (:: r.Monad<Random> map (|>> (n/% ..limit) (n/max 2)))))
(def: (tail? size idx)
(-> Nat Nat Bit)
(n/= (dec size) idx))
(def: case
(Random [Synthesis Path])
(<| r.rec (function (_ case))
(`` ($_ r.either
(do r.Monad<Random>
[value r.i64]
(wrap [(synthesis.i64 value)
synthesis.path/pop]))
(~~ (do-template [<gen> <synth> <path>]
[(do r.Monad<Random>
[value <gen>]
(wrap [(<synth> value)
(<path> value)]))]
[r.bit synthesis.bit synthesis.path/bit]
[r.i64 synthesis.i64 synthesis.path/i64]
[r.frac synthesis.f64 synthesis.path/f64]
[(r.unicode 5) synthesis.text synthesis.path/text]))
(do r.Monad<Random>
[size ..size
idx (|> r.nat (:: @ map (n/% size)))
[subS subP] case
#let [unitS (synthesis.text synthesis.unit)
caseS (synthesis.tuple
(list.concat (list (list.repeat idx unitS)
(list subS)
(list.repeat (|> size dec (n/- idx)) unitS))))
caseP (synthesis.path/seq [(if (tail? size idx)
(synthesis.member/right idx)
(synthesis.member/left idx))
subP])]]
(wrap [caseS caseP]))
(do r.Monad<Random>
[size ..size
idx (|> r.nat (:: @ map (n/% size)))
[subS subP] case
#let [right? (tail? size idx)
caseS (synthesis.variant
{#analysis.lefts idx
#analysis.right? right?
#analysis.value subS})
caseP (synthesis.path/seq
[(if right?
(synthesis.side/right idx)
(synthesis.side/left idx))
subP])]]
(wrap [caseS caseP]))
))))
(def: (let-spec run)
(-> Runner Test)
(do r.Monad<Random>
[value &.safe-frac]
(test "Specialized \"let\"."
(|> (run (synthesis.branch/let [(synthesis.f64 value)
0
(synthesis.variable/local 0)]))
(&.check value)))))
(def: (if-spec run)
(-> Runner Test)
(do r.Monad<Random>
[on-true &.safe-frac
on-false (|> &.safe-frac (r.filter (|>> (f/= on-true) not)))
verdict r.bit]
(test "Specialized \"if\"."
(|> (run (synthesis.branch/if [(synthesis.bit verdict)
(synthesis.f64 on-true)
(synthesis.f64 on-false)]))
(&.check (if verdict on-true on-false))))))
(def: (case-spec run)
(-> Runner Test)
(do r.Monad<Random>
[[inputS pathS] ..case
on-success &.safe-frac
on-failure (|> &.safe-frac (r.filter (|>> (f/= on-success) not)))]
(test "Case."
(|> (run (synthesis.branch/case
[inputS
(synthesis.path/alt [(synthesis.path/seq [pathS
(synthesis.path/then (synthesis.f64 on-success))])
(synthesis.path/then (synthesis.f64 on-failure))])]))
(&.check on-success)))))
(def: (pattern-matching-spec run)
(-> Runner Test)
($_ seq
(let-spec run)
(if-spec run)
(case-spec run)))
(context: "[JVM] Pattern-matching."
(<| (times 100)
(pattern-matching-spec common.run-jvm)))
## (context: "[JS] Pattern-matching."
## (<| (times 100)
## (pattern-matching-spec common.run-js)))
## (context: "[Lua] Pattern-matching."
## (<| (times 100)
## (pattern-matching-spec common.run-lua)))
## (context: "[Ruby] Pattern-matching."
## (<| (times 100)
## (pattern-matching-spec common.run-ruby)))
## (context: "[Python] Function."
## (<| (times 100)
## (pattern-matching-spec common.run-python)))
## (context: "[R] Pattern-matching."
## (<| (times 100)
## (pattern-matching-spec common.run-r)))
## (context: "[Scheme] Pattern-matching."
## (<| (times 100)
## (pattern-matching-spec common.run-scheme)))
## (context: "[Common Lisp] Pattern-matching."
## (<| (times 100)
## (pattern-matching-spec common.run-common-lisp)))
## (context: "[PHP] Pattern-matching."
## (<| (times 100)
## (pattern-matching-spec common.run-php)))
|
