diff options
Diffstat (limited to 'src')
-rw-r--r-- | src/lux.clj | 5 | ||||
-rw-r--r-- | src/lux/analyser.clj | 38 | ||||
-rw-r--r-- | src/lux/analyser/host.clj | 52 | ||||
-rw-r--r-- | src/lux/compiler.clj | 17 | ||||
-rw-r--r-- | src/lux/compiler/host.clj | 128 |
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))))) |