diff options
| author | Eduardo Julian | 2019-08-20 22:00:59 -0400 |
|---|---|---|
| committer | Eduardo Julian | 2019-08-20 22:00:59 -0400 |
| commit | 59ededb795732e04ac8e1eaceb2b1509a1c1cc23 (patch) | |
| tree | c0498fbae7cd18fa9434c972a6f7e35d0e02b456 /new-luxc/source/luxc/lang/translation | |
| parent | cdfda2f80b2abd8ec7d8021aab910ccc82271ade (diff) | |
WIP: Make new-luxc instructions rely on the Descriptor type.
Diffstat (limited to '')
10 files changed, 468 insertions, 472 deletions
diff --git a/new-luxc/source/luxc/lang/translation/jvm.lux b/new-luxc/source/luxc/lang/translation/jvm.lux index b5d53aa4f..b56d285d2 100644 --- a/new-luxc/source/luxc/lang/translation/jvm.lux +++ b/new-luxc/source/luxc/lang/translation/jvm.lux @@ -1,10 +1,11 @@ (.module: - [lux (#- Type Definition) + [lux (#- Definition) ["." host (#+ import: do-to object)] [abstract [monad (#+ do)]] [control pipe + ["." try (#+ Try)] ["." exception (#+ exception:)] ["." io (#+ IO io)] [concurrency @@ -12,7 +13,6 @@ [data [binary (#+ Binary)] ["." product] - ["." error (#+ Error)] ["." text ("#@." hash) ["%" format (#+ format)]] [collection @@ -21,7 +21,7 @@ [target [jvm ["." loader (#+ Library)] - ["." type (#+ Type)]]] + ["." descriptor]]] [tool [compiler ["." name]]]] @@ -48,7 +48,7 @@ (type: #export ByteCode Binary) (def: #export value-field Text "_value") -(def: #export $Object Type (type.class "java.lang.Object" (list))) +(def: #export $Value (descriptor.class "java.lang.Object")) (exception: #export (cannot-load {class Text} {error Text}) (exception.report @@ -66,28 +66,28 @@ ["Class" class])) (def: (class-value class-name class) - (-> Text (Class Object) (Error Any)) + (-> Text (Class Object) (Try Any)) (case (Class::getField ..value-field class) - (#error.Success field) + (#try.Success field) (case (Field::get #.None field) - (#error.Success ?value) + (#try.Success ?value) (case ?value (#.Some value) - (#error.Success value) + (#try.Success value) #.None (exception.throw invalid-value class-name)) - (#error.Failure error) + (#try.Failure error) (exception.throw cannot-load [class-name error])) - (#error.Failure 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 (Error [Any Definition])) + (-> 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 @@ -95,14 +95,14 @@ (list) ["java.lang.Object" (list)] (list) (|>> (def.field #jvm.Public ($_ jvm.++F jvm.finalF jvm.staticF) - ..value-field ..$Object) + ..value-field ..$Value) (def.method #jvm.Public ($_ jvm.++M jvm.staticM jvm.strictM) "<clinit>" - (type.method (list) #.None (list)) + (descriptor.method [(list) descriptor.void]) (|>> valueI - (inst.PUTSTATIC bytecode-name ..value-field ..$Object) + (inst.PUTSTATIC (descriptor.class bytecode-name) ..value-field ..$Value) inst.RETURN))))] - (io.run (do (error.with io.monad) + (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))] @@ -110,23 +110,23 @@ [eval-class bytecode]]))))) (def: (execute! library loader temp-label [class-name class-bytecode]) - (-> Library ClassLoader Text Definition (Error Any)) - (io.run (do (error.with io.monad) + (-> 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)) - (error.lift io.monad) - (: (IO (Error Bit)))) + (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 (Error [Text Any Definition])) + (-> 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 error.monad + (do try.monad [[value definition] (evaluate! library loader class-name valueI)] (wrap [class-name value definition])))) @@ -138,7 +138,7 @@ (structure (def: (evaluate! temp-label valueI) (let [eval-class (|> temp-label name.normalize (text.replace-all " " "$"))] - (:: error.monad map product.left + (:: try.monad map product.left (..evaluate! library loader eval-class valueI)))) (def: execute! @@ -150,6 +150,6 @@ (def: #export runtime-class "LuxRuntime") (def: #export function-class "LuxFunction") -(def: #export $Variant Type (type.array 1 ..$Object)) -(def: #export $Tuple Type (type.array 1 ..$Object)) -(def: #export $Function Type (type.class ..function-class (list))) +(def: #export $Variant (descriptor.array ..$Value)) +(def: #export $Tuple (descriptor.array ..$Value)) +(def: #export $Function (descriptor.class ..function-class)) diff --git a/new-luxc/source/luxc/lang/translation/jvm/case.lux b/new-luxc/source/luxc/lang/translation/jvm/case.lux index 7cea61f14..1f3129cd2 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/case.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/case.lux @@ -10,7 +10,7 @@ ["n" nat]]] [target [jvm - ["$t" type]]] + ["." descriptor]]] [tool [compiler ["." synthesis (#+ Path Synthesis)] @@ -20,9 +20,11 @@ [host ["$" jvm (#+ Label Inst Operation Phase) ["_" inst]]]]] - ["." // (#+ $Object) + ["." // ["." runtime]]) +(def: $Runtime (descriptor.class //.runtime-class)) + (def: (pop-altI stack-depth) (-> Nat Inst) (.case stack-depth @@ -40,12 +42,7 @@ (def: pushI Inst - (|>> (_.INVOKESTATIC //.runtime-class - "pm_push" - ($t.method (list runtime.$Stack $Object) - (#.Some runtime.$Stack) - (list)) - #0))) + (|>> (_.INVOKESTATIC $Runtime "pm_push" (descriptor.method [(list runtime.$Stack //.$Value) runtime.$Stack]) #0))) (def: (path' phase stack-depth @else @end path) (-> Phase Nat Label Label Path (Operation Inst)) @@ -60,19 +57,19 @@ (^ (synthesis.path/bit value)) (operation@wrap (.let [jumpI (.if value _.IFEQ _.IFNE)] (|>> peekI - (_.unwrap #$t.Boolean) + (_.unwrap descriptor.boolean) (jumpI @else)))) (^ (synthesis.path/i64 value)) (operation@wrap (|>> peekI - (_.unwrap #$t.Long) + (_.unwrap descriptor.long) (_.long (.int value)) _.LCMP (_.IFNE @else))) (^ (synthesis.path/f64 value)) (operation@wrap (|>> peekI - (_.unwrap #$t.Double) + (_.unwrap descriptor.double) (_.double value) _.DCMPL (_.IFNE @else))) @@ -80,11 +77,9 @@ (^ (synthesis.path/text value)) (operation@wrap (|>> peekI (_.string value) - (_.INVOKEVIRTUAL "java.lang.Object" + (_.INVOKEVIRTUAL (descriptor.class "java.lang.Object") "equals" - ($t.method (list $Object) - (#.Some $t.boolean) - (list)) + (descriptor.method [(list //.$Value) descriptor.boolean]) #0) (_.IFEQ @else))) @@ -95,20 +90,15 @@ bodyI (_.GOTO @end)))) - (^template [<pattern> <flag> <prepare>] (^ (<pattern> idx)) (operation@wrap (<| _.with-label (function (_ @success)) _.with-label (function (_ @fail)) (|>> peekI - (_.CHECKCAST ($t.descriptor runtime.$Variant)) + (_.CHECKCAST //.$Variant) (_.int (.int (<prepare> idx))) <flag> - (_.INVOKESTATIC //.runtime-class "pm_variant" - ($t.method (list runtime.$Variant runtime.$Tag runtime.$Flag) - (#.Some runtime.$Datum) - (list)) - #0) + (_.INVOKESTATIC $Runtime "pm_variant" (descriptor.method [(list //.$Variant runtime.$Tag runtime.$Flag) runtime.$Value]) #0) _.DUP (_.IFNULL @fail) (_.GOTO @success) @@ -126,28 +116,18 @@ _.AALOAD lefts - (_.INVOKESTATIC //.runtime-class - "tuple_left" - ($t.method (list runtime.$Tuple $t.int) - (#.Some $Object) - (list)) - #0))] + (_.INVOKESTATIC $Runtime "tuple_left" (descriptor.method [(list //.$Tuple runtime.$Index) //.$Value]) #0))] (|>> peekI - (_.CHECKCAST ($t.descriptor runtime.$Tuple)) + (_.CHECKCAST //.$Tuple) (_.int (.int lefts)) accessI pushI))) (^ (synthesis.member/right lefts)) (operation@wrap (|>> peekI - (_.CHECKCAST ($t.descriptor runtime.$Tuple)) + (_.CHECKCAST //.$Tuple) (_.int (.int lefts)) - (_.INVOKESTATIC //.runtime-class - "tuple_right" - ($t.method (list runtime.$Tuple $t.int) - (#.Some $Object) - (list)) - #0) + (_.INVOKESTATIC $Runtime "tuple_right" (descriptor.method [(list //.$Tuple runtime.$Index) //.$Value]) #0) pushI)) ## Extra optimization @@ -157,7 +137,7 @@ (do phase.monad [then! (path' phase stack-depth @else @end thenP)] (wrap (|>> peekI - (_.CHECKCAST ($t.descriptor runtime.$Tuple)) + (_.CHECKCAST //.$Tuple) (_.int +0) _.AALOAD (_.ASTORE register) @@ -171,14 +151,9 @@ (do phase.monad [then! (path' phase stack-depth @else @end thenP)] (wrap (|>> peekI - (_.CHECKCAST ($t.descriptor runtime.$Tuple)) + (_.CHECKCAST //.$Tuple) (_.int (.int lefts)) - (_.INVOKESTATIC //.runtime-class - <getter> - ($t.method (list runtime.$Tuple $t.int) - (#.Some $Object) - (list)) - #0) + (_.INVOKESTATIC $Runtime <getter> (descriptor.method [(list //.$Tuple runtime.$Index) //.$Value]) #0) (_.ASTORE register) then!)))) ([synthesis.member/left "tuple_left"] @@ -211,10 +186,7 @@ (wrap (|>> pathI (_.label @else) _.POP - (_.INVOKESTATIC //.runtime-class - "pm_fail" - ($t.method (list) #.None (list)) - #0) + (_.INVOKESTATIC $Runtime "pm_fail" (descriptor.method [(list) descriptor.void]) #0) _.NULL (_.GOTO @end))))) @@ -227,7 +199,7 @@ (wrap (<| _.with-label (function (_ @else)) _.with-label (function (_ @end)) (|>> testI - (_.unwrap #$t.Boolean) + (_.unwrap descriptor.boolean) (_.IFEQ @else) thenI (_.GOTO @end) diff --git a/new-luxc/source/luxc/lang/translation/jvm/common.lux b/new-luxc/source/luxc/lang/translation/jvm/common.lux index 26dbcfbc8..8b2a83526 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/common.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/common.lux @@ -3,11 +3,11 @@ [abstract [monad (#+ do)]] [control + ["." try (#+ Try)] ["ex" exception (#+ exception:)] ["." io]] [data [binary (#+ Binary)] - ["." error (#+ Error)] ["." text ("#/." hash) format] [collection @@ -34,8 +34,8 @@ ## (set@ #artifacts (dictionary.new text.hash)) ## (:coerce Nothing)) ## state)) -## (#error.Success [state' output]) -## (#error.Success [(update@ #.host +## (#try.Success [state' output]) +## (#try.Success [(update@ #.host ## (|>> (:coerce Host) ## (set@ #artifacts (|> (get@ #.host state) (:coerce Host) (get@ #artifacts))) ## (:coerce Nothing)) @@ -43,11 +43,11 @@ ## [(|> state' (get@ #.host) (:coerce Host) (get@ #artifacts)) ## output]]) -## (#error.Error error) -## (#error.Error error)))) +## (#try.Failure error) +## (#try.Failure error)))) ## (def: #export (load-definition state) -## (-> Lux (-> Name Binary (Error Any))) +## (-> Lux (-> Name Binary (Try Any))) ## (function (_ (^@ def-name [def-module def-name]) def-bytecode) ## (let [normal-name (format (name.normalize def-name) (%n (text/hash def-name))) ## class-name (format (text.replace-all "/" "." def-module) "." normal-name)] @@ -55,16 +55,16 @@ ## (do macro.monad ## [_ (..store-class class-name def-bytecode) ## class (..load-class class-name)] -## (case (do error.monad +## (case (do try.monad ## [field (Class::getField [..value-field] class)] ## (Field::get [#.None] field)) -## (#error.Success (#.Some def-value)) +## (#try.Success (#.Some def-value)) ## (wrap def-value) -## (#error.Success #.None) +## (#try.Success #.None) ## (phase.throw invalid-definition-value (%name def-name)) -## (#error.Error error) +## (#try.Failure error) ## (phase.throw cannot-load-definition ## (format "Definition: " (%name def-name) "\n" ## "Error:\n" diff --git a/new-luxc/source/luxc/lang/translation/jvm/function.lux b/new-luxc/source/luxc/lang/translation/jvm/function.lux index ea9c4ef84..5da2839cd 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/function.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/function.lux @@ -12,8 +12,8 @@ [collection ["." list ("#@." functor monoid)]]] [target - ["." jvm #_ - ["#" type (#+ Type Method)]]] + [jvm + ["." descriptor (#+ Descriptor Class Method Value)]]] [tool [compiler [arity (#+ Arity)] @@ -33,42 +33,40 @@ ["." reference]]) (def: arity-field Text "arity") -(def: $Object Type (jvm.class "java.lang.Object" (list))) (def: (poly-arg? arity) (-> Arity Bit) (n.> 1 arity)) -(def: (reset-method class) - (-> Text Method) - (jvm.method (list) (#.Some (jvm.class class (list))) (list))) +(def: reset-method + (-> (Descriptor Class) (Descriptor Method)) + (|>> [(list)] descriptor.method)) (def: (captured-args env) - (-> Environment (List Type)) - (list.repeat (list.size env) $Object)) + (-> Environment (List (Descriptor Value))) + (list.repeat (list.size env) //.$Value)) (def: (init-method env arity) - (-> Environment Arity Method) + (-> Environment Arity (Descriptor Method)) (if (poly-arg? arity) - (jvm.method (list.concat (list (captured-args env) - (list jvm.int) - (list.repeat (dec arity) $Object))) - #.None - (list)) - (jvm.method (captured-args env) #.None (list)))) + (descriptor.method [(list.concat (list (captured-args env) + (list descriptor.int) + (list.repeat (dec arity) //.$Value))) + descriptor.void]) + (descriptor.method [(captured-args env) descriptor.void]))) (def: (implementation-method arity) - (jvm.method (list.repeat arity $Object) (#.Some $Object) (list))) + (descriptor.method [(list.repeat arity //.$Value) //.$Value])) (def: get-amount-of-partialsI Inst (|>> (_.ALOAD 0) - (_.GETFIELD //.function-class runtime.partials-field jvm.int))) + (_.GETFIELD //.$Function runtime.partials-field descriptor.int))) (def: (load-fieldI class field) - (-> Text Text Inst) + (-> (Descriptor Class) Text Inst) (|>> (_.ALOAD 0) - (_.GETFIELD class field $Object))) + (_.GETFIELD class field //.$Value))) (def: (inputsI start amount) (-> Register Nat Inst) @@ -82,9 +80,9 @@ later-applysI (if (n.> runtime.num-apply-variants amount) (applysI (n.+ runtime.num-apply-variants start) (n.- runtime.num-apply-variants amount)) function.identity)] - (|>> (_.CHECKCAST //.function-class) + (|>> (_.CHECKCAST //.$Function) (inputsI start max-args) - (_.INVOKEVIRTUAL //.function-class runtime.apply-method (runtime.apply-signature max-args) #0) + (_.INVOKEVIRTUAL //.$Function runtime.apply-method (runtime.apply-signature max-args) #0) later-applysI))) (def: (inc-intI by) @@ -102,7 +100,7 @@ (-> Environment Def) (|>> list.enumerate (list@map (.function (_ [env-idx env-source]) - (def.field #$.Private $.finalF (reference.foreign-name env-idx) $Object))) + (def.field #$.Private $.finalF (reference.foreign-name env-idx) //.$Value))) def.fuse)) (def: (with-partial arity) @@ -110,12 +108,12 @@ (if (poly-arg? arity) (|> (list.n/range 0 (n.- 2 arity)) (list@map (.function (_ idx) - (def.field #$.Private $.finalF (reference.partial-name idx) $Object))) + (def.field #$.Private $.finalF (reference.partial-name idx) //.$Value))) def.fuse) function.identity)) (def: (instance class arity env) - (-> Text Arity Environment (Operation Inst)) + (-> (Descriptor Class) Arity Environment (Operation Inst)) (do phase.monad [captureI+ (monad.map @ reference.variable env) #let [argsI (if (poly-arg? arity) @@ -130,7 +128,7 @@ (_.INVOKESPECIAL class "<init>" (init-method env arity) #0))))) (def: (with-reset class arity env) - (-> Text Arity Environment Def) + (-> (Descriptor Class) Arity Environment Def) (def.method #$.Public $.noneM "reset" (reset-method class) (if (poly-arg? arity) (let [env-size (list.size env) @@ -139,7 +137,7 @@ _ (list.n/range 0 (dec env-size))) (list@map (.function (_ source) (|>> (_.ALOAD 0) - (_.GETFIELD class (reference.foreign-name source) $Object)))) + (_.GETFIELD class (reference.foreign-name source) //.$Value)))) _.fuse) argsI (|> (nullsI (dec arity)) (list (_.int +0)) @@ -161,19 +159,18 @@ _.ARETURN))) (def: function-init-method - Method - (jvm.method (list jvm.int) #.None (list))) + (descriptor.method [(list descriptor.int) descriptor.void])) (def: (function-init arity env-size) (-> Arity Nat Inst) (if (n.= 1 arity) (|>> (_.int +0) - (_.INVOKESPECIAL //.function-class "<init>" function-init-method #0)) + (_.INVOKESPECIAL //.$Function "<init>" function-init-method #0)) (|>> (_.ILOAD (inc env-size)) - (_.INVOKESPECIAL //.function-class "<init>" function-init-method #0)))) + (_.INVOKESPECIAL //.$Function "<init>" function-init-method #0)))) (def: (with-init class env arity) - (-> Text Environment Arity Def) + (-> (Descriptor Class) Environment Arity Def) (let [env-size (list.size env) offset-partial (: (-> Nat Nat) (|>> inc (n.+ env-size))) @@ -183,7 +180,7 @@ (list@map (.function (_ register) (|>> (_.ALOAD 0) (_.ALOAD (inc register)) - (_.PUTFIELD class (reference.foreign-name register) $Object)))) + (_.PUTFIELD class (reference.foreign-name register) //.$Value)))) _.fuse) store-partialI (if (poly-arg? arity) (|> (list.n/range 0 (n.- 2 arity)) @@ -191,7 +188,7 @@ (let [register (offset-partial idx)] (|>> (_.ALOAD 0) (_.ALOAD (inc register)) - (_.PUTFIELD class (reference.partial-name idx) $Object))))) + (_.PUTFIELD class (reference.partial-name idx) //.$Value))))) _.fuse) function.identity)] (def.method #$.Public $.noneM "<init>" (init-method env arity) @@ -202,7 +199,7 @@ _.RETURN)))) (def: (with-apply class env function-arity @begin bodyI apply-arity) - (-> Text Environment Arity Label Inst Arity + (-> (Descriptor Class) Environment Arity Label Inst Arity Def) (let [num-partials (dec function-arity) @default ($.new-label []) @@ -263,7 +260,7 @@ (_.TABLESWITCH +0 (|> num-partials dec .int) @default @labels) casesI - (_.INVOKESTATIC //.runtime-class "apply_fail" (jvm.method (list) #.None (list)) #0) + (_.INVOKESTATIC runtime.$Runtime "apply_fail" (descriptor.method [(list) descriptor.void]) #0) _.NULL _.ARETURN )))) @@ -271,12 +268,13 @@ (def: #export (with-function @begin class env arity bodyI) (-> Label Text Environment Arity Inst (Operation [Def Inst])) - (let [env-size (list.size env) + (let [classD (descriptor.class class) + env-size (list.size env) applyD (: Def (if (poly-arg? arity) (|> (n.min arity runtime.num-apply-variants) (list.n/range 1) - (list@map (with-apply class env arity @begin bodyI)) + (list@map (with-apply classD env arity @begin bodyI)) (list& (with-implementation arity @begin bodyI)) def.fuse) (def.method #$.Public $.strictM runtime.apply-method (runtime.apply-signature 1) @@ -287,12 +285,12 @@ (|>> (def.int-field #$.Public ($_ $.++F $.staticF $.finalF) arity-field (.int arity)) (with-environment env) (with-partial arity) - (with-init class env arity) - (with-reset class arity env) + (with-init classD env arity) + (with-reset classD arity env) applyD ))] (do phase.monad - [instanceI (instance class arity env)] + [instanceI (instance classD arity env)] (wrap [functionD instanceI])))) (def: #export (function generate [env arity bodyS]) @@ -319,9 +317,9 @@ #let [applyI (|> argsI (list.split-all runtime.num-apply-variants) (list@map (.function (_ chunkI+) - (|>> (_.CHECKCAST //.function-class) + (|>> (_.CHECKCAST //.$Function) (_.fuse chunkI+) - (_.INVOKEVIRTUAL //.function-class runtime.apply-method (runtime.apply-signature (list.size chunkI+)) #0)))) + (_.INVOKEVIRTUAL //.$Function runtime.apply-method (runtime.apply-signature (list.size chunkI+)) #0)))) _.fuse)]] (wrap (|>> functionI applyI)))) diff --git a/new-luxc/source/luxc/lang/translation/jvm/primitive.lux b/new-luxc/source/luxc/lang/translation/jvm/primitive.lux index 85fed0a8e..6903b065d 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/primitive.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/primitive.lux @@ -2,6 +2,7 @@ [lux (#- i64) [target [jvm + ["." descriptor] ["$t" type]]] [tool [compiler @@ -12,11 +13,11 @@ ["." jvm (#+ Inst Operation) ["_" inst]]]]]) -(def: #export (bit value) +(def: #export bit (-> Bit (Operation Inst)) - (operation@wrap (_.GETSTATIC "java.lang.Boolean" - (if value "TRUE" "FALSE") - ($t.class "java.lang.Boolean" (list))))) + (let [Boolean (descriptor.class "java.lang.Boolean")] + (function (_ value) + (operation@wrap (_.GETSTATIC Boolean (if value "TRUE" "FALSE") Boolean))))) (template [<name> <type> <load> <wrap>] [(def: #export (<name> value) @@ -24,7 +25,7 @@ (let [loadI (|> value <load>)] (operation@wrap (|>> loadI <wrap>))))] - [i64 (I64 Any) (<| _.long .int) (_.wrap #$t.Long)] - [f64 Frac _.double (_.wrap #$t.Double)] + [i64 (I64 Any) (<| _.long .int) (_.wrap descriptor.long)] + [f64 Frac _.double (_.wrap descriptor.double)] [text Text _.string (<|)] ) diff --git a/new-luxc/source/luxc/lang/translation/jvm/procedure/common.lux b/new-luxc/source/luxc/lang/translation/jvm/procedure/common.lux index 93d4b6c0b..dbf3a13be 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/procedure/common.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/procedure/common.lux @@ -3,12 +3,12 @@ [abstract ["." monad (#+ do)]] [control + ["." try] ["<>" parser ["<s>" synthesis (#+ Parser)]] ["ex" exception (#+ exception:)]] [data ["." product] - ["." error] [number ["f" frac]] [collection @@ -16,7 +16,7 @@ ["." dictionary]]] [target [jvm - ["_t" type (#+ Type Method)]]] + ["." descriptor]]] [tool [compiler ["." synthesis (#+ Synthesis %synthesis)] @@ -42,36 +42,38 @@ Handler)) (function (_ extension-name phase input) (case (<s>.run input parser) - (#error.Success input') + (#try.Success input') (handler extension-name phase input') - (#error.Failure error) + (#try.Failure error) (phase.throw extension.invalid-syntax [extension-name %synthesis input])))) (import: java/lang/Double (#static MIN_VALUE Double) (#static MAX_VALUE Double)) -(def: $Object-Array Type (_t.array 1 ///.$Object)) -(def: $String Type (_t.class "java.lang.String" (list))) -(def: $CharSequence Type (_t.class "java.lang.CharSequence" (list))) +(def: $String (descriptor.class "java.lang.String")) +(def: $CharSequence (descriptor.class "java.lang.CharSequence")) +(def: $System (descriptor.class "java.lang.System")) +(def: $Object (descriptor.class "java.lang.Object")) -(def: lux-intI Inst (|>> _.I2L (_.wrap #_t.Long))) -(def: jvm-intI Inst (|>> (_.unwrap #_t.Long) _.L2I)) -(def: check-stringI Inst (_.CHECKCAST "java.lang.String")) +(def: lux-intI Inst (|>> _.I2L (_.wrap descriptor.long))) +(def: jvm-intI Inst (|>> (_.unwrap descriptor.long) _.L2I)) +(def: check-stringI Inst (_.CHECKCAST $String)) (def: (predicateI tester) (-> (-> Label Inst) Inst) - (<| _.with-label (function (_ @then)) - _.with-label (function (_ @end)) - (|>> (tester @then) - (_.GETSTATIC "java.lang.Boolean" "FALSE" (_t.class "java.lang.Boolean" (list))) - (_.GOTO @end) - (_.label @then) - (_.GETSTATIC "java.lang.Boolean" "TRUE" (_t.class "java.lang.Boolean" (list))) - (_.label @end) - ))) + (let [$Boolean (descriptor.class "java.lang.Boolean")] + (<| _.with-label (function (_ @then)) + _.with-label (function (_ @end)) + (|>> (tester @then) + (_.GETSTATIC $Boolean "FALSE" $Boolean) + (_.GOTO @end) + (_.label @then) + (_.GETSTATIC $Boolean "TRUE" $Boolean) + (_.label @end) + )))) (def: unitI Inst (_.string synthesis.unit)) @@ -108,7 +110,7 @@ conditionalsG (|> conditionalsG+ (list@map product.right) _.fuse)]] - (wrap (|>> inputG (_.unwrap #_t.Long) _.L2I + (wrap (|>> inputG (_.unwrap descriptor.long) _.L2I (_.LOOKUPSWITCH @else table) conditionalsG (_.label @else) @@ -125,17 +127,17 @@ (def: (lux::try riskyI) (Unary Inst) (|>> riskyI - (_.CHECKCAST ///.function-class) - (_.INVOKESTATIC ///.runtime-class "try" - (_t.method (list ///.$Function) (#.Some $Object-Array) (list)) + (_.CHECKCAST ///.$Function) + (_.INVOKESTATIC runtime.$Runtime "try" + (descriptor.method [(list ///.$Function) ///.$Variant]) #0))) (template [<name> <op>] [(def: (<name> [maskI inputI]) (Binary Inst) - (|>> inputI (_.unwrap #_t.Long) - maskI (_.unwrap #_t.Long) - <op> (_.wrap #_t.Long)))] + (|>> inputI (_.unwrap descriptor.long) + maskI (_.unwrap descriptor.long) + <op> (_.wrap descriptor.long)))] [i64::and _.LAND] [i64::or _.LOR] @@ -145,10 +147,10 @@ (template [<name> <op>] [(def: (<name> [shiftI inputI]) (Binary Inst) - (|>> inputI (_.unwrap #_t.Long) + (|>> inputI (_.unwrap descriptor.long) shiftI jvm-intI <op> - (_.wrap #_t.Long)))] + (_.wrap descriptor.long)))] [i64::left-shift _.LSHL] [i64::arithmetic-right-shift _.LSHR] @@ -160,9 +162,9 @@ (Nullary Inst) (|>> <const> (_.wrap <type>)))] - [frac::smallest (_.double (Double::MIN_VALUE)) #_t.Double] - [frac::min (_.double (f.* -1.0 (Double::MAX_VALUE))) #_t.Double] - [frac::max (_.double (Double::MAX_VALUE)) #_t.Double] + [f64::smallest (_.double (Double::MIN_VALUE)) descriptor.double] + [f64::min (_.double (f.* -1.0 (Double::MAX_VALUE))) descriptor.double] + [f64::max (_.double (Double::MAX_VALUE)) descriptor.double] ) (template [<name> <type> <op>] @@ -173,25 +175,25 @@ <op> (_.wrap <type>)))] - [i64::+ #_t.Long _.LADD] - [i64::- #_t.Long _.LSUB] - [i64::* #_t.Long _.LMUL] - [i64::/ #_t.Long _.LDIV] - [i64::% #_t.Long _.LREM] + [i64::+ descriptor.long _.LADD] + [i64::- descriptor.long _.LSUB] + [i64::* descriptor.long _.LMUL] + [i64::/ descriptor.long _.LDIV] + [i64::% descriptor.long _.LREM] - [frac::+ #_t.Double _.DADD] - [frac::- #_t.Double _.DSUB] - [frac::* #_t.Double _.DMUL] - [frac::/ #_t.Double _.DDIV] - [frac::% #_t.Double _.DREM] + [f64::+ descriptor.double _.DADD] + [f64::- descriptor.double _.DSUB] + [f64::* descriptor.double _.DMUL] + [f64::/ descriptor.double _.DDIV] + [f64::% descriptor.double _.DREM] ) -(template [<eq> <lt> <unwrap> <cmp>] +(template [<eq> <lt> <descriptor> <cmp>] [(template [<name> <reference>] [(def: (<name> [paramI subjectI]) (Binary Inst) - (|>> subjectI <unwrap> - paramI <unwrap> + (|>> subjectI (_.unwrap <descriptor>) + paramI (_.unwrap <descriptor>) <cmp> (_.int <reference>) (predicateI _.IF_ICMPEQ)))] @@ -199,8 +201,8 @@ [<eq> +0] [<lt> -1])] - [i64::= i64::< (_.unwrap #_t.Long) _.LCMP] - [frac::= frac::< (_.unwrap #_t.Double) _.DCMPG] + [i64::= i64::< descriptor.long _.LCMP] + [f64::= f64::< descriptor.double _.DCMPG] ) (template [<name> <prepare> <transform>] @@ -208,22 +210,22 @@ (Unary Inst) (|>> inputI <prepare> <transform>))] - [i64::f64 (_.unwrap #_t.Long) (<| (_.wrap #_t.Double) _.L2D)] - [i64::char (_.unwrap #_t.Long) - ((|>> _.L2I _.I2C (_.INVOKESTATIC "java.lang.Character" "toString" (_t.method (list _t.char) (#.Some $String) (list)) #0)))] + [i64::f64 (_.unwrap descriptor.long) (<| (_.wrap descriptor.double) _.L2D)] + [i64::char (_.unwrap descriptor.long) + ((|>> _.L2I _.I2C (_.INVOKESTATIC (descriptor.class "java.lang.Character") "toString" (descriptor.method [(list descriptor.char) $String]) #0)))] - [frac::i64 (_.unwrap #_t.Double) (<| (_.wrap #_t.Long) _.D2L)] - [frac::encode (_.unwrap #_t.Double) - (_.INVOKESTATIC "java.lang.Double" "toString" (_t.method (list _t.double) (#.Some $String) (list)) #0)] - [frac::decode ..check-stringI - (_.INVOKESTATIC ///.runtime-class "decode_frac" (_t.method (list $String) (#.Some $Object-Array) (list)) #0)] + [f64::i64 (_.unwrap descriptor.double) (<| (_.wrap descriptor.long) _.D2L)] + [f64::encode (_.unwrap descriptor.double) + (_.INVOKESTATIC (descriptor.class "java.lang.Double") "toString" (descriptor.method [(list descriptor.double) $String]) #0)] + [f64::decode ..check-stringI + (_.INVOKESTATIC runtime.$Runtime "decode_frac" (descriptor.method [(list $String) ///.$Variant]) #0)] ) (def: (text::size inputI) (Unary Inst) (|>> inputI ..check-stringI - (_.INVOKEVIRTUAL "java.lang.String" "length" (_t.method (list) (#.Some _t.int) (list)) #0) + (_.INVOKEVIRTUAL $String "length" (descriptor.method [(list) descriptor.int]) #0) lux-intI)) (template [<name> <pre-subject> <pre-param> <op> <post>] @@ -234,13 +236,13 @@ <op> <post>))] [text::= (<|) (<|) - (_.INVOKEVIRTUAL "java.lang.Object" "equals" (_t.method (list ///.$Object) (#.Some _t.boolean) (list)) #0) - (_.wrap #_t.Boolean)] + (_.INVOKEVIRTUAL $Object "equals" (descriptor.method [(list $Object) descriptor.boolean]) #0) + (_.wrap descriptor.boolean)] [text::< ..check-stringI ..check-stringI - (_.INVOKEVIRTUAL "java.lang.String" "compareTo" (_t.method (list $String) (#.Some _t.int) (list)) #0) + (_.INVOKEVIRTUAL $String "compareTo" (descriptor.method [(list $String) descriptor.int]) #0) (predicateI _.IFLT)] [text::char ..check-stringI jvm-intI - (_.INVOKEVIRTUAL "java.lang.String" "charAt" (_t.method (list _t.int) (#.Some _t.char) (list)) #0) + (_.INVOKEVIRTUAL $String "charAt" (descriptor.method [(list descriptor.int) descriptor.char]) #0) lux-intI] ) @@ -248,16 +250,16 @@ (Binary Inst) (|>> leftI ..check-stringI rightI ..check-stringI - (_.INVOKEVIRTUAL "java.lang.String" "concat" (_t.method (list $String) (#.Some $String) (list)) #0))) + (_.INVOKEVIRTUAL $String "concat" (descriptor.method [(list $String) $String]) #0))) (def: (text::clip [startI endI subjectI]) (Trinary Inst) (|>> subjectI ..check-stringI startI jvm-intI endI jvm-intI - (_.INVOKEVIRTUAL "java.lang.String" "substring" (_t.method (list _t.int _t.int) (#.Some $String) (list)) #0))) + (_.INVOKEVIRTUAL $String "substring" (descriptor.method [(list descriptor.int descriptor.int) $String]) #0))) -(def: index-method Method (_t.method (list $String _t.int) (#.Some _t.int) (list))) +(def: index-method (descriptor.method [(list $String descriptor.int) descriptor.int])) (def: (text::index [startI partI textI]) (Trinary Inst) (<| _.with-label (function (_ @not-found)) @@ -265,7 +267,7 @@ (|>> textI ..check-stringI partI ..check-stringI startI jvm-intI - (_.INVOKEVIRTUAL "java.lang.String" "indexOf" index-method #0) + (_.INVOKEVIRTUAL $String "indexOf" index-method #0) _.DUP (_.int -1) (_.IF_ICMPEQ @not-found) @@ -277,34 +279,36 @@ runtime.noneI (_.label @end)))) -(def: string-method Method (_t.method (list $String) #.None (list))) +(def: string-method (descriptor.method [(list $String) descriptor.void])) (def: (io::log messageI) (Unary Inst) - (|>> (_.GETSTATIC "java.lang.System" "out" (_t.class "java.io.PrintStream" (list))) - messageI - ..check-stringI - (_.INVOKEVIRTUAL "java.io.PrintStream" "println" string-method #0) - unitI)) + (let [$PrintStream (descriptor.class "java.io.PrintStream")] + (|>> (_.GETSTATIC $System "out" $PrintStream) + messageI + ..check-stringI + (_.INVOKEVIRTUAL $PrintStream "println" string-method #0) + unitI))) (def: (io::error messageI) (Unary Inst) - (|>> (_.NEW "java.lang.Error") - _.DUP - messageI - ..check-stringI - (_.INVOKESPECIAL "java.lang.Error" "<init>" string-method #0) - _.ATHROW)) + (let [$Error (descriptor.class "java.lang.Error")] + (|>> (_.NEW $Error) + _.DUP + messageI + ..check-stringI + (_.INVOKESPECIAL $Error "<init>" string-method #0) + _.ATHROW))) (def: (io::exit codeI) (Unary Inst) (|>> codeI jvm-intI - (_.INVOKESTATIC "java.lang.System" "exit" (_t.method (list _t.int) #.None (list)) #0) + (_.INVOKESTATIC $System "exit" (descriptor.method [(list descriptor.int) descriptor.void]) #0) _.NULL)) (def: (io::current-time _) (Nullary Inst) - (|>> (_.INVOKESTATIC "java.lang.System" "currentTimeMillis" (_t.method (list) (#.Some _t.long) (list)) #0) - (_.wrap #_t.Long))) + (|>> (_.INVOKESTATIC $System "currentTimeMillis" (descriptor.method [(list) descriptor.long]) #0) + (_.wrap descriptor.long))) (def: bundle::lux Bundle @@ -337,19 +341,19 @@ Bundle (<| (bundle.prefix "f64") (|> (: Bundle bundle.empty) - (bundle.install "+" (binary frac::+)) - (bundle.install "-" (binary frac::-)) - (bundle.install "*" (binary frac::*)) - (bundle.install "/" (binary frac::/)) - (bundle.install "%" (binary frac::%)) - (bundle.install "=" (binary frac::=)) - (bundle.install "<" (binary frac::<)) - (bundle.install "smallest" (nullary frac::smallest)) - (bundle.install "min" (nullary frac::min)) - (bundle.install "max" (nullary frac::max)) - (bundle.install "i64" (unary frac::i64)) - (bundle.install "encode" (unary frac::encode)) - (bundle.install "decode" (unary frac::decode))))) + (bundle.install "+" (binary f64::+)) + (bundle.install "-" (binary f64::-)) + (bundle.install "*" (binary f64::*)) + (bundle.install "/" (binary f64::/)) + (bundle.install "%" (binary f64::%)) + (bundle.install "=" (binary f64::=)) + (bundle.install "<" (binary f64::<)) + (bundle.install "smallest" (nullary f64::smallest)) + (bundle.install "min" (nullary f64::min)) + (bundle.install "max" (nullary f64::max)) + (bundle.install "i64" (unary f64::i64)) + (bundle.install "encode" (unary f64::encode)) + (bundle.install "decode" (unary f64::decode))))) (def: bundle::text Bundle diff --git a/new-luxc/source/luxc/lang/translation/jvm/procedure/host.lux b/new-luxc/source/luxc/lang/translation/jvm/procedure/host.lux index 1b3d3c345..62fd37fdb 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/procedure/host.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/procedure/host.lux @@ -1,5 +1,5 @@ (.module: - [lux (#- Type primitive int char) + [lux (#- primitive int char) [abstract ["." monad (#+ do)]] [control @@ -11,7 +11,6 @@ [data ["." product] ["." maybe] - ["." error] [number ["." nat]] ["." text] @@ -21,7 +20,8 @@ ["." set]]] [target ["." jvm #_ - ["#" type (#+ Primitive Bound Generic Class Type Method Var Typed Argument Return) + ["." descriptor (#+ Descriptor Value Primitive Object Method)] + ["#" type (#+ Bound Generic Class Var Typed Argument Return) ["." box] ["." reflection]]]] [tool @@ -64,7 +64,7 @@ [L2C (|>> _.L2I _.I2C)] ) -(template [<name> <unwrap> <conversion> <wrap>] +(template [<conversion> <name>] [(def: (<name> inputI) (Unary Inst) (if (is? _.NOP <conversion>) @@ -72,30 +72,30 @@ (|>> inputI <conversion>)))] - [conversion::double-to-float #jvm.Double _.D2F #jvm.Float] - [conversion::double-to-int #jvm.Double _.D2I #jvm.Int] - [conversion::double-to-long #jvm.Double _.D2L #jvm.Long] - [conversion::float-to-double #jvm.Float _.F2D #jvm.Double] - [conversion::float-to-int #jvm.Float _.F2I #jvm.Int] - [conversion::float-to-long #jvm.Float _.F2L #jvm.Long] - [conversion::int-to-byte #jvm.Int _.I2B #jvm.Byte] - [conversion::int-to-char #jvm.Int _.I2C #jvm.Char] - [conversion::int-to-double #jvm.Int _.I2D #jvm.Double] - [conversion::int-to-float #jvm.Int _.I2F #jvm.Float] - [conversion::int-to-long #jvm.Int _.I2L #jvm.Long] - [conversion::int-to-short #jvm.Int _.I2S #jvm.Short] - [conversion::long-to-double #jvm.Long _.L2D #jvm.Double] - [conversion::long-to-float #jvm.Long _.L2F #jvm.Float] - [conversion::long-to-int #jvm.Long _.L2I #jvm.Int] - [conversion::long-to-short #jvm.Long L2S #jvm.Short] - [conversion::long-to-byte #jvm.Long L2B #jvm.Byte] - [conversion::long-to-char #jvm.Long L2C #jvm.Char] - [conversion::char-to-byte #jvm.Char _.I2B #jvm.Byte] - [conversion::char-to-short #jvm.Char _.I2S #jvm.Short] - [conversion::char-to-int #jvm.Char _.NOP #jvm.Int] - [conversion::char-to-long #jvm.Char _.I2L #jvm.Long] - [conversion::byte-to-long #jvm.Byte _.I2L #jvm.Long] - [conversion::short-to-long #jvm.Short _.I2L #jvm.Long] + [_.D2F conversion::double-to-float] + [_.D2I conversion::double-to-int] + [_.D2L conversion::double-to-long] + [_.F2D conversion::float-to-double] + [_.F2I conversion::float-to-int] + [_.F2L conversion::float-to-long] + [_.I2B conversion::int-to-byte] + [_.I2C conversion::int-to-char] + [_.I2D conversion::int-to-double] + [_.I2F conversion::int-to-float] + [_.I2L conversion::int-to-long] + [_.I2S conversion::int-to-short] + [_.L2D conversion::long-to-double] + [_.L2F conversion::long-to-float] + [_.L2I conversion::long-to-int] + [..L2S conversion::long-to-short] + [..L2B conversion::long-to-byte] + [..L2C conversion::long-to-char] + [_.I2B conversion::char-to-byte] + [_.I2S conversion::char-to-short] + [_.NOP conversion::char-to-int] + [_.I2L conversion::char-to-long] + [_.I2L conversion::byte-to-long] + [_.I2L conversion::short-to-long] ) (def: conversion @@ -172,9 +172,9 @@ [double::% _.DREM] ) -(def: boolean-class (jvm.class box.boolean (list))) -(def: falseI (_.GETSTATIC "java.lang.Boolean" "FALSE" boolean-class)) -(def: trueI (_.GETSTATIC "java.lang.Boolean" "TRUE" boolean-class)) +(def: $Boolean (descriptor.class box.boolean)) +(def: falseI (_.GETSTATIC $Boolean "FALSE" $Boolean)) +(def: trueI (_.GETSTATIC $Boolean "TRUE" $Boolean)) (template [<name> <op>] [(def: (<name> [xI yI]) @@ -296,28 +296,29 @@ ))) (def: (array-java-type nesting elem-class) - (-> Nat Text Type) - (jvm.array nesting - (case elem-class - (^ (static reflection.boolean)) jvm.boolean - (^ (static reflection.byte)) jvm.byte - (^ (static reflection.short)) jvm.short - (^ (static reflection.int)) jvm.int - (^ (static reflection.long)) jvm.long - (^ (static reflection.float)) jvm.float - (^ (static reflection.double)) jvm.double - (^ (static reflection.char)) jvm.char - _ (jvm.class elem-class (list))))) + (-> Nat Text (Descriptor Object)) + (descriptor.array (case nesting + 1 (case elem-class + (^ (static reflection.boolean)) descriptor.boolean + (^ (static reflection.byte)) descriptor.byte + (^ (static reflection.short)) descriptor.short + (^ (static reflection.int)) descriptor.int + (^ (static reflection.long)) descriptor.long + (^ (static reflection.float)) descriptor.float + (^ (static reflection.double)) descriptor.double + (^ (static reflection.char)) descriptor.char + _ (descriptor.class elem-class)) + _ (array-java-type (dec nesting) elem-class)))) (def: (primitive-array-length-handler jvm-primitive) - (-> Type Handler) + (-> (Descriptor Primitive) Handler) (..custom [<s>.any (function (_ extension-name generate arrayS) (do phase.monad [arrayI (generate arrayS)] (wrap (|>> arrayI - (_.CHECKCAST (jvm.descriptor (jvm.array 1 jvm-primitive))) + (_.CHECKCAST (descriptor.array jvm-primitive)) _.ARRAYLENGTH))))])) (def: (array::length::object extension-name generate inputs) @@ -329,14 +330,14 @@ (do phase.monad [arrayI (generate arrayS)] (wrap (|>> arrayI - (_.CHECKCAST (jvm.descriptor (array-java-type (.nat nesting) elem-class))) + (_.CHECKCAST (array-java-type (.nat nesting) elem-class)) _.ARRAYLENGTH))) _ (phase.throw extension.invalid-syntax [extension-name %synthesis inputs]))) (def: (new-primitive-array-handler jvm-primitive) - (-> Type Handler) + (-> (Descriptor Primitive) Handler) (function (_ extension-name generate inputs) (case inputs (^ (list lengthS)) @@ -363,7 +364,7 @@ (phase.throw extension.invalid-syntax [extension-name %synthesis inputs]))) (def: (read-primitive-array-handler jvm-primitive loadI) - (-> Type Inst Handler) + (-> (Descriptor Primitive) Inst Handler) (function (_ extension-name generate inputs) (case inputs (^ (list idxS arrayS)) @@ -371,7 +372,7 @@ [arrayI (generate arrayS) idxI (generate idxS)] (wrap (|>> arrayI - (_.CHECKCAST (jvm.descriptor (jvm.array 1 jvm-primitive))) + (_.CHECKCAST (descriptor.array jvm-primitive)) idxI loadI))) @@ -389,7 +390,7 @@ [arrayI (generate arrayS) idxI (generate idxS)] (wrap (|>> arrayI - (_.CHECKCAST (jvm.descriptor (array-java-type (.nat nesting) elem-class))) + (_.CHECKCAST (array-java-type (.nat nesting) elem-class)) idxI _.AALOAD))) @@ -397,7 +398,7 @@ (phase.throw extension.invalid-syntax [extension-name %synthesis inputs]))) (def: (write-primitive-array-handler jvm-primitive storeI) - (-> Type Inst Handler) + (-> (Descriptor Primitive) Inst Handler) (function (_ extension-name generate inputs) (case inputs (^ (list idxS valueS arrayS)) @@ -406,7 +407,7 @@ idxI (generate idxS) valueI (generate valueS)] (wrap (|>> arrayI - (_.CHECKCAST (jvm.descriptor (jvm.array 1 jvm-primitive))) + (_.CHECKCAST (descriptor.array jvm-primitive)) _.DUP idxI valueI @@ -428,7 +429,7 @@ idxI (generate idxS) valueI (generate valueS)] (wrap (|>> arrayI - (_.CHECKCAST (jvm.descriptor (array-java-type (.nat nesting) elem-class))) + (_.CHECKCAST (array-java-type (.nat nesting) elem-class)) _.DUP idxI valueI @@ -443,47 +444,47 @@ (|> bundle.empty (dictionary.merge (<| (bundle.prefix "length") (|> bundle.empty - (bundle.install reflection.boolean (primitive-array-length-handler jvm.boolean)) - (bundle.install reflection.byte (primitive-array-length-handler jvm.byte)) - (bundle.install reflection.short (primitive-array-length-handler jvm.short)) - (bundle.install reflection.int (primitive-array-length-handler jvm.int)) - (bundle.install reflection.long (primitive-array-length-handler jvm.long)) - (bundle.install reflection.float (primitive-array-length-handler jvm.float)) - (bundle.install reflection.double (primitive-array-length-handler jvm.double)) - (bundle.install reflection.char (primitive-array-length-handler jvm.char)) + (bundle.install reflection.boolean (primitive-array-length-handler descriptor.boolean)) + (bundle.install reflection.byte (primitive-array-length-handler descriptor.byte)) + (bundle.install reflection.short (primitive-array-length-handler descriptor.short)) + (bundle.install reflection.int (primitive-array-length-handler descriptor.int)) + (bundle.install reflection.long (primitive-array-length-handler descriptor.long)) + (bundle.install reflection.float (primitive-array-length-handler descriptor.float)) + (bundle.install reflection.double (primitive-array-length-handler descriptor.double)) + (bundle.install reflection.char (primitive-array-length-handler descriptor.char)) (bundle.install "object" array::length::object)))) (dictionary.merge (<| (bundle.prefix "new") (|> bundle.empty - (bundle.install reflection.boolean (new-primitive-array-handler jvm.boolean)) - (bundle.install reflection.byte (new-primitive-array-handler jvm.byte)) - (bundle.install reflection.short (new-primitive-array-handler jvm.short)) - (bundle.install reflection.int (new-primitive-array-handler jvm.int)) - (bundle.install reflection.long (new-primitive-array-handler jvm.long)) - (bundle.install reflection.float (new-primitive-array-handler jvm.float)) - (bundle.install reflection.double (new-primitive-array-handler jvm.double)) - (bundle.install reflection.char (new-primitive-array-handler jvm.char)) + (bundle.install reflection.boolean (new-primitive-array-handler descriptor.boolean)) + (bundle.install reflection.byte (new-primitive-array-handler descriptor.byte)) + (bundle.install reflection.short (new-primitive-array-handler descriptor.short)) + (bundle.install reflection.int (new-primitive-array-handler descriptor.int)) + (bundle.install reflection.long (new-primitive-array-handler descriptor.long)) + (bundle.install reflection.float (new-primitive-array-handler descriptor.float)) + (bundle.install reflection.double (new-primitive-array-handler descriptor.double)) + (bundle.install reflection.char (new-primitive-array-handler descriptor.char)) (bundle.install "object" array::new::object)))) (dictionary.merge (<| (bundle.prefix "read") (|> bundle.empty - (bundle.install reflection.boolean (read-primitive-array-handler jvm.boolean _.BALOAD)) - (bundle.install reflection.byte (read-primitive-array-handler jvm.byte _.BALOAD)) - (bundle.install reflection.short (read-primitive-array-handler jvm.short _.SALOAD)) - (bundle.install reflection.int (read-primitive-array-handler jvm.int _.IALOAD)) - (bundle.install reflection.long (read-primitive-array-handler jvm.long _.LALOAD)) - (bundle.install reflection.float (read-primitive-array-handler jvm.float _.FALOAD)) - (bundle.install reflection.double (read-primitive-array-handler jvm.double _.DALOAD)) - (bundle.install reflection.char (read-primitive-array-handler jvm.char _.CALOAD)) + (bundle.install reflection.boolean (read-primitive-array-handler descriptor.boolean _.BALOAD)) + (bundle.install reflection.byte (read-primitive-array-handler descriptor.byte _.BALOAD)) + (bundle.install reflection.short (read-primitive-array-handler descriptor.short _.SALOAD)) + (bundle.install reflection.int (read-primitive-array-handler descriptor.int _.IALOAD)) + (bundle.install reflection.long (read-primitive-array-handler descriptor.long _.LALOAD)) + (bundle.install reflection.float (read-primitive-array-handler descriptor.float _.FALOAD)) + (bundle.install reflection.double (read-primitive-array-handler descriptor.double _.DALOAD)) + (bundle.install reflection.char (read-primitive-array-handler descriptor.char _.CALOAD)) (bundle.install "object" array::read::object)))) (dictionary.merge (<| (bundle.prefix "write") (|> bundle.empty - (bundle.install reflection.boolean (write-primitive-array-handler jvm.boolean _.BASTORE)) - (bundle.install reflection.byte (write-primitive-array-handler jvm.byte _.BASTORE)) - (bundle.install reflection.short (write-primitive-array-handler jvm.short _.SASTORE)) - (bundle.install reflection.int (write-primitive-array-handler jvm.int _.IASTORE)) - (bundle.install reflection.long (write-primitive-array-handler jvm.long _.LASTORE)) - (bundle.install reflection.float (write-primitive-array-handler jvm.float _.FASTORE)) - (bundle.install reflection.double (write-primitive-array-handler jvm.double _.DASTORE)) - (bundle.install reflection.char (write-primitive-array-handler jvm.char _.CASTORE)) + (bundle.install reflection.boolean (write-primitive-array-handler descriptor.boolean _.BASTORE)) + (bundle.install reflection.byte (write-primitive-array-handler descriptor.byte _.BASTORE)) + (bundle.install reflection.short (write-primitive-array-handler descriptor.short _.SASTORE)) + (bundle.install reflection.int (write-primitive-array-handler descriptor.int _.IASTORE)) + (bundle.install reflection.long (write-primitive-array-handler descriptor.long _.LASTORE)) + (bundle.install reflection.float (write-primitive-array-handler descriptor.float _.FASTORE)) + (bundle.install reflection.double (write-primitive-array-handler descriptor.double _.DASTORE)) + (bundle.install reflection.char (write-primitive-array-handler descriptor.char _.CASTORE)) (bundle.install "object" array::write::object)))) ))) @@ -517,6 +518,8 @@ (|>> exceptionI _.ATHROW)) +(def: $Class (descriptor.class "java.lang.Class")) + (def: (object::class extension-name generate inputs) Handler (case inputs @@ -524,10 +527,9 @@ (do phase.monad [] (wrap (|>> (_.string class) - (_.INVOKESTATIC "java.lang.Class" "forName" - (jvm.method (list (jvm.class "java.lang.String" (list))) - (#.Some (jvm.class "java.lang.Class" (list))) - (list)) + (_.INVOKESTATIC $Class "forName" + (descriptor.method [(list (descriptor.class "java.lang.String")) + $Class]) false)))) _ @@ -541,8 +543,8 @@ (do phase.monad [objectI (generate objectS)] (wrap (|>> objectI - (_.INSTANCEOF class) - (_.wrap #jvm.Boolean)))))])) + (_.INSTANCEOF (descriptor.class class)) + (_.wrap descriptor.boolean)))))])) (def: (object::cast extension-name generate inputs) Handler @@ -558,14 +560,14 @@ (^ [(static <object>) (static <primitive>)]) (wrap (|>> valueI (_.unwrap <type>)))) - ([reflection.boolean box.boolean #jvm.Boolean] - [reflection.byte box.byte #jvm.Byte] - [reflection.short box.short #jvm.Short] - [reflection.int box.int #jvm.Int] - [reflection.long box.long #jvm.Long] - [reflection.float box.float #jvm.Float] - [reflection.double box.double #jvm.Double] - [reflection.char box.char #jvm.Char]) + ([reflection.boolean box.boolean descriptor.boolean] + [reflection.byte box.byte descriptor.byte] + [reflection.short box.short descriptor.short] + [reflection.int box.int descriptor.int] + [reflection.long box.long descriptor.long] + [reflection.float box.float descriptor.float] + [reflection.double box.double descriptor.double] + [reflection.char box.char descriptor.char]) _ (wrap valueI))) @@ -587,15 +589,15 @@ ))) (def: primitives - (Dictionary Text Primitive) - (|> (list [reflection.boolean #jvm.Boolean] - [reflection.byte #jvm.Byte] - [reflection.short #jvm.Short] - [reflection.int #jvm.Int] - [reflection.long #jvm.Long] - [reflection.float #jvm.Float] - [reflection.double #jvm.Double] - [reflection.char #jvm.Char]) + (Dictionary Text (Descriptor Primitive)) + (|> (list [reflection.boolean descriptor.boolean] + [reflection.byte descriptor.byte] + [reflection.short descriptor.short] + [reflection.int descriptor.int] + [reflection.long descriptor.long] + [reflection.float descriptor.float] + [reflection.double descriptor.double] + [reflection.char descriptor.char]) (dictionary.from-list text.hash))) (def: (static::get extension-name generate inputs) @@ -606,12 +608,12 @@ (synthesis.text unboxed))) (do phase.monad [] - (case (dictionary.get unboxed primitives) + (case (dictionary.get unboxed ..primitives) (#.Some primitive) - (wrap (_.GETSTATIC class field (#jvm.Primitive primitive))) + (wrap (_.GETSTATIC (descriptor.class class) field primitive)) #.None - (wrap (_.GETSTATIC class field (jvm.class unboxed (list)))))) + (wrap (_.GETSTATIC (descriptor.class class) field (descriptor.class unboxed))))) _ (phase.throw extension.invalid-syntax [extension-name %synthesis inputs]))) @@ -624,17 +626,18 @@ (synthesis.text unboxed) valueS)) (do phase.monad - [valueI (generate valueS)] - (case (dictionary.get unboxed primitives) + [valueI (generate valueS) + #let [$class (descriptor.class class)]] + (case (dictionary.get unboxed ..primitives) (#.Some primitive) (wrap (|>> valueI - (_.PUTSTATIC class field (#jvm.Primitive primitive)) + (_.PUTSTATIC $class field primitive) (_.string synthesis.unit))) #.None (wrap (|>> valueI - (_.CHECKCAST class) - (_.PUTSTATIC class field (jvm.class class (list))) + (_.CHECKCAST $class) + (_.PUTSTATIC $class field $class) (_.string synthesis.unit))))) _ @@ -648,17 +651,17 @@ (synthesis.text unboxed) objectS)) (do phase.monad - [objectI (generate objectS)] - (case (dictionary.get unboxed primitives) - (#.Some primitive) - (wrap (|>> objectI - (_.CHECKCAST class) - (_.GETFIELD class field (#jvm.Primitive primitive)))) - - #.None - (wrap (|>> objectI - (_.CHECKCAST class) - (_.GETFIELD class field (jvm.class unboxed (list))))))) + [objectI (generate objectS) + #let [$class (descriptor.class class) + getI (case (dictionary.get unboxed ..primitives) + (#.Some primitive) + (_.GETFIELD $class field primitive) + + #.None + (_.GETFIELD $class field (descriptor.class unboxed)))]] + (wrap (|>> objectI + (_.CHECKCAST $class) + getI))) _ (phase.throw extension.invalid-syntax [extension-name %synthesis inputs]))) @@ -673,22 +676,21 @@ objectS)) (do phase.monad [valueI (generate valueS) - objectI (generate objectS)] - (case (dictionary.get unboxed primitives) - (#.Some primitive) - (wrap (|>> objectI - (_.CHECKCAST class) - _.DUP - valueI - (_.PUTFIELD class field (#jvm.Primitive primitive)))) - - #.None - (wrap (|>> objectI - (_.CHECKCAST class) - _.DUP - valueI - (_.CHECKCAST unboxed) - (_.PUTFIELD class field (jvm.class unboxed (list))))))) + objectI (generate objectS) + #let [$class (descriptor.class class) + putI (case (dictionary.get unboxed ..primitives) + (#.Some primitive) + (_.PUTFIELD $class field primitive) + + #.None + (let [$unboxed (descriptor.class unboxed)] + (|>> (_.CHECKCAST $unboxed) + (_.PUTFIELD $class field $unboxed))))]] + (wrap (|>> objectI + (_.CHECKCAST $class) + _.DUP + valueI + putI))) _ (phase.throw extension.invalid-syntax [extension-name %synthesis inputs]))) @@ -709,7 +711,7 @@ (def: (method-return-type description) (-> Text (Operation Return)) (case description - (^ (static jvm.void-descriptor)) + (^ (static descriptor.void)) (phase@wrap #.None) _ @@ -747,7 +749,8 @@ returnT (method-return-type unboxed)] (wrap (|>> (_.fuse (list@map ..prepare-argI argsTI)) (_.INVOKESTATIC class method - (jvm.method (list@map product.left argsTI) returnT (list)) + (descriptor.method [(list@map product.left argsTI) + returnT]) false) (prepare-returnI returnT)))))])) @@ -765,7 +768,8 @@ (_.CHECKCAST class) (_.fuse (list@map ..prepare-argI argsTI)) (<invoke> class method - (jvm.method (list@map product.left argsTI) returnT (list)) + (descriptor.method [(list@map product.left argsTI) + returnT]) <interface?>) (prepare-returnI returnT)))))]))] @@ -784,7 +788,8 @@ _.DUP (_.fuse (list@map ..prepare-argI argsTI)) (_.INVOKESPECIAL class "<init>" - (jvm.method (list@map product.left argsTI) #.None (list)) + (descriptor.method [(list@map product.left argsTI) + descriptor.void]) false)))) _ @@ -840,16 +845,24 @@ (class' ..generic)) (def: primitive - (Parser Primitive) + (Parser (Descriptor Primitive)) ($_ <>.or - (<s>.constant! ["" reflection.boolean]) - (<s>.constant! ["" reflection.byte]) - (<s>.constant! ["" reflection.short]) - (<s>.constant! ["" reflection.int]) - (<s>.constant! ["" reflection.long]) - (<s>.constant! ["" reflection.float]) - (<s>.constant! ["" reflection.double]) - (<s>.constant! ["" reflection.char]) + (<>.after (<s>.constant! ["" reflection.boolean]) + (<>@wrap descriptor.boolean)) + (<>.after (<s>.constant! ["" reflection.byte]) + (<>@wrap descriptor.byte)) + (<>.after (<s>.constant! ["" reflection.short]) + (<>@wrap descriptor.short)) + (<>.after (<s>.constant! ["" reflection.int]) + (<>@wrap descriptor.int)) + (<>.after (<s>.constant! ["" reflection.long]) + (<>@wrap descriptor.long)) + (<>.after (<s>.constant! ["" reflection.float]) + (<>@wrap descriptor.float)) + (<>.after (<s>.constant! ["" reflection.double]) + (<>@wrap descriptor.double)) + (<>.after (<s>.constant! ["" reflection.char]) + (<>@wrap descriptor.char)) )) (def: jvm-type @@ -879,7 +892,7 @@ (def: return (Parser Return) - (<>.or (<s>.constant! ["" jvm.void-descriptor]) + (<>.or (<s>.constant! ["" (descriptor.descriptor descriptor.void)]) ..jvm-type)) (def: overriden-method-definition @@ -976,13 +989,12 @@ (#synthesis.Extension [name inputsS+]) (#synthesis.Extension [name (list@map recur inputsS+)])))) -(def: $Object (jvm.class jvm.object-class (list))) +(def: $Object (descriptor.class "java.lang.Object")) (def: (anonymous-init-method env) - (-> Environment Method) - (jvm.method (list.repeat (list.size env) $Object) - #.None - (list))) + (-> Environment (Descriptor Method)) + (descriptor.method [(list.repeat (list.size env) $Object) + descriptor.void])) (def: (with-anonymous-init class env super-class constructor-argsI) (-> Text Environment Class (List (Typed Inst)) Def) @@ -999,7 +1011,8 @@ ((_.fuse (list@map product.right constructor-argsI))) (_.INVOKESPECIAL (product.left super-class) "<init>" - (jvm.method (list@map product.left constructor-argsI) #.None (list)) + (descriptor.method [(list@map product.left constructor-argsI) + descriptor.void]) #0) store-capturedI _.RETURN)))) @@ -1077,10 +1090,11 @@ ($_ $.++M $.finalM $.strictM) $.finalM) name - (jvm.method (list@map product.right arguments) - returnT - (list@map (|>> #jvm.Class) - exceptionsT)) + (descriptor.method [(list@map product.right arguments) + returnT] + ## (list@map (|>> #jvm.Class) + ## exceptionsT) + ) (let [returnI (case returnT (#.Some returnT) (case returnT diff --git a/new-luxc/source/luxc/lang/translation/jvm/reference.lux b/new-luxc/source/luxc/lang/translation/jvm/reference.lux index 5fb0e0d63..8352c7d6f 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/reference.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/reference.lux @@ -5,6 +5,9 @@ [data [text ["%" format (#+ format)]]] + [target + [jvm + ["." descriptor]]] [tool [compiler ["." name] @@ -32,9 +35,9 @@ (do phase.monad [function-class generation.context] (wrap (|>> (_.ALOAD 0) - (_.GETFIELD function-class + (_.GETFIELD (descriptor.class function-class) (|> variable .nat foreign-name) - //.$Object))))) + //.$Value))))) (def: local (-> Register Inst) @@ -53,4 +56,4 @@ (-> Name (Operation Inst)) (do phase.monad [bytecode-name (generation.remember name)] - (wrap (_.GETSTATIC bytecode-name //.value-field //.$Object)))) + (wrap (_.GETSTATIC (descriptor.class bytecode-name) //.value-field //.$Value)))) diff --git a/new-luxc/source/luxc/lang/translation/jvm/runtime.lux b/new-luxc/source/luxc/lang/translation/jvm/runtime.lux index 05d43a367..755ae7a3b 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/runtime.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/runtime.lux @@ -1,5 +1,5 @@ (.module: - [lux (#- Type) + [lux #* [abstract [monad (#+ do)]] [data @@ -8,7 +8,8 @@ ["." math] [target [jvm - ["$t" type (#+ Type Method)]]] + ["." descriptor (#+ Descriptor)] + ["$t" type]]] [tool [compiler [arity (#+ Arity)] @@ -23,33 +24,36 @@ ["_" inst]]]]] ["." // (#+ ByteCode)]) -(def: $Object Type ($t.class "java.lang.Object" (list))) -(def: $Object-Array Type ($t.array 1 $Object)) -(def: $String Type ($t.class "java.lang.String" (list))) -(def: #export $Stack Type ($t.array 1 $Object)) -(def: #export $Tuple Type $Object-Array) -(def: #export $Variant Type $Object-Array) -(def: #export $Tag Type $t.int) -(def: #export $Flag Type $Object) -(def: #export $Datum Type $Object) -(def: #export $Function Type ($t.class //.function-class (list))) -(def: $Throwable Type ($t.class "java.lang.Throwable" (list))) -(def: $Runtime Type ($t.class "java.lang.Runtime" (list))) +(def: $Text (descriptor.class "java.lang.String")) +(def: #export $Tag descriptor.int) +(def: #export $Flag (descriptor.class "java.lang.Object")) +(def: #export $Value (descriptor.class "java.lang.Object")) +(def: #export $Index descriptor.int) +(def: #export $Stack (descriptor.array $Value)) +(def: $Throwable (descriptor.class "java.lang.Throwable")) +(def: #export $Runtime (descriptor.class "java.lang.Runtime")) + +(def: nullary-init-methodT + (descriptor.method [(list) descriptor.void])) + +(def: throw-methodT + (descriptor.method [(list) descriptor.void])) (def: #export logI Inst - (let [outI (_.GETSTATIC "java.lang.System" "out" ($t.class "java.io.PrintStream" (list))) - printI (function (_ method) (_.INVOKEVIRTUAL "java.io.PrintStream" method ($t.method (list $Object) #.None (list)) #0))] + (let [PrintStream (descriptor.class "java.io.PrintStream") + outI (_.GETSTATIC (descriptor.class "java.lang.System") "out" PrintStream) + printI (function (_ method) + (_.INVOKEVIRTUAL PrintStream method (descriptor.method [(list $Value) descriptor.void]) #0))] (|>> outI (_.string "LOG: ") (printI "print") outI _.SWAP (printI "println")))) (def: variant-method - Method - ($t.method (list $t.int $Object $Object) (#.Some $Object-Array) (list))) + (descriptor.method [(list $Tag $Flag $Value) //.$Variant])) (def: #export variantI Inst - (_.INVOKESTATIC //.runtime-class "variant_make" variant-method #0)) + (_.INVOKESTATIC (descriptor.class //.runtime-class) "variant_make" variant-method #0)) (def: #export leftI Inst @@ -81,7 +85,7 @@ (<| _.with-label (function (_ @from)) _.with-label (function (_ @to)) _.with-label (function (_ @handler)) - (|>> (_.try @from @to @handler "java.lang.Exception") + (|>> (_.try @from @to @handler (descriptor.class "java.lang.Exception")) (_.label @from) unsafeI someI @@ -93,27 +97,25 @@ (def: #export string-concatI Inst - (_.INVOKEVIRTUAL "java.lang.String" "concat" ($t.method (list $String) (#.Some $String) (list)) #0)) + (_.INVOKEVIRTUAL $Text "concat" (descriptor.method [(list $Text) $Text]) #0)) (def: #export partials-field Text "partials") (def: #export apply-method Text "apply") (def: #export num-apply-variants Nat 8) (def: #export (apply-signature arity) - (-> Arity Method) - ($t.method (list.repeat arity $Object) (#.Some $Object) (list))) + (-> Arity (Descriptor descriptor.Method)) + (descriptor.method [(list.repeat arity $Value) $Value])) (def: adt-methods Def - (let [store-tagI (|>> _.DUP (_.int +0) (_.ILOAD 0) (_.wrap #$t.Int) _.AASTORE) + (let [store-tagI (|>> _.DUP (_.int +0) (_.ILOAD 0) (_.wrap descriptor.int) _.AASTORE) store-flagI (|>> _.DUP (_.int +1) (_.ALOAD 1) _.AASTORE) store-valueI (|>> _.DUP (_.int +2) (_.ALOAD 2) _.AASTORE)] (|>> ($d.method #$.Public $.staticM "variant_make" - ($t.method (list $t.int $Object $Object) - (#.Some $Variant) - (list)) + (descriptor.method [(list $Tag $Flag $Value) //.$Variant]) (|>> (_.int +3) - (_.array $Object) + (_.array //.$Variant) store-tagI store-flagI store-valueI @@ -123,22 +125,30 @@ (def: frac-methods Def - (|>> ($d.method #$.Public $.staticM "decode_frac" ($t.method (list $String) (#.Some $Object-Array) (list)) + (|>> ($d.method #$.Public $.staticM "decode_frac" (descriptor.method [(list $Text) //.$Variant]) (try-methodI (|>> (_.ALOAD 0) - (_.INVOKESTATIC "java.lang.Double" "parseDouble" ($t.method (list $String) (#.Some $t.double) (list)) #0) - (_.wrap #$t.Double)))) + (_.INVOKESTATIC (descriptor.class "java.lang.Double") "parseDouble" (descriptor.method [(list $Text) descriptor.double]) #0) + (_.wrap descriptor.double)))) )) (def: #export popI (|>> (_.int +1) _.AALOAD - (_.CHECKCAST ($t.descriptor $Stack)))) + (_.CHECKCAST $Stack))) (def: #export peekI (|>> (_.int +0) _.AALOAD)) +(def: (illegal-state-exception message) + (-> Text Inst) + (let [IllegalStateException (descriptor.class "java.lang.IllegalStateException")] + (|>> (_.NEW IllegalStateException) + _.DUP + (_.string message) + (_.INVOKESPECIAL IllegalStateException "<init>" (descriptor.method [(list $Text) descriptor.void]) #0)))) + (def: pm-methods Def (let [tuple-sizeI (|>> (_.ALOAD 0) _.ARRAYLENGTH) @@ -148,27 +158,21 @@ sub-leftsI (|>> leftsI last-rightI _.ISUB) - sub-tupleI (|>> (_.ALOAD 0) last-rightI _.AALOAD (_.CHECKCAST ($t.descriptor $Tuple))) + sub-tupleI (|>> (_.ALOAD 0) last-rightI _.AALOAD (_.CHECKCAST //.$Tuple)) recurI (: (-> Label Inst) (function (_ @loop) (|>> sub-leftsI (_.ISTORE 1) sub-tupleI (_.ASTORE 0) (_.GOTO @loop))))] - (|>> ($d.method #$.Public $.staticM "pm_fail" ($t.method (list) #.None (list)) - (|>> (_.NEW "java.lang.IllegalStateException") - _.DUP - (_.string "Invalid expression for pattern-matching.") - (_.INVOKESPECIAL "java.lang.IllegalStateException" "<init>" ($t.method (list $String) #.None (list)) #0) + (|>> ($d.method #$.Public $.staticM "pm_fail" throw-methodT + (|>> (illegal-state-exception "Invalid expression for pattern-matching.") _.ATHROW)) - ($d.method #$.Public $.staticM "apply_fail" ($t.method (list) #.None (list)) - (|>> (_.NEW "java.lang.IllegalStateException") - _.DUP - (_.string "Error while applying function.") - (_.INVOKESPECIAL "java.lang.IllegalStateException" "<init>" ($t.method (list $String) #.None (list)) #0) + ($d.method #$.Public $.staticM "apply_fail" throw-methodT + (|>> (illegal-state-exception "Error while applying function.") _.ATHROW)) - ($d.method #$.Public $.staticM "pm_push" ($t.method (list $Stack $Object) (#.Some $Stack) (list)) + ($d.method #$.Public $.staticM "pm_push" (descriptor.method [(list $Stack $Value) $Stack]) (|>> (_.int +2) - (_.ANEWARRAY "java.lang.Object") + (_.ANEWARRAY $Stack) _.DUP (_.int +1) (_.ALOAD 0) @@ -178,7 +182,7 @@ (_.ALOAD 1) _.AASTORE _.ARETURN)) - ($d.method #$.Public $.staticM "pm_variant" ($t.method (list $Variant $Tag $Flag) (#.Some $Object) (list)) + ($d.method #$.Public $.staticM "pm_variant" (descriptor.method [(list //.$Variant $Tag $Flag) $Value]) (<| _.with-label (function (_ @loop)) _.with-label (function (_ @just-return)) _.with-label (function (_ @then)) @@ -189,7 +193,7 @@ (function (_ idx) (|>> (_.int (.int idx)) _.AALOAD))) tagI (: Inst - (|>> (variant-partI 0) (_.unwrap #$t.Int))) + (|>> (variant-partI 0) (_.unwrap descriptor.int))) flagI (variant-partI 1) datumI (variant-partI 2) shortenI (|>> (_.ALOAD 0) tagI ## Get tag @@ -199,7 +203,7 @@ variantI ## Build sum _.ARETURN) update-tagI (|>> _.ISUB (_.ISTORE 1)) - update-variantI (|>> (_.ALOAD 0) datumI (_.CHECKCAST ($t.descriptor $Variant)) (_.ASTORE 0)) + update-variantI (|>> (_.ALOAD 0) datumI (_.CHECKCAST //.$Variant) (_.ASTORE 0)) failureI (|>> _.NULL _.ARETURN) return-datumI (|>> (_.ALOAD 0) datumI _.ARETURN)]) (|>> (_.label @loop) @@ -230,7 +234,7 @@ (_.label @wrong) ## tag, sumT ## _.POP2 failureI))) - ($d.method #$.Public $.staticM "tuple_left" ($t.method (list $Tuple $t.int) (#.Some $Object) (list)) + ($d.method #$.Public $.staticM "tuple_left" (descriptor.method [(list //.$Tuple $Index) $Value]) (<| _.with-label (function (_ @loop)) _.with-label (function (_ @recursive)) (let [left-accessI (|>> (_.ALOAD 0) left-indexI _.AALOAD)]) @@ -241,7 +245,7 @@ (_.label @recursive) ## Recursive (recurI @loop)))) - ($d.method #$.Public $.staticM "tuple_right" ($t.method (list $Tuple $t.int) (#.Some $Object) (list)) + ($d.method #$.Public $.staticM "tuple_right" (descriptor.method [(list //.$Tuple $Index) $Value]) (<| _.with-label (function (_ @loop)) _.with-label (function (_ @not-tail)) _.with-label (function (_ @slice)) @@ -254,10 +258,9 @@ sub-rightI (|>> (_.ALOAD 0) right-indexI tuple-sizeI - (_.INVOKESTATIC "java.util.Arrays" "copyOfRange" - ($t.method (list $Object-Array $t.int $t.int) - (#.Some $Object-Array) - (list)) + (_.INVOKESTATIC (descriptor.class "java.util.Arrays") "copyOfRange" + (descriptor.method [(list //.$Tuple $Index $Index) + //.$Tuple]) #0))]) (|>> (_.label @loop) last-rightI right-indexI @@ -277,26 +280,28 @@ (def: io-methods Def - (let [string-writerI (|>> (_.NEW "java.io.StringWriter") + (let [StringWriter (descriptor.class "java.io.StringWriter") + PrintWriter (descriptor.class "java.io.PrintWriter") + string-writerI (|>> (_.NEW StringWriter) _.DUP - (_.INVOKESPECIAL "java.io.StringWriter" "<init>" ($t.method (list) #.None (list)) #0)) - print-writerI (|>> (_.NEW "java.io.PrintWriter") + (_.INVOKESPECIAL StringWriter "<init>" nullary-init-methodT #0)) + print-writerI (|>> (_.NEW PrintWriter) _.SWAP _.DUP2 _.POP _.SWAP - (_.boolean #1) - (_.INVOKESPECIAL "java.io.PrintWriter" "<init>" ($t.method (list ($t.class "java.io.Writer" (list)) $t.boolean) #.None (list)) #0) + (_.boolean true) + (_.INVOKESPECIAL PrintWriter "<init>" (descriptor.method [(list (descriptor.class "java.io.Writer") descriptor.boolean) descriptor.void]) #0) )] - (|>> ($d.method #$.Public $.staticM "try" ($t.method (list $Function) (#.Some $Variant) (list)) + (|>> ($d.method #$.Public $.staticM "try" (descriptor.method [(list //.$Function) //.$Variant]) (<| _.with-label (function (_ @from)) _.with-label (function (_ @to)) _.with-label (function (_ @handler)) - (|>> (_.try @from @to @handler "java.lang.Throwable") + (|>> (_.try @from @to @handler $Throwable) (_.label @from) (_.ALOAD 0) _.NULL - (_.INVOKEVIRTUAL //.function-class apply-method (apply-signature 1) #0) + (_.INVOKEVIRTUAL //.$Function apply-method (apply-signature 1) #0) rightI _.ARETURN (_.label @to) @@ -304,8 +309,8 @@ string-writerI ## TW _.DUP2 ## TWTW print-writerI ## TWTP - (_.INVOKEVIRTUAL "java.lang.Throwable" "printStackTrace" ($t.method (list ($t.class "java.io.PrintWriter" (list))) #.None (list)) #0) ## TW - (_.INVOKEVIRTUAL "java.io.StringWriter" "toString" ($t.method (list) (#.Some $String) (list)) #0) ## TS + (_.INVOKEVIRTUAL $Throwable "printStackTrace" (descriptor.method [(list (descriptor.class "java.io.PrintWriter")) descriptor.void]) #0) ## TW + (_.INVOKEVIRTUAL StringWriter "toString" (descriptor.method [(list) $Text]) #0) ## TS _.SWAP _.POP leftI _.ARETURN))) ))) @@ -330,21 +335,21 @@ (list/map _.ALOAD) _.fuse)] (|>> preI - (_.INVOKEVIRTUAL //.function-class apply-method (apply-signature (dec arity)) #0) - (_.CHECKCAST //.function-class) + (_.INVOKEVIRTUAL //.$Function apply-method (apply-signature (dec arity)) #0) + (_.CHECKCAST //.$Function) (_.ALOAD arity) - (_.INVOKEVIRTUAL //.function-class apply-method (apply-signature 1) #0) + (_.INVOKEVIRTUAL //.$Function apply-method (apply-signature 1) #0) _.ARETURN))))) (list& ($d.abstract-method #$.Public $.noneM apply-method (apply-signature 1))) $d.fuse) bytecode ($d.abstract #$.V1_6 #$.Public $.noneC //.function-class (list) ["java.lang.Object" (list)] (list) - (|>> ($d.field #$.Public $.finalF partials-field $t.int) - ($d.method #$.Public $.noneM "<init>" ($t.method (list $t.int) #.None (list)) + (|>> ($d.field #$.Public $.finalF partials-field descriptor.int) + ($d.method #$.Public $.noneM "<init>" (descriptor.method [(list descriptor.int) descriptor.void]) (|>> (_.ALOAD 0) - (_.INVOKESPECIAL "java.lang.Object" "<init>" ($t.method (list) #.None (list)) #0) + (_.INVOKESPECIAL (descriptor.class "java.lang.Object") "<init>" nullary-init-methodT #0) (_.ALOAD 0) (_.ILOAD 1) - (_.PUTFIELD //.function-class partials-field $t.int) + (_.PUTFIELD //.$Function partials-field descriptor.int) _.RETURN)) applyI))] (do phase.monad diff --git a/new-luxc/source/luxc/lang/translation/jvm/structure.lux b/new-luxc/source/luxc/lang/translation/jvm/structure.lux index 5e721f65a..92bf41256 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/structure.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/structure.lux @@ -13,6 +13,7 @@ ["." list]]] [target [jvm + ["." descriptor] ["$t" type (#+ Type)]]] [tool [compiler @@ -23,14 +24,13 @@ [host [jvm (#+ Inst Operation Phase) ["_" inst]]]]] - ["." //]) + ["." // + ["#." runtime]]) (exception: #export (not-a-tuple {size Nat}) (ex.report ["Expected size" ">= 2"] ["Actual size" (%.nat size)])) -(def: $Object ($t.class "java.lang.Object" (list))) - (def: #export (tuple generate members) (-> Phase (List Synthesis) (Operation Inst)) (do phase.monad @@ -48,7 +48,7 @@ _.AASTORE))))) (:: @ map _.fuse))] (wrap (|>> (_.int (.int size)) - (_.array $Object) + (_.array //runtime.$Value) membersI)))) (def: (flagI right?) @@ -66,9 +66,8 @@ lefts))) (flagI right?) memberI - (_.INVOKESTATIC //.runtime-class + (_.INVOKESTATIC (descriptor.class //.runtime-class) "variant_make" - ($t.method (list $t.int $Object $Object) - (#.Some ($t.array 1 $Object)) - (list)) + (descriptor.method [(list //runtime.$Tag //runtime.$Flag //runtime.$Value) + //.$Variant]) #0))))) |