aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--new-luxc/source/luxc/lang/host/jvm/def.lux20
-rw-r--r--new-luxc/source/luxc/lang/host/jvm/inst.lux9
-rw-r--r--new-luxc/source/luxc/lang/translation/jvm/extension/host.lux5
-rw-r--r--new-luxc/source/luxc/lang/translation/jvm/function.lux8
-rw-r--r--new-luxc/source/luxc/lang/translation/jvm/runtime.lux11
-rw-r--r--stdlib/source/lux/target/jvm/type.lux46
-rw-r--r--stdlib/source/lux/target/jvm/type/alias.lux39
-rw-r--r--stdlib/source/lux/target/jvm/type/parser.lux8
-rw-r--r--stdlib/source/lux/tool/compiler/phase/extension/analysis/jvm.lux70
-rw-r--r--stdlib/source/test/lux/extension.lux32
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 [<name> <inst> <interface?>]
- [(def: #export (<name> class method-name [method-signature method-descriptor])
- (-> (Type Class) Text [(Signature Method) (Descriptor Method)] Inst)
+ [(def: #export (<name> class method-name method)
+ (-> (Type Class) Text (Type Method) Inst)
(function (_ visitor)
(do-to visitor
(org/objectweb/asm/MethodVisitor::visitMethodInsn (<inst>)
(..class-name class)
method-name
- (descriptor.descriptor method-descriptor)
+ (|> method type.descriptor descriptor.descriptor)
<interface?>))))]
[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>" (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 [<category> <name> <signature> <descriptor> <reflection>]
[(def: #export <name>
(Type <category>)
@@ -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)
["<t>" 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 (<t>.this //signature.arguments-start))
+ (<>.before (<t>.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 (<t>.this //signature.arguments-start))
- (<>.before (<t>.this //signature.arguments-end))))
- exception (: (Parser (Type Class))
- (|> (..class (..parameter aliasing))
- (<>.after (<t>.this //signature.exception-prefix))))]
- (|> (//signature.signature signature)
- (<t>.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 (<t>.this //signature.exception-prefix))))
+
+(def: #export (method aliasing type)
+ (-> Aliasing (Type Method) (Type Method))
+ (|> type
+ //.signature
+ //signature.signature
+ (<t>.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 (<t>.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
- (<t>.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 (<t>.run (luxT.return mapping)))
- (#try.Success check)
- (typeA.with-env
- check)
-
- (#try.Failure error)
- (////.fail error)))
+(template [<name> <category> <parser>]
+ [(def: (<name> mapping typeJ)
+ (-> Mapping (Type <category>) (Operation .Type))
+ (case (|> typeJ ..signature (<t>.run (<parser> 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 [<name> <filter>]
[(def: <name>
(-> (java/lang/Class java/lang/Object)
- (Try (List [Text (Signature Method)])))
+ (Try (List [Text (Type Method)])))
(|>> java/lang/Class::getDeclaredMethods
array.to-list
<filter>
@@ -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 [<name> <methods>]
[(def: <name>
- (-> (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 <methods>))
try@join
@@ -1500,11 +1499,11 @@
)
(template [<name>]
- [(exception: #export (<name> {methods (List [Text (Signature Method)])})
+ [(exception: #export (<name> {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 <c>.any)})
- (do @
- [_ (type.infer .Text)]
- (wrap (#analysis.Extension self (list)))))
+(`` (for {(~~ (static @.old))
+ (as-is)}
+ (as-is (analysis: (..my-extension self phase {parameters (<>.some <c>.any)})
+ (do @
+ [_ (type.infer .Text)]
+ (wrap (#analysis.Extension self (list)))))
-(synthesis: (..my-extension self phase {parameters (<>.some <a>.any)})
- (wrap (synthesis.text self)))
+ (synthesis: (..my-extension self phase {parameters (<>.some <a>.any)})
+ (wrap (synthesis.text self)))
-(directive: (..my-extension self phase {parameters (<>.some <c>.any)})
- (do @
- [#let [_ (log! (format "directive: " (%.text self)))]]
- (wrap directive.no-requirements)))
+ (directive: (..my-extension self phase {parameters (<>.some <c>.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"))))))
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-25 20:06:56 +0000