blob: a7e420eec614ce3daf088aa2b4d938a8d7bf3fff (
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
132
133
134
135
136
137
138
139
140
|
(;module:
lux
(lux (control monad)
(data ["R" result]
[text "T/" Eq<Text>]
text/format
[number]
[product])
[macro #+ Monad<Lux>]
[type]
(type ["TC" check]))
(luxc ["&" base]
(lang ["la" analysis])
["&;" module]
["&;" env])
(. ["&&;" common]
["&&;" function]
["&&;" primitive]
["&&;" reference]
["&&;" type]
["&&;" structure]
["&&;" case]
["&&;" procedure]))
(def: (to-branches raw)
(-> (List Code) (Lux (List [Code Code])))
(case raw
(^ (list))
(:: Monad<Lux> wrap (list))
(^ (list& patternH bodyH inputT))
(do Monad<Lux>
[outputT (to-branches inputT)]
(wrap (list& [patternH bodyH] outputT)))
_
(&;fail "Uneven expressions for pattern-matching.")))
(def: #export (analyser eval)
(-> &;Eval &;Analyser)
(: (-> Code (Lux la;Analysis))
(function analyse [ast]
(let [[cursor ast'] ast]
## The cursor must be set in the compiler for the sake
## of having useful error messages.
(&;with-cursor cursor
(case ast'
(^template [<tag> <analyser>]
(<tag> value)
(<analyser> value))
([#;Bool &&primitive;analyse-bool]
[#;Nat &&primitive;analyse-nat]
[#;Int &&primitive;analyse-int]
[#;Deg &&primitive;analyse-deg]
[#;Frac &&primitive;analyse-frac]
[#;Text &&primitive;analyse-text])
(^ (#;Tuple (list)))
&&primitive;analyse-unit
## Singleton tuples are equivalent to the element they contain.
(^ (#;Tuple (list singleton)))
(analyse singleton)
(^ (#;Tuple elems))
(&&structure;analyse-product analyse elems)
(^ (#;Record pairs))
(&&structure;analyse-record analyse pairs)
(#;Symbol reference)
(&&reference;analyse-reference reference)
(^ (#;Form (list [_ (#;Symbol ["" "_lux_function"])]
[_ (#;Symbol ["" func-name])]
[_ (#;Symbol ["" arg-name])]
body)))
(&&function;analyse-function analyse func-name arg-name body)
(^ (#;Form (list [_ (#;Symbol ["" "_lux_check"])]
type
value)))
(&&type;analyse-check analyse eval type value)
(^ (#;Form (list [_ (#;Symbol ["" "_lux_coerce"])]
type
value)))
(&&type;analyse-coerce analyse eval type value)
(^ (#;Form (list& [_ (#;Text proc-name)] proc-args)))
(&&procedure;analyse-procedure analyse proc-name proc-args)
(^ (#;Form (list& [_ (#;Symbol ["" "_lux_case"])]
input
branches)))
(do Monad<Lux>
[paired (to-branches branches)]
(&&case;analyse-case analyse input paired))
(^ (#;Form (list [_ (#;Nat tag)]
value)))
(&&structure;analyse-sum analyse tag value)
(^ (#;Form (list [_ (#;Tag tag)]
value)))
(&&structure;analyse-tagged-sum analyse tag value)
(^ (#;Form (list& func args)))
(do Monad<Lux>
[[funcT =func] (&&common;with-unknown-type
(analyse func))]
(case =func
(#la;Definition def-name)
(do @
[[def-type def-anns def-value] (macro;find-def def-name)]
(if (macro;macro? def-anns)
(do @
[## macro-expansion (function [compiler]
## (case (macro-caller def-value args compiler)
## (#R;Success [compiler' output])
## (#R;Success [compiler' output])
## (#R;Error error)
## ((&;fail error) compiler)))
macro-expansion (: (Lux (List Code))
(undefined))]
(case macro-expansion
(^ (list single-expansion))
(analyse single-expansion)
_
(&;fail (format "Macro expressions must expand to a single expression: " (%code ast)))))
(&&function;analyse-apply analyse funcT =func args)))
_
(&&function;analyse-apply analyse funcT =func args)))
_
(&;fail (format "Unrecognized syntax: " (%code ast)))
))))))
|
