From 581ccee156457b0f84696def59fc324c1cbbdaba Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Fri, 27 Dec 2019 00:51:00 -0400 Subject: Falling back to using the old method of JVM generation while I properly debug and optimize the new one. --- new-luxc/source/luxc/lang/translation/jvm.lux | 154 +++++++++++++++++++++ .../source/luxc/lang/translation/jvm/common.lux | 39 +++--- .../source/luxc/lang/translation/jvm/function.lux | 6 +- .../source/luxc/lang/translation/jvm/program.lux | 82 +++++++++++ 4 files changed, 257 insertions(+), 24 deletions(-) create mode 100644 new-luxc/source/luxc/lang/translation/jvm.lux create mode 100644 new-luxc/source/luxc/lang/translation/jvm/program.lux (limited to 'new-luxc/source/luxc') diff --git a/new-luxc/source/luxc/lang/translation/jvm.lux b/new-luxc/source/luxc/lang/translation/jvm.lux new file mode 100644 index 000000000..fccbd14bf --- /dev/null +++ b/new-luxc/source/luxc/lang/translation/jvm.lux @@ -0,0 +1,154 @@ +(.module: + [lux (#- Definition) + ["." host (#+ import: do-to object)] + [abstract + [monad (#+ do)]] + [control + pipe + ["." try (#+ Try)] + ["." exception (#+ exception:)] + ["." io (#+ IO io)] + [concurrency + ["." atom (#+ Atom atom)]]] + [data + [binary (#+ Binary)] + ["." product] + ["." text ("#@." hash) + ["%" format (#+ format)]] + [collection + ["." array] + ["." dictionary (#+ Dictionary)]]] + [target + [jvm + ["." loader (#+ Library)] + ["." type + ["." descriptor]]]] + [tool + [compiler + ["." name]]]] + [/// + [host + ["." jvm (#+ Inst Definition Host State) + ["." def] + ["." inst]]]] + ) + +(import: org/objectweb/asm/Label) + +(import: java/lang/reflect/Field + (get [#? Object] #try #? Object)) + +(import: (java/lang/Class a) + (getField [String] #try Field)) + +(import: java/lang/Object + (getClass [] (Class Object))) + +(import: java/lang/ClassLoader) + +(type: #export ByteCode Binary) + +(def: #export value-field Text "_value") +(def: #export $Value (type.class "java.lang.Object" (list))) + +(exception: #export (cannot-load {class Text} {error Text}) + (exception.report + ["Class" class] + ["Error" error])) + +(exception: #export (invalid-field {class Text} {field Text} {error Text}) + (exception.report + ["Class" class] + ["Field" field] + ["Error" error])) + +(exception: #export (invalid-value {class Text}) + (exception.report + ["Class" class])) + +(def: (class-value class-name class) + (-> Text (Class Object) (Try Any)) + (case (Class::getField ..value-field class) + (#try.Success field) + (case (Field::get #.None field) + (#try.Success ?value) + (case ?value + (#.Some value) + (#try.Success value) + + #.None + (exception.throw invalid-value class-name)) + + (#try.Failure error) + (exception.throw cannot-load [class-name error])) + + (#try.Failure error) + (exception.throw invalid-field [class-name ..value-field error]))) + +(def: class-path-separator ".") + +(def: (evaluate! library loader eval-class valueI) + (-> Library ClassLoader Text Inst (Try [Any Definition])) + (let [bytecode-name (text.replace-all class-path-separator .module-separator eval-class) + bytecode (def.class #jvm.V1_6 + #jvm.Public jvm.noneC + bytecode-name + (list) $Value + (list) + (|>> (def.field #jvm.Public ($_ jvm.++F jvm.finalF jvm.staticF) + ..value-field ..$Value) + (def.method #jvm.Public ($_ jvm.++M jvm.staticM jvm.strictM) + "" + (type.method [(list) type.void (list)]) + (|>> valueI + (inst.PUTSTATIC (type.class bytecode-name (list)) ..value-field ..$Value) + inst.RETURN))))] + (io.run (do (try.with io.monad) + [_ (loader.store eval-class bytecode library) + class (loader.load eval-class loader) + value (:: io.monad wrap (class-value eval-class class))] + (wrap [value + [eval-class bytecode]]))))) + +(def: (execute! library loader temp-label [class-name class-bytecode]) + (-> Library ClassLoader Text Definition (Try Any)) + (io.run (do (try.with io.monad) + [existing-class? (|> (atom.read library) + (:: io.monad map (dictionary.contains? class-name)) + (try.lift io.monad) + (: (IO (Try Bit)))) + _ (if existing-class? + (wrap []) + (loader.store class-name class-bytecode library))] + (loader.load class-name loader)))) + +(def: (define! library loader [module name] valueI) + (-> Library ClassLoader Name Inst (Try [Text Any Definition])) + (let [class-name (format (text.replace-all .module-separator class-path-separator module) + class-path-separator (name.normalize name) + "___" (%.nat (text@hash name)))] + (do try.monad + [[value definition] (evaluate! library loader class-name valueI)] + (wrap [class-name value definition])))) + +(def: #export host + (IO Host) + (io (let [library (loader.new-library []) + loader (loader.memory library)] + (: Host + (structure + (def: (evaluate! temp-label valueI) + (let [eval-class (|> temp-label name.normalize (text.replace-all " " "$"))] + (:: try.monad map product.left + (..evaluate! library loader eval-class valueI)))) + + (def: execute! + (..execute! library loader)) + + (def: define! + (..define! library loader))))))) + +(def: #export $Variant (type.array ..$Value)) +(def: #export $Tuple (type.array ..$Value)) +(def: #export $Function (type.class "LuxFunction" (list))) +(def: #export $Runtime (type.class "LuxRuntime" (list))) diff --git a/new-luxc/source/luxc/lang/translation/jvm/common.lux b/new-luxc/source/luxc/lang/translation/jvm/common.lux index 8b2a83526..6cd7f4f2f 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/common.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/common.lux @@ -1,24 +1,25 @@ (.module: [lux #* - [abstract - [monad (#+ do)]] - [control - ["." try (#+ Try)] - ["ex" exception (#+ exception:)] - ["." io]] - [data - [binary (#+ Binary)] - ["." text ("#/." hash) - format] - [collection - ["." dictionary (#+ Dictionary)]]] - ["." macro] - [host (#+ import:)] - [tool - [compiler - [reference (#+ Register)] - ["." name] - ["." phase]]]] + ## [abstract + ## [monad (#+ do)]] + ## [control + ## ["." try (#+ Try)] + ## ["ex" exception (#+ exception:)] + ## ["." io]] + ## [data + ## [binary (#+ Binary)] + ## ["." text ("#/." hash) + ## format] + ## [collection + ## ["." dictionary (#+ Dictionary)]]] + ## ["." macro] + ## [host (#+ import:)] + ## [tool + ## [compiler + ## [reference (#+ Register)] + ## ["." name] + ## ["." phase]]] + ] ## [luxc ## [lang ## [host diff --git a/new-luxc/source/luxc/lang/translation/jvm/function.lux b/new-luxc/source/luxc/lang/translation/jvm/function.lux index 34a4c890e..7a4bbef4e 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/function.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/function.lux @@ -240,16 +240,12 @@ (_.INVOKESPECIAL class "" (init-method env function-arity)) _.ARETURN)) )))) - _.fuse) - failureI (|>> (_.INVOKESTATIC //.$Runtime "apply_fail" (type.method [(list) type.void (list)])) - _.NULL - _.ARETURN)] + _.fuse)] (def.method #$.Public $.noneM runtime.apply-method (runtime.apply-signature apply-arity) (|>> get-amount-of-partialsI (_.TABLESWITCH +0 (|> num-partials dec .int) @default @labels) casesI - failureI )))) (def: #export with-environment diff --git a/new-luxc/source/luxc/lang/translation/jvm/program.lux b/new-luxc/source/luxc/lang/translation/jvm/program.lux new file mode 100644 index 000000000..7ac897009 --- /dev/null +++ b/new-luxc/source/luxc/lang/translation/jvm/program.lux @@ -0,0 +1,82 @@ +(.module: + [lux #* + [target + [jvm + ["$t" type]]]] + [luxc + [lang + [host + ["_" jvm + ["$d" def] + ["$i" inst]]] + [translation + ["." jvm + ["." runtime]]]]]) + +(def: #export class "LuxProgram") + +(def: ^Object ($t.class "java.lang.Object" (list))) + +(def: #export (program programI) + (-> _.Inst _.Definition) + (let [nilI runtime.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 ..^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 + runtime.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)) + feed-inputsI ($i.INVOKEVIRTUAL jvm.$Function runtime.apply-method (runtime.apply-signature 1)) + run-ioI (|>> ($i.CHECKCAST jvm.$Function) + $i.NULL + ($i.INVOKEVIRTUAL jvm.$Function runtime.apply-method (runtime.apply-signature 1))) + main-type ($t.method [(list ($t.array ($t.class "java.lang.String" (list)))) + $t.void + (list)])] + [..class + ($d.class #_.V1_6 + #_.Public _.finalC + ..class + (list) ..^Object + (list) + (|>> ($d.method #_.Public _.staticM "main" main-type + (|>> programI + prepare-input-listI + feed-inputsI + run-ioI + $i.RETURN))))])) -- cgit v1.2.3