diff options
Diffstat (limited to 'new-luxc/source/luxc/lang/translation/statement.jvm.lux')
| -rw-r--r-- | new-luxc/source/luxc/lang/translation/statement.jvm.lux | 159 |
1 files changed, 0 insertions, 159 deletions
diff --git a/new-luxc/source/luxc/lang/translation/statement.jvm.lux b/new-luxc/source/luxc/lang/translation/statement.jvm.lux deleted file mode 100644 index b2e302e1b..000000000 --- a/new-luxc/source/luxc/lang/translation/statement.jvm.lux +++ /dev/null @@ -1,159 +0,0 @@ -(.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] - [".L" host] - (translation [".T" eval] - [".T" common] - [".T" runtime])))) - -(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 programI) - (-> $.Inst (Meta Unit)) - (let [nilI runtimeT.noneI - num-inputsI (|>> ($i.ALOAD +0) $i.ARRAYLENGTH) - decI (|>> ($i.int 1) $i.ISUB) - headI (|>> $i.DUP - ($i.ALOAD +0) - $i.SWAP - $i.AALOAD - $i.SWAP - $i.DUP_X2 - $i.POP) - pairI (|>> ($i.int 2) - ($i.ANEWARRAY "java.lang.Object") - $i.DUP_X1 - $i.SWAP - ($i.int 0) - $i.SWAP - $i.AASTORE - $i.DUP_X1 - $i.SWAP - ($i.int 1) - $i.SWAP - $i.AASTORE) - consI (|>> ($i.int 1) - ($i.string "") - $i.DUP2_X1 - $i.POP2 - runtimeT.variantI) - prepare-input-listI (<| $i.with-label (function [@loop]) - $i.with-label (function [@end]) - (|>> nilI - num-inputsI - ($i.label @loop) - decI - $i.DUP - ($i.IFLT @end) - headI - pairI - consI - $i.SWAP - ($i.GOTO @loop) - ($i.label @end) - $i.POP - ($i.ASTORE +0))) - run-ioI (|>> ($i.CHECKCAST hostL.function-class) - $i.NULL - ($i.INVOKEVIRTUAL hostL.function-class runtimeT.apply-method (runtimeT.apply-signature +1) false)) - main-type ($t.method (list ($t.array +1 ($t.class "java.lang.String" (list)))) - #.None - (list))] - (do macro.Monad<Meta> - [current-module macro.current-module-name - #let [normal-name "_" - bytecode-name (format current-module "/" normal-name) - class-name (text.replace-all "/" "." bytecode-name) - bytecode ($d.class #$.V1_6 - #$.Public $.finalC - bytecode-name - (list) ["java.lang.Object" (list)] - (list) - (|>> ($d.method #$.Public $.staticM "main" main-type - (|>> prepare-input-listI - programI - run-ioI - $i.POP - $i.RETURN))))] - #let [_ (log! (format "PROGRAM " current-module))] - _ (commonT.store-class class-name bytecode)] - (commonT.record-artifact (format bytecode-name ".class") bytecode)))) |