blob: 7d83f00c8664943dab6cf497d0a11997b69f750a (
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
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
|
(.module:
[lux #*
[io]
[control
[monad (#+ do)]
pipe]
[concurrency
["." atom]]
[data
["." error]
["." product]
[text
format]]
[math
["r" random]]
["." type ("#;." equivalence)]
[macro
["." code]]
[compiler
[default
["." init]
["." phase
[analysis
["." scope]
[".A" type]]
[extension
[".E" analysis]]]]]
test]
[///
["_." primitive]])
(do-template [<name> <success> <failure>]
[(def: (<name> procedure params output-type)
(-> Text (List Code) Type Bit)
(|> (scope.with-scope ""
(typeA.with-type output-type
(_primitive.phase (` ((~ (code.text procedure)) (~+ params))))))
(phase.run _primitive.state)
(case> (#error.Success _)
<success>
(#error.Failure error)
<failure>)))]
[check-success+ #1 #0]
[check-failure+ #0 #1]
)
(context: "Lux procedures"
(<| (times 100)
(do @
[[primT primC] _primitive.primitive
[antiT antiC] (|> _primitive.primitive
(r.filter (|>> product.left (type;= primT) not)))]
($_ seq
(test "Can test for reference equality."
(check-success+ "lux is" (list primC primC) Bit))
(test "Reference equality must be done with elements of the same type."
(check-failure+ "lux is" (list primC antiC) Bit))
(test "Can 'try' risky IO computations."
(check-success+ "lux try"
(list (` ([(~' _) (~' _)] (~ primC))))
(type (Either Text primT))))
))))
(context: "Bit procedures"
(<| (times 100)
(do @
[subjectC (|> r.nat (:: @ map code.nat))
signedC (|> r.int (:: @ map code.int))
paramC (|> r.nat (:: @ map code.nat))]
($_ seq
(test "Can perform bit 'and'."
(check-success+ "lux bit and" (list subjectC paramC) Nat))
(test "Can perform bit 'or'."
(check-success+ "lux bit or" (list subjectC paramC) Nat))
(test "Can perform bit 'xor'."
(check-success+ "lux bit xor" (list subjectC paramC) Nat))
(test "Can shift bit pattern to the left."
(check-success+ "lux bit left-shift" (list subjectC paramC) Nat))
(test "Can shift bit pattern to the right."
(check-success+ "lux bit logical-right-shift" (list subjectC paramC) Nat))
(test "Can shift signed bit pattern to the right."
(check-success+ "lux bit arithmetic-right-shift" (list signedC paramC) Int))
))))
(context: "Int procedures"
(<| (times 100)
(do @
[subjectC (|> r.int (:: @ map code.int))
paramC (|> r.int (:: @ map code.int))]
($_ seq
(test "Can add integers."
(check-success+ "lux int +" (list subjectC paramC) Int))
(test "Can subtract integers."
(check-success+ "lux int -" (list subjectC paramC) Int))
(test "Can multiply integers."
(check-success+ "lux int *" (list subjectC paramC) Int))
(test "Can divide integers."
(check-success+ "lux int /" (list subjectC paramC) Int))
(test "Can calculate remainder of integers."
(check-success+ "lux int %" (list subjectC paramC) Int))
(test "Can test equivalence of integers."
(check-success+ "lux int =" (list subjectC paramC) Bit))
(test "Can compare integers."
(check-success+ "lux int <" (list subjectC paramC) Bit))
(test "Can convert integer to fraction."
(check-success+ "lux int to-frac" (list subjectC) Frac))
(test "Can convert integer to text."
(check-success+ "lux int char" (list subjectC) Text))
))))
(context: "Frac procedures"
(<| (times 100)
(do @
[subjectC (|> r.frac (:: @ map code.frac))
paramC (|> r.frac (:: @ map code.frac))
encodedC (|> (r.unicode 5) (:: @ map code.text))]
($_ seq
(test "Can add frac numbers."
(check-success+ "lux frac +" (list subjectC paramC) Frac))
(test "Can subtract frac numbers."
(check-success+ "lux frac -" (list subjectC paramC) Frac))
(test "Can multiply frac numbers."
(check-success+ "lux frac *" (list subjectC paramC) Frac))
(test "Can divide frac numbers."
(check-success+ "lux frac /" (list subjectC paramC) Frac))
(test "Can calculate remainder of frac numbers."
(check-success+ "lux frac %" (list subjectC paramC) Frac))
(test "Can test equivalence of frac numbers."
(check-success+ "lux frac =" (list subjectC paramC) Bit))
(test "Can compare frac numbers."
(check-success+ "lux frac <" (list subjectC paramC) Bit))
(test "Can obtain minimum frac number."
(check-success+ "lux frac min" (list) Frac))
(test "Can obtain maximum frac number."
(check-success+ "lux frac max" (list) Frac))
(test "Can obtain smallest frac number."
(check-success+ "lux frac smallest" (list) Frac))
(test "Can convert frac number to integer."
(check-success+ "lux frac to-int" (list subjectC) Int))
(test "Can convert frac number to text."
(check-success+ "lux frac encode" (list subjectC) Text))
(test "Can convert text to frac number."
(check-success+ "lux frac decode" (list encodedC) (type (Maybe Frac))))
))))
(context: "Text procedures"
(<| (times 100)
(do @
[subjectC (|> (r.unicode 5) (:: @ map code.text))
paramC (|> (r.unicode 5) (:: @ map code.text))
replacementC (|> (r.unicode 5) (:: @ map code.text))
fromC (|> r.nat (:: @ map code.nat))
toC (|> r.nat (:: @ map code.nat))]
($_ seq
(test "Can test text equivalence."
(check-success+ "lux text =" (list subjectC paramC) Bit))
(test "Compare texts in lexicographical order."
(check-success+ "lux text <" (list subjectC paramC) Bit))
(test "Can concatenate one text to another."
(check-success+ "lux text concat" (list subjectC paramC) Text))
(test "Can find the index of a piece of text inside a larger one that (may) contain it."
(check-success+ "lux text index" (list subjectC paramC fromC) (type (Maybe Nat))))
(test "Can query the size/length of a text."
(check-success+ "lux text size" (list subjectC) Nat))
(test "Can obtain the character code of a text at a given index."
(check-success+ "lux text char" (list subjectC fromC) Nat))
(test "Can clip a piece of text between 2 indices."
(check-success+ "lux text clip" (list subjectC fromC toC) Text))
))))
(context: "IO procedures"
(<| (times 100)
(do @
[logC (|> (r.unicode 5) (:: @ map code.text))
exitC (|> r.int (:: @ map code.int))]
($_ seq
(test "Can log messages to standard output."
(check-success+ "lux io log" (list logC) Any))
(test "Can throw a run-time error."
(check-success+ "lux io error" (list logC) Nothing))
(test "Can exit the program."
(check-success+ "lux io exit" (list exitC) Nothing))
(test "Can query the current time (as milliseconds since epoch)."
(check-success+ "lux io current-time" (list) Int))
))))
|
