aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--src/lux/analyser/host.clj8
-rw-r--r--src/lux/compiler.clj8
-rw-r--r--src/lux/compiler/host.clj23
-rw-r--r--src/lux/host/generics.clj2
-rw-r--r--src/lux/type/host.clj26
5 files changed, 50 insertions, 17 deletions
diff --git a/src/lux/analyser/host.clj b/src/lux/analyser/host.clj
index bec12c4de..fb4c3e55d 100644
--- a/src/lux/analyser/host.clj
+++ b/src/lux/analyser/host.clj
@@ -231,13 +231,14 @@
(defn analyse-jvm-putstatic [analyse exo-type class field value]
(|do [class-loader &/loader
[gvars gtype] (&host/lookup-static-field class-loader class field)
+ :let [gclass (&host-type/gtype->gclass gtype)]
=type (&host-type/instance-param &type/existential (&/|list) gtype)
=value (&&/analyse-1 analyse =type value)
:let [output-type &type/Unit]
_ (&type/check exo-type output-type)
_cursor &/cursor]
(return (&/|list (&&/|meta exo-type _cursor
- (&/V &&/$jvm-putstatic (&/T class field =value =type)))))))
+ (&/V &&/$jvm-putstatic (&/T class field =value gclass =type)))))))
(defn analyse-jvm-putfield [analyse exo-type class field value object]
(|do [class-loader &/loader
@@ -245,13 +246,14 @@
:let [obj-type (&&/expr-type* =object)]
_ (ensure-object obj-type)
[gvars gtype] (&host/lookup-field class-loader class field)
+ :let [gclass (&host-type/gtype->gclass gtype)]
=type (analyse-field-access-helper obj-type gvars gtype)
=value (&&/analyse-1 analyse =type value)
:let [output-type &type/Unit]
_ (&type/check exo-type output-type)
_cursor &/cursor]
(return (&/|list (&&/|meta exo-type _cursor
- (&/V &&/$jvm-putfield (&/T class field =value =object =type)))))))
+ (&/V &&/$jvm-putfield (&/T class field =value gclass =object =type)))))))
(defn analyse-jvm-instanceof [analyse exo-type class object]
(|do [=object (&&/analyse-1+ analyse object)
@@ -561,7 +563,7 @@
(|do [:let [[ca-type ca-term] ctor-arg]
=ca-type (generic-class->type full-env ca-type)
=ca-term (&&/analyse-1 analyse =ca-type ca-term)]
- (return (&/T =ca-type =ca-term))))
+ (return (&/T ca-type =ca-term))))
?ctor-args)
=body (&&env/with-local &&/jvm-this class-type
(&/fold (fn [body* input*]
diff --git a/src/lux/compiler.clj b/src/lux/compiler.clj
index 7fe6871b0..73b5a4206 100644
--- a/src/lux/compiler.clj
+++ b/src/lux/compiler.clj
@@ -219,11 +219,11 @@
(&o/$jvm-getfield ?class ?field ?object ?output-type)
(&&host/compile-jvm-getfield compile-expression ?class ?field ?object ?output-type)
- (&o/$jvm-putstatic ?class ?field ?value ?input-type)
- (&&host/compile-jvm-putstatic compile-expression ?class ?field ?value ?input-type)
+ (&o/$jvm-putstatic ?class ?field ?value input-gclass ?input-type)
+ (&&host/compile-jvm-putstatic compile-expression ?class ?field ?value input-gclass ?input-type)
- (&o/$jvm-putfield ?class ?field ?value ?object ?input-type)
- (&&host/compile-jvm-putfield compile-expression ?class ?field ?object ?value ?input-type)
+ (&o/$jvm-putfield ?class ?field ?value input-gclass ?object ?input-type)
+ (&&host/compile-jvm-putfield compile-expression ?class ?field ?object ?value input-gclass ?input-type)
(&o/$jvm-invokestatic ?class ?method ?classes ?args ?output-type)
(&&host/compile-jvm-invokestatic compile-expression ?class ?method ?classes ?args ?output-type)
diff --git a/src/lux/compiler/host.clj b/src/lux/compiler/host.clj
index 0401593f7..009c9a9e4 100644
--- a/src/lux/compiler/host.clj
+++ b/src/lux/compiler/host.clj
@@ -389,23 +389,27 @@
(prepare-return! ?output-type))]]
(return nil)))
-(defn compile-jvm-putstatic [compile ?class ?field ?value ?input-type]
+(defn compile-jvm-putstatic [compile ?class ?field ?value input-gclass ?input-type]
(|do [^MethodVisitor *writer* &/get-writer
_ (compile ?value)
=input-sig (&host/->java-sig ?input-type)
- :let [_ (.visitFieldInsn *writer* Opcodes/PUTSTATIC (&host-generics/->bytecode-class-name (&host-type/as-obj ?class)) ?field =input-sig)]
- :let [_ (.visitInsn *writer* Opcodes/ACONST_NULL)]]
+ :let [_ (doto *writer*
+ (prepare-arg! (&host-generics/gclass->class-name input-gclass))
+ (.visitFieldInsn Opcodes/PUTSTATIC (&host-generics/->bytecode-class-name (&host-type/as-obj ?class)) ?field =input-sig)
+ (.visitInsn Opcodes/ACONST_NULL))]]
(return nil)))
-(defn compile-jvm-putfield [compile ?class ?field ?object ?value ?input-type]
+(defn compile-jvm-putfield [compile ?class ?field ?object ?value input-gclass ?input-type]
(|do [:let [class* (&host-generics/->bytecode-class-name (&host-type/as-obj ?class))]
^MethodVisitor *writer* &/get-writer
_ (compile ?object)
- :let [_ (.visitInsn *writer* Opcodes/DUP)]
- _ (compile ?value)
:let [_ (.visitTypeInsn *writer* Opcodes/CHECKCAST class*)]
+ _ (compile ?value)
=input-sig (&host/->java-sig ?input-type)
- :let [_ (.visitFieldInsn *writer* Opcodes/PUTFIELD class* ?field =input-sig)]]
+ :let [_ (doto *writer*
+ (prepare-arg! (&host-generics/gclass->class-name input-gclass))
+ (.visitFieldInsn Opcodes/PUTFIELD class* ?field =input-sig)
+ (.visitInsn Opcodes/ACONST_NULL))]]
(return nil)))
(defn compile-jvm-instanceof [compile class object]
@@ -496,11 +500,14 @@
(->> ?exceptions (&/|map &host-generics/->bytecode-class-name) &/->seq (into-array java.lang.String)))
(|do [^MethodVisitor =method &/get-writer
:let [[super-class-name super-class-params] ?super-class
- init-types (->> ?ctor-args (&/|map (comp &host-generics/->type-signature &/|first)) (&/fold str ""))
+ init-types (->> ?ctor-args (&/|map (comp &host-generics/gclass->signature &/|first)) (&/fold str ""))
init-sig (str "(" init-types ")" "V")
_ (&/|map (partial compile-annotation =method) ?anns)
_ (doto =method
(.visitCode)
+ (.visitVarInsn Opcodes/ALOAD 0))]
+ _ (->> ?ctor-args (&/|map &/|second) (&/map% compile))
+ :let [_ (doto =method
(.visitMethodInsn Opcodes/INVOKESPECIAL (&host-generics/->bytecode-class-name super-class-name) init-method init-sig))]
_ (compile ?body)
:let [_ (doto =method
diff --git a/src/lux/host/generics.clj b/src/lux/host/generics.clj
index 30d7629c1..1050da53a 100644
--- a/src/lux/host/generics.clj
+++ b/src/lux/host/generics.clj
@@ -111,7 +111,7 @@
"(-> GenericClass Text)"
(|case gclass
(&/$GenericTypeVar name)
- (gclass->class-name "java.lang.Object")
+ (->bytecode-class-name "java.lang.Object")
(&/$GenericClass name params)
(->bytecode-class-name name)
diff --git a/src/lux/type/host.clj b/src/lux/type/host.clj
index ff5759923..3c76b431e 100644
--- a/src/lux/type/host.clj
+++ b/src/lux/type/host.clj
@@ -92,7 +92,7 @@
(return (class->type refl-type))
(instance? GenericArrayType refl-type)
- (let [inner-type (instance-param existential matchings (.getGenericComponentType ^GenericArrayType refl-type))]
+ (|do [inner-type (instance-param existential matchings (.getGenericComponentType ^GenericArrayType refl-type))]
(return (&/V &/$DataT (&/T array-data-tag (&/|list inner-type)))))
(instance? ParameterizedType refl-type)
@@ -254,3 +254,27 @@
"[C" (&/V &/$DataT (&/T array-data-tag (&/|list (&/V &/$DataT (&/T "char" (&/|list))))))
;; else
(&/V &/$DataT (&/T class-name (&/|list)))))
+
+(defn gtype->gclass [gtype]
+ "(-> GenericType GenericClass)"
+ (cond (instance? Class gtype)
+ (&/V &/$GenericClass (&/T (.getName gtype) &/Nil$))
+
+ (instance? GenericArrayType gtype)
+ (&/V &/$GenericArray (gtype->gclass (.getGenericComponentType ^GenericArrayType gtype)))
+
+ (instance? ParameterizedType gtype)
+ (let [type-name (->> ^ParameterizedType gtype ^Class (.getRawType) .getName)
+ type-params (->> ^ParameterizedType gtype
+ .getActualTypeArguments
+ seq &/->list
+ (&/|map gtype->gclass))]
+ (&/V &/$GenericClass (&/T type-name type-params)))
+
+ (instance? TypeVariable gtype)
+ (&/V &/$GenericTypeVar (.getName ^TypeVariable gtype))
+
+ (instance? WildcardType gtype)
+ (if-let [bound (->> ^WildcardType gtype .getUpperBounds seq first)]
+ (gtype->gclass bound)
+ (&/V &/$GenericClass (&/T "java.lang.Object" &/Nil$)))))
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-09 20:36:16 +0000