blob: 917ea1632e22a528ea02834425558c9db18c5892 (
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
126
127
128
129
130
131
|
(.module:
[lux #*
[control
[monad (#+ do)]
["ex" exception (#+ exception:)]]
[data
["." error]
[text
format]]
["." macro]]
[/
["/." type]
["/." primitive]
["/." structure]
["/." reference]
["/." case]
["/." function]
["." //
["//." macro (#+ Expander)]
["//." extension]
[//
["." reference]
["/" analysis (#+ Analysis Operation Phase)]]]])
(exception: #export (unrecognized-syntax {code Code})
(ex.report ["Code" (%code code)]))
## TODO: Had to split the 'compile' function due to compilation issues
## with old-luxc. Must re-combine all the code ASAP
(type: (Fix a)
(-> a a))
(def: (compile|primitive else code')
(Fix (-> (Code' (Ann Cursor)) (Operation Analysis)))
(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])
_
(else code')))
(def: (compile|structure compile else code')
(-> Phase (Fix (-> (Code' (Ann Cursor)) (Operation Analysis))))
(case code'
(^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)
_
(else code')))
(def: (compile|others expander compile code')
(-> Expander Phase (-> (Code' (Ann Cursor)) (Operation Analysis)))
(case code'
(#.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 [_ (#.Tuple (list [_ (#.Identifier ["" function-name])]
[_ (#.Identifier ["" arg-name])]))]
body)))
(/function.function compile function-name arg-name body)
(^ (#.Form (list& functionC argsC+)))
(do //.monad
[[functionT functionA] (/type.with-inference
(compile functionC))]
(case functionA
(#/.Reference (#reference.Constant def-name))
(do @
[?macro (//extension.lift (macro.find-macro def-name))]
(case ?macro
(#.Some macro)
(do @
[expansion (//extension.lift (//macro.expand-one expander def-name macro argsC+))]
(compile expansion))
_
(/function.apply compile functionT functionA argsC+)))
_
(/function.apply compile functionT functionA argsC+)))
_
(//.throw unrecognized-syntax [.dummy-cursor code'])))
(def: #export (phase expander)
(-> Expander Phase)
(function (compile code)
(let [[cursor code'] code]
## The cursor must be set in the state for the sake
## of having useful error messages.
(/.with-cursor cursor
(compile|primitive (compile|structure compile (compile|others expander compile))
code')))))
|
