blob: e465762013d60f39b63996cca8160ad164d9a577 (
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
|
(.module:
[lux #*
[control
[monad (#+ do)]
["ex" exception (#+ exception:)]]
[data
["e" error]
[text
format]]
["." macro]]
["." // (#+ Analysis Operation Phase)
["." type]
["." primitive]
["." structure]
["." reference]
["." case]
["/." //
["." extension]
[//
## [".L" macro]
]]])
(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 (compile code)
Phase
(do ///.Monad<Operation>
[expectedT (extension.lift macro.expected-type)]
(let [[cursor code'] code]
## The cursor must be set in the state for the sake
## of having useful error messages.
(//.with-cursor cursor
(case code'
(^template [<tag> <analyser>]
(<tag> value)
(<analyser> value))
([#.Bit primitive.bit]
[#.Nat primitive.nat]
[#.Int primitive.int]
[#.Rev primitive.rev]
[#.Frac primitive.frac]
[#.Text primitive.text])
(^template [<tag> <analyser>]
(^ (#.Form (list& [_ (<tag> tag)]
values)))
(case values
(#.Cons value #.Nil)
(<analyser> compile tag value)
_
(<analyser> compile tag (` [(~+ values)]))))
([#.Nat structure.sum]
[#.Tag structure.tagged-sum])
(#.Tag tag)
(structure.tagged-sum compile tag (' []))
(^ (#.Tuple (list)))
primitive.unit
(^ (#.Tuple (list singleton)))
(compile singleton)
(^ (#.Tuple elems))
(structure.product compile elems)
(^ (#.Record pairs))
(structure.record compile pairs)
(#.Identifier reference)
(reference.reference reference)
(^ (#.Form (list [_ (#.Record branches)] input)))
(case.case compile input branches)
(^ (#.Form (list& [_ (#.Text extension-name)] extension-args)))
(extension.apply compile [extension-name extension-args])
## (^ (#.Form (list& func args)))
## (do ///.Monad<Operation>
## [[funcT funcA] (type.with-inference
## (compile func))]
## (case funcA
## [_ (#.Identifier def-name)]
## (do @
## [?macro (///.with-error-tracking
## (extension.lift (macro.find-macro def-name)))]
## (case ?macro
## (#.Some macro)
## (do @
## [expansion (: (Operation (List Code))
## (function (_ state)
## (case (macroL.expand macro args state)
## (#e.Error error)
## ((///.throw macro-expansion-failed error) state)
## output
## output)))]
## (case expansion
## (^ (list single))
## (compile single)
## _
## (///.throw macro-call-must-have-single-expansion code)))
## _
## (functionA.apply compile funcT funcA args)))
## _
## (functionA.apply compile funcT funcA args)))
_
(///.throw unrecognized-syntax code)
)))))
|
