diff options
author | Eduardo Julian | 2018-08-02 23:03:19 -0400 |
---|---|---|
committer | Eduardo Julian | 2018-08-02 23:03:19 -0400 |
commit | 015134cd44e066e49b3bac56b442a6150c782600 (patch) | |
tree | 365056bf5bd62796b41e1e7eff9fcf0909cd430b /new-luxc/source/luxc/lang/translation/jvm/statement.jvm.lux | |
parent | a4d56600054d833002a7793f98f192feb5d3f27b (diff) |
Moved statement phase into stdlib.
Diffstat (limited to 'new-luxc/source/luxc/lang/translation/jvm/statement.jvm.lux')
-rw-r--r-- | new-luxc/source/luxc/lang/translation/jvm/statement.jvm.lux | 73 |
1 files changed, 1 insertions, 72 deletions
diff --git a/new-luxc/source/luxc/lang/translation/jvm/statement.jvm.lux b/new-luxc/source/luxc/lang/translation/jvm/statement.jvm.lux index 14208903c..7461d981f 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/statement.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/statement.jvm.lux @@ -7,8 +7,7 @@ [text "text/" Monoid<Text> Hash<Text>] text/format (coll [list "list/" Functor<List> Fold<List>])) - [macro] - [host]) + [macro]) (luxc ["&" lang] ["&." io] (lang (host ["$" jvm] @@ -21,76 +20,6 @@ (// [".T" common] [".T" runtime])) -(do-template [<name>] - [(exception: #export (<name> {message Text}) - message)] - - [Invalid-Definition-Value] - [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 metaV) - (-> Text Type $.Inst Code (Meta Any)) - (do macro.Monad<Meta> - [current-module macro.current-module-name - #let [def-name [current-module def-name]]] - (case (macro.get-identifier-ann (name-of #.alias) metaV) - (#.Some real-def) - (do @ - [[realT realA realV] (macro.find-def real-def) - _ (&module.define def-name [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 Any) - (case (do e.Monad<Error> - [field (Class::getField [commonT.value-field] class)] - (Field::get [#.None] field)) - (#e.Success #.None) - (&.throw Invalid-Definition-Value (%name def-name)) - - (#e.Success (#.Some valueV)) - (wrap valueV) - - (#e.Error error) - (&.throw Cannot-Evaluate-Definition - (format "Definition: " (%name def-name) "\n" - "Error:\n" - error)))) - _ (&module.define def-name [valueT metaV valueV]) - _ (if (macro.type? metaV) - (case (macro.declared-tags metaV) - #.Nil - (wrap []) - - tags - (&module.declare-tags tags (macro.export? metaV) (:coerce Type valueV))) - (wrap [])) - #let [_ (log! (format "DEF " (%name def-name)))]] - (commonT.record-artifact (format bytecode-name ".class") bytecode))))) - (def: #export (translate-program programI) (-> $.Inst (Meta Any)) (let [nilI runtimeT.noneI |