blob: b2d819ec5590e2fa578e1095b4776e5b477d1901 (
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
|
(.module:
lux
(lux [io]
(control [monad #+ do]
pipe)
(data [bit "bit/" Eq<Bit>]
[text "text/" Eq<Text>]
(text format
["l" lexer])
[number]
["e" error]
[product]
(coll [list "list/" Functor<List> Fold<List>]))
["r" math/random "r/" Monad<Random>]
[macro #+ Monad<Meta>]
(macro [code])
(lang [type "type/" Eq<Type>])
test)
(luxc ["&" lang]
(lang ["&." module]
["~" analysis]
(analysis [".A" expression]
["@" type]
["@." common])
(translation (jvm ["@." runtime]))
[eval]))
(// common)
(test/luxc common))
(def: check
(r.Random [Code Type Code])
(with-expansions [<triples> (do-template [<random> <type> <code>]
[(do r.Monad<Random>
[value <random>]
(wrap [(` <type>)
<type>
(<code> value)]))]
[r.bit (+0 "#Bit" (+0)) code.bit]
[r.nat (+0 "#Nat" (+0)) code.nat]
[r.int (+0 "#Int" (+0)) code.int]
[r.rev (+0 "#Rev" (+0)) code.rev]
[r.frac (+0 "#Frac" (+0)) code.frac]
[(r.text +5) (+0 "#Text" (+0)) code.text]
)]
($_ r.either
<triples>)))
(context: "Type checking/coercion."
(<| (times +100)
(do @
[[typeC codeT exprC] check]
($_ seq
(test (format "Can analyse type-checking.")
(|> (do Monad<Meta>
[runtime-bytecode @runtime.translate]
(&.with-scope
(@common.with-unknown-type
(@.analyse-check analyse eval.eval typeC exprC))))
(&.with-current-module "")
(macro.run (io.run init-jvm))
(case> (#e.Success [_ [analysisT analysisA]])
(and (type/= codeT analysisT)
(case [exprC analysisA]
(^template [<tag> <test>]
[[_ (<tag> expected)] [_ (<tag> actual)]]
(<test> expected actual))
([#.Bit bit/=]
[#.Nat n/=]
[#.Int i/=]
[#.Rev r/=]
[#.Frac f/=]
[#.Text text/=])
_
false))
(#e.Error error)
false)))
(test (format "Can analyse type-coercion.")
(|> (do Monad<Meta>
[runtime-bytecode @runtime.translate]
(&.with-scope
(@common.with-unknown-type
(@.analyse-coerce analyse eval.eval typeC exprC))))
(&.with-current-module "")
(macro.run (io.run init-jvm))
(case> (#e.Success [_ [analysisT analysisA]])
(type/= codeT analysisT)
(#e.Error error)
false)))
))))
|
