diff options
Diffstat (limited to '')
9 files changed, 170 insertions, 177 deletions
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)))) |