diff options
Diffstat (limited to '')
18 files changed, 443 insertions, 457 deletions
diff --git a/stdlib/source/lux/target/jvm/bytecode.lux b/stdlib/source/lux/target/jvm/bytecode.lux index 32e29b82f..34e887bc1 100644 --- a/stdlib/source/lux/target/jvm/bytecode.lux +++ b/stdlib/source/lux/target/jvm/bytecode.lux @@ -471,25 +471,27 @@ (exception.report ["ID" (%.nat id)])) -(def: #export (register id) +(def: (register id) (-> Nat (Bytecode Register)) (case (//unsigned.u1 id) (#try.Success register) (:: ..monad wrap register) (#try.Failure error) - (..throw invalid-register [id]))) + (..throw ..invalid-register [id]))) (template [<for> <size> <name> <general> <specials>] [(def: #export (<name> local) - (-> Register (Bytecode Any)) + (-> Nat (Bytecode Any)) (with-expansions [<specials>' (template.splice <specials>)] - (`` (case (//unsigned.value local) + (`` (case local (~~ (template [<case> <instruction> <registry>] [<case> (..bytecode $0 <size> <registry> <instruction> [])] <specials>')) - _ (..bytecode $0 <size> (<for> local) <general> [local])))))] + _ (do ..monad + [local (..register local)] + (..bytecode $0 <size> (<for> local) <general> [local]))))))] [/registry.for $1 iload _.iload [[0 _.iload-0 @0] @@ -520,14 +522,16 @@ (template [<for> <size> <name> <general> <specials>] [(def: #export (<name> local) - (-> Register (Bytecode Any)) + (-> Nat (Bytecode Any)) (with-expansions [<specials>' (template.splice <specials>)] - (`` (case (//unsigned.value local) + (`` (case local (~~ (template [<case> <instruction> <registry>] [<case> (..bytecode <size> $0 <registry> <instruction> [])] <specials>')) - _ (..bytecode <size> $0 (<for> local) <general> [local])))))] + _ (do ..monad + [local (..register local)] + (..bytecode <size> $0 (<for> local) <general> [local]))))))] [/registry.for $1 istore _.istore [[0 _.istore-0 @0] @@ -792,8 +796,10 @@ ) (def: #export (iinc register increase) - (-> Register U1 (Bytecode Any)) - (..bytecode $0 $0 (/registry.for register) _.iinc [register increase])) + (-> Nat U1 (Bytecode Any)) + (do ..monad + [register (..register register)] + (..bytecode $0 $0 (/registry.for register) _.iinc [register increase]))) (exception: #export (multiarray-cannot-be-zero-dimensional {class (Type Object)}) (exception.report ["Class" (..reflection class)])) diff --git a/stdlib/source/lux/tool/compiler/phase/generation/jvm/case.lux b/stdlib/source/lux/tool/compiler/phase/generation/jvm/case.lux index e583b36b7..cdb84ad6a 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation/jvm/case.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation/jvm/case.lux @@ -1,5 +1,5 @@ (.module: - [lux (#- Type if let case) + [lux (#- Type if let case int) [abstract ["." monad (#+ do)]] [control @@ -10,12 +10,9 @@ ["n" nat]]] [target [jvm - ["." constant] ["_" bytecode (#+ Label Bytecode) ("#@." monad)] ["." type (#+ Type) - [category (#+ Method)]] - [encoding - ["." unsigned]]]]] + [category (#+ Method)]]]]] ["." // #_ ["#." type] ["#." runtime (#+ Operation Phase)] @@ -43,17 +40,17 @@ _.pop2 (pop-alt (n.- 2 stack-depth))))) -(def: ldc/integer +(def: int (-> (I64 Any) (Bytecode Any)) - (|>> .i64 i32.i32 constant.integer _.ldc/integer)) + (|>> .i64 i32.i32 _.int)) -(def: ldc/long +(def: long (-> (I64 Any) (Bytecode Any)) - (|>> .int constant.long _.ldc/long)) + (|>> .int _.long)) -(def: ldc/double +(def: double (-> Frac (Bytecode Any)) - (|>> constant.double _.ldc/double)) + (|>> _.double)) (def: peek (Bytecode Any) @@ -76,7 +73,7 @@ (#synthesis.Bind register) (operation@wrap ($_ _.compose ..peek - (_.astore (unsigned.u1 register)))) + (_.astore register))) (^ (synthesis.path/bit value)) (operation@wrap (.let [jump (.if value _.ifeq _.ifne)] @@ -89,7 +86,7 @@ (operation@wrap ($_ _.compose ..peek (//value.unwrap type.long) - (..ldc/long value) + (..long value) _.lcmp (_.ifne @else))) @@ -97,14 +94,14 @@ (operation@wrap ($_ _.compose ..peek (//value.unwrap type.double) - (..ldc/double value) + (..double value) _.dcmpl (_.ifne @else))) (^ (synthesis.path/text value)) (operation@wrap ($_ _.compose ..peek - (_.ldc/string value) + (_.string value) (_.invokevirtual //type.text ..equals-name ..equals-type) (_.ifeq @else))) @@ -125,7 +122,7 @@ ($_ _.compose ..peek (_.checkcast //type.variant) - (..ldc/integer (<prepare> idx)) + (..int (<prepare> idx)) <flag> //runtime.case _.dup @@ -149,7 +146,7 @@ ($_ _.compose ..peek (_.checkcast //type.tuple) - (..ldc/integer lefts) + (..int lefts) optimized-projection //runtime.push))) @@ -157,7 +154,7 @@ (operation@wrap ($_ _.compose ..peek (_.checkcast //type.tuple) - (..ldc/integer lefts) + (..int lefts) //runtime.right-projection //runtime.push)) @@ -172,7 +169,7 @@ (_.checkcast //type.tuple) _.iconst-0 _.aaload - (_.astore (unsigned.u1 register)) + (_.astore register) thenG))) ## Extra optimization @@ -185,9 +182,9 @@ (wrap ($_ _.compose ..peek (_.checkcast //type.tuple) - (..ldc/integer lefts) + (..int lefts) <projection> - (_.astore (unsigned.u1 register)) + (_.astore register) then!)))) ([synthesis.member/left //runtime.left-projection] [synthesis.member/right //runtime.right-projection]) @@ -252,7 +249,7 @@ bodyG (phase bodyS)] (wrap ($_ _.compose inputG - (_.astore (unsigned.u1 register)) + (_.astore register) bodyG)))) (def: #export (case phase valueS path) 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 1fba35532..d06a5167c 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 @@ -19,7 +19,6 @@ [target [jvm ["_" bytecode (#+ Label Bytecode) ("#@." monad)] - ["." constant] [encoding ["." signed (#+ S4)]] ["." type (#+ Type) @@ -113,7 +112,7 @@ [branchG (phase branch) @branch ///runtime.forge-label] (wrap [(list@map (function (_ char) - [(signed.s4 (.int char)) @branch]) + [(try.assume (signed.s4 (.int char))) @branch]) chars) ($_ _.compose (_.set-label @branch) @@ -192,7 +191,7 @@ [(def: (<name> _) (Nullary (Bytecode Any)) ($_ _.compose - (_.ldc/double (constant.double <const>)) + (_.double <const>) (///value.wrap type.double)))] [f64::smallest (java/lang/Double::MIN_VALUE)] diff --git a/stdlib/source/lux/tool/compiler/phase/generation/jvm/function.lux b/stdlib/source/lux/tool/compiler/phase/generation/jvm/function.lux index 35137a77b..c5b18f6b3 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation/jvm/function.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation/jvm/function.lux @@ -2,8 +2,6 @@ [lux (#- Type) [abstract ["." monad (#+ do)]] - [control - [state (#+ State)]] [data [number ["." i32] @@ -11,8 +9,8 @@ [collection ["." list ("#@." monoid functor)] ["." row]] - [format - [".F" binary]]] + ["." format #_ + ["#" binary]]] [target [jvm ["." version] @@ -25,7 +23,7 @@ [category (#+ Return' Value')] ["." reflection]] ["." constant - [pool (#+ Pool)]] + [pool (#+ Resource)]] [encoding ["." name (#+ External Internal)] ["." unsigned]]]]] @@ -55,15 +53,15 @@ (def: #export (with @begin class environment arity body) (-> Label External Environment Arity (Bytecode Any) - (Operation [(List (State Pool Field)) - (List (State Pool Method)) + (Operation [(List (Resource Field)) + (List (Resource Method)) (Bytecode Any)])) (let [classT (type.class class (list)) - fields (: (List (State Pool Field)) + fields (: (List (Resource Field)) (list& /arity.constant (list@compose (/foreign.variables environment) (/partial.variables arity)))) - methods (: (List (State Pool Method)) + methods (: (List (Resource Method)) (list& (/init.method classT environment arity) (/reset.method classT environment arity) (if (arity.multiary? arity) @@ -98,16 +96,16 @@ (generation.with-anchor [@begin ..this-offset] (generate bodyS))) [fields methods instance] (..with @begin function-class environment arity bodyG) + class (phase.lift (class.class version.v6_0 + ..modifier + (name.internal function-class) + (..internal /abstract.class) (list) + fields + methods + (row.row))) _ (generation.save! true ["" function-class] [function-class - (<| (binaryF.run class.writer) - (class.class version.v6_0 - ..modifier - (name.internal function-class) - (..internal /abstract.class) (list) - fields - methods - (row.row)))])] + (format.run class.writer class)])] (wrap instance))) (def: #export (apply generate [abstractionS inputsS]) diff --git a/stdlib/source/lux/tool/compiler/phase/generation/jvm/function/field/variable.lux b/stdlib/source/lux/tool/compiler/phase/generation/jvm/function/field/variable.lux index cbff8ea5e..30ed3a524 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation/jvm/function/field/variable.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation/jvm/function/field/variable.lux @@ -1,7 +1,5 @@ (.module: [lux (#- Type type) - [control - [state (#+ State)]] [data [collection ["." list ("#@." functor)] @@ -10,11 +8,11 @@ [jvm ["." modifier (#+ Modifier) ("#@." monoid)] ["." field (#+ Field)] - ["_" instruction (#+ Instruction)] + ["_" bytecode (#+ Bytecode)] [type (#+ Type) [category (#+ Value Class)]] [constant - [pool (#+ Pool)]]]]] + [pool (#+ Resource)]]]]] ["." //// #_ ["#." type] ["#." reference] @@ -24,14 +22,14 @@ (def: #export type ////type.value) (def: #export (get class name) - (-> (Type Class) Text (Instruction Any)) + (-> (Type Class) Text (Bytecode Any)) ($_ _.compose ////reference.this (_.getfield class name ..type) )) (def: #export (put naming class register value) - (-> (-> Register Text) (Type Class) Register (Instruction Any) (Instruction Any)) + (-> (-> Register Text) (Type Class) Register (Bytecode Any) (Bytecode Any)) ($_ _.compose ////reference.this value @@ -45,11 +43,11 @@ )) (def: #export (variable name type) - (-> Text (Type Value) (State Pool Field)) + (-> Text (Type Value) (Resource Field)) (field.field ..modifier name type (row.row))) (def: #export (variables naming amount) - (-> (-> Register Text) Nat (List (State Pool Field))) + (-> (-> Register Text) Nat (List (Resource Field))) (|> amount list.indices (list@map (function (_ register) diff --git a/stdlib/source/lux/tool/compiler/phase/generation/jvm/function/field/variable/foreign.lux b/stdlib/source/lux/tool/compiler/phase/generation/jvm/function/field/variable/foreign.lux index 0b4a2bc3d..8df5c304c 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation/jvm/function/field/variable/foreign.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation/jvm/function/field/variable/foreign.lux @@ -1,17 +1,15 @@ (.module: [lux (#- Type) - [control - [state (#+ State)]] [data [collection ["." list ("#@." functor)] ["." row]]] [target [jvm - ["_" instruction (#+ Instruction)] + ["_" bytecode (#+ Bytecode)] ["." field (#+ Field)] [constant - [pool (#+ Pool)]] + [pool (#+ Resource)]] [type (#+ Type) [category (#+ Value Class)]]]]] ["." // @@ -26,13 +24,13 @@ (list.repeat (list.size environment) //.type)) (def: #export (get class register) - (-> (Type Class) Register (Instruction Any)) + (-> (Type Class) Register (Bytecode Any)) (//.get class (/////reference.foreign-name register))) (def: #export (put class register value) - (-> (Type Class) Register (Instruction Any) (Instruction Any)) + (-> (Type Class) Register (Bytecode Any) (Bytecode Any)) (//.put /////reference.foreign-name class register value)) (def: #export variables - (-> Environment (List (State Pool Field))) + (-> Environment (List (Resource Field))) (|>> list.size (//.variables /////reference.foreign-name))) diff --git a/stdlib/source/lux/tool/compiler/phase/generation/jvm/function/field/variable/partial.lux b/stdlib/source/lux/tool/compiler/phase/generation/jvm/function/field/variable/partial.lux index 39be26183..62bb75c23 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation/jvm/function/field/variable/partial.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation/jvm/function/field/variable/partial.lux @@ -2,8 +2,6 @@ [lux (#- Type) [abstract ["." monad]] - [control - [state (#+ State)]] [data [number ["n" nat]] @@ -13,11 +11,11 @@ [target [jvm ["." field (#+ Field)] - ["_" instruction (#+ Label Instruction) ("#@." monad)] + ["_" bytecode (#+ Label Bytecode) ("#@." monad)] [type (#+ Type) [category (#+ Class)]] [constant - [pool (#+ Pool)]]]]] + [pool (#+ Resource)]]]]] ["." / #_ ["#." count] ["/#" // @@ -31,7 +29,7 @@ ["." arity (#+ Arity)]]]]]]) (def: #export (initial amount) - (-> Nat (Instruction Any)) + (-> Nat (Bytecode Any)) ($_ _.compose (|> _.aconst-null (list.repeat amount) @@ -39,19 +37,19 @@ (_@wrap []))) (def: #export (get class register) - (-> (Type Class) Register (Instruction Any)) + (-> (Type Class) Register (Bytecode Any)) (//.get class (/////reference.partial-name register))) (def: #export (put class register value) - (-> (Type Class) Register (Instruction Any) (Instruction Any)) + (-> (Type Class) Register (Bytecode Any) (Bytecode Any)) (//.put /////reference.partial-name class register value)) (def: #export variables - (-> Arity (List (State Pool Field))) + (-> Arity (List (Resource Field))) (|>> (n.- ///arity.minimum) (//.variables /////reference.partial-name))) (def: #export (new arity) - (-> Arity (Instruction Any)) + (-> Arity (Bytecode Any)) (if (arity.multiary? arity) ($_ _.compose /count.initial diff --git a/stdlib/source/lux/tool/compiler/phase/generation/jvm/function/method/apply.lux b/stdlib/source/lux/tool/compiler/phase/generation/jvm/function/method/apply.lux index e25889a37..68e81845b 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation/jvm/function/method/apply.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation/jvm/function/method/apply.lux @@ -3,7 +3,7 @@ [abstract ["." monad (#+ do)]] [control - [state (#+ State)]] + ["." try]] [data [number ["n" nat] @@ -13,12 +13,11 @@ ["." list ("#@." monoid functor)]]] [target [jvm - ["_" instruction (#+ Label Instruction) ("#@." monad)] + ["_" bytecode (#+ Label Bytecode) ("#@." monad)] ["." method (#+ Method)] - ["." constant - [pool (#+ Pool)]] + [constant + [pool (#+ Resource)]] [encoding - ["." unsigned] ["." signed]] ["." type (#+ Type) ["." category (#+ Class)]]]]] @@ -45,22 +44,22 @@ ["." reference (#+ Register)]]]]]) (def: (increment by) - (-> Nat (Instruction Any)) + (-> Nat (Bytecode Any)) ($_ _.compose - (<| _.ldc/integer constant.integer i32.i32 .i64 by) + (<| _.int .i64 by) _.iadd)) (def: (inputs offset amount) - (-> Register Nat (Instruction Any)) + (-> Register Nat (Bytecode Any)) ($_ _.compose (|> amount list.indices - (monad.map _.monad (|>> (n.+ offset) unsigned.u1 _.aload))) + (monad.map _.monad (|>> (n.+ offset) _.aload))) (_@wrap []) )) (def: (apply offset amount) - (-> Register Nat (Instruction Any)) + (-> Register Nat (Bytecode Any)) (let [arity (n.min amount ///arity.maximum)] ($_ _.compose (_.checkcast ///abstract.class) @@ -75,78 +74,86 @@ (def: this-offset 1) (def: #export (method class environment function-arity @begin body apply-arity) - (-> (Type Class) Environment Arity Label (Instruction Any) Arity (State Pool Method)) + (-> (Type Class) Environment Arity Label (Bytecode Any) Arity (Resource Method)) (let [num-partials (dec function-arity) over-extent (i.- (.int apply-arity) - (.int function-arity)) - failure ($_ _.compose - ////runtime.apply-failure - _.aconst-null - _.areturn)] + (.int function-arity))] (method.method //.modifier ////runtime.apply::name (////runtime.apply::type apply-arity) (list) - (do _.monad - [@default _.new-label - @labels (|> _.new-label - (list.repeat num-partials) - (monad.seq _.monad)) - #let [cases (|> (list@compose @labels (list @default)) - list.enumerate - (list@map (function (_ [stage @case]) - (let [current-partials (|> (list.indices stage) - (list@map (///partial.get class)) - (monad.seq _.monad)) - already-partial? (n.> 0 stage) - exact-match? (i.= over-extent (.int stage)) - has-more-than-necessary? (i.> over-extent (.int stage))] - (cond exact-match? - ($_ _.compose - (_.set-label @case) - ////reference.this - (if already-partial? - (_.invokevirtual class //reset.name (//reset.type class)) - (_@wrap [])) - current-partials - (inputs ..this-offset apply-arity) - (_.invokevirtual class //implementation.name (//implementation.type function-arity)) - _.areturn) - - has-more-than-necessary? - (let [inputs-to-completion (|> function-arity (n.- stage)) - inputs-left (|> apply-arity (n.- inputs-to-completion))] - ($_ _.compose - (_.set-label @case) - ////reference.this - (_.invokevirtual class //reset.name (//reset.type class)) - current-partials - (inputs ..this-offset inputs-to-completion) - (_.invokevirtual class //implementation.name (//implementation.type function-arity)) - (apply (n.+ ..this-offset inputs-to-completion) inputs-left) - _.areturn)) + (#.Some (case num-partials + 0 ($_ _.compose + ////reference.this + (..inputs ..this-offset apply-arity) + (_.invokevirtual class //implementation.name (//implementation.type function-arity)) + _.areturn) + _ (do _.monad + [@default _.new-label + #let [failure ($_ _.compose + (_.set-label @default) + ////runtime.apply-failure + _.aconst-null + _.areturn)] + @labelsH _.new-label + @labelsT (|> _.new-label + (list.repeat (dec num-partials)) + (monad.seq _.monad)) + #let [cases (|> (#.Cons [@labelsH @labelsT]) + list.enumerate + (list@map (function (_ [stage @case]) + (let [current-partials (|> (list.indices stage) + (list@map (///partial.get class)) + (monad.seq _.monad)) + already-partial? (n.> 0 stage) + exact-match? (i.= over-extent (.int stage)) + has-more-than-necessary? (i.> over-extent (.int stage))] + (cond exact-match? + ($_ _.compose + (_.set-label @case) + ////reference.this + (if already-partial? + (_.invokevirtual class //reset.name (//reset.type class)) + (_@wrap [])) + current-partials + (..inputs ..this-offset apply-arity) + (_.invokevirtual class //implementation.name (//implementation.type function-arity)) + _.areturn) + + has-more-than-necessary? + (let [inputs-to-completion (|> function-arity (n.- stage)) + inputs-left (|> apply-arity (n.- inputs-to-completion))] + ($_ _.compose + (_.set-label @case) + ////reference.this + (_.invokevirtual class //reset.name (//reset.type class)) + current-partials + (..inputs ..this-offset inputs-to-completion) + (_.invokevirtual class //implementation.name (//implementation.type function-arity)) + (apply (n.+ ..this-offset inputs-to-completion) inputs-left) + _.areturn)) - ## (i.< over-extent (.int stage)) - (let [current-environment (|> (list.indices (list.size environment)) - (list@map (///foreign.get class)) - (monad.seq _.monad)) - missing-partials (|> _.aconst-null - (list.repeat (|> num-partials (n.- apply-arity) (n.- stage))) - (monad.seq _.monad))] - ($_ _.compose - (_.set-label @case) - (_.new class) - _.dup - current-environment - ///partial/count.value - (..increment apply-arity) - current-partials - (inputs ..this-offset apply-arity) - missing-partials - (_.invokevirtual class //init.name (//init.type environment function-arity)) - _.areturn)))))) - (monad.seq _.monad))]] - ($_ _.compose - ///partial/count.value - (_.tableswitch (signed.s4 +0) @default @labels) - cases - failure))))) + ## (i.< over-extent (.int stage)) + (let [current-environment (|> (list.indices (list.size environment)) + (list@map (///foreign.get class)) + (monad.seq _.monad)) + missing-partials (|> _.aconst-null + (list.repeat (|> num-partials (n.- apply-arity) (n.- stage))) + (monad.seq _.monad))] + ($_ _.compose + (_.set-label @case) + (_.new class) + _.dup + current-environment + ///partial/count.value + (..increment apply-arity) + current-partials + (..inputs ..this-offset apply-arity) + missing-partials + (_.invokevirtual class //init.name (//init.type environment function-arity)) + _.areturn)))))) + (monad.seq _.monad))]] + ($_ _.compose + ///partial/count.value + (_.tableswitch (try.assume (signed.s4 +0)) @default [@labelsH @labelsT]) + ## cases + failure))))))) diff --git a/stdlib/source/lux/tool/compiler/phase/generation/jvm/function/method/implementation.lux b/stdlib/source/lux/tool/compiler/phase/generation/jvm/function/method/implementation.lux index f7a3edb93..a0e606194 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation/jvm/function/method/implementation.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation/jvm/function/method/implementation.lux @@ -1,16 +1,14 @@ (.module: [lux (#- Type type) - [control - [state (#+ State)]] [data [collection ["." list]]] [target [jvm ["." method (#+ Method)] - ["_" instruction (#+ Label Instruction)] + ["_" bytecode (#+ Label Bytecode)] [constant - [pool (#+ Pool)]] + [pool (#+ Resource)]] ["." type (#+ Type) ["." category]]]]] ["." // @@ -28,16 +26,16 @@ (list)])) (def: #export (method' name arity @begin body) - (-> Text Arity Label (Instruction Any) (State Pool Method)) + (-> Text Arity Label (Bytecode Any) (Resource Method)) (method.method //.modifier name (..type arity) (list) - ($_ _.compose - (_.set-label @begin) - body - _.areturn - ))) + (#.Some ($_ _.compose + (_.set-label @begin) + body + _.areturn + )))) (def: #export method - (-> Arity Label (Instruction Any) (State Pool Method)) + (-> Arity Label (Bytecode Any) (Resource Method)) (method' ..name)) diff --git a/stdlib/source/lux/tool/compiler/phase/generation/jvm/function/method/init.lux b/stdlib/source/lux/tool/compiler/phase/generation/jvm/function/method/init.lux index 691c4df70..0a51d555d 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation/jvm/function/method/init.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation/jvm/function/method/init.lux @@ -3,7 +3,7 @@ [abstract ["." monad]] [control - [state (#+ State)]] + ["." try]] [data [number ["n" nat]] @@ -11,12 +11,12 @@ ["." list ("#@." monoid functor)]]] [target [jvm - ["_" instruction (#+ Instruction)] + ["_" bytecode (#+ Bytecode)] ["." method (#+ Method)] [encoding ["." unsigned]] [constant - [pool (#+ Pool)]] + [pool (#+ Resource)]] ["." type (#+ Type) ["." category (#+ Class Value)]]]]] ["." // @@ -52,28 +52,30 @@ type.void (list)])) +(def: no-partials (|> 0 unsigned.u1 try.assume _.bipush)) + (def: #export (super environment-size arity) - (-> Nat Arity (Instruction Any)) + (-> Nat Arity (Bytecode Any)) (let [arity-register (inc environment-size)] ($_ _.compose (if (arity.unary? arity) - (_.bipush (unsigned.u1 0)) - (_.iload (unsigned.u1 arity-register))) + ..no-partials + (_.iload arity-register)) (_.invokespecial ///abstract.class ..name ///abstract.init)))) (def: (store-all amount put offset) (-> Nat - (-> Register (Instruction Any) (Instruction Any)) + (-> Register (Bytecode Any) (Bytecode Any)) (-> Register Register) - (Instruction Any)) + (Bytecode Any)) (|> (list.indices amount) (list@map (function (_ register) (put register - (_.aload (unsigned.u1 (offset register)))))) + (_.aload (offset register))))) (monad.seq _.monad))) (def: #export (method class environment arity) - (-> (Type Class) Environment Arity (State Pool Method)) + (-> (Type Class) Environment Arity (Resource Method)) (let [environment-size (list.size environment) offset-foreign (: (-> Register Register) (n.+ 1)) @@ -84,9 +86,9 @@ (method.method //.modifier ..name (..type environment arity) (list) - ($_ _.compose - ////reference.this - (..super environment-size arity) - (store-all environment-size (///foreign.put class) offset-foreign) - (store-all (dec arity) (///partial.put class) offset-partial) - _.return)))) + (#.Some ($_ _.compose + ////reference.this + (..super environment-size arity) + (store-all environment-size (///foreign.put class) offset-foreign) + (store-all (dec arity) (///partial.put class) offset-partial) + _.return))))) diff --git a/stdlib/source/lux/tool/compiler/phase/generation/jvm/function/method/new.lux b/stdlib/source/lux/tool/compiler/phase/generation/jvm/function/method/new.lux index 241ec2676..ac1347c2d 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation/jvm/function/method/new.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation/jvm/function/method/new.lux @@ -2,8 +2,6 @@ [lux (#- Type type) [abstract ["." monad (#+ do)]] - [control - [state (#+ State)]] [data [number ["n" nat]] @@ -14,11 +12,9 @@ ["." modifier (#+ Modifier) ("#@." monoid)] ["." field (#+ Field)] ["." method (#+ Method)] - ["_" instruction (#+ Instruction)] + ["_" bytecode (#+ Bytecode)] ["." constant - [pool (#+ Pool)]] - [encoding - ["." unsigned]] + [pool (#+ Resource)]] [type (#+ Type) ["." category (#+ Class Value Return)]]]]] ["." // @@ -41,7 +37,7 @@ ["." phase]]]]]) (def: #export (instance' foreign-setup class environment arity) - (-> (List (Instruction Any)) (Type Class) Environment Arity (Instruction Any)) + (-> (List (Bytecode Any)) (Type Class) Environment Arity (Bytecode Any)) ($_ _.compose (_.new class) _.dup @@ -50,13 +46,13 @@ (_.invokespecial class //init.name (//init.type environment arity)))) (def: #export (instance class environment arity) - (-> (Type Class) Environment Arity (Operation (Instruction Any))) + (-> (Type Class) Environment Arity (Operation (Bytecode Any))) (do phase.monad [foreign* (monad.map @ ////reference.variable environment)] (wrap (instance' foreign* class environment arity)))) (def: #export (method class environment arity) - (-> (Type Class) Environment Arity (State Pool Method)) + (-> (Type Class) Environment Arity (Resource Method)) (let [after-this (: (-> Nat Nat) (n.+ 1)) environment-size (list.size environment) @@ -67,13 +63,13 @@ (method.method //.modifier //init.name (//init.type environment arity) (list) - ($_ _.compose - ////reference.this - (//init.super environment-size arity) - (monad.map _.monad (function (_ register) - (///foreign.put class register (_.aload (unsigned.u1 (after-this register))))) - (list.indices environment-size)) - (monad.map _.monad (function (_ register) - (///partial.put class register (_.aload (unsigned.u1 (after-arity register))))) - (list.indices (n.- ///arity.minimum arity))) - _.areturn)))) + (#.Some ($_ _.compose + ////reference.this + (//init.super environment-size arity) + (monad.map _.monad (function (_ register) + (///foreign.put class register (_.aload (after-this register)))) + (list.indices environment-size)) + (monad.map _.monad (function (_ register) + (///partial.put class register (_.aload (after-arity register)))) + (list.indices (n.- ///arity.minimum arity))) + _.areturn))))) diff --git a/stdlib/source/lux/tool/compiler/phase/generation/jvm/function/method/reset.lux b/stdlib/source/lux/tool/compiler/phase/generation/jvm/function/method/reset.lux index 2eab6933b..c196208bc 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation/jvm/function/method/reset.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation/jvm/function/method/reset.lux @@ -1,16 +1,14 @@ (.module: [lux (#- Type type) - [control - [state (#+ State)]] [data [collection ["." list ("#@." functor)]]] [target [jvm ["." method (#+ Method)] - ["_" instruction (#+ Instruction)] + ["_" bytecode (#+ Bytecode)] [constant - [pool (#+ Pool)]] + [pool (#+ Resource)]] ["." type (#+ Type) ["." category (#+ Class)]]]]] ["." // @@ -32,18 +30,18 @@ (type.method [(list) class (list)])) (def: (current-environment class) - (-> (Type Class) Environment (List (Instruction Any))) + (-> (Type Class) Environment (List (Bytecode Any))) (|>> list.size list.indices (list@map (///foreign.get class)))) (def: #export (method class environment arity) - (-> (Type Class) Environment Arity (State Pool Method)) + (-> (Type Class) Environment Arity (Resource Method)) (method.method //.modifier ..name (..type class) (list) - ($_ _.compose - (if (arity.multiary? arity) - (//new.instance' (..current-environment class environment) class environment arity) - ////reference.this) - _.areturn))) + (#.Some ($_ _.compose + (if (arity.multiary? arity) + (//new.instance' (..current-environment class environment) class environment arity) + ////reference.this) + _.areturn)))) diff --git a/stdlib/source/lux/tool/compiler/phase/generation/jvm/loop.lux b/stdlib/source/lux/tool/compiler/phase/generation/jvm/loop.lux index 371b900a7..f27dbc269 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation/jvm/loop.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation/jvm/loop.lux @@ -12,9 +12,7 @@ ["." list ("#@." functor)]]] [target [jvm - ["_" bytecode (#+ Label Bytecode) ("#@." monad)] - [encoding - ["." unsigned]]]]] + ["_" bytecode (#+ Label Bytecode) ("#@." monad)]]]] ["." // #_ ["#." runtime (#+ Operation Phase)] ["#." value] @@ -50,7 +48,7 @@ ..no-op]) (do @ [fetchG (translate updateS) - #let [storeG (_.astore (unsigned.u1 register))]] + #let [storeG (_.astore register)]] (wrap [fetchG storeG]))))))] (wrap ($_ _.compose ## It may look weird that first I fetch all the values separately, @@ -81,7 +79,7 @@ (list@map (function (_ [index initG]) ($_ _.compose initG - (_.astore (unsigned.u1 (n.+ offset index)))))) + (_.astore (n.+ offset index))))) (monad.seq _.monad))]] (wrap ($_ _.compose initializationG diff --git a/stdlib/source/lux/tool/compiler/phase/generation/jvm/primitive.lux b/stdlib/source/lux/tool/compiler/phase/generation/jvm/primitive.lux index 946ea34d5..f49c3b517 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation/jvm/primitive.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation/jvm/primitive.lux @@ -4,7 +4,6 @@ [monad (#+ do)]] [target [jvm - ["." constant] ["_" bytecode (#+ Bytecode)] ["." type]]] [macro @@ -27,8 +26,8 @@ [_ (`` (|> value (~~ (template.splice <ldc>))))] (_.invokestatic <class> "valueOf" (type.method [(list <inputD>) <class> (list)]))))] - [i64 (I64 Any) [.int constant.long _.ldc/long] $Long type.long] - [f64 Frac [constant.double _.ldc/double] $Double type.double] + [i64 (I64 Any) [.int _.long] $Long type.long] + [f64 Frac [_.double] $Double type.double] ) (def: #export text _.string) diff --git a/stdlib/source/lux/tool/compiler/phase/generation/jvm/reference.lux b/stdlib/source/lux/tool/compiler/phase/generation/jvm/reference.lux index a5c4c3156..13f6bb846 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation/jvm/reference.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation/jvm/reference.lux @@ -5,11 +5,6 @@ [data [text ["%" format (#+ format)]]] - [tool - [compiler - ["." reference (#+ Register Variable)] - ["." phase ("operation@." monad) - ["." generation]]]] [target [jvm ["_" bytecode (#+ Bytecode)] @@ -19,11 +14,11 @@ ["." // #_ [runtime (#+ Operation)] ["#." value] - ["#." type]]) - -(def: local - (-> Register (Bytecode Any)) - (|>> unsigned.u1 _.aload)) + ["#." type] + ["//#" /// ("operation@." monad) + ["." generation] + [// + ["." reference (#+ Register Variable)]]]]) (def: #export this (Bytecode Any) @@ -40,7 +35,7 @@ (def: (foreign variable) (-> Register (Operation (Bytecode Any))) - (do phase.monad + (do ////.monad [function-class generation.context] (wrap ($_ _.compose ..this @@ -52,13 +47,13 @@ (-> Variable (Operation (Bytecode Any))) (case variable (#reference.Local variable) - (operation@wrap (..local variable)) + (operation@wrap (_.aload variable)) (#reference.Foreign variable) (..foreign variable))) (def: #export (constant name) (-> Name (Operation (Bytecode Any))) - (do phase.monad + (do ////.monad [bytecode-name (generation.remember name)] (wrap (_.getstatic (type.class bytecode-name (list)) //value.field //type.value)))) diff --git a/stdlib/source/lux/tool/compiler/phase/generation/jvm/runtime.lux b/stdlib/source/lux/tool/compiler/phase/generation/jvm/runtime.lux index 384193d99..c8076cada 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation/jvm/runtime.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation/jvm/runtime.lux @@ -26,7 +26,6 @@ ["." constant [pool (#+ Resource)]] [encoding - ["." unsigned] ["." name]] ["." type (#+ Type) ["." category (#+ Return' Value')] @@ -82,10 +81,6 @@ method.strict )) -(def: local - (-> Nat (Bytecode Any)) - (|>> unsigned.u1 try.assume _.aload)) - (def: this (Bytecode Any) _.aload-0) @@ -126,12 +121,12 @@ (method.method ..modifier ..variant::name ..variant::type (list) - ($_ _.compose - new-variant - (..set! ..variant-tag $tag) - (..set! ..variant-last? $last?) - (..set! ..variant-value $value) - _.areturn)))) + (#.Some ($_ _.compose + new-variant + (..set! ..variant-tag $tag) + (..set! ..variant-last? $last?) + (..set! ..variant-value $value) + _.areturn))))) (def: #export left-flag _.aconst-null) (def: #export right-flag ..unit) @@ -189,11 +184,12 @@ (method.method ..modifier ..variant::name ..variant::type (list) - (..risky - ($_ _.compose - ..this - (_.invokestatic //type.frac "parseDouble" (type.method [(list //type.text) type.double (list)])) - (//value.wrap type.double))))) + (#.Some + (..risky + ($_ _.compose + ..this + (_.invokestatic //type.frac "parseDouble" (type.method [(list //type.text) type.double (list)])) + (//value.wrap type.double)))))) (def: #export log! (Bytecode Any) @@ -224,9 +220,10 @@ (method.method ..modifier name ..failure::type (list) - ($_ _.compose - (..illegal-state-exception message) - _.athrow))) + (#.Some + ($_ _.compose + (..illegal-state-exception message) + _.athrow)))) (def: apply-failure::name "apply_failure") (def: #export apply-failure (..procedure ..apply-failure::name ..failure::type)) @@ -251,16 +248,17 @@ (method.method ..modifier ..push::name ..push::type (list) - (let [new-stack-frame! ($_ _.compose - _.iconst-2 - (_.anewarray //type.value)) - $head _.aload-1 - $tail _.aload-0] - ($_ _.compose - new-stack-frame! - (..set! ..stack-head $head) - (..set! ..stack-tail $tail) - _.areturn)))) + (#.Some + (let [new-stack-frame! ($_ _.compose + _.iconst-2 + (_.anewarray //type.value)) + $head _.aload-1 + $tail _.aload-0] + ($_ _.compose + new-stack-frame! + (..set! ..stack-head $head) + (..set! ..stack-tail $tail) + _.areturn))))) (def: case::name "case") (def: case::type (type.method [(list //type.variant //type.tag //type.flag) //type.value (list)])) @@ -269,79 +267,80 @@ (def: case::method (method.method ..modifier ..case::name ..case::type (list) - (do _.monad - [@loop _.new-label - @perfect-match! _.new-label - @tags-match! _.new-label - @maybe-nested _.new-label - @maybe-super-nested _.new-label - @mismatch! _.new-label - #let [::tag ($_ _.compose - (..get ..variant-tag) - (//value.unwrap type.int)) - ::last? (..get ..variant-last?) - ::value (..get ..variant-value) - - $variant _.aload-0 - $tag _.iload-1 - $last? _.aload-2 - - not-found _.aconst-null - - update-$tag ($_ _.compose - _.isub - _.istore-1) - update-$variant ($_ _.compose - $variant ::value - (_.checkcast //type.variant) - _.astore-0) - recur (: (-> Label (Bytecode Any)) - (function (_ @loop-start) - ($_ _.compose - update-$tag - update-$variant - (_.goto @loop-start)))) - - super-nested-tag ($_ _.compose - $variant ::tag - $tag _.isub) - super-nested ($_ _.compose - super-nested-tag - $variant ::last? - $variant ::value - ..variant)]] - ($_ _.compose - (_.set-label @loop) - $tag - $variant ::tag - _.dup2 (_.if-icmpeq @tags-match!) - _.dup2 (_.if-icmpgt @maybe-nested) - _.dup2 (_.if-icmplt @maybe-super-nested) - ## _.pop2 - not-found - _.areturn - (_.set-label @tags-match!) ## tag, sumT - $last? ## tag, sumT, wants-last? - $variant ::last? ## tag, sumT, wants-last?, is-last? - (_.if-acmpeq @perfect-match!) ## tag, sumT - (_.set-label @maybe-nested) ## tag, sumT - $variant ::last? ## tag, sumT, last? - (_.ifnull @mismatch!) ## tag, sumT - (recur @loop) - (_.set-label @perfect-match!) ## tag, sumT - ## _.pop2 - $variant ::value - _.areturn - (_.set-label @maybe-super-nested) ## tag, sumT - $last? (_.ifnull @mismatch!) - ## _.pop2 - super-nested - _.areturn - (_.set-label @mismatch!) ## tag, sumT - ## _.pop2 - not-found - _.areturn - )))) + (#.Some + (do _.monad + [@loop _.new-label + @perfect-match! _.new-label + @tags-match! _.new-label + @maybe-nested _.new-label + @maybe-super-nested _.new-label + @mismatch! _.new-label + #let [::tag ($_ _.compose + (..get ..variant-tag) + (//value.unwrap type.int)) + ::last? (..get ..variant-last?) + ::value (..get ..variant-value) + + $variant _.aload-0 + $tag _.iload-1 + $last? _.aload-2 + + not-found _.aconst-null + + update-$tag ($_ _.compose + _.isub + _.istore-1) + update-$variant ($_ _.compose + $variant ::value + (_.checkcast //type.variant) + _.astore-0) + recur (: (-> Label (Bytecode Any)) + (function (_ @loop-start) + ($_ _.compose + update-$tag + update-$variant + (_.goto @loop-start)))) + + super-nested-tag ($_ _.compose + $variant ::tag + $tag _.isub) + super-nested ($_ _.compose + super-nested-tag + $variant ::last? + $variant ::value + ..variant)]] + ($_ _.compose + (_.set-label @loop) + $tag + $variant ::tag + _.dup2 (_.if-icmpeq @tags-match!) + _.dup2 (_.if-icmpgt @maybe-nested) + _.dup2 (_.if-icmplt @maybe-super-nested) + ## _.pop2 + not-found + _.areturn + (_.set-label @tags-match!) ## tag, sumT + $last? ## tag, sumT, wants-last? + $variant ::last? ## tag, sumT, wants-last?, is-last? + (_.if-acmpeq @perfect-match!) ## tag, sumT + (_.set-label @maybe-nested) ## tag, sumT + $variant ::last? ## tag, sumT, last? + (_.ifnull @mismatch!) ## tag, sumT + (recur @loop) + (_.set-label @perfect-match!) ## tag, sumT + ## _.pop2 + $variant ::value + _.areturn + (_.set-label @maybe-super-nested) ## tag, sumT + $last? (_.ifnull @mismatch!) + ## _.pop2 + super-nested + _.areturn + (_.set-label @mismatch!) ## tag, sumT + ## _.pop2 + not-found + _.areturn + ))))) (def: projection-type (type.method [(list //type.tuple //type.offset) //type.value (list)])) @@ -378,53 +377,55 @@ left-projection::method (method.method ..modifier ..left-projection::name ..projection-type (list) - (do _.monad - [@loop _.new-label - @recursive _.new-label - #let [::left ($_ _.compose - $lefts _.aaload)]] - ($_ _.compose - (_.set-label @loop) - $lefts $last-right (_.if-icmpge @recursive) - $tuple ::left - _.areturn - (_.set-label @recursive) - ## Recursive - (recur @loop)))) + (#.Some + (do _.monad + [@loop _.new-label + @recursive _.new-label + #let [::left ($_ _.compose + $lefts _.aaload)]] + ($_ _.compose + (_.set-label @loop) + $lefts $last-right (_.if-icmpge @recursive) + $tuple ::left + _.areturn + (_.set-label @recursive) + ## Recursive + (recur @loop))))) right-projection::method (method.method ..modifier ..right-projection::name ..projection-type (list) - (do _.monad - [@loop _.new-label - @not-tail _.new-label - @slice _.new-label - #let [$right ($_ _.compose - $lefts - _.iconst-1 - _.iadd) - $::nested ($_ _.compose - $tuple _.swap _.aaload) - super-nested ($_ _.compose - $tuple - $right - $tuple::size - (_.invokestatic (type.class "java.util.Arrays" (list)) "copyOfRange" - (type.method [(list //type.tuple //type.index //type.index) //type.tuple (list)])))]] - ($_ _.compose - (_.set-label @loop) - $last-right $right - _.dup2 (_.if-icmpne @not-tail) - ## _.pop - $::nested - _.areturn - (_.set-label @not-tail) - (_.if-icmpgt @slice) - ## Must recurse - (recur @loop) - (_.set-label @slice) - super-nested - _.areturn)))] + (#.Some + (do _.monad + [@loop _.new-label + @not-tail _.new-label + @slice _.new-label + #let [$right ($_ _.compose + $lefts + _.iconst-1 + _.iadd) + $::nested ($_ _.compose + $tuple _.swap _.aaload) + super-nested ($_ _.compose + $tuple + $right + $tuple::size + (_.invokestatic (type.class "java.util.Arrays" (list)) "copyOfRange" + (type.method [(list //type.tuple //type.index //type.index) //type.tuple (list)])))]] + ($_ _.compose + (_.set-label @loop) + $last-right $right + _.dup2 (_.if-icmpne @not-tail) + ## _.pop + $::nested + _.areturn + (_.set-label @not-tail) + (_.if-icmpgt @slice) + ## Must recurse + (recur @loop) + (_.set-label @slice) + super-nested + _.areturn))))] [left-projection::method right-projection::method])) @@ -447,53 +448,55 @@ (def: try::method (method.method ..modifier ..try::name ..try::type (list) - (do _.monad - [@from _.new-label - @to _.new-label - @handler _.new-label - #let [$unsafe ..this - unit _.aconst-null - - ^StringWriter (type.class "java.io.StringWriter" (list)) - string-writer ($_ _.compose - (_.new ^StringWriter) - _.dup - (_.invokespecial ^StringWriter "<init>" (type.method [(list) type.void (list)]))) - - ^PrintWriter (type.class "java.io.PrintWriter" (list)) - print-writer ($_ _.compose - ## WTW - (_.new ^PrintWriter) ## WTWP - _.dup-x1 ## WTPWP - _.swap ## WTPPW - ..true ## WTPPWZ - (_.invokespecial ^PrintWriter "<init>" (type.method [(list (type.class "java.io.Writer" (list)) type.boolean) type.void (list)])) - ## WTP - )]] - ($_ _.compose - (_.try @from @to @handler //type.error) - (_.set-label @from) - $unsafe unit ..apply - ..right-injection _.areturn - (_.set-label @to) - (_.set-label @handler) ## T - string-writer ## TW - _.dup-x1 ## WTW - print-writer ## WTP - (_.invokevirtual //type.error "printStackTrace" (type.method [(list ^PrintWriter) type.void (list)])) ## W - (_.invokevirtual ^StringWriter "toString" (type.method [(list) //type.text (list)])) ## S - ..left-injection _.areturn - )))) + (#.Some + (do _.monad + [@from _.new-label + @to _.new-label + @handler _.new-label + #let [$unsafe ..this + unit _.aconst-null + + ^StringWriter (type.class "java.io.StringWriter" (list)) + string-writer ($_ _.compose + (_.new ^StringWriter) + _.dup + (_.invokespecial ^StringWriter "<init>" (type.method [(list) type.void (list)]))) + + ^PrintWriter (type.class "java.io.PrintWriter" (list)) + print-writer ($_ _.compose + ## WTW + (_.new ^PrintWriter) ## WTWP + _.dup-x1 ## WTPWP + _.swap ## WTPPW + ..true ## WTPPWZ + (_.invokespecial ^PrintWriter "<init>" (type.method [(list (type.class "java.io.Writer" (list)) type.boolean) type.void (list)])) + ## WTP + )]] + ($_ _.compose + (_.try @from @to @handler //type.error) + (_.set-label @from) + $unsafe unit ..apply + ..right-injection _.areturn + (_.set-label @to) + (_.set-label @handler) ## T + string-writer ## TW + _.dup-x1 ## WTW + print-writer ## WTP + (_.invokevirtual //type.error "printStackTrace" (type.method [(list ^PrintWriter) type.void (list)])) ## W + (_.invokevirtual ^StringWriter "toString" (type.method [(list) //type.text (list)])) ## S + ..left-injection _.areturn + ))))) (def: reflection (All [category] (-> (Type (<| Return' Value' category)) Text)) (|>> type.reflection reflection.reflection)) +(def: ^Object (type.class "java.lang.Object" (list))) + (def: translate-runtime (Operation Any) - (let [^Object (type.class "java.lang.Object" (list)) - class (..reflection ..class) + (let [class (..reflection ..class) modifier (: (Modifier Class) ($_ modifier@compose class.public @@ -517,7 +520,8 @@ left-projection::method right-projection::method - ..try::method)) + ..try::method + )) (row.row)))] (do ////.monad [_ (///.execute! class [class bytecode])] @@ -530,35 +534,38 @@ (list@map (function (_ arity) (method.method method.public ..apply::name (..apply::type arity) (list) - (let [previous-inputs (|> arity - list.indices - (monad.map _.monad ..local))] - ($_ _.compose - previous-inputs - (_.invokevirtual //function.class ..apply::name (..apply::type (dec arity))) - (_.checkcast //function.class) - (..local arity) - (_.invokevirtual //function.class ..apply::name (..apply::type //function/arity.minimum)) - _.areturn))))) + (#.Some + (let [previous-inputs (|> arity + list.indices + (monad.map _.monad _.aload))] + ($_ _.compose + previous-inputs + (_.invokevirtual //function.class ..apply::name (..apply::type (dec arity))) + (_.checkcast //function.class) + (_.aload arity) + (_.invokevirtual //function.class ..apply::name (..apply::type //function/arity.minimum)) + _.areturn)))))) (list& (method.method (modifier@compose method.public method.abstract) ..apply::name (..apply::type //function/arity.minimum) (list) ## TODO: It shouldn't be necessary to set the code for this method, since it's abstract. ## Setting this might be a bug. Verify & fix ASAP. - ($_ _.compose - ..apply-failure - ..this - _.areturn)))) + (#.Some + ($_ _.compose + ..apply-failure + ..this + _.areturn))))) <init>::method (method.method method.public "<init>" //function.init (list) - (let [$partials _.iload-1] - ($_ _.compose - ..this - (_.invokespecial ^Object "<init>" (type.method [(list) type.void (list)])) - ..this - $partials - (_.putfield //function.class //function/count.field //function/count.type) - _.return))) + (#.Some + (let [$partials _.iload-1] + ($_ _.compose + ..this + (_.invokespecial ^Object "<init>" (type.method [(list) type.void (list)])) + ..this + $partials + (_.putfield //function.class //function/count.field //function/count.type) + _.return)))) modifier (: (Modifier Class) ($_ modifier@compose class.public diff --git a/stdlib/source/lux/tool/compiler/phase/generation/jvm/structure.lux b/stdlib/source/lux/tool/compiler/phase/generation/jvm/structure.lux index b48711dd0..0b5ebb5e7 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation/jvm/structure.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation/jvm/structure.lux @@ -9,7 +9,6 @@ ["." list]]] [target [jvm - ["." constant] ["_" bytecode (#+ Bytecode)] ["." type]]]] ["." // #_ @@ -24,9 +23,6 @@ (def: unitG (Bytecode Any) (//primitive.text /////synthesis.unit)) -(template: (!integer <value>) - (|> <value> .i64 i32.i32 constant.integer)) - (def: #export (tuple generate membersS) (Generator (Tuple Synthesis)) (case membersS @@ -45,11 +41,11 @@ [memberI (generate member)] (wrap (do _.monad [_ _.dup - _ (_.ldc/integer (!integer idx)) + _ (_.int (.i64 idx)) _ memberI] _.aastore))))))] (wrap (do _.monad - [_ (_.ldc/integer (!integer (list.size membersS))) + [_ (_.int (.i64 (list.size membersS))) _ (_.anewarray $Object)] (monad.seq @ membersI)))))) @@ -64,9 +60,9 @@ (do ////.monad [valueI (generate valueS)] (wrap (do _.monad - [_ (_.ldc/integer (!integer (if right? - (.inc lefts) - lefts))) + [_ (_.int (.i64 (if right? + (.inc lefts) + lefts))) _ (flagG right?) _ valueI] (_.invokestatic //runtime.class "variant" diff --git a/stdlib/source/test/lux/target/jvm.lux b/stdlib/source/test/lux/target/jvm.lux index 2617eeacf..7b2283cb8 100644 --- a/stdlib/source/test/lux/target/jvm.lux +++ b/stdlib/source/test/lux/target/jvm.lux @@ -53,10 +53,7 @@ ["#." signed] ["#." unsigned]] ["#" bytecode (#+ Label Bytecode) - ["#." instruction] - [environment - [limit - [registry (#+ Register)]]]] + ["#." instruction]] ["#." type (#+ Type) ["." category (#+ Value Object Class)]]]}) @@ -993,13 +990,13 @@ *wrap))))) store-and-load (: (All [a] (-> (Random a) (-> a (Bytecode Any)) (Bytecode Any) - [(-> Register (Bytecode Any)) (-> Register (Bytecode Any))] + [(-> Nat (Bytecode Any)) (-> Nat (Bytecode Any))] (-> a (-> Any Bit)) (Random Bit))) (function (_ random-value literal *wrap [store load] test) (do random.monad [expected random-value - register (:: @ map (|>> (n.% 128) /unsigned.u1 try.assume) random.nat)] + register (:: @ map (n.% 128) random.nat)] (<| (..bytecode (test expected)) (do /.monad [_ (literal expected) @@ -1033,8 +1030,7 @@ (do /.monad [_ (..$Byte::literal base) _ /.istore-0 - @0 (/.register 0) - _ (/.iinc @0 increment) + _ (/.iinc 0 increment) _ /.iload-0 _ /.i2l] ..$Long::wrap))))))) |