diff options
Diffstat (limited to 'stdlib/source/lux/tool/compiler/phase')
22 files changed, 570 insertions, 270 deletions
diff --git a/stdlib/source/lux/tool/compiler/phase/generation/jvm.lux b/stdlib/source/lux/tool/compiler/phase/generation/jvm.lux index b67ddcbcd..97db2b34c 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation/jvm.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation/jvm.lux @@ -7,7 +7,7 @@ ["#." primitive] ["#." structure] ["#." reference] - ## ["#." function] + ["#." function] ## ["#." case] ## ["#." loop] ["//#" /// @@ -57,11 +57,11 @@ ## (^ (synthesis.loop/recur updates)) ## (/loop.recur generate updates) - ## (^ (synthesis.function/abstraction abstraction)) - ## (/function.abstraction generate abstraction) + (^ (synthesis.function/abstraction abstraction)) + (/function.abstraction generate abstraction) - ## (^ (synthesis.function/apply application)) - ## (/function.apply generate application) + (^ (synthesis.function/apply application)) + (/function.apply generate application) ## (#synthesis.Extension extension) ## (/extension.apply generate extension) 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 36f8d72c6..a6a89993e 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation/jvm/function.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation/jvm/function.lux @@ -1,5 +1,5 @@ (.module: - [lux #* + [lux (#- Type) [abstract ["." monad (#+ do)]] [control @@ -10,54 +10,120 @@ ["n" nat]] [collection ["." list ("#@." monoid functor)] - ["." row]]] + ["." row]] + [format + [".F" binary]]] [target [jvm + ["." version] ["." modifier (#+ Modifier) ("#@." monoid)] ["." field (#+ Field)] ["." method (#+ Method)] ["_" instruction (#+ Label Instruction) ("#@." monad)] + ["." class (#+ Class)] + ["." type (#+ Type) + [category (#+ Return' Value')] + ["." reflection]] ["." constant [pool (#+ Pool)]] [encoding - [name (#+ External)] + ["." name (#+ External Internal)] ["." unsigned]]]]] ["." / #_ ["#." abstract] - ["#." arity] - ["#." field - ["#/." foreign] - ["#/." partial - ["#/." count]]] - ["#." method #_ - ["#/." new] - ["#/." reset] - ["#/." implementation] - ["#/." apply]] + [field + [constant + ["#." arity]] + [variable + ["#." foreign] + ["#." partial]]] + [method + ["#." init] + ["#." new] + ["#." implementation] + ["#." reset] + ["#." apply]] ["/#" // #_ [runtime (#+ Operation Phase)] - ["#." value] - ["#." reference] [//// [reference (#+ Register)] [analysis (#+ Environment)] [synthesis (#+ Synthesis Abstraction Apply)] ["." arity (#+ Arity)] - ["." phase]]]]) + ["." phase + ["." generation]]]]]) -(def: #export (apply generate [abstractionS argsS]) +(def: #export (with @begin class environment arity body) + (-> Label External Environment Arity (Instruction Any) + (Operation [(List (State Pool Field)) + (List (State Pool Method)) + (Instruction Any)])) + (let [classT (type.class class (list)) + fields (: (List (State Pool Field)) + (list& /arity.constant + (list@compose (/foreign.variables environment) + (/partial.variables arity)))) + methods (: (List (State Pool Method)) + (list& (/init.method classT environment arity) + (/reset.method classT environment arity) + (if (arity.multiary? arity) + (|> (n.min arity /arity.maximum) + list.indices + (list@map (|>> inc (/apply.method classT environment arity @begin body))) + (list& (/implementation.method arity @begin body))) + (list (/implementation.method' /apply.name arity @begin body)))))] + (do phase.monad + [instance (/new.instance classT environment arity)] + (wrap [fields methods instance])))) + +(def: modifier + (Modifier Class) + ($_ modifier@compose + class.public + class.final)) + +(def: this-offset 1) + +(def: internal + (All [category] + (-> (Type (<| Return' Value' category)) + Internal)) + (|>> type.reflection reflection.reflection name.internal)) + +(def: #export (abstraction generate [environment arity bodyS]) + (-> Phase Abstraction (Operation (Instruction Any))) + (do phase.monad + [@begin generation.next + [function-class bodyG] (generation.with-context + (generation.with-anchor [@begin ..this-offset] + (generate bodyS))) + [fields methods instance] (..with @begin function-class environment arity bodyG) + _ (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)))])] + (wrap instance))) + +(def: #export (apply generate [abstractionS inputsS]) (-> Phase Apply (Operation (Instruction Any))) (do phase.monad [abstractionG (generate abstractionS) - argsG (monad.map @ generate argsS)] + inputsG (monad.map @ generate inputsS)] (wrap ($_ _.compose abstractionG - (|> argsG + (|> inputsG (list.split-all /arity.maximum) (monad.map _.monad (function (_ batchG) ($_ _.compose (_.checkcast /abstract.class) (monad.seq _.monad batchG) - (_.invokevirtual /abstract.class /method/apply.name (/method/apply.type (list.size batchG))) - )))))))) + (_.invokevirtual /abstract.class /apply.name (/apply.type (list.size batchG))) + )))) + )))) 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))) 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 0f4cdfec7..f17b3f2d1 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation/jvm/primitive.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation/jvm/primitive.lux @@ -6,30 +6,29 @@ [jvm ["." constant] ["_" instruction (#+ Instruction)] - [type - ["|" descriptor]]]] + ["." type]]] [macro ["." template]]] ["." // #_ ["#." runtime]]) +(def: $Boolean (type.class "java.lang.Boolean" (list))) +(def: $Long (type.class "java.lang.Long" (list))) +(def: $Double (type.class "java.lang.Double" (list))) + (def: #export (bit value) (-> Bit (Instruction Any)) - (_.getstatic "java.lang.Boolean" - (if value "TRUE" "FALSE") - (|.class "java.lang.Boolean"))) + (_.getstatic $Boolean (if value "TRUE" "FALSE") $Boolean)) (template [<name> <inputT> <ldc> <class> <inputD>] [(def: #export (<name> value) (-> <inputT> (Instruction Any)) (do _.monad [_ (`` (|> value (~~ (template.splice <ldc>))))] - (_.invokestatic <class> "valueOf" - [(list <inputD>) - (|.class <class>)])))] + (_.invokestatic <class> "valueOf" (type.method [(list <inputD>) <class> (list)]))))] - [i64 (I64 Any) [.int constant.long _.ldc/long] "java.lang.Long" |.long] - [f64 Frac [constant.double _.ldc/double] "java.lang.Double" |.double] + [i64 (I64 Any) [.int constant.long _.ldc/long] $Long type.long] + [f64 Frac [constant.double _.ldc/double] $Double type.double] ) (def: #export text _.ldc/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 3e6738df0..9e60e6cda 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation/jvm/reference.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation/jvm/reference.lux @@ -13,15 +13,20 @@ [target [jvm ["_" instruction (#+ Instruction)] + ["." type] [encoding ["." unsigned]]]]] ["." // #_ [runtime (#+ Operation)] ["#." value]]) +(def: local + (-> Register (Instruction Any)) + (|>> unsigned.u1 _.aload)) + (def: #export this (Instruction Any) - (_.aload (unsigned.u1 0))) + (..local 0)) (template [<name> <prefix>] [(def: #export <name> @@ -38,13 +43,10 @@ [function-class generation.context] (wrap ($_ _.compose ..this - (_.getfield function-class (..foreign-name variable) + (_.getfield (type.class function-class (list)) + (..foreign-name variable) //value.type))))) -(def: local - (-> Register (Instruction Any)) - (|>> unsigned.u1 _.aload)) - (def: #export (variable variable) (-> Variable (Operation (Instruction Any))) (case variable @@ -58,4 +60,4 @@ (-> Name (Operation (Instruction Any))) (do phase.monad [bytecode-name (generation.remember name)] - (wrap (_.getstatic bytecode-name //value.field //value.type)))) + (wrap (_.getstatic (type.class bytecode-name (list)) //value.field //value.type)))) 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 b45965dc5..05ef66973 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation/jvm/runtime.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation/jvm/runtime.lux @@ -4,7 +4,11 @@ [binary (#+ Binary)]] [target [jvm - ["_" instruction (#+ Label Instruction)]]]] + ["_" instruction (#+ Label Instruction)] + [encoding + [name (#+ External)]] + ["." type + [category (#+ Value Return Method)]]]]] ["." /// [/// [reference (#+ Register)]]] @@ -29,4 +33,14 @@ (type: #export (Generator i) (-> Phase i (Operation (Instruction Any)))) -(def: #export class "LuxRuntime") +(def: #export class (type.class "LuxRuntime" (list))) + +(def: apply-failure-name + "apply_fail") + +(def: apply-failure-type + (type.method [(list) type.void (list)])) + +(def: #export apply-failure + (Instruction Any) + (_.invokestatic ..class ..apply-failure-name ..apply-failure-type)) 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 1ea837947..b75c646e8 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation/jvm/structure.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation/jvm/structure.lux @@ -9,10 +9,9 @@ ["." list]]] [target [jvm - ["_." constant] + ["." constant] ["_" instruction (#+ Instruction)] - [type - ["|" descriptor]]]]] + ["." type]]]] ["." // #_ ["#." runtime (#+ Operation Phase Generator)] ["#." primitive] @@ -21,10 +20,12 @@ [analysis (#+ Variant Tuple)] ["#." synthesis (#+ Synthesis)]]]]) +(def: $Object (type.class "java.lang.Object" (list))) + (def: unitG (Instruction Any) (//primitive.text /////synthesis.unit)) (template: (!integer <value>) - (|> <value> .i64 i32.i32 _constant.integer)) + (|> <value> .i64 i32.i32 constant.integer)) (def: #export (tuple generate membersS) (Generator (Tuple Synthesis)) @@ -49,7 +50,7 @@ _.aastore))))))] (wrap (do _.monad [_ (_.ldc/integer (!integer (list.size membersS))) - _ (_.anewarray "java.lang.Object")] + _ (_.anewarray $Object)] (monad.seq @ membersI)))))) (def: (flagG right?) @@ -58,8 +59,6 @@ ..unitG _.aconst-null)) -(def: $Object (|.class "java.lang.Object")) - (def: #export (variant generate [lefts right? valueS]) (Generator (Variant Synthesis)) (do ////.monad @@ -71,5 +70,6 @@ _ (flagG right?) _ valueI] (_.invokestatic //runtime.class "variant" - [(list |.int $Object $Object) - (|.array $Object)]))))) + (type.method [(list type.int $Object $Object) + (type.array $Object) + (list)])))))) diff --git a/stdlib/source/lux/tool/compiler/phase/generation/jvm/value.lux b/stdlib/source/lux/tool/compiler/phase/generation/jvm/value.lux index 0dfbe4861..52fcc390a 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation/jvm/value.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation/jvm/value.lux @@ -2,9 +2,8 @@ [lux (#- type) [target [jvm - [type - ["." descriptor]]]]]) + ["." type]]]]) -(def: #export field "_value") +(def: #export field "value") -(def: #export type (descriptor.class "java.lang.Object")) +(def: #export type (type.class "java.lang.Object" (list))) |