blob: f6ec5d11a76ed201440bb6423357c281b8fdcd49 (
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 #*
[control
[monad (#+ do)]
["ex" exception (#+ exception:)]]
[data
["e" error]
[product]
[text
format]]
[macro]]
[//// (#+ Eval)
## [".L" macro]
## [".L" extension]
]
[///]
[// (#+ Analysis Operation Compiler)]
[//type]
[//primitive]
[//structure]
[//reference])
(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 Compiler)
(function (compile code)
(do ///.Monad<Operation>
[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 //primitive.bool]
[#.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)
(#.Symbol reference)
(//reference.reference reference)
(^ (#.Form (list& [_ (#.Text extension-name)] extension-args)))
(undefined)
## (do ///.Monad<Operation>
## [extension (extensionL.find-analysis extension-name)]
## (extension compile eval extension-args))
## (^ (#.Form (list& func args)))
## (do ///.Monad<Operation>
## [[funcT funcA] (//type.with-inference
## (compile func))]
## (case funcA
## [_ (#.Symbol def-name)]
## (do @
## [?macro (///.with-error-tracking
## (macro.find-macro def-name))]
## (case ?macro
## (#.Some macro)
## (do @
## [expansion (: (Operation (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))
## (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)
))))))
|
