diff options
Diffstat (limited to 'src')
-rw-r--r-- | src/lux/analyser.clj | 28 | ||||
-rw-r--r-- | src/lux/analyser/base.clj | 4 | ||||
-rw-r--r-- | src/lux/analyser/host.clj | 112 | ||||
-rw-r--r-- | src/lux/compiler.clj | 12 | ||||
-rw-r--r-- | src/lux/compiler/host.clj | 95 | ||||
-rw-r--r-- | src/lux/optimizer.clj | 16 |
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)) |