blob: 0619d6894282a2f2c5d8f22c9809753f00d19d47 (
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
|
(.module:
lux
(lux [io #+ IO]
(control [monad #+ do]
pipe)
(data ["e" error]
[maybe]
[bool "bool/" Eq<Bool>]
[text "text/" Eq<Text>]
text/format
(coll [array]
[list "list/" Functor<List>]))
["r" math/random "r/" Monad<Random>]
[macro]
(macro [code])
[host]
test)
(luxc [lang]
(lang [".L" host]
[synthesis #+ Synthesis]))
(test/luxc common))
(host.import java/lang/Integer)
(def: (tuples-spec run)
(-> Runner Test)
(do r.Monad<Random>
[size (|> r.nat (:: @ map (|>> (n/% +10) (n/max +2))))
tuple-in (r.list size r.int)]
(test "Can translate tuple."
(|> (run (code.tuple (list/map code.int tuple-in)))
(case> (#e.Success tuple-out)
(let [tuple-out (:! (Array Top) tuple-out)]
(and (n/= size (array.size tuple-out))
(list.every? (function (_ [left right])
(i/= left (:! Int right)))
(list.zip2 tuple-in (array.to-list tuple-out)))))
(#e.Error error)
(exec (log! error)
false))))))
(def: (variants-spec run)
(-> Runner Test)
(do r.Monad<Random>
[num-tags (|> r.nat (:: @ map (|>> (n/% +10) (n/max +2))))
tag-in (|> r.nat (:: @ map (n/% num-tags)))
#let [last?-in (n/= (n/dec num-tags) tag-in)]
value-in r.int]
(test "Can translate variant."
(|> (run (` ((~ (code.nat tag-in)) (~ (code.bool last?-in)) (~ (code.int value-in)))))
(case> (#e.Success valueT)
(let [valueT (:! (Array Top) valueT)]
(and (n/= +3 (array.size valueT))
(let [tag-out (:! Integer (maybe.assume (array.read +0 valueT)))
last?-out (array.read +1 valueT)
value-out (:! Top (maybe.assume (array.read +2 valueT)))
same-tag? (n/= tag-in (|> tag-out host.int-to-long (:! Nat)))
same-flag? (case last?-out
(#.Some last?-out')
(and last?-in (text/= "" (:! Text last?-out')))
#.None
(not last?-in))
same-value? (i/= value-in (:! Int value-out))]
(and same-tag?
same-flag?
same-value?))))
(#e.Error error)
(exec (log! error)
false))))))
(def: (structure-spec run)
(-> Runner Test)
($_ seq
(tuples-spec run)
(variants-spec run)))
## (context: "[JVM] Structures."
## (<| (times +100)
## (structure-spec run-jvm)))
## (context: "[JS] Structures."
## (<| (times +100)
## (structure-spec run-js)))
## (context: "[Lua] Structures."
## (<| (times +100)
## (structure-spec run-lua)))
## (context: "[Ruby] Structures."
## (<| (times +100)
## (structure-spec run-ruby)))
## (context: "[Python] Structures."
## (<| (times +100)
## (structure-spec run-python)))
## (context: "[R] Structures."
## (<| (times +100)
## (structure-spec run-r)))
## (context: "[Scheme] Structures."
## (<| (times +100)
## (structure-spec run-scheme)))
## (context: "[Common Lisp] Structures."
## (<| (times +100)
## (structure-spec run-common-lisp)))
(context: "[PHP] Structures."
(<| (times +100)
(structure-spec run-php)))
|
