blob: 718c1d01e24ef2e7902cd714384736a38273f874 (
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
|
(.module:
[lux #*
["_" test (#+ Test)]
["." type ("#@." equivalence)]
[abstract
[monad (#+ do)]]
[control
[pipe (#+ case>)]
["." io]
["." try]]
[data
["." bit ("#@." equivalence)]
["." text ("#@." equivalence)]]
[math
["r" random (#+ Random)]]
[macro
["." code]]
[tool
[compiler
[analysis (#+ State+)]
["." phase
[macro (#+ Expander)]
["." analysis
["#/." scope]
["#/." type]]]]]])
(def: (check-success+ expander state extension params output-type)
(-> Expander State+ Text (List Code) Type Bit)
(|> (analysis/scope.with-scope ""
(analysis/type.with-type output-type
(analysis.phase expander (` ((~ (code.text extension)) (~+ params))))))
(phase.run state)
(case> (#try.Success _)
true
(#try.Failure _)
false)))
(def: check
(Random [Code Type Code])
(`` ($_ r.either
(~~ (template [<random> <type> <code>]
[(do r.monad
[value <random>]
(wrap [(` <type>)
<type>
(<code> value)]))]
[r.bit (0 #0 "#Bit" (0 #0)) code.bit]
[r.nat (0 #0 "#I64" (0 #1 (0 #0 "#Nat" (0 #0)) (0 #0))) code.nat]
[r.int (0 #0 "#I64" (0 #1 (0 #0 "#Int" (0 #0)) (0 #0))) code.int]
[r.rev (0 #0 "#I64" (0 #1 (0 #0 "#Rev" (0 #0)) (0 #0))) code.rev]
[r.safe-frac (0 #0 "#Frac" (0 #0)) code.frac]
[(r.ascii/upper-alpha 5) (0 #0 "#Text" (0 #0)) code.text]
)))))
(def: #export (spec expander state)
(-> Expander State+ Test)
(do r.monad
[[typeC exprT exprC] ..check
[other-typeC other-exprT other-exprC] ..check]
($_ _.and
(_.test "lux check"
(check-success+ expander state "lux check" (list typeC exprC) exprT))
(_.test "lux coerce"
(check-success+ expander state "lux coerce" (list typeC other-exprC) exprT))
)))
|