blob: 9eb25d380f299a83dfd80269017924556d702882 (
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
|
(.module:
lux
(lux [io #+ IO]
(control [monad #+ do]
pipe)
(data [product]
[maybe]
["e" error]
text/format
(coll ["a" array]
[list "list/" Functor<List>]))
["r" math/random "r/" Monad<Random>]
[macro]
(macro [code])
[host]
test)
(luxc [lang]
(lang ["ls" synthesis]))
(test/luxc common))
(def: arity-limit Nat +10)
(def: arity
(r.Random ls.Arity)
(|> r.nat (r/map (|>> (n/% arity-limit) (n/max +1)))))
(def: gen-function
(r.Random [ls.Arity Nat ls.Synthesis])
(do r.Monad<Random>
[arity arity
arg (|> r.nat (:: @ map (n/% arity)))
#let [functionS (` ("lux function" (~ (code.nat arity)) []
((~ (code.int (nat-to-int (n/inc arg)))))))]]
(wrap [arity arg functionS])))
(def: upper-alpha-ascii
(r.Random Nat)
(|> r.nat (:: r.Functor<Random> map (|>> (n/% +26) (n/+ +65)))))
(def: (function-spec run)
(-> Runner Test)
(do r.Monad<Random>
[[arity arg functionS] gen-function
cut-off (|> r.nat (:: @ map (n/% arity)))
args (r.list arity r.frac)
#let [arg-value (maybe.assume (list.nth arg args))
argsS (list/map code.frac args)
last-arg (n/dec arity)
cut-off (|> cut-off (n/min (n/dec last-arg)))]]
($_ seq
(test "Can read arguments."
(|> (run (` ("lux call" (~ functionS) (~+ argsS))))
(case> (#e.Success valueT)
(f/= arg-value (:coerce Frac valueT))
(#e.Error error)
(exec (log! error)
#0))))
(test "Can partially apply functions."
(or (n/= +1 arity)
(let [partial-arity (n/inc cut-off)
preS (list.take partial-arity argsS)
postS (list.drop partial-arity argsS)]
(|> (run (` ("lux call"
("lux call" (~ functionS) (~+ preS))
(~+ postS))))
(case> (#e.Success valueT)
(f/= arg-value (:coerce Frac valueT))
(#e.Error error)
(exec (log! error)
#0))))))
(test "Can read environment."
(or (n/= +1 arity)
(let [env (|> (list.n/range +0 cut-off)
(list/map (|>> n/inc nat-to-int)))
super-arity (n/inc cut-off)
arg-var (if (n/<= cut-off arg)
(|> arg n/inc nat-to-int (i/* -1))
(|> arg n/inc (n/- super-arity) nat-to-int))
sub-arity (|> arity (n/- super-arity))
functionS (` ("lux function" (~ (code.nat super-arity)) []
("lux function" (~ (code.nat sub-arity)) [(~+ (list/map code.int env))]
((~ (code.int arg-var))))))]
(|> (run (` ("lux call" (~ functionS) (~+ argsS))))
(case> (#e.Success valueT)
(f/= arg-value (:coerce Frac valueT))
(#e.Error error)
(exec (log! error)
#0))))))
)))
(context: "[JVM] Function."
(<| (times +100)
(function-spec run-jvm)))
## (context: "[JS] Function."
## (<| (times +100)
## (function-spec run-js)))
## (context: "[Lua] Function."
## (<| (times +100)
## (function-spec run-lua)))
## (context: "[Ruby] Function."
## (<| (times +100)
## (function-spec run-ruby)))
## (context: "[Python] Function."
## (<| (times +100)
## (function-spec run-python)))
## (context: "[R] Function."
## (<| (times +100)
## (function-spec run-r)))
## (context: "[Scheme] Function."
## (<| (times +100)
## (function-spec run-scheme)))
## (context: "[Common Lisp] Function."
## (<| (times +100)
## (function-spec run-common-lisp)))
## (context: "[PHP] Function."
## (<| (times +100)
## (function-spec run-php)))
|
