diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/lux/analyser.clj | 109 | ||||
| -rw-r--r-- | src/lux/compiler.clj | 177 |
2 files changed, 190 insertions, 96 deletions
diff --git a/src/lux/analyser.clj b/src/lux/analyser.clj index 6f9573f4c..dd41f638d 100644 --- a/src/lux/analyser.clj +++ b/src/lux/analyser.clj @@ -332,6 +332,52 @@ _ (fail ""))) +(defn full-class [class] + ;; (prn 'full-class-name class) + (case class + "boolean" (return Boolean/TYPE) + "byte" (return Byte/TYPE) + "short" (return Short/TYPE) + "int" (return Integer/TYPE) + "long" (return Long/TYPE) + "float" (return Float/TYPE) + "double" (return Double/TYPE) + "char" (return Character/TYPE) + ;; else + (if (.contains class ".") + (return (Class/forName class)) + (try-all-m [(exec [=class (resolve class) + ;; :let [_ (prn '=class =class)] + ] + (match (:form =class) + [::class ?full-name] + (return (Class/forName ?full-name)) + _ + (fail "Unknown class."))) + (let [full-name* (str "java.lang." class)] + (if-let [full-name (try (Class/forName full-name*) + full-name* + (catch Exception e + nil))] + (return (Class/forName full-name)) + (fail "Unknown class.")))])))) + +(defn extract-jvm-param [token] + (match token + [::&parser/ident ?ident] + (full-class ?ident) + + [::&parser/form ([[::&parser/ident "Array"] [::&parser/ident ?inner]] :seq)] + (exec [;; :let [_ (prn '?inner ?inner)] + =inner (full-class ?inner) + ;; :let [_ (prn '=inner =inner) + ;; _ (prn '(.getName =inner) (.getName =inner))] + ] + (return (Class/forName (str "[L" (.getName =inner) ";")))) + + _ + (fail ""))) + (defn extract-class [x] (match x [::class ?class] @@ -423,36 +469,6 @@ (return full-name) (fail "Unknown class.")))]))) -(defn full-class [class] - ;; (prn 'full-class-name class) - (case class - "boolean" (return Boolean/TYPE) - "byte" (return Byte/TYPE) - "short" (return Short/TYPE) - "int" (return Integer/TYPE) - "long" (return Long/TYPE) - "float" (return Float/TYPE) - "double" (return Double/TYPE) - "char" (return Character/TYPE) - ;; else - (if (.contains class ".") - (return class) - (try-all-m [(exec [=class (resolve class) - ;; :let [_ (prn '=class =class)] - ] - (match (:form =class) - [::class ?full-name] - (return (Class/forName ?full-name)) - _ - (fail "Unknown class."))) - (let [full-name* (str "java.lang." class)] - (if-let [full-name (try (Class/forName full-name*) - full-name* - (catch Exception e - nil))] - (return (Class/forName full-name)) - (fail "Unknown class.")))])))) - (defanalyser analyse-jvm-getstatic [::&parser/form ([[::&parser/ident "jvm/getstatic"] [::&parser/ident ?class] [::&parser/ident ?field]] :seq)] (exec [=class (full-class-name ?class) @@ -462,9 +478,7 @@ (defanalyser analyse-jvm-invokevirtual [::&parser/form ([[::&parser/ident "jvm/invokevirtual"] [::&parser/ident ?class] [::&parser/text ?method] [::&parser/tuple ?classes] ?object [::&parser/tuple ?args]] :seq)] (exec [=class (full-class-name ?class) - =classes (map-m #(exec [class* (extract-ident %)] - (full-class class*)) - ?classes) + =classes (map-m extract-jvm-param ?classes) =return (lookup-virtual-method (Class/forName =class) ?method =classes) :let [_ (prn 'analyse-jvm-invokevirtual ?class ?method =classes '-> =return)] ;; =return =return @@ -472,6 +486,29 @@ =args (map-m analyse-form* ?args)] (return (annotated [::jvm-invokevirtual =class ?method (map #(.getName %) =classes) =object =args] =return)))) +(defanalyser analyse-jvm-new + [::&parser/form ([[::&parser/ident "jvm/new"] [::&parser/ident ?class] [::&parser/tuple ?classes] [::&parser/tuple ?args]] :seq)] + (exec [=class (full-class-name ?class) + =classes (map-m extract-jvm-param ?classes) + =args (map-m analyse-form* ?args)] + (return (annotated [::jvm-new =class (map #(.getName %) =classes) =args] [::&type/object =class []])))) + +(defanalyser analyse-jvm-new-array + [::&parser/form ([[::&parser/ident "jvm/new-array"] [::&parser/ident ?class] [::&parser/int ?length]] :seq)] + (exec [=class (full-class-name ?class)] + (return (annotated [::jvm-new-array =class ?length] [::&type/array [::&type/object =class []]])))) + +(defanalyser analyse-jvm-aastore + [::&parser/form ([[::&parser/ident "jvm/aastore"] ?array [::&parser/int ?idx] ?elem] :seq)] + (exec [=array (analyse-form* ?array) + =elem (analyse-form* ?elem)] + (return (annotated [::jvm-aastore =array ?idx =elem] (:type =array))))) + +(defanalyser analyse-jvm-aaload + [::&parser/form ([[::&parser/ident "jvm/aaload"] ?array [::&parser/int ?idx]] :seq)] + (exec [=array (analyse-form* ?array)] + (return (annotated [::jvm-aaload =array ?idx] (-> =array :type (nth 1)))))) + ;; (defanalyser analyse-access ;; [::&parser/access ?object ?member] ;; (match ?member @@ -894,7 +931,7 @@ [::&parser/form ([[::&parser/ident "let"] [::&parser/ident ?label] ?value ?body] :seq)] (exec [=value (analyse-form* ?value) idx next-local-idx - =body (with-local ?label =value + =body (with-local ?label (:type =value) (analyse-form* ?body))] (return (annotated [::let idx ?label =value =body] (:type =body))))) @@ -1053,4 +1090,8 @@ analyse-jvm-irem analyse-jvm-getstatic analyse-jvm-invokevirtual + analyse-jvm-new + analyse-jvm-new-array + analyse-jvm-aastore + analyse-jvm-aaload ])) diff --git a/src/lux/compiler.clj b/src/lux/compiler.clj index 76f3efb54..a7ebcf8c1 100644 --- a/src/lux/compiler.clj +++ b/src/lux/compiler.clj @@ -80,7 +80,11 @@ "double" "D" "char" "C" ;; else - (str "L" (->class class) ";"))) + (let [class* (->class class)] + (if (.startsWith class* "[") + class* + (str "L" class* ";"))) + )) (defn ^:private ->java-sig [type] (match type @@ -102,6 +106,9 @@ [::&type/object ?name []] (->type-signature ?name) + [::&type/array [::&type/object ?name _]] + (str "[" (->type-signature ?name)) + [::&type/variant ?tag ?value] (->type-signature +variant-class+) @@ -276,69 +283,111 @@ (.visitInsn Opcodes/ACONST_NULL))) )) +(defn prepare-arg! [*writer* class-name] + (condp = class-name + "boolean" (let [wrapper-class (->class "java.lang.Boolean")] + (doto *writer* + (.visitTypeInsn Opcodes/CHECKCAST wrapper-class) + (.visitMethodInsn Opcodes/INVOKEVIRTUAL wrapper-class "booleanValue" "()Z"))) + "byte" (let [wrapper-class (->class "java.lang.Byte")] + (doto *writer* + (.visitTypeInsn Opcodes/CHECKCAST wrapper-class) + (.visitMethodInsn Opcodes/INVOKEVIRTUAL wrapper-class "byteValue" "()B"))) + "short" (let [wrapper-class (->class "java.lang.Short")] + (doto *writer* + (.visitTypeInsn Opcodes/CHECKCAST wrapper-class) + (.visitMethodInsn Opcodes/INVOKEVIRTUAL wrapper-class "shortValue" "()S"))) + "int" (let [wrapper-class (->class "java.lang.Integer")] + (doto *writer* + (.visitTypeInsn Opcodes/CHECKCAST wrapper-class) + (.visitMethodInsn Opcodes/INVOKEVIRTUAL wrapper-class "intValue" "()I"))) + "long" (let [wrapper-class (->class "java.lang.Long")] + (doto *writer* + (.visitTypeInsn Opcodes/CHECKCAST wrapper-class) + (.visitMethodInsn Opcodes/INVOKEVIRTUAL wrapper-class "longValue" "()J"))) + "float" (let [wrapper-class (->class "java.lang.Float")] + (doto *writer* + (.visitTypeInsn Opcodes/CHECKCAST wrapper-class) + (.visitMethodInsn Opcodes/INVOKEVIRTUAL wrapper-class "floatValue" "()F"))) + "double" (let [wrapper-class (->class "java.lang.Double")] + (doto *writer* + (.visitTypeInsn Opcodes/CHECKCAST wrapper-class) + (.visitMethodInsn Opcodes/INVOKEVIRTUAL wrapper-class "doubleValue" "()D"))) + "char" (let [wrapper-class (->class "java.lang.Character")] + (doto *writer* + (.visitTypeInsn Opcodes/CHECKCAST wrapper-class) + (.visitMethodInsn Opcodes/INVOKEVIRTUAL wrapper-class "charValue" "()C"))) + ;; else + (.visitTypeInsn *writer* Opcodes/CHECKCAST (->class class-name)))) + (let [boolean-class "java.lang.Boolean" integer-class "java.lang.Integer" char-class "java.lang.Character"] - (defcompiler ^:private compile-jvm-invokevirtual - [::&analyser/jvm-invokevirtual ?class ?method ?classes ?object ?args] - (let [_ (prn 'compile-jvm-invokevirtual [?class ?method ?classes] '-> *type*) - method-sig (str "(" (reduce str "" (map ->type-signature ?classes)) ")" (->java-sig *type*))] - (compile-form (assoc *state* :form ?object)) - (.visitTypeInsn *writer* Opcodes/CHECKCAST (->class ?class)) - (doseq [[class-name arg] (map vector ?classes ?args)] - (do (compile-form (assoc *state* :form arg)) - (condp = class-name - "boolean" (let [wrapper-class (->class "java.lang.Boolean")] - (doto *writer* - (.visitTypeInsn Opcodes/CHECKCAST wrapper-class) - (.visitMethodInsn Opcodes/INVOKEVIRTUAL wrapper-class "booleanValue" "()Z"))) - "byte" (let [wrapper-class (->class "java.lang.Byte")] - (doto *writer* - (.visitTypeInsn Opcodes/CHECKCAST wrapper-class) - (.visitMethodInsn Opcodes/INVOKEVIRTUAL wrapper-class "byteValue" "()B"))) - "short" (let [wrapper-class (->class "java.lang.Short")] - (doto *writer* - (.visitTypeInsn Opcodes/CHECKCAST wrapper-class) - (.visitMethodInsn Opcodes/INVOKEVIRTUAL wrapper-class "shortValue" "()S"))) - "int" (let [wrapper-class (->class "java.lang.Integer")] - (doto *writer* - (.visitTypeInsn Opcodes/CHECKCAST wrapper-class) - (.visitMethodInsn Opcodes/INVOKEVIRTUAL wrapper-class "intValue" "()I"))) - "long" (let [wrapper-class (->class "java.lang.Long")] - (doto *writer* - (.visitTypeInsn Opcodes/CHECKCAST wrapper-class) - (.visitMethodInsn Opcodes/INVOKEVIRTUAL wrapper-class "longValue" "()J"))) - "float" (let [wrapper-class (->class "java.lang.Float")] - (doto *writer* - (.visitTypeInsn Opcodes/CHECKCAST wrapper-class) - (.visitMethodInsn Opcodes/INVOKEVIRTUAL wrapper-class "floatValue" "()F"))) - "double" (let [wrapper-class (->class "java.lang.Double")] - (doto *writer* - (.visitTypeInsn Opcodes/CHECKCAST wrapper-class) - (.visitMethodInsn Opcodes/INVOKEVIRTUAL wrapper-class "doubleValue" "()D"))) - "char" (let [wrapper-class (->class "java.lang.Character")] - (doto *writer* - (.visitTypeInsn Opcodes/CHECKCAST wrapper-class) - (.visitMethodInsn Opcodes/INVOKEVIRTUAL wrapper-class "charValue" "()C"))) - ;; else - (.visitTypeInsn *writer* Opcodes/CHECKCAST (->class class-name))))) - (.visitMethodInsn *writer* Opcodes/INVOKEVIRTUAL (->class ?class) ?method method-sig) - (match *type* - ::&type/nothing - (.visitInsn *writer* Opcodes/ACONST_NULL) - - [::&type/primitive "char"] - (.visitMethodInsn *writer* Opcodes/INVOKESTATIC (->class char-class) "valueOf" (str "(C)" (->type-signature char-class))) - - [::&type/primitive "int"] - (.visitMethodInsn *writer* Opcodes/INVOKESTATIC (->class integer-class) "valueOf" (str "(I)" (->type-signature integer-class))) - - [::&type/primitive "boolean"] - (.visitMethodInsn *writer* Opcodes/INVOKESTATIC (->class boolean-class) "valueOf" (str "(Z)" (->type-signature boolean-class))) - - [::&type/object ?oclass _] - nil) - ))) + (defn prepare-return! [*writer* *type*] + (match *type* + ::&type/nothing + (.visitInsn *writer* Opcodes/ACONST_NULL) + + [::&type/primitive "char"] + (.visitMethodInsn *writer* Opcodes/INVOKESTATIC (->class char-class) "valueOf" (str "(C)" (->type-signature char-class))) + + [::&type/primitive "int"] + (.visitMethodInsn *writer* Opcodes/INVOKESTATIC (->class integer-class) "valueOf" (str "(I)" (->type-signature integer-class))) + + [::&type/primitive "boolean"] + (.visitMethodInsn *writer* Opcodes/INVOKESTATIC (->class boolean-class) "valueOf" (str "(Z)" (->type-signature boolean-class))) + + [::&type/object ?oclass _] + nil))) + +(defcompiler ^:private compile-jvm-invokevirtual + [::&analyser/jvm-invokevirtual ?class ?method ?classes ?object ?args] + (let [_ (prn 'compile-jvm-invokevirtual [?class ?method ?classes] '-> *type*) + method-sig (str "(" (reduce str "" (map ->type-signature ?classes)) ")" (->java-sig *type*))] + (compile-form (assoc *state* :form ?object)) + (.visitTypeInsn *writer* Opcodes/CHECKCAST (->class ?class)) + (doseq [[class-name arg] (map vector ?classes ?args)] + (do (compile-form (assoc *state* :form arg)) + (prepare-arg! *writer* class-name))) + (.visitMethodInsn *writer* Opcodes/INVOKEVIRTUAL (->class ?class) ?method method-sig) + (prepare-return! *writer* *type*) + )) + +(defcompiler ^:private compile-jvm-new + [::&analyser/jvm-new ?class ?classes ?args] + (let [init-sig (str "(" (reduce str "" (map ->type-signature ?classes)) ")V") + class* (->class ?class)] + (doto *writer* + (.visitTypeInsn Opcodes/NEW class*) + (.visitInsn Opcodes/DUP)) + (doseq [[class-name arg] (map vector ?classes ?args)] + (do (compile-form (assoc *state* :form arg)) + (prepare-arg! *writer* class-name))) + (doto *writer* + (.visitMethodInsn Opcodes/INVOKESPECIAL class* "<init>" init-sig)) + )) + +(defcompiler ^:private compile-jvm-new-array + [::&analyser/jvm-new-array ?class ?length] + (doto *writer* + (.visitLdcInsn (int ?length)) + (.visitTypeInsn Opcodes/ANEWARRAY (->class ?class)))) + +(defcompiler ^:private compile-jvm-aastore + [::&analyser/jvm-aastore ?array ?idx ?elem] + (doto *writer* + (do (compile-form (assoc *state* :form ?array))) + (.visitInsn Opcodes/DUP) + (.visitLdcInsn (int ?idx)) + (do (compile-form (assoc *state* :form ?elem))) + (.visitInsn Opcodes/AASTORE))) + +(defcompiler ^:private compile-jvm-aaload + [::&analyser/jvm-aaload ?array ?idx] + (doto *writer* + (do (compile-form (assoc *state* :form ?array))) + (.visitLdcInsn (int ?idx)) + (.visitInsn Opcodes/AALOAD))) (let [+bool-class+ (->class "java.lang.Boolean")] (defcompiler ^:private compile-if @@ -1114,7 +1163,11 @@ compile-jvm-idiv compile-jvm-irem compile-jvm-getstatic - compile-jvm-invokevirtual]] + compile-jvm-invokevirtual + compile-jvm-new + compile-jvm-new-array + compile-jvm-aastore + compile-jvm-aaload]] (defn ^:private compile-form [state] ;; (prn 'compile-form/state state) (or (some #(% state) +compilers+) |