blob: a22e3d32b55b37310e811008de1b9be4e390f541 (
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
|
(.module:
lux
(lux (control [monad #+ do]
["ex" exception #+ exception:])
(data ["e" error]
[product]
text/format)
[macro]
[lang #+ Eval]
(lang [type]
(type ["tc" check])
[".L" analysis #+ Analysis Analyser]
(analysis [".A" type]
[".A" primitive]
[".A" structure]
## [".A" function]
## [".A" reference]
)
## [".L" macro]
## [".L" extension]
)))
(exception: #export (macro-expansion-failed {message Text})
message)
(do-template [<name>]
[(exception: #export (<name> {code Code})
(%code code))]
[macro-call-must-have-single-expansion]
[unrecognized-syntax]
)
(def: #export (analyser eval)
(-> Eval Analyser)
(: (-> Code (Meta 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.
(lang.with-cursor cursor
(case code'
(^template [<tag> <analyser>]
(<tag> value)
(<analyser> value))
([#.Bool primitiveA.bool]
[#.Nat primitiveA.nat]
[#.Int primitiveA.int]
[#.Deg primitiveA.deg]
[#.Frac primitiveA.frac]
[#.Text primitiveA.text])
(^template [<tag> <analyser>]
(^ (#.Form (list& [_ (<tag> tag)]
values)))
(case values
(#.Cons value #.Nil)
(<analyser> analyse tag value)
_
(<analyser> analyse tag (` [(~+ values)]))))
([#.Nat structureA.sum]
[#.Tag structureA.tagged-sum])
(#.Tag tag)
(structureA.tagged-sum analyse tag (' []))
(^ (#.Tuple (list)))
primitiveA.unit
(^ (#.Tuple (list singleton)))
(analyse singleton)
(^ (#.Tuple elems))
(structureA.product analyse elems)
(^ (#.Record pairs))
(structureA.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))
## (^ (#.Form (list& func args)))
## (do macro.Monad<Meta>
## [[funcT funcA] (typeA.with-inference
## (analyse func))]
## (case funcA
## [_ (#.Symbol def-name)]
## (do @
## [?macro (lang.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)
## ((lang.throw macro-expansion-failed error) compiler)
## output
## output)))]
## (case expansion
## (^ (list single))
## (analyse single)
## _
## (lang.throw macro-call-must-have-single-expansion code)))
## _
## (functionA.analyse-apply analyse funcT funcA args)))
## _
## (functionA.analyse-apply analyse funcT funcA args)))
_
(lang.throw unrecognized-syntax code)
)))))))
|
