aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--src/lux.clj5
-rw-r--r--src/lux/analyser.clj38
-rw-r--r--src/lux/analyser/host.clj52
-rw-r--r--src/lux/compiler.clj17
-rw-r--r--src/lux/compiler/host.clj128
5 files changed, 181 insertions, 59 deletions
diff --git a/src/lux.clj b/src/lux.clj
index f69bdf9dc..508b45bb9 100644
--- a/src/lux.clj
+++ b/src/lux.clj
@@ -6,10 +6,11 @@
;; TODO: Finish type system.
;; TODO: Re-implement compiler in language.
;; TODO: Adding metadata to global vars.
- ;; TODO: Allow setting fields.
;; TODO: Add column & line numbers for syntactic elements.
;; TODO: Add source-file information to .class files for easier debugging.
- ;; TODO: invokespecial & invokeinterface
+ ;; TODO: Finish implementing class & interface definition
+ ;; TODO: All optimizations
+ ;; TODO: Take module-name aliasing into account.
;; TODO:
(time (&compiler/compile-all ["lux"]))
diff --git a/src/lux/analyser.clj b/src/lux/analyser.clj
index 41e304521..8c8bb61d1 100644
--- a/src/lux/analyser.clj
+++ b/src/lux/analyser.clj
@@ -205,7 +205,6 @@
["Nil" _]]]]]]]]]]]
(&&host/analyse-jvm-new analyse-ast ?class ?classes ?args)
-
[["Form" ["Cons" [["Ident" "jvm-getstatic"]
["Cons" [["Ident" ?class]
["Cons" [["Text" ?field]
@@ -219,6 +218,21 @@
["Nil" _]]]]]]]]]]]
(&&host/analyse-jvm-getfield analyse-ast ?class ?field ?object)
+ [["Form" ["Cons" [["Ident" "jvm-putstatic"]
+ ["Cons" [["Ident" ?class]
+ ["Cons" [["Text" ?field]
+ ["Cons" [?value
+ ["Nil" _]]]]]]]]]]]
+ (&&host/analyse-jvm-putstatic analyse-ast ?class ?field ?value)
+
+ [["Form" ["Cons" [["Ident" "jvm-putfield"]
+ ["Cons" [["Ident" ?class]
+ ["Cons" [["Text" ?field]
+ ["Cons" [?object
+ ["Cons" [?value
+ ["Nil" _]]]]]]]]]]]]]
+ (&&host/analyse-jvm-putfield analyse-ast ?class ?field ?object ?value)
+
[["Form" ["Cons" [["Ident" "jvm-invokestatic"]
["Cons" [["Ident" ?class]
["Cons" [["Text" ?method]
@@ -235,6 +249,24 @@
["Cons" [["Tuple" ?args]
["Nil" _]]]]]]]]]]]]]]]
(&&host/analyse-jvm-invokevirtual analyse-ast ?class ?method (&/->seq ?classes) ?object (&/->seq ?args))
+
+ [["Form" ["Cons" [["Ident" "jvm-invokeinterface"]
+ ["Cons" [["Ident" ?class]
+ ["Cons" [["Text" ?method]
+ ["Cons" [["Tuple" ?classes]
+ ["Cons" [?object
+ ["Cons" [["Tuple" ?args]
+ ["Nil" _]]]]]]]]]]]]]]]
+ (&&host/analyse-jvm-invokeinterface analyse-ast ?class ?method (&/->seq ?classes) ?object (&/->seq ?args))
+
+ [["Form" ["Cons" [["Ident" "jvm-invokespecial"]
+ ["Cons" [["Ident" ?class]
+ ["Cons" [["Text" ?method]
+ ["Cons" [["Tuple" ?classes]
+ ["Cons" [?object
+ ["Cons" [["Tuple" ?args]
+ ["Nil" _]]]]]]]]]]]]]]]
+ (&&host/analyse-jvm-invokespecial analyse-ast ?class ?method (&/->seq ?classes) ?object (&/->seq ?args))
;; Exceptions
[["Form" ["Cons" [["Ident" "jvm-try"]
@@ -346,6 +378,10 @@
[["Form" ["Cons" [["Ident" "jvm-interface"] ["Cons" [["Ident" ?name] ?members]]]]]]
(&&host/analyse-jvm-interface analyse-ast ?name ?members)
+ ;; Programs
+ [["Form" ["Cons" [["Ident" "jvm-program"] ["Cons" [["Ident" ?args] ["Cons" [?body ["Nil" _]]]]]]]]]
+ (&&host/analyse-jvm-program analyse-ast ?args ?body)
+
[_]
(fail (str "[Analyser Error] Unmatched token: " (&/show-ast token)))))
diff --git a/src/lux/analyser/host.clj b/src/lux/analyser/host.clj
index fd4244178..59022a0e0 100644
--- a/src/lux/analyser/host.clj
+++ b/src/lux/analyser/host.clj
@@ -107,6 +107,21 @@
=object (&&/analyse-1 analyse ?object)]
(return (list [::&&/Expression [::&&/jvm-getfield =class ?field =object] =type]))))
+(defn analyse-jvm-putstatic [analyse ?class ?field ?value]
+ (exec [=class (&host/full-class-name ?class)
+ ;; :let [_ (prn 'analyse-jvm-getstatic/=class =class)]
+ =type (&host/lookup-static-field =class ?field)
+ ;; :let [_ (prn 'analyse-jvm-getstatic/=type =type)]
+ =value (&&/analyse-1 analyse ?value)]
+ (return (list [::&&/Expression [::&&/jvm-putstatic =class ?field =value] =type]))))
+
+(defn analyse-jvm-putfield [analyse ?class ?field ?object ?value]
+ (exec [=class (&host/full-class-name ?class)
+ =type (&host/lookup-static-field =class ?field)
+ =object (&&/analyse-1 analyse ?object)
+ =value (&&/analyse-1 analyse ?value)]
+ (return (list [::&&/Expression [::&&/jvm-putfield =class ?field =object =value] =type]))))
+
(defn analyse-jvm-invokestatic [analyse ?class ?method ?classes ?args]
(exec [=class (&host/full-class-name ?class)
=classes (map-m &host/extract-jvm-param ?classes)
@@ -114,19 +129,25 @@
=args (mapcat-m analyse ?args)]
(return (list [::&&/Expression [::&&/jvm-invokestatic =class ?method =classes =args] =return]))))
-(defn analyse-jvm-invokevirtual [analyse ?class ?method ?classes ?object ?args]
- (exec [=class (&host/full-class-name ?class)
- ;; :let [_ (prn 'analyse-jvm-invokevirtual/=class =class)]
- =classes (map-m &host/extract-jvm-param ?classes)
- ;; :let [_ (prn 'analyse-jvm-invokevirtual/=classes =classes)]
- [=method-args =return] (&host/lookup-virtual-method =class ?method =classes)
- ;; :let [_ (prn 'analyse-jvm-invokevirtual/=return =return)]
- =object (&&/analyse-1 analyse ?object)
- ;; :let [_ (prn 'analyse-jvm-invokevirtual/=object =object)]
- =args (mapcat-m analyse ?args)
- ;; :let [_ (prn 'analyse-jvm-invokevirtual/=args =args)]
- ]
- (return (list [::&&/Expression [::&&/jvm-invokevirtual =class ?method =classes =object =args] =return]))))
+(do-template [<name> <tag>]
+ (defn <name> [analyse ?class ?method ?classes ?object ?args]
+ (exec [=class (&host/full-class-name ?class)
+ ;; :let [_ (prn 'analyse-jvm-invokevirtual/=class =class)]
+ =classes (map-m &host/extract-jvm-param ?classes)
+ ;; :let [_ (prn 'analyse-jvm-invokevirtual/=classes =classes)]
+ [=method-args =return] (&host/lookup-virtual-method =class ?method =classes)
+ ;; :let [_ (prn 'analyse-jvm-invokevirtual/=return =return)]
+ =object (&&/analyse-1 analyse ?object)
+ ;; :let [_ (prn 'analyse-jvm-invokevirtual/=object =object)]
+ =args (mapcat-m analyse ?args)
+ ;; :let [_ (prn 'analyse-jvm-invokevirtual/=args =args)]
+ ]
+ (return (list [::&&/Expression [<tag> =class ?method =classes =object =args] =return]))))
+
+ analyse-jvm-invokevirtual ::&&/jvm-invokevirtual
+ analyse-jvm-invokeinterface ::&&/jvm-invokeinterface
+ analyse-jvm-invokespecial ::&&/jvm-invokespecial
+ )
(defn analyse-jvm-null? [analyse ?object]
(exec [=object (&&/analyse-1 analyse ?object)]
@@ -262,3 +283,8 @@
analyse-jvm-lshr ::&&/jvm-lshr "java.lang.Long" "java.lang.Integer"
analyse-jvm-lushr ::&&/jvm-lushr "java.lang.Long" "java.lang.Integer"
)
+
+(defn analyse-jvm-program [analyse ?args ?body]
+ (exec [=body (&&env/with-local ?args [::&type/Any]
+ (&&/analyse-1 analyse ?body))]
+ (return (list [::&&/Statement [::&&/jvm-program =body]]))))
diff --git a/src/lux/compiler.clj b/src/lux/compiler.clj
index 62a11868d..6fea4f405 100644
--- a/src/lux/compiler.clj
+++ b/src/lux/compiler.clj
@@ -198,13 +198,25 @@
[::&a/jvm-getfield ?class ?field ?object]
(&&host/compile-jvm-getfield compile-expression ?type ?class ?field ?object)
-
+
+ [::&a/jvm-putstatic ?class ?field ?value]
+ (&&host/compile-jvm-putstatic compile-expression ?type ?class ?field ?value)
+
+ [::&a/jvm-putfield ?class ?field ?object ?value]
+ (&&host/compile-jvm-putfield compile-expression ?type ?class ?field ?object ?value)
+
[::&a/jvm-invokestatic ?class ?method ?classes ?args]
(&&host/compile-jvm-invokestatic compile-expression ?type ?class ?method ?classes ?args)
[::&a/jvm-invokevirtual ?class ?method ?classes ?object ?args]
(&&host/compile-jvm-invokevirtual compile-expression ?type ?class ?method ?classes ?object ?args)
+ [::&a/jvm-invokeinterface ?class ?method ?classes ?object ?args]
+ (&&host/compile-jvm-invokeinterface compile-expression ?type ?class ?method ?classes ?object ?args)
+
+ [::&a/jvm-invokespecial ?class ?method ?classes ?object ?args]
+ (&&host/compile-jvm-invokespecial compile-expression ?type ?class ?method ?classes ?object ?args)
+
[::&a/jvm-new-array ?class ?length]
(&&host/compile-jvm-new-array compile-expression ?type ?class ?length)
@@ -294,6 +306,9 @@
[::&a/jvm-lushr ?x y]
(&&host/compile-jvm-lushr compile-expression ?type ?x y)
+
+ [::&a/jvm-program ?body]
+ (&&host/compile-jvm-program compile-expression ?type ?body)
)
_
diff --git a/src/lux/compiler/host.clj b/src/lux/compiler/host.clj
index 18695522d..81b8f3981 100644
--- a/src/lux/compiler/host.clj
+++ b/src/lux/compiler/host.clj
@@ -183,21 +183,27 @@
(prepare-return! *type*))]]
(return nil)))
-(defn compile-jvm-invokevirtual [compile *type* ?class ?method ?classes ?object ?args]
- ;; (prn 'compile-jvm-invokevirtual ?classes *type*)
- (exec [*writer* &/get-writer
- :let [method-sig (str "(" (reduce str "" (map &host/->type-signature ?classes)) ")" (&host/->java-sig *type*))]
- _ (compile ?object)
- :let [_ (.visitTypeInsn *writer* Opcodes/CHECKCAST (&host/->class ?class))]
- _ (map-m (fn [[class-name arg]]
- (exec [ret (compile arg)
- :let [_ (prepare-arg! *writer* class-name)]]
- (return ret)))
- (map vector ?classes ?args))
- :let [_ (doto *writer*
- (.visitMethodInsn Opcodes/INVOKEVIRTUAL (&host/->class ?class) ?method method-sig)
- (prepare-return! *type*))]]
- (return nil)))
+(do-template [<name> <op>]
+ (defn <name> [compile *type* ?class ?method ?classes ?object ?args]
+ ;; (prn 'compile-jvm-invokevirtual ?classes *type*)
+ (exec [*writer* &/get-writer
+ :let [method-sig (str "(" (reduce str "" (map &host/->type-signature ?classes)) ")" (&host/->java-sig *type*))]
+ _ (compile ?object)
+ :let [_ (.visitTypeInsn *writer* Opcodes/CHECKCAST (&host/->class ?class))]
+ _ (map-m (fn [[class-name arg]]
+ (exec [ret (compile arg)
+ :let [_ (prepare-arg! *writer* class-name)]]
+ (return ret)))
+ (map vector ?classes ?args))
+ :let [_ (doto *writer*
+ (.visitMethodInsn <op> (&host/->class ?class) ?method method-sig)
+ (prepare-return! *type*))]]
+ (return nil)))
+
+ compile-jvm-invokevirtual Opcodes/INVOKEVIRTUAL
+ compile-jvm-invokeinterface Opcodes/INVOKEINTERFACE
+ compile-jvm-invokespecial Opcodes/INVOKESPECIAL
+ )
(defn compile-jvm-null [compile *type*]
(exec [*writer* &/get-writer
@@ -271,6 +277,20 @@
:let [_ (.visitFieldInsn *writer* Opcodes/GETFIELD (&host/->class ?class) ?field (&host/->java-sig *type*))]]
(return nil)))
+(defn compile-jvm-putstatic [compile *type* ?class ?field ?value]
+ (exec [*writer* &/get-writer
+ _ (compile ?value)
+ :let [_ (.visitFieldInsn *writer* Opcodes/PUTSTATIC (&host/->class ?class) ?field (&host/->java-sig *type*))]]
+ (return nil)))
+
+(defn compile-jvm-putfield [compile *type* ?class ?field ?object ?value]
+ (exec [*writer* &/get-writer
+ _ (compile ?object)
+ _ (compile ?value)
+ :let [_ (.visitTypeInsn *writer* Opcodes/CHECKCAST (&host/->class ?class))]
+ :let [_ (.visitFieldInsn *writer* Opcodes/PUTFIELD (&host/->class ?class) ?field (&host/->java-sig *type*))]]
+ (return nil)))
+
(defn compile-jvm-class [compile ?package ?name ?super-class ?fields ?methods]
(let [parent-dir (&host/->package ?package)
full-name (str parent-dir "/" ?name)
@@ -383,51 +403,75 @@
compile-jvm-monitorexit Opcodes/MONITOREXIT
)
-(do-template [<name> <op> <from-class> <to-class>]
+(do-template [<name> <op> <from-class> <from-method> <from-sig> <to-class> <to-sig>]
(defn <name> [compile *type* ?value]
(exec [*writer* &/get-writer
+ :let [_ (doto *writer*
+ (.visitTypeInsn Opcodes/NEW (&host/->class <to-class>))
+ (.visitInsn Opcodes/DUP))]
_ (compile ?value)
:let [_ (doto *writer*
- (.visitInsn <op>))]]
+ (.visitMethodInsn Opcodes/INVOKEVIRTUAL (&host/->class <from-class>) <from-method> <from-sig>)
+ (.visitInsn <op>)
+ (.visitMethodInsn Opcodes/INVOKESPECIAL (&host/->class <to-class>) "<init>" <to-sig>))]]
(return nil)))
- compile-jvm-d2f Opcodes/D2F "java.lang.Double" "java.lang.Float"
- compile-jvm-d2i Opcodes/D2I "java.lang.Double" "java.lang.Integer"
- compile-jvm-d2l Opcodes/D2L "java.lang.Double" "java.lang.Long"
+ compile-jvm-d2f Opcodes/D2F "java.lang.Double" "doubleValue" "()D" "java.lang.Float" "(F)V"
+ compile-jvm-d2i Opcodes/D2I "java.lang.Double" "doubleValue" "()D" "java.lang.Integer" "(I)V"
+ compile-jvm-d2l Opcodes/D2L "java.lang.Double" "doubleValue" "()D" "java.lang.Long" "(J)V"
- compile-jvm-f2d Opcodes/F2D "java.lang.Float" "java.lang.Double"
- compile-jvm-f2i Opcodes/F2I "java.lang.Float" "java.lang.Integer"
- compile-jvm-f2l Opcodes/F2L "java.lang.Float" "java.lang.Long"
+ compile-jvm-f2d Opcodes/F2D "java.lang.Float" "floatValue" "()F" "java.lang.Double" "(D)V"
+ compile-jvm-f2i Opcodes/F2I "java.lang.Float" "floatValue" "()F" "java.lang.Integer" "(I)V"
+ compile-jvm-f2l Opcodes/F2L "java.lang.Float" "floatValue" "()F" "java.lang.Long" "(J)V"
- compile-jvm-i2b Opcodes/I2B "java.lang.Integer" "java.lang.Byte"
- compile-jvm-i2c Opcodes/I2C "java.lang.Integer" "java.lang.Character"
- compile-jvm-i2d Opcodes/I2D "java.lang.Integer" "java.lang.Double"
- compile-jvm-i2f Opcodes/I2F "java.lang.Integer" "java.lang.Float"
- compile-jvm-i2l Opcodes/I2L "java.lang.Integer" "java.lang.Long"
- compile-jvm-i2s Opcodes/I2S "java.lang.Integer" "java.lang.Short"
+ compile-jvm-i2b Opcodes/I2B "java.lang.Integer" "intValue" "()I" "java.lang.Byte" "(B)V"
+ compile-jvm-i2c Opcodes/I2C "java.lang.Integer" "intValue" "()I" "java.lang.Character" "(C)V"
+ compile-jvm-i2d Opcodes/I2D "java.lang.Integer" "intValue" "()I" "java.lang.Double" "(D)V"
+ compile-jvm-i2f Opcodes/I2F "java.lang.Integer" "intValue" "()I" "java.lang.Float" "(F)V"
+ compile-jvm-i2l Opcodes/I2L "java.lang.Integer" "intValue" "()I" "java.lang.Long" "(J)V"
+ compile-jvm-i2s Opcodes/I2S "java.lang.Integer" "intValue" "()I" "java.lang.Short" "(S)V"
- compile-jvm-l2d Opcodes/L2D "java.lang.Long" "java.lang.Double"
- compile-jvm-l2f Opcodes/L2F "java.lang.Long" "java.lang.Float"
- compile-jvm-l2i Opcodes/L2I "java.lang.Long" "java.lang.Integer"
+ compile-jvm-l2d Opcodes/L2D "java.lang.Long" "longValue" "()J" "java.lang.Double" "(D)V"
+ compile-jvm-l2f Opcodes/L2F "java.lang.Long" "longValue" "()J" "java.lang.Float" "(F)V"
+ compile-jvm-l2i Opcodes/L2I "java.lang.Long" "longValue" "()J" "java.lang.Integer" "(I)V"
)
-(do-template [<name> <op> <from-class> <to-class>]
+(do-template [<name> <op> <from1-method> <from1-sig> <from1-class> <from2-method> <from2-sig> <from2-class> <to-class> <to-sig>]
(defn <name> [compile *type* ?x ?y]
(exec [*writer* &/get-writer
+ :let [_ (doto *writer*
+ (.visitTypeInsn Opcodes/NEW (&host/->class <to-class>))
+ (.visitInsn Opcodes/DUP))]
_ (compile ?x)
+ :let [_ (.visitMethodInsn *writer* Opcodes/INVOKEVIRTUAL (&host/->class <from1-class>) <from1-method> <from1-sig>)]
_ (compile ?y)
+ :let [_ (.visitMethodInsn *writer* Opcodes/INVOKEVIRTUAL (&host/->class <from2-class>) <from2-method> <from2-sig>)]
:let [_ (doto *writer*
- (.visitInsn <op>))]]
+ (.visitInsn <op>)
+ (.visitMethodInsn Opcodes/INVOKESPECIAL (&host/->class <to-class>) "<init>" <to-sig>))]]
(return nil)))
- compile-jvm-iand Opcodes/IAND "java.lang.Integer" "java.lang.Integer"
- compile-jvm-ior Opcodes/IOR "java.lang.Integer" "java.lang.Integer"
+ compile-jvm-iand Opcodes/IAND "intValue" "()I" "java.lang.Integer" "intValue" "()I" "java.lang.Integer" "java.lang.Integer" "(I)V"
+ compile-jvm-ior Opcodes/IOR "intValue" "()I" "java.lang.Integer" "intValue" "()I" "java.lang.Integer" "java.lang.Integer" "(I)V"
- compile-jvm-land Opcodes/LAND "java.lang.Long" "java.lang.Long"
- compile-jvm-lor Opcodes/LOR "java.lang.Long" "java.lang.Long"
- compile-jvm-lxor Opcodes/LXOR "java.lang.Long" "java.lang.Long"
+ compile-jvm-land Opcodes/LAND "longValue" "()J" "java.lang.Long" "longValue" "()J" "java.lang.Long" "java.lang.Long" "(J)V"
+ compile-jvm-lor Opcodes/LOR "longValue" "()J" "java.lang.Long" "longValue" "()J" "java.lang.Long" "java.lang.Long" "(J)V"
+ compile-jvm-lxor Opcodes/LXOR "longValue" "()J" "java.lang.Long" "longValue" "()J" "java.lang.Long" "java.lang.Long" "(J)V"
- compile-jvm-lshl Opcodes/LSHL "java.lang.Long" "java.lang.Integer"
- compile-jvm-lshr Opcodes/LSHR "java.lang.Long" "java.lang.Integer"
- compile-jvm-lushr Opcodes/LUSHR "java.lang.Long" "java.lang.Integer"
+ compile-jvm-lshl Opcodes/LSHL "longValue" "()J" "java.lang.Long" "intValue" "()I" "java.lang.Integer" "java.lang.Long" "(J)V"
+ compile-jvm-lshr Opcodes/LSHR "longValue" "()J" "java.lang.Long" "intValue" "()I" "java.lang.Integer" "java.lang.Long" "(J)V"
+ compile-jvm-lushr Opcodes/LUSHR "longValue" "()J" "java.lang.Long" "intValue" "()I" "java.lang.Integer" "java.lang.Long" "(J)V"
)
+
+(defn compile-jvm-program [compile *type* ?body]
+ (exec [*writer* &/get-writer]
+ (&/with-writer (doto (.visitMethod *writer* (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) "main" "([Ljava/lang/String;)V" nil nil)
+ (.visitCode))
+ (exec [*writer* &/get-writer
+ _ (compile ?body)
+ :let [_ (doto *writer*
+ (.visitInsn Opcodes/POP)
+ (.visitInsn Opcodes/RETURN)
+ (.visitMaxs 0 0)
+ (.visitEnd))]]
+ (return nil)))))
generated by cgit v1.2.3 (git 2.25.1) at 2024-07-07 22:26:58 +0000