blob: 250d14721b4b04720d0a1f9c1c6d4797159548bf (
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
|
(.module:
[lux #*
[abstract
["." monad (#+ do)]]
[control
["." exception (#+ exception:)]]
[data
[text
["%" format (#+ format)]]
[collection
["." list ("#;." fold monoid)]]]
["." macro]]
["." //
["#." macro (#+ Expander)]
["#." extension]
[".P" analysis
["." type]]
["#/" // #_
[reference (#+)]
["#." analysis]
["/" statement (#+ Phase)]]])
(exception: #export (not-a-statement {code Code})
(exception.report
["Statement" (%.code code)]))
(exception: #export (invalid-macro-call {code Code})
(exception.report
["Code" (%.code code)]))
(exception: #export (macro-was-not-found {name Name})
(exception.report
["Name" (%.name name)]))
(with-expansions [<lux_def_module> (as-is [|form-cursor| (#.Form (list& [|text-cursor| (#.Text "lux def module")] annotations))])]
(def: #export (phase expander)
(-> Expander Phase)
(let [analyze (analysisP.phase expander)]
(function (compile code)
(case code
(^ [_ (#.Form (list& [_ (#.Text name)] inputs))])
(do //.monad
[requirements (//extension.apply compile [name inputs])]
(wrap requirements))
(^ [_ (#.Form (list& macro inputs))])
(do //.monad
[expansion (/.lift-analysis
(do @
[macroA (type.with-type Macro
(analyze macro))]
(case macroA
(^ (///analysis.constant macro-name))
(do @
[?macro (//extension.lift (macro.find-macro macro-name))
macro (case ?macro
(#.Some macro)
(wrap macro)
#.None
(//.throw macro-was-not-found macro-name))]
(//extension.lift (//macro.expand expander macro-name macro inputs)))
_
(//.throw invalid-macro-call code))))
requirements (case expansion
(^ (list& <lux_def_module> referrals))
(do @
[requirements (compile <lux_def_module>)]
(wrap (update@ #/.referrals (list;compose referrals) requirements)))
_
(|> expansion
(monad.map @ compile)
(:: @ map (list;fold /.merge-requirements /.no-requirements))))]
(wrap requirements))
_
(//.throw not-a-statement code))))))
|
