blob: 1da6520a5d9412e19978c09cd7a9467824b8193a (
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
|
(.module:
[lux #*
[control
[monad (#+ do)]
["ex" exception (#+ exception:)]]
[data
["." error]
[text
format]]
["." macro]]
["." // (#+ Analysis Operation Phase)
["." type]
["." primitive]
["." structure]
["//." reference]
["." case]
["." function]
["//." macro]
["/." //
["." extension]
[//
["." reference]]]])
(exception: #export (unrecognized-syntax {code Code})
(ex.report ["Code" (%code code)]))
(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 "Analysis" 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 @
[[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 def-name macro argsC+))]
(compile expansion))
_
(function.apply compile functionT functionA argsC+)))
_
(function.apply compile functionT functionA argsC+)))
_
(///.throw unrecognized-syntax code)
)))))
|
