diff options
Diffstat (limited to 'stdlib/source/lux/tool/compiler/phase/generation')
14 files changed, 518 insertions, 5 deletions
diff --git a/stdlib/source/lux/tool/compiler/phase/generation/jvm.lux b/stdlib/source/lux/tool/compiler/phase/generation/jvm.lux index 9a4847165..23f3defea 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation/jvm.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation/jvm.lux @@ -6,15 +6,16 @@ [runtime (#+ Phase)] ["#." primitive] ["#." structure] - ## ["." reference ("#@." system)] - ## ["." function] + ["#." reference] + ["#." function] ## ["." case] ## ["." loop] ["//#" /// ## ["." extension] [// [analysis (#+)] - ["." synthesis]]]]) + ["." synthesis] + ["." reference]]]]) (def: #export (generate synthesis) Phase @@ -33,8 +34,13 @@ (^ (synthesis.tuple members)) (/structure.tuple generate members) - ## (#synthesis.Reference value) - ## (/reference@reference value) + (#synthesis.Reference reference) + (case reference + (#reference.Variable variable) + (/reference.variable variable) + + (#reference.Constant constant) + (/reference.constant constant)) ## (^ (synthesis.branch/case case)) ## (/case.case generate case) diff --git a/stdlib/source/lux/tool/compiler/phase/generation/jvm/function.lux b/stdlib/source/lux/tool/compiler/phase/generation/jvm/function.lux new file mode 100644 index 000000000..12e1bc460 --- /dev/null +++ b/stdlib/source/lux/tool/compiler/phase/generation/jvm/function.lux @@ -0,0 +1,64 @@ +(.module: + [lux #* + [abstract + ["." monad (#+ do)]] + [control + [state (#+ State)]] + [data + [number + ["." i32] + ["n" nat]] + [collection + ["." list ("#@." monoid functor)] + ["." row]]] + [target + [jvm + ["." descriptor (#+ Descriptor Value Return)] + ["." modifier (#+ Modifier) ("#@." monoid)] + ["." field (#+ Field)] + ["." method (#+ Method)] + ["_" instruction (#+ Label Instruction) ("#@." monad)] + ["." constant + [pool (#+ Pool)]] + [encoding + [name (#+ External)] + ["." unsigned]]]]] + ["." / #_ + ["#." abstract] + ["#." arity] + ["#." field + ["#/." foreign] + ["#/." partial + ["#/." count]]] + ["#." method #_ + ["#/." new] + ["#/." reset] + ["#/." implementation] + ["#/." apply]] + ["/#" // #_ + [runtime (#+ Operation Phase)] + ["#." value] + ["#." reference] + [//// + [reference (#+ Register)] + [analysis (#+ Environment)] + [synthesis (#+ Synthesis Abstraction Apply)] + ["." arity (#+ Arity)] + ["." phase]]]]) + +(def: #export (apply generate [abstractionS argsS]) + (-> Phase Apply (Operation (Instruction Any))) + (do phase.monad + [abstractionG (generate abstractionS) + argsG (monad.map @ generate argsS)] + (wrap ($_ _.compose + abstractionG + (|> argsG + (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))) + )))))))) 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 new file mode 100644 index 000000000..79cede3a4 --- /dev/null +++ b/stdlib/source/lux/tool/compiler/phase/generation/jvm/function/abstract.lux @@ -0,0 +1,4 @@ +(.module: + [lux #*]) + +(def: #export class "LuxFunction") 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 new file mode 100644 index 000000000..08954a7c0 --- /dev/null +++ b/stdlib/source/lux/tool/compiler/phase/generation/jvm/function/arity.lux @@ -0,0 +1,10 @@ +(.module: + [lux (#- type) + [target + [jvm + ["." 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 new file mode 100644 index 000000000..849d9a663 --- /dev/null +++ b/stdlib/source/lux/tool/compiler/phase/generation/jvm/function/field.lux @@ -0,0 +1,29 @@ +(.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/foreign.lux b/stdlib/source/lux/tool/compiler/phase/generation/jvm/function/field/foreign.lux new file mode 100644 index 000000000..b4fa6727e --- /dev/null +++ b/stdlib/source/lux/tool/compiler/phase/generation/jvm/function/field/foreign.lux @@ -0,0 +1,33 @@ +(.module: + [lux #* + [control + [state (#+ State)]] + [data + [collection + ["." list ("#@." functor)] + ["." row]]] + [target + [jvm + [descriptor (#+ Descriptor Value)] + ["." field (#+ Field)] + [constant + [pool (#+ Pool)]]]]] + ["." // + ["//#" /// #_ + ["#." value] + ["#." reference] + [//// + [analysis (#+ Environment)]]]]) + +(def: #export (closure environment) + (-> Environment (List (Descriptor (Value Any)))) + (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/partial.lux b/stdlib/source/lux/tool/compiler/phase/generation/jvm/function/field/partial.lux new file mode 100644 index 000000000..0f3c9ced5 --- /dev/null +++ b/stdlib/source/lux/tool/compiler/phase/generation/jvm/function/field/partial.lux @@ -0,0 +1,53 @@ +(.module: + [lux #* + [abstract + ["." monad]] + [control + [state (#+ State)]] + [data + [number + ["n" nat]] + [collection + ["." list ("#@." functor)] + ["." row]]] + [target + [jvm + ["." field (#+ Field)] + ["_" instruction (#+ Label Instruction) ("#@." monad)] + [constant + [pool (#+ Pool)]]]]] + ["." / #_ + ["#." count] + ["/#" // + ["/#" // #_ + ["#." arity] + ["/#" // #_ + ["#." reference] + [//// + ["." arity (#+ Arity)]]]]]]) + +(def: #export (initial amount) + (-> Nat (Instruction Any)) + ($_ _.compose + (|> _.aconst-null + (list.repeat amount) + (monad.seq _.monad)) + (_@wrap []))) + +(def: #export fields + (-> Arity (List (State Pool Field))) + (|>> (n.- ///arity.minimum) + list.indices + (list@map (function (_ index) + (field.field //.modifier + (////reference.partial-name index) + //.type + (row.row)))))) + +(def: #export (new arity) + (-> Arity (Instruction Any)) + (if (arity.multiary? arity) + ($_ _.compose + /count.initial + (initial (n.- ///arity.minimum arity))) + (_@wrap []))) 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/partial/count.lux new file mode 100644 index 000000000..625cad78d --- /dev/null +++ b/stdlib/source/lux/tool/compiler/phase/generation/jvm/function/field/partial/count.lux @@ -0,0 +1,27 @@ +(.module: + [lux (#- type) + [target + [jvm + ["." descriptor] + ["_" instruction (#+ Instruction) ("#@." monad)] + [encoding + [name (#+ External)] + ["." unsigned]]]]] + ["." //// #_ + ["#." abstract] + ["/#" // #_ + ["#." reference]]]) + +(def: #export field "partials") +(def: #export type descriptor.int) + +(def: #export initial + (Instruction Any) + (_.bipush (unsigned.u1 0))) + +(def: #export value + (Instruction Any) + ($_ _.compose + /////reference.this + (_.getfield ////abstract.class ..field ..type) + )) diff --git a/stdlib/source/lux/tool/compiler/phase/generation/jvm/function/method.lux b/stdlib/source/lux/tool/compiler/phase/generation/jvm/function/method.lux new file mode 100644 index 000000000..2fd419d18 --- /dev/null +++ b/stdlib/source/lux/tool/compiler/phase/generation/jvm/function/method.lux @@ -0,0 +1,13 @@ +(.module: + [lux #* + [target + [jvm + ["." modifier (#+ Modifier) ("#@." monoid)] + ["." method (#+ Method)]]]]) + +(def: #export modifier + (Modifier Method) + ($_ modifier@compose + method.public + method.strict + )) 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 new file mode 100644 index 000000000..3971610ff --- /dev/null +++ b/stdlib/source/lux/tool/compiler/phase/generation/jvm/function/method/apply.lux @@ -0,0 +1,60 @@ +(.module: + [lux (#- type) + [abstract + ["." monad]] + [data + [number + ["n" nat] + ["." i32]] + [collection + ["." list]]] + [target + [jvm + ["." descriptor (#+ Descriptor Value Return)] + ["_" instruction (#+ Instruction) ("#@." monad)] + ["." constant] + [encoding + ["." unsigned]]]]] + ["." /// #_ + ["#." abstract] + ["#." arity] + ["/#" // #_ + ["#." value] + [//// + [reference (#+ Register)] + [arity (#+ Arity)]]]]) + +(def: #export name "apply") + +(def: #export (type arity) + (-> Arity [(List (Descriptor (Value Any))) (Descriptor (Return Any))]) + [(list.repeat arity ////value.type) + ////value.type]) + +(def: (increment by) + (-> Nat (Instruction Any)) + ($_ _.compose + (<| _.ldc/integer constant.integer i32.i32 .i64 by) + _.iadd)) + +(def: (inputs offset amount) + (-> Register Nat (Instruction Any)) + ($_ _.compose + (|> amount + list.indices + (monad.map _.monad (|>> (n.+ offset) unsigned.u1 _.aload))) + (_@wrap []) + )) + +(def: #export (instruction offset amount) + (-> Register Nat (Instruction Any)) + (let [arity (n.min amount ///arity.maximum)] + ($_ _.compose + (_.checkcast ///abstract.class) + (..inputs offset arity) + (_.invokevirtual ///abstract.class ..name (..type arity)) + (if (n.> ///arity.maximum amount) + (instruction (n.+ ///arity.maximum offset) + (n.- ///arity.maximum amount)) + (_@wrap [])) + ))) 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 new file mode 100644 index 000000000..9b8a19b59 --- /dev/null +++ b/stdlib/source/lux/tool/compiler/phase/generation/jvm/function/method/implementation.lux @@ -0,0 +1,37 @@ +(.module: + [lux (#- type) + [control + [state (#+ State)]] + [data + [collection + ["." list]]] + [target + [jvm + ["." descriptor (#+ Descriptor)] + ["." method (#+ Method)] + ["_" instruction (#+ Label Instruction)] + [constant + [pool (#+ Pool)]]]]] + ["." // + ["//#" /// #_ + ["#." value] + [//// + [arity (#+ Arity)]]]]) + +(def: #export name "impl") + +(def: #export (type arity) + (-> Arity (Descriptor descriptor.Method)) + (descriptor.method [(list.repeat arity ////value.type) + ////value.type])) + +(def: #export (method arity @begin body) + (-> Arity Label (Instruction Any) (State Pool Method)) + (method.method //.modifier ..name + (..type arity) + (list) + ($_ _.compose + (_.set-label @begin) + body + _.areturn + ))) 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 new file mode 100644 index 000000000..0489b8f12 --- /dev/null +++ b/stdlib/source/lux/tool/compiler/phase/generation/jvm/function/method/init.lux @@ -0,0 +1,28 @@ +(.module: + [lux (#- type) + [target + [jvm + ["." descriptor (#+ Descriptor Value Return)] + ["_" instruction (#+ Instruction)] + [encoding + ["." unsigned]]]]] + ["." /// #_ + ["#." abstract] + ["#." arity] + ["/#" // #_ + [//// + ["." arity (#+ Arity)]]]]) + +(def: #export type + [(List (Descriptor (Value Any))) + (Descriptor (Return Any))] + [(list ///arity.type) descriptor.void]) + +(def: #export (instruction 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)))) 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 new file mode 100644 index 000000000..c0bf6e44b --- /dev/null +++ b/stdlib/source/lux/tool/compiler/phase/generation/jvm/function/method/new.lux @@ -0,0 +1,91 @@ +(.module: + [lux (#- type) + [abstract + ["." monad (#+ do)]] + [control + [state (#+ State)]] + [data + [number + ["n" nat]] + [collection + ["." list ("#@." monoid)]]] + [target + [jvm + ["." descriptor (#+ Descriptor Value Return)] + ["." modifier (#+ Modifier) ("#@." monoid)] + ["." field (#+ Field)] + ["." method (#+ Method)] + ["_" instruction (#+ Instruction)] + ["." constant + [pool (#+ Pool)]] + [encoding + [name (#+ External)] + ["." unsigned]]]]] + ["." // + ["#." init] + ["/#" // #_ + ["#." arity] + ["#." field + ["#/." foreign] + ["#/." partial]] + ["/#" // #_ + [runtime (#+ Operation)] + ["#." value] + ["#." reference] + [//// + [analysis (#+ Environment)] + ["." arity (#+ Arity)] + ["." phase]]]]]) + +(def: (arguments arity) + (-> Arity (List (Descriptor (Value Any)))) + (list.repeat (dec arity) ////value.type)) + +(def: #export (type environment arity) + (-> Environment Arity [(List (Descriptor (Value Any))) + (Descriptor (Return Any))]) + [(list@compose (///field/foreign.closure environment) + (if (arity.multiary? arity) + (list& ///arity.type (arguments arity)) + (list))) + descriptor.void]) + +(def: #export (instance class environment arity) + (-> External 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)))))) + +(def: #export (method class environment arity) + (-> External Environment Arity (State Pool Method)) + (let [after-this (: (-> Nat Nat) + (n.+ 1)) + environment-size (list.size environment) + after-environment (: (-> Nat Nat) + (|>> after-this (n.+ environment-size))) + after-arity (: (-> Nat Nat) + (|>> after-environment (n.+ 1)))] + (method.method //.modifier "<init>" + (descriptor.method (..type environment arity)) + (list) + ($_ _.compose + ////reference.this + (//init.instruction 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))) + (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))) + (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 new file mode 100644 index 000000000..7aee9e428 --- /dev/null +++ b/stdlib/source/lux/tool/compiler/phase/generation/jvm/function/method/reset.lux @@ -0,0 +1,58 @@ +(.module: + [lux (#- type) + [abstract + ["." monad]] + [control + [state (#+ State)]] + [data + [collection + ["." list]]] + [target + [jvm + [modifier (#+ Modifier)] + ["." descriptor (#+ Descriptor)] + ["." method (#+ Method)] + ["_" instruction] + [constant + [pool (#+ Pool)]] + [encoding + [name (#+ External)]]]]] + ["." // + ["#." new] + ["/#" // #_ + ["#." arity] + ["#." field + ["#/." partial]] + ["/#" // #_ + ["#." value] + ["#." reference] + [//// + [analysis (#+ Environment)] + [reference (#+ Register)] + ["." arity (#+ Arity)]]]]]) + +(def: #export name "reset") + +(def: #export type + (-> External (Descriptor descriptor.Method)) + (|>> descriptor.object [(list)] descriptor.method)) + +(def: #export (method class environment arity) + (-> External 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))) + ////reference.this) + _.areturn))) |