blob: 7cb404b138b33503c3137fbf9dae68df35f58604 (
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
141
142
143
144
145
146
|
(.module:
lux
(lux (control [monad #+ do]
["ex" exception #+ exception:])
(data [text]
text/format
(coll [list "list/" Functor<List>]
[dict #+ Dict]))
[macro]
(lang (type ["tc" check]))
[io #+ IO])
[//]
(luxc [lang]
(lang [".L" host]
(host ["$" jvm])
(analysis [".A" common]
[".A" expression])
(synthesis [".S" expression])
(translation [".T" expression]
[".T" statement]
[".T" eval])
[".L" eval])))
(exception: #export Invalid-Statement)
(exception: #export Invalid-Alias)
(def: (throw-invalid-statement procedure inputsC+)
(All [a] (-> Text (List Code) (Meta a)))
(lang.throw Invalid-Statement
(format "Statement: " procedure "\n"
" Inputs:"
(|> inputsC+
list.enumerate
(list/map (function [[idx inputC]]
(format "\n " (%n idx) " " (%code inputC))))
(text.join-with "")) "\n")))
(def: (process-annotations annsC)
(-> Code (Meta [$.Inst Code]))
(do macro.Monad<Meta>
[[_ annsA] (lang.with-scope
(lang.with-type Code
(expressionA.analyser evalL.eval annsC)))
annsI (expressionT.translate (expressionS.synthesize annsA))
annsV (evalT.eval annsI)]
(wrap [annsI (:! Code annsV)])))
(def: (ensure-valid-alias def-name annotations value)
(-> Text Code Code (Meta Unit))
(case [annotations value]
(^multi [[_ (#.Record pairs)] [_ (#.Symbol _)]]
(|> pairs list.size (n/= +1)))
(:: macro.Monad<Meta> wrap [])
_
(lang.throw Invalid-Alias def-name)))
(def: (lux//def procedure)
(-> Text //.Statement)
(function [inputsC+]
(case inputsC+
(^ (list [_ (#.Symbol ["" def-name])] valueC annotationsC))
(hostL.with-context def-name
(lang.with-fresh-type-env
(do macro.Monad<Meta>
[[annotationsI annotationsV] (process-annotations annotationsC)]
(case (macro.get-symbol-ann (ident-for #.alias) annotationsV)
(#.Some real-def)
(do @
[_ (ensure-valid-alias def-name annotationsV valueC)
_ (lang.with-scope
(statementT.translate-def def-name Void id annotationsI annotationsV))]
(wrap []))
#.None
(do @
[[_ valueT valueA] (lang.with-scope
(if (macro.type? (:! Code annotationsV))
(do @
[valueA (lang.with-type Type
(expressionA.analyser evalL.eval valueC))]
(wrap [Type valueA]))
(commonA.with-unknown-type
(expressionA.analyser evalL.eval valueC))))
valueT (lang.with-type-env
(tc.clean valueT))
valueI (expressionT.translate (expressionS.synthesize valueA))
_ (lang.with-scope
(statementT.translate-def def-name valueT valueI annotationsI annotationsV))]
(wrap []))))))
_
(throw-invalid-statement procedure inputsC+))))
(def: (lux//program procedure)
(-> Text //.Statement)
(function [inputsC+]
(case inputsC+
(^ (list [_ (#.Symbol ["" args])] programC))
(do macro.Monad<Meta>
[[_ programA] (lang.with-scope
(lang.with-type (type (IO Unit))
(expressionA.analyser evalL.eval programC)))
programI (expressionT.translate (expressionS.synthesize programA))
_ (statementT.translate-program args programI)]
(wrap []))
_
(throw-invalid-statement procedure inputsC+))))
(do-template [<mame> <type> <installer>]
[(def: (<mame> procedure)
(-> Text //.Statement)
(function [inputsC+]
(case inputsC+
(^ (list [_ (#.Text name)] valueC))
(do macro.Monad<Meta>
[[_ valueA] (lang.with-scope
(lang.with-type <type>
(expressionA.analyser evalL.eval valueC)))
valueI (expressionT.translate (expressionS.synthesize valueA))
valueV (evalT.eval valueI)
_ (<installer> name (:! <type> valueV))]
(wrap []))
_
(throw-invalid-statement procedure inputsC+))))]
[lux//analysis //.Analysis //.install-analysis]
[lux//synthesis //.Synthesis //.install-synthesis]
[lux//translation //.Translation //.install-translation]
[lux//statement //.Statement //.install-statement])
(def: #export defaults
(Dict Text //.Statement)
(`` (|> (dict.new text.Hash<Text>)
(~~ (do-template [<name> <extension>]
[(dict.put <name> (<extension> <name>))]
["lux def" lux//def]
["lux program" lux//program]
["lux analysis" lux//analysis]
["lux synthesis" lux//synthesis]
["lux translation" lux//translation]
["lux statement" lux//statement]
)))))
|
