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. --- luxc/src/lux/compiler/jvm/function.clj | 9 +- 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 +++++++++++ new-luxc/source/program.lux | 38 +++-- stdlib/source/lux/host.jvm.lux | 25 +++- stdlib/source/lux/target/jvm/bytecode.lux | 10 +- .../phase/generation/jvm/extension/common.lux | 4 +- 9 files changed, 314 insertions(+), 53 deletions(-) create mode 100644 new-luxc/source/luxc/lang/translation/jvm.lux create mode 100644 new-luxc/source/luxc/lang/translation/jvm/program.lux diff --git a/luxc/src/lux/compiler/jvm/function.clj b/luxc/src/lux/compiler/jvm/function.clj index 14ad9884f..551f0851c 100644 --- a/luxc/src/lux/compiler/jvm/function.clj +++ b/luxc/src/lux/compiler/jvm/function.clj @@ -164,7 +164,6 @@ $default (new Label) $labels* (map (fn [_] (new Label)) (repeat num-partials nil)) $labels (vec (concat $labels* (list $default))) - $end (new Label) method-writer (.visitMethod class-writer (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STRICT) &&/apply-method (&&/apply-signature +degree+) nil nil) frame-locals (to-array (list class-name "java/lang/Object" "java/lang/Object")) frame-stack (to-array [Opcodes/INTEGER]) @@ -186,7 +185,7 @@ (consecutive-args 1 +degree+) (fill-nulls! (- (- num-partials +degree+) stage)) (.visitMethodInsn Opcodes/INVOKESPECIAL class-name "" (function--signature env arity)) - (.visitJumpInsn Opcodes/GOTO $end)) + (.visitInsn Opcodes/ARETURN)) (->> (cond (= stage arity-over-extent) (doto method-writer (.visitLabel $label) @@ -197,7 +196,7 @@ (->> (dotimes [idx stage]))) (consecutive-args 1 +degree+) (.visitMethodInsn Opcodes/INVOKEVIRTUAL class-name "impl" (function-impl-signature arity)) - (.visitJumpInsn Opcodes/GOTO $end)) + (.visitInsn Opcodes/ARETURN)) (> stage arity-over-extent) (let [args-to-completion (- arity stage) @@ -211,12 +210,10 @@ (consecutive-args 1 args-to-completion) (.visitMethodInsn Opcodes/INVOKEVIRTUAL class-name "impl" (function-impl-signature arity)) (consecutive-applys (+ 1 args-to-completion) args-left) - (.visitJumpInsn Opcodes/GOTO $end))) + (.visitInsn Opcodes/ARETURN))) :else) (doseq [[stage $label] (map vector (range arity) $labels)]))) - (.visitLabel $end) - (.visitInsn Opcodes/ARETURN) (.visitMaxs 0 0) (.visitEnd)) (return nil))) 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))))])) 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 diff --git a/stdlib/source/lux/host.jvm.lux b/stdlib/source/lux/host.jvm.lux index d0952f71e..b34cd4242 100644 --- a/stdlib/source/lux/host.jvm.lux +++ b/stdlib/source/lux/host.jvm.lux @@ -32,7 +32,7 @@ [encoding ["." name (#+ External)]] ["." type (#+ Type Argument Typed) - ["." category (#+ Void Value Return Method Primitive Object Class Array Var Parameter Declaration)] + ["." category (#+ Void Value' Value Return' Return Method Primitive Object Class Array Var Parameter Declaration)] ["." box] ["." descriptor] ["." signature] @@ -44,8 +44,15 @@ (|>> name.internal name.read)) -(def: signature (|>> type.signature signature.signature)) -(def: reflection (|>> type.reflection reflection.reflection)) +(def: signature + (All [category] + (-> (Type category) Text)) + (|>> type.signature signature.signature)) + +(def: reflection + (All [category] + (-> (Type (<| Return' Value' category)) Text)) + (|>> type.reflection reflection.reflection)) (template [ ] [(def: #export .Type (#.Primitive #.Nil))] @@ -657,7 +664,9 @@ ))))) (def: (itself^ type) - (All [a] (-> (Type a) (Parser (Type a)))) + (All [category] + (-> (Type (<| Return' Value' category)) + (Parser (Type (<| Return' Value' category))))) (do <>.monad [_ (.identifier! ["" (..reflection type)])] (wrap type))) @@ -690,9 +699,15 @@ (..array^ type^) )))) +(def: void^ + (Parser (Type Void)) + (do <>.monad + [_ (.identifier! ["" (reflection.reflection reflection.void)])] + (wrap type.void))) + (def: (return^ imports type-vars) (-> Context (List (Type Var)) (Parser (Type Return))) - (<>.either (itself^ type.void) + (<>.either ..void^ (..type^ imports type-vars))) (def: var^ diff --git a/stdlib/source/lux/target/jvm/bytecode.lux b/stdlib/source/lux/target/jvm/bytecode.lux index bba140a7a..9092445c7 100644 --- a/stdlib/source/lux/target/jvm/bytecode.lux +++ b/stdlib/source/lux/target/jvm/bytecode.lux @@ -458,7 +458,7 @@ (import: #long java/lang/Float) -(template [ ] +(template [ ] [(def: #export ( value) (-> (Bytecode Any)) (case (|> value ) @@ -473,7 +473,7 @@ (..bytecode $0 $1 @_ _.ldc [index]) (#try.Failure _) - (..bytecode $0 $1 @_ [index])))))] + (..bytecode $0 $1 @_ [index])))))] [int I32 //constant.integer //constant/pool.integer _.ldc-w/integer (<| .int i32.i64) @@ -485,13 +485,13 @@ [+4 _.iconst-4] [+5 _.iconst-5])] [float java/lang/Float //constant.float //constant/pool.float _.ldc-w/float - host.float-to-double + (<| (:coerce Frac) host.float-to-double) ([+0.0 _.fconst-0] [+1.0 _.fconst-1] [+2.0 _.fconst-2])] ) -(template [ ] +(template [ ] [(def: #export ( value) (-> (Bytecode Any)) (case (|> value ) @@ -501,7 +501,7 @@ _ (do ..monad [index (..lift ( ( value)))] - (..bytecode $0 $2 @_ [index]))))] + (..bytecode $0 $2 @_ [index]))))] [long Int //constant.long //constant/pool.long _.ldc2-w/long (<|) diff --git a/stdlib/source/lux/tool/compiler/phase/generation/jvm/extension/common.lux b/stdlib/source/lux/tool/compiler/phase/generation/jvm/extension/common.lux index d06a5167c..d57dd6b50 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation/jvm/extension/common.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation/jvm/extension/common.lux @@ -184,8 +184,8 @@ ) (import: #long java/lang/Double - (#static MIN_VALUE java/lang/Double) - (#static MAX_VALUE java/lang/Double)) + (#static MIN_VALUE double) + (#static MAX_VALUE double)) (template [ ] [(def: ( _) -- cgit v1.2.3