blob: 8907ba66518738f17750a31d1067522ac9641907 (
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
|
(.module:
lux
(lux (control [monad #+ do]
["ex" exception #+ exception:])
(data ["e" error]
[product]
text/format)
[macro]
(lang [type]
(type ["tc" check]))
[host])
(luxc ["&" lang]
(lang ["&." module]
[".L" host]
[".L" macro]
[".L" extension]
["la" analysis]
(translation (jvm [".T" common]))))
(// [".A" common]
[".A" function]
[".A" primitive]
[".A" reference]
[".A" structure]))
(exception: #export Macro-Expression-Must-Have-Single-Expansion)
(exception: #export Unrecognized-Syntax)
(exception: #export Macro-Expansion-Failed)
(def: #export (analyser eval)
(-> &.Eval &.Analyser)
(: (-> Code (Meta la.Analysis))
(function analyse [code]
(do macro.Monad<Meta>
[expectedT macro.expected-type]
(let [[cursor code'] code]
## The cursor must be set in the compiler for the sake
## of having useful error messages.
(&.with-cursor cursor
(case code'
(^template [<tag> <analyser>]
(<tag> value)
(<analyser> value))
([#.Bool primitiveA.analyse-bool]
[#.Nat primitiveA.analyse-nat]
[#.Int primitiveA.analyse-int]
[#.Deg primitiveA.analyse-deg]
[#.Frac primitiveA.analyse-frac]
[#.Text primitiveA.analyse-text])
(^ (#.Tuple (list)))
primitiveA.analyse-unit
## Singleton tuples are equivalent to the element they contain.
(^ (#.Tuple (list singleton)))
(analyse singleton)
(^ (#.Tuple elems))
(structureA.analyse-product analyse elems)
(^ (#.Record pairs))
(structureA.analyse-record analyse pairs)
(#.Symbol reference)
(referenceA.analyse-reference reference)
(^ (#.Form (list& [_ (#.Text proc-name)] proc-args)))
(do macro.Monad<Meta>
[procedure (extensionL.find-analysis proc-name)]
(procedure analyse eval proc-args))
(^template [<tag> <analyser>]
(^ (#.Form (list& [_ (<tag> tag)]
values)))
(case values
(#.Cons value #.Nil)
(<analyser> analyse tag value)
_
(<analyser> analyse tag (` [(~+ values)]))))
([#.Nat structureA.analyse-sum]
[#.Tag structureA.analyse-tagged-sum])
(#.Tag tag)
(structureA.analyse-tagged-sum analyse tag (' []))
(^ (#.Form (list& func args)))
(do macro.Monad<Meta>
[[funcT funcA] (commonA.with-unknown-type
(analyse func))]
(case funcA
[_ (#.Symbol def-name)]
(do @
[?macro (&.with-error-tracking
(macro.find-macro def-name))]
(case ?macro
(#.Some macro)
(do @
[expansion (: (Meta (List Code))
(function [compiler]
(case (macroL.expand macro args compiler)
(#e.Error error)
((&.throw Macro-Expansion-Failed error) compiler)
output
output)))]
(case expansion
(^ (list single))
(analyse single)
_
(&.throw Macro-Expression-Must-Have-Single-Expansion (%code code))))
_
(functionA.analyse-apply analyse funcT funcA args)))
_
(functionA.analyse-apply analyse funcT funcA args)))
_
(&.throw Unrecognized-Syntax (%code code))
)))))))
|
