blob: a734adfed8dbf55dbf1706512e78e20aab76f22d (
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
|
(.module:
lux
(lux (control monad
["ex" exception #+ exception:])
(data ["e" error]
[maybe]
[text "text/" Monoid<Text> Hash<Text>]
text/format
(coll [list "list/" Functor<List> Fold<List>]))
[macro]
[host])
(luxc ["&" lang]
["&." io]
(lang (host ["$" jvm]
(jvm ["$t" type]
["$d" def]
["$i" inst]))
["&." scope]
["&." module]
(translation [".T" eval]
[".T" common]))))
(exception: #export Invalid-Definition-Value)
(exception: #export Cannot-Evaluate-Definition)
(host.import java/lang/reflect/Field
(get [#? Object] #try #? Object))
(host.import (java/lang/Class c)
(getField [String] #try Field))
(def: #export (translate-def def-name valueT valueI metaI metaV)
(-> Text Type $.Inst $.Inst Code (Meta Unit))
(do macro.Monad<Meta>
[current-module macro.current-module-name
#let [def-ident [current-module def-name]]]
(case (macro.get-symbol-ann (ident-for #.alias) metaV)
(#.Some real-def)
(do @
[[realT realA realV] (macro.find-def real-def)
_ (&module.define def-ident [realT metaV realV])]
(wrap []))
_
(do @
[#let [normal-name (format (&.normalize-name def-name) (%n (text/hash def-name)))
bytecode-name (format current-module "/" normal-name)
class-name (format (text.replace-all "/" "." current-module) "." normal-name)
bytecode ($d.class #$.V1_6
#$.Public $.finalC
bytecode-name
(list) ["java.lang.Object" (list)]
(list)
(|>> ($d.field #$.Public ($.++F $.finalF $.staticF) commonT.value-field commonT.$Object)
($d.method #$.Public $.staticM "<clinit>" ($t.method (list) #.None (list))
(|>> valueI
($i.PUTSTATIC bytecode-name commonT.value-field commonT.$Object)
$i.RETURN))))]
_ (commonT.store-class class-name bytecode)
class (commonT.load-class class-name)
valueV (: (Meta Top)
(case (do e.Monad<Error>
[field (Class::getField [commonT.value-field] class)]
(Field::get [#.None] field))
(#e.Success #.None)
(&.throw Invalid-Definition-Value (%ident def-ident))
(#e.Success (#.Some valueV))
(wrap valueV)
(#e.Error error)
(&.throw Cannot-Evaluate-Definition
(format "Definition: " (%ident def-ident) "\n"
"Error:\n"
error))))
_ (&module.define def-ident [valueT metaV valueV])
_ (if (macro.type? metaV)
(case (macro.declared-tags metaV)
#.Nil
(wrap [])
tags
(&module.declare-tags tags (macro.export? metaV) (:! Type valueV)))
(wrap []))
#let [_ (log! (format "DEF " (%ident def-ident)))]]
(commonT.record-artifact (format bytecode-name ".class") bytecode)))))
(def: #export (translate-program program-args programI)
(-> Text $.Inst (Meta Unit))
(&.fail "\"lux program\" is unimplemented."))
|
