blob: d8f5abe9b616e53aa44b9d81447b554d313d1627 (
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
|
(;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]
["&&;" struct]
["&&;" case]
["&&;" proc]))
(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]
(&;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]
[#;Real &&primitive;analyse-real]
[#;Char &&primitive;analyse-char]
[#;Text &&primitive;analyse-text])
(^ (#;Tuple (list)))
&&primitive;analyse-unit
(^ (#;Tuple (list singleton)))
(analyse singleton)
(^ (#;Tuple elems))
(&&struct;analyse-tuple analyse elems)
(#;Symbol reference)
(&&reference;analyse-reference reference)
(^ (#;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 [_ (#;Symbol ["" "_lux_proc"])]
[_ (#;Symbol proc)]
[_ (#;Tuple args)])))
(&&proc;analyse-proc analyse 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)))
(&&struct;analyse-variant analyse tag value)
(^ (#;Form (list& func args)))
(do Monad<Lux>
[[funcT =func] (&&common;with-unknown-type
(analyse func))]
(case =func
(#la;Absolute 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)))
))))))
|