diff options
Diffstat (limited to 'stdlib/source/lux/tool/compiler/phase/generation/jvm/function')
15 files changed, 432 insertions, 212 deletions
diff --git a/stdlib/source/lux/tool/compiler/phase/generation/jvm/function/abstract.lux b/stdlib/source/lux/tool/compiler/phase/generation/jvm/function/abstract.lux index 79cede3a4..9b653ec6c 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation/jvm/function/abstract.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation/jvm/function/abstract.lux @@ -1,4 +1,7 @@ (.module: - [lux #*]) + [lux #* + [target + [jvm + ["." type]]]]) -(def: #export class "LuxFunction") +(def: #export class (type.class "LuxFunction" (list))) diff --git a/stdlib/source/lux/tool/compiler/phase/generation/jvm/function/arity.lux b/stdlib/source/lux/tool/compiler/phase/generation/jvm/function/arity.lux deleted file mode 100644 index ac35be9ba..000000000 --- a/stdlib/source/lux/tool/compiler/phase/generation/jvm/function/arity.lux +++ /dev/null @@ -1,11 +0,0 @@ -(.module: - [lux (#- type) - [target - [jvm - [type - ["." descriptor]]]]]) - -(def: #export field "arity") -(def: #export type descriptor.int) -(def: #export minimum 1) -(def: #export maximum 8) diff --git a/stdlib/source/lux/tool/compiler/phase/generation/jvm/function/field.lux b/stdlib/source/lux/tool/compiler/phase/generation/jvm/function/field.lux deleted file mode 100644 index 849d9a663..000000000 --- a/stdlib/source/lux/tool/compiler/phase/generation/jvm/function/field.lux +++ /dev/null @@ -1,29 +0,0 @@ -(.module: - [lux (#- type) - [target - [jvm - ["." modifier (#+ Modifier) ("#@." monoid)] - ["." field (#+ Field)] - ["_" instruction (#+ Instruction)] - [encoding - [name (#+ External)]]]]] - ["." /// #_ - [runtime (#+ Operation)] - ["#." value] - ["#." reference]]) - -(def: #export type ///value.type) - -(def: #export (field class name) - (-> External Text (Instruction Any)) - ($_ _.compose - ///reference.this - (_.getfield class name ..type) - )) - -(def: #export modifier - (Modifier Field) - ($_ modifier@compose - field.private - field.final - )) diff --git a/stdlib/source/lux/tool/compiler/phase/generation/jvm/function/field/constant.lux b/stdlib/source/lux/tool/compiler/phase/generation/jvm/function/field/constant.lux new file mode 100644 index 000000000..456e46b86 --- /dev/null +++ b/stdlib/source/lux/tool/compiler/phase/generation/jvm/function/field/constant.lux @@ -0,0 +1,27 @@ +(.module: + [lux (#- Type type) + [control + [state (#+ State)]] + [data + [collection + ["." row]]] + [target + [jvm + ["." field (#+ Field)] + ["." modifier (#+ Modifier) ("#@." monoid)] + [type (#+ Type) + [category (#+ Value)]] + [constant + [pool (#+ Pool)]]]]]) + +(def: modifier + (Modifier Field) + ($_ modifier@compose + field.public + field.static + field.final + )) + +(def: #export (constant name type) + (-> Text (Type Value) (State Pool Field)) + (field.field ..modifier name type (row.row))) diff --git a/stdlib/source/lux/tool/compiler/phase/generation/jvm/function/field/constant/arity.lux b/stdlib/source/lux/tool/compiler/phase/generation/jvm/function/field/constant/arity.lux new file mode 100644 index 000000000..589d9c43d --- /dev/null +++ b/stdlib/source/lux/tool/compiler/phase/generation/jvm/function/field/constant/arity.lux @@ -0,0 +1,23 @@ +(.module: + [lux (#- type) + [control + [state (#+ State)]] + [target + [jvm + ["." type] + ["." field (#+ Field)] + [constant + [pool (#+ Pool)]]]]] + ["." // + [/////// + [arity (#+ Arity)]]]) + +(def: #export name "arity") +(def: #export type type.int) + +(def: #export minimum Arity 1) +(def: #export maximum Arity 8) + +(def: #export constant + (State Pool Field) + (//.constant ..name ..type)) diff --git a/stdlib/source/lux/tool/compiler/phase/generation/jvm/function/field/foreign.lux b/stdlib/source/lux/tool/compiler/phase/generation/jvm/function/field/foreign.lux deleted file mode 100644 index 1534a9683..000000000 --- a/stdlib/source/lux/tool/compiler/phase/generation/jvm/function/field/foreign.lux +++ /dev/null @@ -1,35 +0,0 @@ -(.module: - [lux (#- Type) - [control - [state (#+ State)]] - [data - [collection - ["." list ("#@." functor)] - ["." row]]] - [target - [jvm - ["." field (#+ Field)] - [constant - [pool (#+ Pool)]] - [type - [category (#+ Value)] - [descriptor (#+ Descriptor)]]]]] - ["." // - ["//#" /// #_ - ["#." value] - ["#." reference] - [//// - [analysis (#+ Environment)]]]]) - -(def: #export (closure environment) - (-> Environment (List (Descriptor Value))) - (list.repeat (list.size environment) ////value.type)) - -(def: #export fields - (-> Environment (List (State Pool Field))) - (|>> list.enumerate - (list@map (function (_ [index source]) - (field.field //.modifier - (////reference.foreign-name index) - //.type - (row.row)))))) 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 new file mode 100644 index 000000000..083d279ea --- /dev/null +++ b/stdlib/source/lux/tool/compiler/phase/generation/jvm/function/field/variable.lux @@ -0,0 +1,56 @@ +(.module: + [lux (#- Type type) + [control + [state (#+ State)]] + [data + [collection + ["." list ("#@." functor)] + ["." row]]] + [target + [jvm + ["." modifier (#+ Modifier) ("#@." monoid)] + ["." field (#+ Field)] + ["_" instruction (#+ Instruction)] + [type (#+ Type) + [category (#+ Value Class)]] + [constant + [pool (#+ Pool)]]]]] + ["." //// #_ + ["#." value] + ["#." reference] + [//// + [reference (#+ Register)]]]) + +(def: #export type ////value.type) + +(def: #export (get class name) + (-> (Type Class) Text (Instruction Any)) + ($_ _.compose + ////reference.this + (_.getfield class name ..type) + )) + +(def: #export (put naming class register value) + (-> (-> Register Text) (Type Class) Register (Instruction Any) (Instruction Any)) + ($_ _.compose + ////reference.this + value + (_.putfield class (naming register) ..type))) + +(def: modifier + (Modifier Field) + ($_ modifier@compose + field.private + field.final + )) + +(def: #export (variable name type) + (-> Text (Type Value) (State Pool Field)) + (field.field ..modifier name type (row.row))) + +(def: #export (variables naming amount) + (-> (-> Register Text) Nat (List (State Pool Field))) + (|> amount + list.indices + (list@map (function (_ register) + (..variable (naming register) ..type))))) 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 new file mode 100644 index 000000000..0b4a2bc3d --- /dev/null +++ b/stdlib/source/lux/tool/compiler/phase/generation/jvm/function/field/variable/foreign.lux @@ -0,0 +1,38 @@ +(.module: + [lux (#- Type) + [control + [state (#+ State)]] + [data + [collection + ["." list ("#@." functor)] + ["." row]]] + [target + [jvm + ["_" instruction (#+ Instruction)] + ["." field (#+ Field)] + [constant + [pool (#+ Pool)]] + [type (#+ Type) + [category (#+ Value Class)]]]]] + ["." // + ["///#" //// #_ + ["#." reference] + [//// + [reference (#+ Register)] + [analysis (#+ Environment)]]]]) + +(def: #export (closure environment) + (-> Environment (List (Type Value))) + (list.repeat (list.size environment) //.type)) + +(def: #export (get class register) + (-> (Type Class) Register (Instruction Any)) + (//.get class (/////reference.foreign-name register))) + +(def: #export (put class register value) + (-> (Type Class) Register (Instruction Any) (Instruction Any)) + (//.put /////reference.foreign-name class register value)) + +(def: #export variables + (-> Environment (List (State Pool Field))) + (|>> list.size (//.variables /////reference.foreign-name))) diff --git a/stdlib/source/lux/tool/compiler/phase/generation/jvm/function/field/partial.lux b/stdlib/source/lux/tool/compiler/phase/generation/jvm/function/field/variable/partial.lux index 0f3c9ced5..39be26183 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation/jvm/function/field/partial.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation/jvm/function/field/variable/partial.lux @@ -1,5 +1,5 @@ (.module: - [lux #* + [lux (#- Type) [abstract ["." monad]] [control @@ -14,16 +14,20 @@ [jvm ["." field (#+ Field)] ["_" instruction (#+ Label Instruction) ("#@." monad)] + [type (#+ Type) + [category (#+ Class)]] [constant [pool (#+ Pool)]]]]] ["." / #_ ["#." count] ["/#" // ["/#" // #_ - ["#." arity] - ["/#" // #_ + [constant + ["#." arity]] + ["//#" /// #_ ["#." reference] [//// + [reference (#+ Register)] ["." arity (#+ Arity)]]]]]]) (def: #export (initial amount) @@ -34,15 +38,17 @@ (monad.seq _.monad)) (_@wrap []))) -(def: #export fields +(def: #export (get class register) + (-> (Type Class) Register (Instruction Any)) + (//.get class (/////reference.partial-name register))) + +(def: #export (put class register value) + (-> (Type Class) Register (Instruction Any) (Instruction Any)) + (//.put /////reference.partial-name class register value)) + +(def: #export variables (-> Arity (List (State Pool Field))) - (|>> (n.- ///arity.minimum) - list.indices - (list@map (function (_ index) - (field.field //.modifier - (////reference.partial-name index) - //.type - (row.row)))))) + (|>> (n.- ///arity.minimum) (//.variables /////reference.partial-name))) (def: #export (new arity) (-> Arity (Instruction Any)) diff --git a/stdlib/source/lux/tool/compiler/phase/generation/jvm/function/field/partial/count.lux b/stdlib/source/lux/tool/compiler/phase/generation/jvm/function/field/variable/partial/count.lux index 9b611fb94..b646ddbf6 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation/jvm/function/field/partial/count.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation/jvm/function/field/variable/partial/count.lux @@ -2,19 +2,18 @@ [lux (#- type) [target [jvm - ["_" instruction (#+ Instruction) ("#@." monad)] + ["_" instruction (#+ Instruction)] [encoding [name (#+ External)] ["." unsigned]] - [type - ["." descriptor]]]]] - ["." //// #_ + ["." type]]]] + ["." ///// #_ ["#." abstract] ["/#" // #_ ["#." reference]]]) (def: #export field "partials") -(def: #export type descriptor.int) +(def: #export type type.int) (def: #export initial (Instruction Any) @@ -23,6 +22,6 @@ (def: #export value (Instruction Any) ($_ _.compose - /////reference.this - (_.getfield ////abstract.class ..field ..type) + //////reference.this + (_.getfield /////abstract.class ..field ..type) )) 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 e298ab187..0d4e1f2b3 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 @@ -1,37 +1,56 @@ (.module: - [lux (#- type) + [lux (#- Type type) [abstract - ["." monad]] + ["." monad (#+ do)]] + [control + [state (#+ State)]] [data [number ["n" nat] + ["i" int] ["." i32]] [collection - ["." list]]] + ["." list ("#@." monoid functor)]]] [target [jvm - ["_" instruction (#+ Instruction) ("#@." monad)] - ["." constant] + ["_" instruction (#+ Label Instruction) ("#@." monad)] + ["." method (#+ Method)] + ["." constant + [pool (#+ Pool)]] [encoding - ["." unsigned]] - [type - ["." category (#+ Value Return)] - ["." descriptor (#+ Descriptor)]]]]] - ["." /// #_ - ["#." abstract] - ["#." arity] + ["." unsigned] + ["." signed]] + ["." type (#+ Type) + ["." category (#+ Class)]]]]] + ["." // + ["#." reset] + ["#." implementation] + ["#." init] ["/#" // #_ - ["#." value] - [//// - [reference (#+ Register)] - [arity (#+ Arity)]]]]) + ["#." abstract] + [field + [constant + ["#." arity]] + [variable + ["#." partial + ["#/." count]] + ["#." foreign]]] + ["/#" // #_ + ["#." runtime] + ["#." value] + ["#." reference] + [//// + [analysis (#+ Environment)] + [arity (#+ Arity)] + ["." reference (#+ Register)]]]]]) (def: #export name "apply") (def: #export (type arity) - (-> Arity [(List (Descriptor Value)) (Descriptor Return)]) - [(list.repeat arity ////value.type) - ////value.type]) + (-> Arity (Type category.Method)) + (type.method [(list.repeat arity ////value.type) + ////value.type + (list)])) (def: (increment by) (-> Nat (Instruction Any)) @@ -48,7 +67,7 @@ (_@wrap []) )) -(def: #export (instruction offset amount) +(def: (apply offset amount) (-> Register Nat (Instruction Any)) (let [arity (n.min amount ///arity.maximum)] ($_ _.compose @@ -56,7 +75,86 @@ (..inputs offset arity) (_.invokevirtual ///abstract.class ..name (..type arity)) (if (n.> ///arity.maximum amount) - (instruction (n.+ ///arity.maximum offset) - (n.- ///arity.maximum amount)) + (apply (n.+ ///arity.maximum offset) + (n.- ///arity.maximum amount)) (_@wrap [])) ))) + +(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)) + (let [num-partials (dec function-arity) + over-extent (i.- (.int apply-arity) + (.int function-arity)) + failure ($_ _.compose + ////runtime.apply-failure + _.aconst-null + _.areturn)] + (method.method //.modifier ..name + (..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)) + + ## (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))))) 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 18df43d9d..8643dc916 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,5 +1,5 @@ (.module: - [lux (#- type) + [lux (#- Type type) [control [state (#+ State)]] [data @@ -11,9 +11,8 @@ ["_" instruction (#+ Label Instruction)] [constant [pool (#+ Pool)]] - [type - ["." category] - ["." descriptor (#+ Descriptor)]]]]] + ["." type (#+ Type) + ["." category]]]]] ["." // ["//#" /// #_ ["#." value] @@ -23,13 +22,14 @@ (def: #export name "impl") (def: #export (type arity) - (-> Arity (Descriptor category.Method)) - (descriptor.method [(list.repeat arity ////value.type) - ////value.type])) + (-> Arity (Type category.Method)) + (type.method [(list.repeat arity ////value.type) + ////value.type + (list)])) -(def: #export (method arity @begin body) - (-> Arity Label (Instruction Any) (State Pool Method)) - (method.method //.modifier ..name +(def: #export (method' name arity @begin body) + (-> Text Arity Label (Instruction Any) (State Pool Method)) + (method.method //.modifier name (..type arity) (list) ($_ _.compose @@ -37,3 +37,7 @@ body _.areturn ))) + +(def: #export method + (-> Arity Label (Instruction Any) (State Pool 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 5f771abcd..5eddafb8a 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 @@ -1,30 +1,96 @@ (.module: - [lux (#- type) + [lux (#- Type type) + [abstract + ["." monad]] + [control + [state (#+ State)]] + [data + [number + ["n" nat]] + [collection + ["." list ("#@." monoid functor)]]] [target [jvm ["_" instruction (#+ Instruction)] + ["." method (#+ Method)] [encoding ["." unsigned]] - [type - ["." category (#+ Value Return)] - ["." descriptor (#+ Descriptor)]]]]] - ["." /// #_ - ["#." abstract] - ["#." arity] + [constant + [pool (#+ Pool)]] + ["." type (#+ Type) + ["." category (#+ Class Value)]]]]] + ["." // + ["#." implementation] ["/#" // #_ - [//// - ["." arity (#+ Arity)]]]]) + ["#." abstract] + [field + [constant + ["#." arity]] + [variable + ["#." foreign] + ["#." partial]]] + ["/#" // #_ + ["#." value] + ["#." reference] + [//// + [reference (#+ Register)] + [analysis (#+ Environment)] + ["." arity (#+ Arity)]]]]]) -(def: #export type - [(List (Descriptor Value)) - (Descriptor Return)] - [(list ///arity.type) descriptor.void]) +(def: #export name "<init>") -(def: #export (instruction environment-size arity) +(def: (partials arity) + (-> Arity (List (Type Value))) + (list.repeat arity ////value.type)) + +(def: #export (type environment arity) + (-> Environment Arity (Type category.Method)) + (type.method [(list@compose (///foreign.closure environment) + (if (arity.multiary? arity) + (list& ///arity.type (..partials arity)) + (list))) + type.void + (list)])) + +(def: super-type + (Type category.Method) + (type.method [(list ///arity.type) type.void (list)])) + +(def: #export (super environment-size arity) (-> Nat Arity (Instruction Any)) (let [arity-register (inc environment-size)] ($_ _.compose (if (arity.unary? arity) (_.bipush (unsigned.u1 0)) (_.iload (unsigned.u1 arity-register))) - (_.invokespecial ///abstract.class "<init>" ..type)))) + (_.invokespecial ///abstract.class ..name ..super-type)))) + +(def: (store-all amount put offset) + (-> Nat + (-> Register (Instruction Any) (Instruction Any)) + (-> Register Register) + (Instruction Any)) + (|> (list.indices amount) + (list@map (function (_ register) + (put register + (_.aload (unsigned.u1 (offset register)))))) + (monad.seq _.monad))) + +(def: #export (method class environment arity) + (-> (Type Class) Environment Arity (State Pool Method)) + (let [environment-size (list.size environment) + offset-foreign (: (-> Register Register) + (n.+ 1)) + offset-arity (: (-> Register Register) + (|>> offset-foreign (n.+ environment-size))) + offset-partial (: (-> Register Register) + (|>> offset-arity (n.+ 1)))] + (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)))) 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 f03d333b2..241ec2676 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 @@ -1,5 +1,5 @@ (.module: - [lux (#- type) + [lux (#- Type type) [abstract ["." monad (#+ do)]] [control @@ -18,18 +18,19 @@ ["." constant [pool (#+ Pool)]] [encoding - [name (#+ External)] ["." unsigned]] - [type - ["." category (#+ Value Return)] - ["." descriptor (#+ Descriptor)]]]]] + [type (#+ Type) + ["." category (#+ Class Value Return)]]]]] ["." // ["#." init] + ["#." implementation] ["/#" // #_ - ["#." arity] - ["#." field - ["#/." foreign] - ["#/." partial]] + [field + [constant + ["#." arity]] + [variable + ["#." foreign] + ["#." partial]]] ["/#" // #_ [runtime (#+ Operation)] ["#." value] @@ -39,32 +40,23 @@ ["." arity (#+ Arity)] ["." phase]]]]]) -(def: (arguments arity) - (-> Arity (List (Descriptor Value))) - (list.repeat (dec arity) ////value.type)) - -(def: #export (type environment arity) - (-> Environment Arity [(List (Descriptor Value)) - (Descriptor Return)]) - [(list@compose (///field/foreign.closure environment) - (if (arity.multiary? arity) - (list& ///arity.type (arguments arity)) - (list))) - descriptor.void]) +(def: #export (instance' foreign-setup class environment arity) + (-> (List (Instruction Any)) (Type Class) Environment Arity (Instruction Any)) + ($_ _.compose + (_.new class) + _.dup + (monad.seq _.monad foreign-setup) + (///partial.new arity) + (_.invokespecial class //init.name (//init.type environment arity)))) (def: #export (instance class environment arity) - (-> External Environment Arity (Operation (Instruction Any))) + (-> (Type Class) Environment Arity (Operation (Instruction Any))) (do phase.monad [foreign* (monad.map @ ////reference.variable environment)] - (wrap ($_ _.compose - (_.new class) - _.dup - (monad.seq _.monad foreign*) - (///field/partial.new arity) - (_.invokespecial class "<init>" (..type environment arity)))))) + (wrap (instance' foreign* class environment arity)))) (def: #export (method class environment arity) - (-> External Environment Arity (State Pool Method)) + (-> (Type Class) Environment Arity (State Pool Method)) (let [after-this (: (-> Nat Nat) (n.+ 1)) environment-size (list.size environment) @@ -72,22 +64,16 @@ (|>> after-this (n.+ environment-size))) after-arity (: (-> Nat Nat) (|>> after-environment (n.+ 1)))] - (method.method //.modifier "<init>" - (descriptor.method (..type environment arity)) + (method.method //.modifier //init.name + (//init.type environment arity) (list) ($_ _.compose ////reference.this - (//init.instruction environment-size arity) + (//init.super environment-size arity) (monad.map _.monad (function (_ register) - ($_ _.compose - ////reference.this - (_.aload (unsigned.u1 (after-this register))) - (_.putfield class (////reference.foreign-name register) ////value.type))) + (///foreign.put class register (_.aload (unsigned.u1 (after-this register))))) (list.indices environment-size)) (monad.map _.monad (function (_ register) - ($_ _.compose - ////reference.this - (_.aload (unsigned.u1 (after-arity register))) - (_.putfield class (////reference.partial-name register) ////value.type))) + (///partial.put class register (_.aload (unsigned.u1 (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 e43fd1b9b..2eab6933b 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,60 +1,49 @@ (.module: - [lux (#- type) - [abstract - ["." monad]] + [lux (#- Type type) [control [state (#+ State)]] [data [collection - ["." list]]] + ["." list ("#@." functor)]]] [target [jvm - [modifier (#+ Modifier)] ["." method (#+ Method)] - ["_" instruction] + ["_" instruction (#+ Instruction)] [constant [pool (#+ Pool)]] - [encoding - [name (#+ External)]] - [type - ["." category] - ["." descriptor (#+ Descriptor)]]]]] + ["." type (#+ Type) + ["." category (#+ Class)]]]]] ["." // ["#." new] ["/#" // #_ - ["#." arity] - ["#." field - ["#/." partial]] + [field + [variable + ["#." foreign]]] ["/#" // #_ - ["#." value] ["#." reference] [//// [analysis (#+ Environment)] - [reference (#+ Register)] ["." arity (#+ Arity)]]]]]) (def: #export name "reset") -(def: #export type - (-> External (Descriptor category.Method)) - (|>> descriptor.class [(list)] descriptor.method)) +(def: #export (type class) + (-> (Type Class) (Type category.Method)) + (type.method [(list) class (list)])) + +(def: (current-environment class) + (-> (Type Class) Environment (List (Instruction Any))) + (|>> list.size + list.indices + (list@map (///foreign.get class)))) (def: #export (method class environment arity) - (-> External Environment Arity (State Pool Method)) + (-> (Type Class) Environment Arity (State Pool Method)) (method.method //.modifier ..name (..type class) (list) ($_ _.compose (if (arity.multiary? arity) - ($_ _.compose - (_.new class) - _.dup - (monad.map _.monad (function (_ source) - ($_ _.compose - ////reference.this - (_.getfield class (////reference.foreign-name source) ////value.type))) - (list.indices (list.size environment))) - (///field/partial.new arity) - (_.invokespecial class "<init>" (//new.type environment arity))) + (//new.instance' (..current-environment class environment) class environment arity) ////reference.this) _.areturn))) |