diff options
29 files changed, 684 insertions, 366 deletions
diff --git a/stdlib/source/lux/target/jvm/encoding/name.lux b/stdlib/source/lux/target/jvm/encoding/name.lux index 1ba56573a..cda98e0a0 100644 --- a/stdlib/source/lux/target/jvm/encoding/name.lux +++ b/stdlib/source/lux/target/jvm/encoding/name.lux @@ -17,7 +17,7 @@ Text (def: #export internal - (-> Text Internal) + (-> External Internal) (|>> (text.replace-all ..external-separator ..internal-separator) :abstraction)) diff --git a/stdlib/source/lux/target/jvm/field.lux b/stdlib/source/lux/target/jvm/field.lux index 012f7b5ee..3f569502a 100644 --- a/stdlib/source/lux/target/jvm/field.lux +++ b/stdlib/source/lux/target/jvm/field.lux @@ -21,9 +21,9 @@ ["#/." pool (#+ Pool)]] ["#." index (#+ Index)] ["#." attribute (#+ Attribute)] - [type - ["#." category (#+ Value)] - ["#." descriptor (#+ Descriptor)]]]) + ["#." type (#+ Type) + [category (#+ Value)] + [descriptor (#+ Descriptor)]]]) (type: #export #rec Field {#modifier (Modifier Field) @@ -63,12 +63,12 @@ [(binaryF.row/16 //attribute.writer) #attributes])) ))) -(def: #export (field modifier name descriptor attributes) - (-> (Modifier Field) UTF8 (Descriptor Value) (Row Attribute) +(def: #export (field modifier name type attributes) + (-> (Modifier Field) UTF8 (Type Value) (Row Attribute) (State Pool Field)) (do state.monad [@name (//constant/pool.utf8 name) - @descriptor (//constant/pool.descriptor descriptor)] + @descriptor (//constant/pool.descriptor (//type.descriptor type))] (wrap {#modifier modifier #name @name #descriptor @descriptor diff --git a/stdlib/source/lux/target/jvm/instruction.lux b/stdlib/source/lux/target/jvm/instruction.lux index 95e2b9a05..10fce7368 100644 --- a/stdlib/source/lux/target/jvm/instruction.lux +++ b/stdlib/source/lux/target/jvm/instruction.lux @@ -27,14 +27,20 @@ ["/#" // #_ ["#." index] [encoding - ["#." name (#+ External)] + ["#." name] ["#." unsigned (#+ U1 U2)] ["#." signed (#+ S4)]] ["#." constant (#+ UTF8) - ["#/."pool (#+ Pool)]] + ["#/." pool (#+ Pool)]] ["." type (#+ Type) - [category (#+ Value Return)] - ["." descriptor (#+ Descriptor)]]]]) + [category (#+ Value' Value Return' Return Method Class)] + ["." reflection] + ["." parser]]]]) + +(def: reflection + (All [category] + (-> (Type (<| Return' Value' category)) Text)) + (|>> type.reflection reflection.reflection)) (type: #export Label Nat) @@ -92,6 +98,7 @@ (def: #export (set-label label) (-> Label (Instruction Any)) + ## TODO: Throw an exception if trying to set an already-set label! (function (_ [pool tracker]) [[pool (update@ #known-labels @@ -506,10 +513,10 @@ (template [<name> <bytecode>] [(def: #export (<name> class) - (-> External (Instruction Any)) + (-> (Type Class) (Instruction Any)) (do ..monad ## TODO: Make sure it"s impossible to have indexes greater than U2. - [index (..lift (//constant/pool.class (//name.internal class)))] + [index (..lift (//constant/pool.class (//name.internal (..reflection class))))] (..nullary (<bytecode> index))))] [new /bytecode.new] @@ -523,38 +530,39 @@ (..nullary (/bytecode.iinc register increase))) (def: #export (multianewarray class count) - (-> External U1 (Instruction Any)) + (-> (Type Class) U1 (Instruction Any)) (do ..monad - [index (..lift (//constant/pool.class (//name.internal class)))] + [index (..lift (//constant/pool.class (//name.internal (..reflection class))))] (..nullary (/bytecode.multianewarray index count)))) -(def: (descriptor-size descriptor) - (-> (Descriptor Return) U1) +(def: (type-size type) + (-> (Type Return) U1) (//unsigned.u1 - (cond (is? descriptor.void descriptor) + (cond (is? type.void type) 0 - (or (is? descriptor.long descriptor) - (is? descriptor.double descriptor)) + (or (is? type.long type) + (is? type.double type)) 2 ## else 1))) (template [<static?> <name> <bytecode>] - [(def: #export (<name> class method [inputs output]) - (-> External Text [(List (Descriptor Value)) (Descriptor Return)] (Instruction Any)) - (do ..monad - [index (<| ..lift - (//constant/pool.method class) - {#//constant/pool.name method - #//constant/pool.descriptor (descriptor.method [inputs output])})] - (..nullary (<bytecode> - index - (|> inputs - (list@map descriptor-size) - (list@fold //unsigned.u1/+ (//unsigned.u1 (if <static?> 0 1)))) - (descriptor-size output)))))] + [(def: #export (<name> class method type) + (-> (Type Class) Text (Type Method) (Instruction Any)) + (let [[inputs output exceptions] (parser.method type)] + (do ..monad + [index (<| ..lift + (//constant/pool.method (..reflection class)) + {#//constant/pool.name method + #//constant/pool.descriptor (type.descriptor type)})] + (..nullary (<bytecode> + index + (|> inputs + (list@map ..type-size) + (list@fold //unsigned.u1/+ (//unsigned.u1 (if <static?> 0 1)))) + (..type-size output))))))] [#1 invokestatic /bytecode.invokestatic] [#0 invokevirtual /bytecode.invokevirtual] @@ -564,16 +572,16 @@ (template [<name> <1> <2>] [(def: #export (<name> class field type) - (-> External Text (Descriptor Value) (Instruction Any)) + (-> (Type Class) Text (Type Value) (Instruction Any)) (do ..monad [index (<| ..lift - (//constant/pool.field class) + (//constant/pool.field (..reflection class)) {#//constant/pool.name field - #//constant/pool.descriptor type})] - (..nullary (cond (is? descriptor.long type) + #//constant/pool.descriptor (type.descriptor type)})] + (..nullary (cond (is? type.long type) (<2> index) - (is? descriptor.double type) + (is? type.double type) (<2> index) ## else diff --git a/stdlib/source/lux/target/jvm/method.lux b/stdlib/source/lux/target/jvm/method.lux index 0c9de952a..cb7324316 100644 --- a/stdlib/source/lux/target/jvm/method.lux +++ b/stdlib/source/lux/target/jvm/method.lux @@ -1,5 +1,5 @@ (.module: - [lux (#- static) + [lux (#- Type static) [abstract [monoid (#+)] ["." equivalence (#+ Equivalence)] @@ -26,14 +26,14 @@ ["#." instruction (#+ Instruction) ["#/." condition] ["#/." bytecode]] - [type - ["#." category] + ["#." type (#+ Type) + ["#/." category] ["#." descriptor (#+ Descriptor)]]]) (type: #export #rec Method {#modifier (Modifier Method) #name (Index UTF8) - #descriptor (Index (Descriptor //category.Method)) + #descriptor (Index (Descriptor //type/category.Method)) #attributes (Row Attribute)}) (modifiers: Method @@ -51,12 +51,12 @@ ["1000" synthetic] ) -(def: #export (method modifier name descriptor attributes code) - (-> (Modifier Method) UTF8 (Descriptor //category.Method) (List (State Pool Attribute)) (Instruction Any) +(def: #export (method modifier name type attributes code) + (-> (Modifier Method) UTF8 (Type //type/category.Method) (List (State Pool Attribute)) (Instruction Any) (State Pool Method)) (do state.monad [@name (//constant/pool.utf8 name) - @descriptor (//constant/pool.descriptor descriptor) + @descriptor (//constant/pool.descriptor (//type.descriptor type)) attributes (monad.seq @ attributes) ?code (//instruction.resolve code) [environment bytecode] (case (do try.monad diff --git a/stdlib/source/lux/target/jvm/type/parser.lux b/stdlib/source/lux/target/jvm/type/parser.lux index 298364357..049d53f45 100644 --- a/stdlib/source/lux/target/jvm/type/parser.lux +++ b/stdlib/source/lux/target/jvm/type/parser.lux @@ -190,25 +190,33 @@ ..class ..array)) +(def: inputs + (|> (<>.some ..value) + (<>.after (<t>.this //signature.arguments-start)) + (<>.before (<t>.this //signature.arguments-end)))) + (def: #export return (Parser (Type Return)) (<>.either ..void ..value)) +(def: exception + (Parser (Type Class)) + (|> (..class' ..parameter) + (<>.after (<t>.this //signature.exception-prefix)))) + (def: #export method - (Parser (Type Method)) - (let [parameters (: (Parser (List (Type Value))) - (|> (<>.some ..value) - (<>.after (<t>.this //signature.arguments-start)) - (<>.before (<t>.this //signature.arguments-end)))) - exception (: (Parser (Type Class)) - (|> (..class' ..parameter) - (<>.after (<t>.this //signature.exception-prefix))))] - (do <>.monad - [parameters parameters - return ..return - exceptions (<>.some exception)] - (wrap (//.method [parameters return exceptions]))))) + (-> (Type Method) + [(List (Type Value)) (Type Return) (List (Type Class))]) + (let [parser (do <>.monad + [inputs ..inputs + return ..return + exceptions (<>.some ..exception)] + (wrap [inputs return exceptions]))] + (|>> //.signature + //signature.signature + (<t>.run parser) + try.assume))) (template [<name> <category> <parser>] [(def: #export <name> 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))) diff --git a/stdlib/source/test/lux.lux b/stdlib/source/test/lux.lux index 34000d362..85b062009 100644 --- a/stdlib/source/test/lux.lux +++ b/stdlib/source/test/lux.lux @@ -1,10 +1,10 @@ (.with-expansions [<host-modules> (.as-is [runtime (#+)] [primitive (#+)] [structure (#+)] - ## [function (#+)] [reference (#+)] ## [case (#+)] ## [loop (#+)] + [function (#+)] ## [extension (#+)] )] (.module: diff --git a/stdlib/source/test/lux/target/jvm.lux b/stdlib/source/test/lux/target/jvm.lux index 5ffe668fc..a9eb21c22 100644 --- a/stdlib/source/test/lux/target/jvm.lux +++ b/stdlib/source/test/lux/target/jvm.lux @@ -1,5 +1,5 @@ (.module: - [lux #* + [lux (#- Type type) ["." host (#+ import:)] [abstract/monad (#+ do)] [control @@ -42,9 +42,8 @@ ["#." name]] ["#." instruction ["#/." condition (#+ Environment)]] - [type - [category (#+ Value)] - ["#." descriptor (#+ Descriptor)]]]}) + ["#." type (#+ Type) + [category (#+ Value)]]]}) ## (def: (write-class! name bytecode) ## (-> Text Binary (IO Text)) @@ -76,45 +75,49 @@ (import: #long java/lang/Long (#static TYPE (java/lang/Class java/lang/Long))) -(def: descriptor - (Random (Descriptor Value)) +(def: class-name + (Random Text) + (do random.monad + [super-package (random.ascii/lower-alpha 10) + package (random.ascii/lower-alpha 10) + name (random.ascii/upper-alpha 10)] + (wrap (format super-package + /name.external-separator package + /name.external-separator name)))) + +(def: type + (Random (Type Value)) (random.rec - (function (_ descriptor) + (function (_ type) ($_ random.either - (random@wrap /descriptor.boolean) - (random@wrap /descriptor.byte) - (random@wrap /descriptor.short) - (random@wrap /descriptor.int) - (random@wrap /descriptor.long) - (random@wrap /descriptor.float) - (random@wrap /descriptor.double) - (random@wrap /descriptor.char) - (random@map (|>> (text.join-with /name.external-separator) /descriptor.class) - (random.list 3 (random.ascii/upper-alpha 10))) - (random@map /descriptor.array descriptor) + (random@wrap /type.boolean) + (random@wrap /type.byte) + (random@wrap /type.short) + (random@wrap /type.int) + (random@wrap /type.long) + (random@wrap /type.float) + (random@wrap /type.double) + (random@wrap /type.char) + (random@map (function (_ name) (/type.class name (list))) ..class-name) + (random@map /type.array type) )))) (def: field - (Random [Text (Descriptor Value)]) + (Random [Text (Type Value)]) ($_ random.and (random.ascii/lower-alpha 10) - ..descriptor + ..type )) -(def: class-name - (Random Text) - (do random.monad - [super-package (random.ascii/lower-alpha 10) - package (random.ascii/lower-alpha 10) - name (random.ascii/upper-alpha 10)] - (wrap (format super-package "." package "." name)))) - (def: (get-method name class) (-> Text (java/lang/Class java/lang/Object) java/lang/reflect/Method) (java/lang/Class::getDeclaredMethod name (host.array (java/lang/Class java/lang/Object) 0) class)) +(def: $Long (/type.class "java.lang.Long" (list))) +(def: $Object (/type.class "java.lang.Object" (list))) + (def: method Test (do random.monad @@ -122,7 +125,7 @@ method-name (random.ascii/upper-alpha 10) expected random.int #let [inputsJT (list) - outputJT (/descriptor.class "java.lang.Object")]] + outputJT $Object]] (_.test "Can compile a method." (let [bytecode (|> (/class.class /version.v6_0 /class.public (/name.internal class-name) @@ -133,13 +136,12 @@ /method.public /method.static) method-name - (/descriptor.method [inputsJT outputJT]) + (/type.method [inputsJT outputJT (list)]) (list) (do /instruction.monad [_ (/instruction.ldc/long (/constant.long expected)) - _ (/instruction.invokestatic "java.lang.Long" "valueOf" - [(list /descriptor.long) - (/descriptor.class "java.lang.Long")])] + _ (/instruction.invokestatic $Long "valueOf" + (/type.method [(list /type.long) $Long (list)]))] /instruction.areturn))) (row.row)) (binaryF.run /class.writer)) @@ -160,15 +162,15 @@ Test (do random.monad [class-name ..class-name - [field0 descriptor0] ..field - [field1 descriptor1] ..field + [field0 type0] ..field + [field1 type1] ..field #let [input (/class.class /version.v6_0 /class.public (/name.internal class-name) (/name.internal "java.lang.Object") (list (/name.internal "java.io.Serializable") (/name.internal "java.lang.Runnable")) - (list (/field.field /field.public field0 descriptor0 (row.row)) - (/field.field /field.public field1 descriptor1 (row.row))) + (list (/field.field /field.public field0 type0 (row.row)) + (/field.field /field.public field1 type1 (row.row))) (list) (row.row)) bytecode (binaryF.run /class.writer input) |