diff options
author | Eduardo Julian | 2019-12-27 00:51:00 -0400 |
---|---|---|
committer | Eduardo Julian | 2019-12-27 00:51:00 -0400 |
commit | 581ccee156457b0f84696def59fc324c1cbbdaba (patch) | |
tree | 0202c9a26d65920eeaabecffb810b5be0bc8a15d /new-luxc | |
parent | 9e6725e3fd45ad0b8faf54ec00ca9dcb8b603e32 (diff) |
Falling back to using the old method of JVM generation while I properly debug and optimize the new one.
Diffstat (limited to 'new-luxc')
-rw-r--r-- | new-luxc/source/luxc/lang/translation/jvm.lux | 154 | ||||
-rw-r--r-- | new-luxc/source/luxc/lang/translation/jvm/common.lux | 39 | ||||
-rw-r--r-- | new-luxc/source/luxc/lang/translation/jvm/function.lux | 6 | ||||
-rw-r--r-- | new-luxc/source/luxc/lang/translation/jvm/program.lux | 82 | ||||
-rw-r--r-- | new-luxc/source/program.lux | 38 |
5 files changed, 284 insertions, 35 deletions
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) + "<clinit>" + (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>" (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))))])) diff --git a/new-luxc/source/program.lux b/new-luxc/source/program.lux index 2b2278cec..d802f7f32 100644 --- a/new-luxc/source/program.lux +++ b/new-luxc/source/program.lux @@ -25,22 +25,33 @@ [phase ["." macro (#+ Expander)] [extension (#+ Phase Bundle Operation Handler Extender) + ["." bundle] ["." analysis #_ ["#" jvm]] ["." directive #_ ["#" jvm]]] ["." generation #_ ["#" jvm/extension] - ["." jvm - ["." runtime (#+ Anchor Definition)] - ["#/." program] + ["." jvm #_ + ## ["." runtime (#+ Anchor Definition)] ["." packager] - ["#/." host]]]] + ## ["#/." host] + ]]] [default ["." platform (#+ Platform)]]]]] [program ["/" compositor - ["/." cli]]]) + ["/." cli]]] + [luxc + [lang + [host + ["_" jvm]] + [translation + ["." jvm + ["." runtime] + ["." expression] + ["#/." program] + ["translation" extension]]]]]) (import: #long java/lang/reflect/Method (invoke [java/lang/Object [java/lang/Object]] #try java/lang/Object)) @@ -85,14 +96,18 @@ apply-method)))) (def: #export platform - (IO (Platform IO Anchor (Bytecode Any) Definition)) + ## (IO (Platform IO Anchor (Bytecode Any) Definition)) + (IO (Platform IO _.Anchor _.Inst _.Definition)) (do io.monad - [host jvm/host.host] + [## host jvm/host.host + host jvm.host] (wrap {#platform.&monad io.monad #platform.&file-system file.system #platform.host host - #platform.phase jvm.generate - #platform.runtime runtime.generate}))) + ## #platform.phase jvm.generate + #platform.phase expression.translate + ## #platform.runtime runtime.generate + #platform.runtime runtime.translate}))) (def: extender Extender @@ -132,8 +147,9 @@ ..expander analysis.bundle ..platform - generation.bundle - directive.bundle + ## generation.bundle + translation.bundle + bundle.empty jvm/program.program ..extender service |