blob: b6fed434e9df0e7636f0ac481a49761286f2ea83 (
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
|
(.module:
lux
(lux (control monad
["ex" exception #+ exception:]
["p" parser])
(data ["e" error]
text/format)
[macro]
(macro ["s" syntax])
["//" lang]
(lang ["//." reference #+ Register]
["//." synthesis #+ Synthesis]
["//." extension]))
(luxc (lang (host ["$" jvm])))
(// [".T" common]
[".T" primitive]
[".T" structure]
[".T" eval]
[".T" function]
[".T" reference]
[".T" case]
[".T" procedure]))
(do-template [<name>]
[(exception: #export (<name> {message Text})
message)]
[Invalid-Function-Syntax]
[Unrecognized-Synthesis]
)
(def: #export (translate synthesis)
(-> Synthesis (Meta $.Inst))
(case synthesis
(^ (//synthesis.bit value))
(primitiveT.translate-bit value)
(^ (//synthesis.i64 value))
(primitiveT.translate-i64 value)
(^ (//synthesis.f64 value))
(primitiveT.translate-f64 value)
(^ (//synthesis.text value))
(primitiveT.translate-text value)
(^code ((~ [_ (#.Nat tag)]) (~ [_ (#.Bit last?)]) (~ valueS)))
(structureT.translate-variant translate tag last? valueS)
(^code [(~+ members)])
(structureT.translate-tuple translate members)
(^ [_ (#.Form (list [_ (#.Int var)]))])
(if (variableL.captured? var)
(referenceT.translate-captured var)
(referenceT.translate-local var))
[_ (#.Symbol definition)]
(referenceT.translate-definition definition)
(^code ("lux let" (~ [_ (#.Nat register)]) (~ inputS) (~ exprS)))
(caseT.translate-let translate register inputS exprS)
(^code ("lux case" (~ inputS) (~ pathPS)))
(caseT.translate-case translate inputS pathPS)
(^code ("lux function" (~ [_ (#.Nat arity)]) [(~+ environment)] (~ bodyS)))
(case (s.run environment (p.some s.int))
(#e.Success environment)
(functionT.translate-function translate environment arity bodyS)
_
(//.throw Invalid-Function-Syntax (%code synthesis)))
(^code ("lux call" (~ functionS) (~+ argsS)))
(functionT.translate-call translate functionS argsS)
(^code ((~ [_ (#.Text procedure)]) (~+ argsS)))
(procedureT.translate-procedure translate procedure argsS)
## (do macro.Monad<Meta>
## [translation (extensionL.find-translation procedure)]
## (translation argsS))
_
(//.throw Unrecognized-Synthesis (%code synthesis))
))
|
