aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--src/lux/analyser.clj28
-rw-r--r--src/lux/analyser/base.clj4
-rw-r--r--src/lux/analyser/host.clj112
-rw-r--r--src/lux/compiler.clj12
-rw-r--r--src/lux/compiler/host.clj95
-rw-r--r--src/lux/optimizer.clj16
6 files changed, 114 insertions, 153 deletions
diff --git a/src/lux/analyser.clj b/src/lux/analyser.clj
index 9c6158325..ad96cdd9b 100644
--- a/src/lux/analyser.clj
+++ b/src/lux/analyser.clj
@@ -125,34 +125,6 @@
(|do [=arg-classes (&/map% &&a-parser/parse-text ?arg-classes)]
(&&host/analyse-jvm-new analyse exo-type ?class =arg-classes ?args))
- (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_getstatic")]
- (&/$Cons [_ (&/$TextS ?class)]
- (&/$Cons [_ (&/$TextS ?field)]
- (&/$Nil)))))
- (&&host/analyse-jvm-getstatic analyse exo-type ?class ?field)
-
- (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_getfield")]
- (&/$Cons [_ (&/$TextS ?class)]
- (&/$Cons [_ (&/$TextS ?field)]
- (&/$Cons ?object
- (&/$Nil))))))
- (&&host/analyse-jvm-getfield analyse exo-type ?class ?field ?object)
-
- (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_putstatic")]
- (&/$Cons [_ (&/$TextS ?class)]
- (&/$Cons [_ (&/$TextS ?field)]
- (&/$Cons ?value
- (&/$Nil))))))
- (&&host/analyse-jvm-putstatic analyse exo-type ?class ?field ?value)
-
- (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_putfield")]
- (&/$Cons [_ (&/$TextS ?class)]
- (&/$Cons [_ (&/$TextS ?field)]
- (&/$Cons ?value
- (&/$Cons ?object
- (&/$Nil)))))))
- (&&host/analyse-jvm-putfield analyse exo-type ?class ?field ?value ?object)
-
(&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_invokestatic")]
(&/$Cons [_ (&/$TextS ?class)]
(&/$Cons [_ (&/$TextS ?method)]
diff --git a/src/lux/analyser/base.clj b/src/lux/analyser/base.clj
index 86838d354..42bbcf284 100644
--- a/src/lux/analyser/base.clj
+++ b/src/lux/analyser/base.clj
@@ -27,10 +27,6 @@
("captured" 1)
("host" 2)
- ("jvm-getstatic" 1)
- ("jvm-getfield" 1)
- ("jvm-putstatic" 1)
- ("jvm-putfield" 1)
("jvm-invokestatic" 1)
("jvm-instanceof" 1)
("jvm-invokevirtual" 1)
diff --git a/src/lux/analyser/host.clj b/src/lux/analyser/host.clj
index 4d422d4d1..c82a71566 100644
--- a/src/lux/analyser/host.clj
+++ b/src/lux/analyser/host.clj
@@ -161,55 +161,6 @@
_
(fail (str "[Type Error] Type is not an object type: " (&type/show-type obj-type)))))
-(defn analyse-jvm-getstatic [analyse exo-type class field]
- (|do [class-loader &/loader
- [gvars gtype] (&host/lookup-static-field class-loader class field)
- =type (&host-type/instance-param &type/existential &/$Nil gtype)
- :let [output-type =type]
- _ (&type/check exo-type output-type)
- _cursor &/cursor]
- (return (&/|list (&&/|meta exo-type _cursor
- (&&/$jvm-getstatic (&/T [class field output-type])))))))
-
-(defn analyse-jvm-getfield [analyse exo-type class field object]
- (|do [class-loader &/loader
- =object (&&/analyse-1+ analyse object)
- _ (ensure-object (&&/expr-type* =object))
- [gvars gtype] (&host/lookup-field class-loader class field)
- =type (analyse-field-access-helper (&&/expr-type* =object) gvars gtype)
- :let [output-type =type]
- _ (&type/check exo-type output-type)
- _cursor &/cursor]
- (return (&/|list (&&/|meta exo-type _cursor
- (&&/$jvm-getfield (&/T [class field =object output-type])))))))
-
-(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 &/$Nil gtype)
- =value (&&/analyse-1 analyse =type value)
- :let [output-type &/$UnitT]
- _ (&type/check exo-type output-type)
- _cursor &/cursor]
- (return (&/|list (&&/|meta exo-type _cursor
- (&&/$jvm-putstatic (&/T [class field =value gclass])))))))
-
-(defn analyse-jvm-putfield [analyse exo-type class field value object]
- (|do [class-loader &/loader
- =object (&&/analyse-1+ analyse object)
- :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 &/$UnitT]
- _ (&type/check exo-type output-type)
- _cursor &/cursor]
- (return (&/|list (&&/|meta exo-type _cursor
- (&&/$jvm-putfield (&/T [class field =value gclass =object =type])))))))
-
(defn analyse-jvm-instanceof [analyse exo-type class object]
(|do [=object (&&/analyse-1+ analyse object)
_ (ensure-object (&&/expr-type* =object))
@@ -919,6 +870,59 @@
(return (&/|list (&&/|meta exo-type _cursor
(&&/$host (&/T ["jvm" "throw"]) (&/|list =ex)))))))
+(defn ^:private analyse-jvm-getstatic [analyse exo-type class field ?values]
+ (|do [:let [(&/$Nil) ?values]
+ class-loader &/loader
+ [gvars gtype] (&host/lookup-static-field class-loader class field)
+ =type (&host-type/instance-param &type/existential &/$Nil gtype)
+ :let [output-type =type]
+ _ (&type/check exo-type output-type)
+ _cursor &/cursor]
+ (return (&/|list (&&/|meta exo-type _cursor
+ (&&/$host (&/T ["jvm" "getstatic"]) (&/|list class field output-type)))))))
+
+(defn ^:private analyse-jvm-getfield [analyse exo-type class field ?values]
+ (|do [:let [(&/$Cons object (&/$Nil)) ?values]
+ class-loader &/loader
+ =object (&&/analyse-1+ analyse object)
+ _ (ensure-object (&&/expr-type* =object))
+ [gvars gtype] (&host/lookup-field class-loader class field)
+ =type (analyse-field-access-helper (&&/expr-type* =object) gvars gtype)
+ :let [output-type =type]
+ _ (&type/check exo-type output-type)
+ _cursor &/cursor]
+ (return (&/|list (&&/|meta exo-type _cursor
+ (&&/$host (&/T ["jvm" "getfield"]) (&/|list class field =object output-type)))))))
+
+(defn ^:private analyse-jvm-putstatic [analyse exo-type class field ?values]
+ (|do [:let [(&/$Cons value (&/$Nil)) ?values]
+ 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 &/$Nil gtype)
+ =value (&&/analyse-1 analyse =type value)
+ :let [output-type &/$UnitT]
+ _ (&type/check exo-type output-type)
+ _cursor &/cursor]
+ (return (&/|list (&&/|meta exo-type _cursor
+ (&&/$host (&/T ["jvm" "putstatic"]) (&/|list class field =value gclass)))))))
+
+(defn ^:private analyse-jvm-putfield [analyse exo-type class field ?values]
+ (|do [:let [(&/$Cons object (&/$Cons value (&/$Nil))) ?values]
+ class-loader &/loader
+ =object (&&/analyse-1+ analyse object)
+ :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 &/$UnitT]
+ _ (&type/check exo-type output-type)
+ _cursor &/cursor]
+ (return (&/|list (&&/|meta exo-type _cursor
+ (&&/$host (&/T ["jvm" "putfield"]) (&/|list class field =object =value gclass =type)))))))
+
(defn analyse-host [analyse exo-type category proc ?values]
(case category
"jvm"
@@ -1007,7 +1011,15 @@
"c2i" (analyse-jvm-c2i analyse exo-type ?values)
"c2l" (analyse-jvm-c2l analyse exo-type ?values)
;; else
- (fail (str "[Analyser Error] Unknown host procedure: " [category proc])))
+ (->> (fail (str "[Analyser Error] Unknown host procedure: " [category proc]))
+ (if-let [[_ _class _field] (re-find #"getstatic:([^:]+):([^:]+)" proc)]
+ (analyse-jvm-getstatic analyse exo-type _class _field ?values))
+ (if-let [[_ _class _field] (re-find #"getfield:([^:]+):([^:]+)" proc)]
+ (analyse-jvm-getfield analyse exo-type _class _field ?values))
+ (if-let [[_ _class _field] (re-find #"putstatic:([^:]+):([^:]+)" proc)]
+ (analyse-jvm-putstatic analyse exo-type _class _field ?values))
+ (if-let [[_ _class _field] (re-find #"putfield:([^:]+):([^:]+)" proc)]
+ (analyse-jvm-putfield analyse exo-type _class _field ?values))))
;; else
(fail (str "[Analyser Error] Unknown host procedure: " [category proc]))))
diff --git a/src/lux/compiler.clj b/src/lux/compiler.clj
index f3af23768..57ded26fe 100644
--- a/src/lux/compiler.clj
+++ b/src/lux/compiler.clj
@@ -98,18 +98,6 @@
(&o/$jvm-new ?class ?classes ?args)
(&&host/compile-jvm-new compile-expression ?class ?classes ?args)
- (&o/$jvm-getstatic ?class ?field ?output-type)
- (&&host/compile-jvm-getstatic compile-expression ?class ?field ?output-type)
-
- (&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-gclass)
- (&&host/compile-jvm-putstatic compile-expression ?class ?field ?value input-gclass)
-
- (&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 ba73cb283..c63587347 100644
--- a/src/lux/compiler/host.clj
+++ b/src/lux/compiler/host.clj
@@ -149,48 +149,6 @@
(.visitMethodInsn Opcodes/INVOKESPECIAL class* "<init>" init-sig))]]
(return nil)))
-(defn compile-jvm-getstatic [compile ?class ?field ?output-type]
- (|do [^MethodVisitor *writer* &/get-writer
- =output-type (&host/->java-sig ?output-type)
- :let [_ (doto *writer*
- (.visitFieldInsn Opcodes/GETSTATIC (&host-generics/->bytecode-class-name (&host-type/as-obj ?class)) ?field =output-type)
- (prepare-return! ?output-type))]]
- (return nil)))
-
-(defn compile-jvm-getfield [compile ?class ?field ?object ?output-type]
- (|do [:let [class* (&host-generics/->bytecode-class-name (&host-type/as-obj ?class))]
- ^MethodVisitor *writer* &/get-writer
- _ (compile ?object)
- =output-type (&host/->java-sig ?output-type)
- :let [_ (doto *writer*
- (.visitTypeInsn Opcodes/CHECKCAST class*)
- (.visitFieldInsn Opcodes/GETFIELD class* ?field =output-type)
- (prepare-return! ?output-type))]]
- (return nil)))
-
-(defn compile-jvm-putstatic [compile ?class ?field ?value input-gclass]
- (|do [^MethodVisitor *writer* &/get-writer
- _ (compile ?value)
- :let [=input-sig (&host-type/gclass->sig input-gclass)
- _ (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-gclass ?input-type]
- (|do [:let [class* (&host-generics/->bytecode-class-name (&host-type/as-obj ?class))]
- ^MethodVisitor *writer* &/get-writer
- _ (compile ?object)
- :let [_ (.visitTypeInsn *writer* Opcodes/CHECKCAST class*)]
- _ (compile ?value)
- =input-sig (&host/->java-sig ?input-type)
- :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]
(|do [:let [class* (&host-generics/->bytecode-class-name class)]
^MethodVisitor *writer* &/get-writer
@@ -570,6 +528,7 @@
))
fields)))
+(declare compile-jvm-putstatic)
(defn compile-jvm-class [compile class-decl ?super-class ?interfaces ?inheritance-modifier ?anns ?fields ?methods env ??ctor-args]
(|do [module &/get-module-name
[file-name line column] &/cursor
@@ -598,7 +557,7 @@
(.visitCode))]
_ (&/map% (fn [ftriple]
(|let [[fname fgclass fvalue] ftriple]
- (compile-jvm-putstatic compile ?name fname fvalue fgclass)))
+ (compile-jvm-putstatic compile (&/|list ?name fname fvalue fgclass))))
(constant-inits ?fields))
:let [_ (doto =method
(.visitInsn Opcodes/RETURN)
@@ -1215,10 +1174,60 @@
:let [_ (.visitInsn *writer* Opcodes/ATHROW)]]
(return nil)))
+(defn ^:private compile-jvm-getstatic [compile ?values]
+ (|do [:let [(&/$Cons ?class (&/$Cons ?field (&/$Cons ?output-type (&/$Nil)))) ?values]
+ ^MethodVisitor *writer* &/get-writer
+ =output-type (&host/->java-sig ?output-type)
+ :let [_ (doto *writer*
+ (.visitFieldInsn Opcodes/GETSTATIC (&host-generics/->bytecode-class-name (&host-type/as-obj ?class)) ?field =output-type)
+ (prepare-return! ?output-type))]]
+ (return nil)))
+
+(defn ^:private compile-jvm-getfield [compile ?values]
+ (|do [:let [(&/$Cons ?class (&/$Cons ?field (&/$Cons ?object (&/$Cons ?output-type (&/$Nil))))) ?values]
+ :let [class* (&host-generics/->bytecode-class-name (&host-type/as-obj ?class))]
+ ^MethodVisitor *writer* &/get-writer
+ _ (compile ?object)
+ =output-type (&host/->java-sig ?output-type)
+ :let [_ (doto *writer*
+ (.visitTypeInsn Opcodes/CHECKCAST class*)
+ (.visitFieldInsn Opcodes/GETFIELD class* ?field =output-type)
+ (prepare-return! ?output-type))]]
+ (return nil)))
+
+(defn ^:private compile-jvm-putstatic [compile ?values]
+ (|do [:let [(&/$Cons ?class (&/$Cons ?field (&/$Cons ?value (&/$Cons input-gclass (&/$Nil))))) ?values]
+ ^MethodVisitor *writer* &/get-writer
+ _ (compile ?value)
+ :let [=input-sig (&host-type/gclass->sig input-gclass)
+ _ (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 ^:private compile-jvm-putfield [compile ?values]
+ (|do [:let [(&/$Cons ?class (&/$Cons ?field (&/$Cons ?object (&/$Cons ?value (&/$Cons input-gclass (&/$Cons ?input-type (&/$Nil))))))) ?values]
+ :let [class* (&host-generics/->bytecode-class-name (&host-type/as-obj ?class))]
+ ^MethodVisitor *writer* &/get-writer
+ _ (compile ?object)
+ :let [_ (.visitTypeInsn *writer* Opcodes/CHECKCAST class*)]
+ _ (compile ?value)
+ =input-sig (&host/->java-sig ?input-type)
+ :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-host [compile proc-category proc-name ?values]
(case proc-category
"jvm"
(case proc-name
+ "getstatic" (compile-jvm-getstatic compile ?values)
+ "getfield" (compile-jvm-getfield compile ?values)
+ "putstatic" (compile-jvm-putstatic compile ?values)
+ "putfield" (compile-jvm-putfield compile ?values)
"throw" (compile-jvm-throw compile ?values)
"monitorenter" (compile-jvm-monitorenter compile ?values)
"monitorexit" (compile-jvm-monitorexit compile ?values)
diff --git a/src/lux/optimizer.clj b/src/lux/optimizer.clj
index 14cd42fdb..e9bac0e08 100644
--- a/src/lux/optimizer.clj
+++ b/src/lux/optimizer.clj
@@ -26,10 +26,6 @@
("captured" 1)
("host" 2)
- ("jvm-getstatic" 1)
- ("jvm-getfield" 1)
- ("jvm-putstatic" 1)
- ("jvm-putfield" 1)
("jvm-invokestatic" 1)
("jvm-instanceof" 1)
("jvm-invokevirtual" 1)
@@ -91,18 +87,6 @@
(&-base/$host ?proc-ident ?args)
(return ($host ?proc-ident ?args))
- (&-base/$jvm-getstatic value)
- (return ($jvm-getstatic value))
-
- (&-base/$jvm-getfield value)
- (return ($jvm-getfield value))
-
- (&-base/$jvm-putstatic value)
- (return ($jvm-putstatic value))
-
- (&-base/$jvm-putfield value)
- (return ($jvm-putfield value))
-
(&-base/$jvm-invokestatic value)
(return ($jvm-invokestatic value))
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-06 01:01:25 +0000