blob: 5157848ec80b200f95614a42cc3da675558a50bf (
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
|
(;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]
(host [";H" macro])
["la" analysis]
(translation [";T" common])))
(.. [";A" common]
[";A" function]
[";A" primitive]
[";A" reference]
[";A" structure]
[";A" procedure]))
(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 [ast]
(do macro;Monad<Meta>
[expectedT macro;expected-type]
(let [[cursor ast'] ast]
## The cursor must be set in the compiler for the sake
## of having useful error messages.
(&;with-cursor cursor
(case ast'
(^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)))
(procedureA;analyse-procedure analyse eval proc-name 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 =func] (commonA;with-unknown-type
(analyse func))]
(case =func
[_ (#;Symbol def-name)]
(do @
[[def-type def-anns def-value] (macro;find-def def-name)]
(if (macro;macro? def-anns)
(do @
[expansion (function [compiler]
(case (macroH;expand (:! Macro def-value) args compiler)
(#e;Success [compiler' output])
(#e;Success [compiler' output])
(#e;Error error)
((&;throw Macro-Expansion-Failed error) compiler)))]
(case expansion
(^ (list single))
(analyse single)
_
(&;throw Macro-Expression-Must-Have-Single-Expansion (%code ast))))
(functionA;analyse-apply analyse funcT =func args)))
_
(functionA;analyse-apply analyse funcT =func args)))
_
(&;throw Unrecognized-Syntax (%code ast))
)))))))
|
