From 3028cc4f45d2d7d66456467de506341800df14d8 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Wed, 16 Oct 2019 02:19:52 -0400 Subject: Now allowing types for methods. --- new-luxc/source/luxc/lang/host/jvm/def.lux | 20 +++---- new-luxc/source/luxc/lang/host/jvm/inst.lux | 9 ++- .../luxc/lang/translation/jvm/extension/host.lux | 5 +- .../source/luxc/lang/translation/jvm/function.lux | 8 +-- .../source/luxc/lang/translation/jvm/runtime.lux | 11 ++-- stdlib/source/lux/target/jvm/type.lux | 46 ++++++++------ stdlib/source/lux/target/jvm/type/alias.lux | 39 ++++++------ stdlib/source/lux/target/jvm/type/parser.lux | 8 +-- .../tool/compiler/phase/extension/analysis/jvm.lux | 70 +++++++++++----------- stdlib/source/test/lux/extension.lux | 32 ++++++---- 10 files changed, 132 insertions(+), 116 deletions(-) diff --git a/new-luxc/source/luxc/lang/host/jvm/def.lux b/new-luxc/source/luxc/lang/host/jvm/def.lux index 08fccc640..f274da61f 100644 --- a/new-luxc/source/luxc/lang/host/jvm/def.lux +++ b/new-luxc/source/luxc/lang/host/jvm/def.lux @@ -18,8 +18,8 @@ ["." name]] ["." type (#+ Type Constraint) [category (#+ Class Value Method)] - ["." signature (#+ Signature)] - ["." descriptor (#+ Descriptor)]]]]] + ["." signature] + ["." descriptor]]]]] ["." //]) (def: signature (|>> type.signature signature.signature)) @@ -211,16 +211,16 @@ _ (ClassWriter::visitEnd writer)] (ClassWriter::toByteArray writer))) -(def: #export (method visibility config name [signature descriptor] then) - (-> //.Visibility //.Method-Config Text [(Signature Method) (Descriptor Method)] //.Inst +(def: #export (method visibility config name type then) + (-> //.Visibility //.Method-Config Text (Type Method) //.Inst //.Def) (function (_ writer) (let [=method (ClassWriter::visitMethod ($_ i.+ (visibility-flag visibility) (method-flags config)) (..binary-name name) - (descriptor.descriptor descriptor) - (signature.signature signature) + (..descriptor type) + (..signature type) (string-array (list)) writer) _ (MethodVisitor::visitCode =method) @@ -229,8 +229,8 @@ _ (MethodVisitor::visitEnd =method)] writer))) -(def: #export (abstract-method visibility config name [signature descriptor]) - (-> //.Visibility //.Method-Config Text [(Signature Method) (Descriptor Method)] +(def: #export (abstract-method visibility config name type) + (-> //.Visibility //.Method-Config Text (Type Method) //.Def) (function (_ writer) (let [=method (ClassWriter::visitMethod ($_ i.+ @@ -238,8 +238,8 @@ (method-flags config) (Opcodes::ACC_ABSTRACT)) (..binary-name name) - (descriptor.descriptor descriptor) - (signature.signature signature) + (..descriptor type) + (..signature type) (string-array (list)) writer) _ (MethodVisitor::visitEnd =method)] diff --git a/new-luxc/source/luxc/lang/host/jvm/inst.lux b/new-luxc/source/luxc/lang/host/jvm/inst.lux index d5d7cb1fb..e52d11d9b 100644 --- a/new-luxc/source/luxc/lang/host/jvm/inst.lux +++ b/new-luxc/source/luxc/lang/host/jvm/inst.lux @@ -27,8 +27,7 @@ ["." type (#+ Type) ("#@." equivalence) [category (#+ Void Value Return Method Primitive Object Class Array Var Parameter)] ["." box] - ["." signature (#+ Signature)] - ["." descriptor (#+ Descriptor)] + ["." descriptor] ["." reflection]]]] [tool [compiler @@ -297,14 +296,14 @@ (undefined))))))) (template [ ] - [(def: #export ( class method-name [method-signature method-descriptor]) - (-> (Type Class) Text [(Signature Method) (Descriptor Method)] Inst) + [(def: #export ( class method-name method) + (-> (Type Class) Text (Type Method) Inst) (function (_ visitor) (do-to visitor (org/objectweb/asm/MethodVisitor::visitMethodInsn () (..class-name class) method-name - (descriptor.descriptor method-descriptor) + (|> method type.descriptor descriptor.descriptor) ))))] [INVOKESTATIC org/objectweb/asm/Opcodes::INVOKESTATIC false] diff --git a/new-luxc/source/luxc/lang/translation/jvm/extension/host.lux b/new-luxc/source/luxc/lang/translation/jvm/extension/host.lux index ea7ba6d33..7b03bc451 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/extension/host.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/extension/host.lux @@ -24,8 +24,7 @@ ["." category (#+ Void Value Return Primitive Object Class Array Var Parameter Method)] ["." box] ["." reflection] - ["." descriptor (#+ Descriptor)] - ["." signature (#+ Signature)] + ["." signature] ["." parser]]]] [tool [compiler @@ -881,7 +880,7 @@ (def: $Object (type.class "java.lang.Object" (list))) (def: (anonymous-init-method env) - (-> Environment [(Signature Method) (Descriptor Method)]) + (-> Environment (Type Method)) (type.method [(list.repeat (list.size env) $Object) type.void (list)])) diff --git a/new-luxc/source/luxc/lang/translation/jvm/function.lux b/new-luxc/source/luxc/lang/translation/jvm/function.lux index bd651f786..34a4c890e 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/function.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/function.lux @@ -14,9 +14,7 @@ [target [jvm ["." type (#+ Type) - ["." category (#+ Void Value Return Primitive Object Class Array Var Parameter Method)] - ["." descriptor (#+ Descriptor)] - ["." signature (#+ Signature)]]]] + ["." category (#+ Void Value Return Primitive Object Class Array Var Parameter Method)]]]] [tool [compiler [arity (#+ Arity)] @@ -46,7 +44,7 @@ (list.repeat (list.size env) //.$Value)) (def: (init-method env arity) - (-> Environment Arity [(Signature Method) (Descriptor Method)]) + (-> Environment Arity (Type Method)) (if (poly-arg? arity) (type.method [(list.concat (list (captured-args env) (list type.int) @@ -112,7 +110,7 @@ (_.INVOKESPECIAL class "" (init-method env arity)))))) (def: (reset-method return) - (-> (Type Class) [(Signature Method) (Descriptor Method)]) + (-> (Type Class) (Type Method)) (type.method [(list) return (list)])) (def: (with-reset class arity env) diff --git a/new-luxc/source/luxc/lang/translation/jvm/runtime.lux b/new-luxc/source/luxc/lang/translation/jvm/runtime.lux index f97831ac5..c0e48f30d 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/runtime.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/runtime.lux @@ -9,9 +9,7 @@ [target [jvm ["." type (#+ Type) - ["." category (#+ Void Value Return Primitive Object Class Array Var Parameter Method)] - ["." descriptor (#+ Descriptor)] - ["." signature (#+ Signature)] + ["." category (#+ Void Value' Value Return' Return Primitive Object Class Array Var Parameter Method)] ["." reflection]]]] [tool [compiler @@ -106,7 +104,7 @@ (def: #export num-apply-variants Nat 8) (def: #export (apply-signature arity) - (-> Arity [(Signature Method) (Descriptor Method)]) + (-> Arity (Type Method)) (type.method [(list.repeat arity $Value) $Value (list)])) (def: adt-methods @@ -319,7 +317,10 @@ _.ARETURN))) ))) -(def: reflection (|>> type.reflection reflection.reflection)) +(def: reflection + (All [category] + (-> (Type (<| Return' Value' category)) Text)) + (|>> type.reflection reflection.reflection)) (def: translate-runtime (Operation Any) diff --git a/stdlib/source/lux/target/jvm/type.lux b/stdlib/source/lux/target/jvm/type.lux index e5190429b..e5c7304ee 100644 --- a/stdlib/source/lux/target/jvm/type.lux +++ b/stdlib/source/lux/target/jvm/type.lux @@ -16,7 +16,7 @@ [encoding ["#." name (#+ External)]]] ["." / #_ - [category (#+ Void Value Return Method Primitive Object Class Array Var Parameter Declaration)] + [category (#+ Void Value' Value Return' Return Method Primitive Object Class Array Var Parameter Declaration)] ["#." signature (#+ Signature)] ["#." descriptor (#+ Descriptor)] ["#." reflection (#+ Reflection)]]) @@ -45,9 +45,15 @@ [signature Signature] [descriptor Descriptor] - [reflection Reflection] ) + (def: #export (reflection type) + (All [category] + (-> (Type (<| Return' Value' category)) + (Reflection (<| Return' Value' category)))) + (let [[signature descriptor reflection] (:representation type)] + reflection)) + (template [ ] [(def: #export (Type ) @@ -88,9 +94,10 @@ (def: #export (as-class type) (-> (Type Declaration) (Type Class)) (:abstraction - [(/signature.as-class (..signature type)) - (/descriptor.as-class (..descriptor type)) - (/reflection.as-class (..reflection type))])) + (let [[signature descriptor reflection] (:representation type)] + [(/signature.as-class signature) + (/descriptor.as-class descriptor) + (/reflection.as-class reflection)]))) (def: #export wildcard (Type Parameter) @@ -109,28 +116,31 @@ (def: #export (lower bound) (-> (Type Class) (Type Parameter)) (:abstraction - [(/signature.lower (..signature bound)) - (/descriptor.lower (..descriptor bound)) - (/reflection.lower (..reflection bound))])) + (let [[signature descriptor reflection] (:representation bound)] + [(/signature.lower signature) + (/descriptor.lower descriptor) + (/reflection.lower reflection)]))) (def: #export (upper bound) (-> (Type Class) (Type Parameter)) (:abstraction - [(/signature.upper (..signature bound)) - (/descriptor.upper (..descriptor bound)) - (/reflection.upper (..reflection bound))])) + (let [[signature descriptor reflection] (:representation bound)] + [(/signature.upper signature) + (/descriptor.upper descriptor) + (/reflection.upper reflection)]))) (def: #export (method [inputs output exceptions]) (-> [(List (Type Value)) (Type Return) (List (Type Class))] - [(Signature Method) - (Descriptor Method)]) - [(/signature.method [(list@map ..signature inputs) - (..signature output) - (list@map ..signature exceptions)]) - (/descriptor.method [(list@map ..descriptor inputs) - (..descriptor output)])]) + (Type Method)) + (:abstraction + [(/signature.method [(list@map ..signature inputs) + (..signature output) + (list@map ..signature exceptions)]) + (/descriptor.method [(list@map ..descriptor inputs) + (..descriptor output)]) + (:assume ..void)])) (structure: #export equivalence (All [category] (Equivalence (Type category))) diff --git a/stdlib/source/lux/target/jvm/type/alias.lux b/stdlib/source/lux/target/jvm/type/alias.lux index cd631a251..49b4c0297 100644 --- a/stdlib/source/lux/target/jvm/type/alias.lux +++ b/stdlib/source/lux/target/jvm/type/alias.lux @@ -8,7 +8,6 @@ ["<>" parser ("#@." monad) ["" text (#+ Parser)]]] [data - ["." product] ["." maybe] ["." text ["%" format (#+ format)]] @@ -86,6 +85,12 @@ (//parser.array' value) )))) +(def: (inputs aliasing) + (-> Aliasing (Parser (List (Type Value)))) + (|> (<>.some (..value aliasing)) + (<>.after (.this //signature.arguments-start)) + (<>.before (.this //signature.arguments-end)))) + (def: (return aliasing) (-> Aliasing (Parser (Type Return))) ($_ <>.either @@ -93,19 +98,19 @@ (..value aliasing) )) -(def: #export (method aliasing signature) - (-> Aliasing (Signature Method) (Signature Method)) - (let [parameters (: (Parser (List (Type Value))) - (|> (<>.some (..value aliasing)) - (<>.after (.this //signature.arguments-start)) - (<>.before (.this //signature.arguments-end)))) - exception (: (Parser (Type Class)) - (|> (..class (..parameter aliasing)) - (<>.after (.this //signature.exception-prefix))))] - (|> (//signature.signature signature) - (.run (do <>.monad - [parameters parameters - return (..return aliasing) - exceptions (<>.some exception)] - (wrap (product.left (//.method [parameters return exceptions]))))) - try.assume))) +(def: (exception aliasing) + (-> Aliasing (Parser (Type Class))) + (|> (..class (..parameter aliasing)) + (<>.after (.this //signature.exception-prefix)))) + +(def: #export (method aliasing type) + (-> Aliasing (Type Method) (Type Method)) + (|> type + //.signature + //signature.signature + (.run (do <>.monad + [inputs (..inputs aliasing) + return (..return aliasing) + exceptions (<>.some (..exception aliasing))] + (wrap (//.method [inputs return exceptions])))) + try.assume)) diff --git a/stdlib/source/lux/target/jvm/type/parser.lux b/stdlib/source/lux/target/jvm/type/parser.lux index 99f4a57ee..298364357 100644 --- a/stdlib/source/lux/target/jvm/type/parser.lux +++ b/stdlib/source/lux/target/jvm/type/parser.lux @@ -15,9 +15,8 @@ ["." list]]]] ["." // (#+ Type) [category (#+ Void Value Return Method Primitive Object Class Array Var Parameter Declaration)] - ["#." signature (#+ Signature)] - ["#." descriptor (#+ Descriptor)] - ["#." reflection (#+ Reflection)] + ["#." signature] + ["#." descriptor] ["." // #_ [encoding ["#." name (#+ External)]]]]) @@ -197,8 +196,7 @@ ..value)) (def: #export method - (Parser [(Signature Method) - (Descriptor Method)]) + (Parser (Type Method)) (let [parameters (: (Parser (List (Type Value))) (|> (<>.some ..value) (<>.after (.this //signature.arguments-start)) diff --git a/stdlib/source/lux/tool/compiler/phase/extension/analysis/jvm.lux b/stdlib/source/lux/tool/compiler/phase/extension/analysis/jvm.lux index 98cf8baf8..8202fd101 100644 --- a/stdlib/source/lux/tool/compiler/phase/extension/analysis/jvm.lux +++ b/stdlib/source/lux/tool/compiler/phase/extension/analysis/jvm.lux @@ -30,11 +30,11 @@ [encoding [name (#+ External)]] ["#" type (#+ Type Argument Typed) ("#@." equivalence) - ["." category (#+ Void Value Return Primitive Object Class Array Var Parameter Method)] + ["." category (#+ Void Value' Value Return' Return Primitive Object Class Array Var Parameter Method)] ["." box] ["." reflection] - ["." descriptor (#+ Descriptor)] - ["." signature (#+ Signature) ("#@." equivalence)] + ["." descriptor] + ["." signature] ["#-." parser] ["#-." alias (#+ Aliasing)] [".T" lux (#+ Mapping)]]]]] @@ -55,10 +55,14 @@ [archive [descriptor (#+ Module)]]]]]]]) -(def: reflection (|>> jvm.reflection reflection.reflection)) +(def: reflection + (All [category] + (-> (Type (<| Return' Value' category)) Text)) + (|>> jvm.reflection reflection.reflection)) + (def: signature (|>> jvm.signature signature.signature)) -(def: object-class "java.lang.Object") +(def: object-class External "java.lang.Object") (def: inheritance-relationship-type-name "_jvm_inheritance") (def: #export (inheritance-relationship-type class super-class super-interfaces) @@ -319,7 +323,8 @@ (^ (list arrayC)) (do ////.monad [_ (typeA.infer ..int) - arrayA (typeA.with-type (#.Primitive (|> (jvm.array primitive-type) ..reflection) + arrayA (typeA.with-type (#.Primitive (|> (jvm.array primitive-type) + ..reflection) (list)) (analyse arrayC))] (wrap (#/////analysis.Extension extension-name (list arrayA)))) @@ -791,26 +796,20 @@ (getConstructors [] [(java/lang/reflect/Constructor java/lang/Object)]) (getDeclaredMethods [] [java/lang/reflect/Method])) -(def: (reflection-type mapping typeJ) - (-> Mapping (Type Value) (Operation .Type)) - (case (|> typeJ jvm.signature signature.signature - (.run (luxT.type mapping))) - (#try.Success check) - (typeA.with-env - check) - - (#try.Failure error) - (////.fail error))) - -(def: (reflection-return mapping typeJ) - (-> Mapping (Type Return) (Operation .Type)) - (case (|> typeJ ..signature (.run (luxT.return mapping))) - (#try.Success check) - (typeA.with-env - check) - - (#try.Failure error) - (////.fail error))) +(template [ ] + [(def: ( mapping typeJ) + (-> Mapping (Type ) (Operation .Type)) + (case (|> typeJ ..signature (.run ( mapping))) + (#try.Success check) + (typeA.with-env + check) + + (#try.Failure error) + (////.fail error)))] + + [reflection-type Value luxT.type] + [reflection-return Return luxT.return] + ) (def: (class-candidate-parents from-name fromT to-name to-class) (-> External .Type External (java/lang/Class java/lang/Object) (Operation (List [[Text .Type] Bit]))) @@ -1462,7 +1461,7 @@ (template [ ] [(def: (-> (java/lang/Class java/lang/Object) - (Try (List [Text (Signature Method)]))) + (Try (List [Text (Type Method)]))) (|>> java/lang/Class::getDeclaredMethods array.to-list @@ -1479,7 +1478,7 @@ array.to-list (monad.map @ reflection!.class))] (wrap [(java/lang/reflect/Method::getName method) - (product.left (jvm.method [inputs return exceptions]))]))))))] + (jvm.method [inputs return exceptions])]))))))] [abstract-methods (list.filter (|>> java/lang/reflect/Method::getModifiers java/lang/reflect/Modifier::isAbstract))] [methods (<|)] @@ -1489,7 +1488,7 @@ (template [ ] [(def: - (-> (List (Type Class)) (Try (List [Text (Signature Method)]))) + (-> (List (Type Class)) (Try (List [Text (Type Method)]))) (|>> (monad.map try.monad (|>> ..reflection reflection!.load)) (try@map (monad.map try.monad )) try@join @@ -1500,11 +1499,11 @@ ) (template [] - [(exception: #export ( {methods (List [Text (Signature Method)])}) + [(exception: #export ( {methods (List [Text (Type Method)])}) (exception.report ["Methods" (exception.enumerate - (function (_ [name signature]) - (format (%.text name) " " (signature.signature signature))) + (function (_ [name type]) + (format (%.text name) " " (..signature type))) methods)]))] [missing-abstract-methods] @@ -1853,12 +1852,14 @@ (wrap [parameterJ parameterT]))))) (def: (mismatched-methods super-set sub-set) - (-> (List [Text (Signature Method)]) (List [Text (Signature Method)]) (List [Text (Signature Method)])) + (-> (List [Text (Type Method)]) + (List [Text (Type Method)]) + (List [Text (Type Method)])) (list.filter (function (_ [sub-name subJT]) (|> super-set (list.filter (function (_ [super-name superJT]) (and (text@= super-name sub-name) - (signature@= superJT subJT)))) + (jvm@= superJT subJT)))) list.size (n.= 1) not)) @@ -1954,7 +1955,6 @@ (wrap [method-name (|> (jvm.method [(list@map product.right arguments) return exceptions]) - product.left (jvm-alias.method aliasing))]))) methods) #let [missing-abstract-methods (mismatched-methods overriden-methods required-abstract-methods) diff --git a/stdlib/source/test/lux/extension.lux b/stdlib/source/test/lux/extension.lux index 645558d5f..7b2d9ffd5 100644 --- a/stdlib/source/test/lux/extension.lux +++ b/stdlib/source/test/lux/extension.lux @@ -1,5 +1,6 @@ (.module: [lux #* + ["@" target] [abstract [monad (#+ do)]] [control @@ -23,24 +24,29 @@ (def: my-extension "example YOLO") -(analysis: (..my-extension self phase {parameters (<>.some .any)}) - (do @ - [_ (type.infer .Text)] - (wrap (#analysis.Extension self (list))))) +(`` (for {(~~ (static @.old)) + (as-is)} + (as-is (analysis: (..my-extension self phase {parameters (<>.some .any)}) + (do @ + [_ (type.infer .Text)] + (wrap (#analysis.Extension self (list))))) -(synthesis: (..my-extension self phase {parameters (<>.some .any)}) - (wrap (synthesis.text self))) + (synthesis: (..my-extension self phase {parameters (<>.some .any)}) + (wrap (synthesis.text self))) -(directive: (..my-extension self phase {parameters (<>.some .any)}) - (do @ - [#let [_ (log! (format "directive: " (%.text self)))]] - (wrap directive.no-requirements))) + (directive: (..my-extension self phase {parameters (<>.some .any)}) + (do @ + [#let [_ (log! (format "directive: " (%.text self)))]] + (wrap directive.no-requirements))) -("example YOLO") + ("example YOLO") + ))) (def: #export test Test (<| (_.context (%.name (name-of /._))) (_.test "Can define and use analysis & synthesis extensions." - (text@= ("example YOLO") - "example YOLO")))) + (`` (for {(~~ (static @.old)) + false} + (text@= ("example YOLO") + "example YOLO")))))) -- cgit v1.2.3