aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/lux/analyser.clj109
-rw-r--r--src/lux/compiler.clj177
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+)