From 520ed8dc98644218c5aef7081187ef8d5acd7a60 Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Tue, 3 May 2016 22:04:55 -0400
Subject: - Added multi-platform support for arrays.

---
 src/lux/analyser/host.clj | 48 +++++++++++++++++++++++++++++++++++++++++++++++
 src/lux/compiler/host.clj | 35 ++++++++++++++++++++++++++++++++++
 2 files changed, 83 insertions(+)

diff --git a/src/lux/analyser/host.clj b/src/lux/analyser/host.clj
index 16b68ad0d..bb70bf0e2 100644
--- a/src/lux/analyser/host.clj
+++ b/src/lux/analyser/host.clj
@@ -918,8 +918,56 @@
     (return (&/|list (&&/|meta output-type _cursor
                                (&&/$proc (&/T ["jvm" "instanceof"]) (&/|list class =object)))))))
 
+(let [length-type &type/Int
+      idx-type &type/Int]
+  (defn ^:private analyse-array-new [analyse exo-type ?values]
+    (|do [:let [(&/$Cons length (&/$Nil)) ?values]
+          :let [gclass (&/$GenericClass "java.lang.Object" (&/|list))
+                array-type (&/$UnivQ (&/|list) (&/$HostT &host-type/array-data-tag (&/|list (&/$BoundT 1))))]
+          gtype-env &/get-type-env
+          =length (&&/analyse-1 analyse length-type length)
+          _ (&type/check exo-type array-type)
+          _cursor &/cursor]
+      (return (&/|list (&&/|meta exo-type _cursor
+                                 (&&/$proc (&/T ["jvm" "anewarray"]) (&/|list gclass =length gtype-env)))))))
+
+  (defn ^:private analyse-array-get [analyse exo-type ?values]
+    (|do [:let [(&/$Cons array (&/$Cons idx (&/$Nil))) ?values]
+          =array (&&/analyse-1+ analyse array)
+          [arr-class arr-params] (ensure-object (&&/expr-type* =array))
+          _ (&/assert! (= &host-type/array-data-tag arr-class) (str "[Analyser Error] Expected array. Instead got: " arr-class))
+          :let [(&/$Cons inner-arr-type (&/$Nil)) arr-params]
+          =idx (&&/analyse-1 analyse idx-type idx)
+          _ (&type/check exo-type (&/$AppT &type/Maybe inner-arr-type))
+          _cursor &/cursor]
+      (return (&/|list (&&/|meta exo-type _cursor
+                                 (&&/$proc (&/T ["array" "get"]) (&/|list =array =idx)))))))
+
+  (defn ^:private analyse-array-remove [analyse exo-type ?values]
+    (|do [:let [(&/$Cons array (&/$Cons idx (&/$Nil))) ?values]
+          =array (&&/analyse-1+ analyse array)
+          :let [array-type (&&/expr-type* =array)]
+          [arr-class arr-params] (ensure-object array-type)
+          _ (&/assert! (= &host-type/array-data-tag arr-class) (str "[Analyser Error] Expected array. Instead got: " arr-class))
+          :let [(&/$Cons inner-arr-type (&/$Nil)) arr-params]
+          =idx (&&/analyse-1 analyse idx-type idx)
+          _cursor &/cursor
+          :let [=elem (&&/|meta inner-arr-type _cursor
+                                (&&/$proc (&/T ["jvm" "null"]) (&/|list)))]
+          _ (&type/check exo-type array-type)]
+      (return (&/|list (&&/|meta exo-type _cursor
+                                 (&&/$proc (&/T ["jvm" "aastore"]) (&/|list =array =idx =elem))))))))
+
 (defn analyse-host [analyse exo-type category proc ?values]
   (case category
+    "array"
+    (case proc
+      "new"    (analyse-array-new analyse exo-type ?values)
+      "get"    (analyse-array-get analyse exo-type ?values)
+      "put"    (analyse-jvm-aastore analyse exo-type ?values)
+      "remove" (analyse-array-remove analyse exo-type ?values)
+      "size"   (analyse-jvm-arraylength analyse exo-type ?values))
+    
     "jvm"
     (case proc
       "try"          (analyse-jvm-try analyse exo-type ?values)
diff --git a/src/lux/compiler/host.clj b/src/lux/compiler/host.clj
index 4a713d948..198e77254 100644
--- a/src/lux/compiler/host.clj
+++ b/src/lux/compiler/host.clj
@@ -1192,8 +1192,43 @@
                   (&&/wrap-boolean))]]
     (return nil)))
 
+(defn ^:private compile-array-get [compile ?values]
+  (|do [:let [(&/$Cons ?array (&/$Cons ?idx (&/$Nil))) ?values]
+        ^MethodVisitor *writer* &/get-writer
+        array-type (&host/->java-sig (&a/expr-type* ?array))
+        _ (compile ?array)
+        :let [_ (.visitTypeInsn *writer* Opcodes/CHECKCAST array-type)]
+        _ (compile ?idx)
+        :let [_ (doto *writer*
+                  &&/unwrap-long
+                  (.visitInsn Opcodes/L2I))]
+        :let [_ (.visitInsn *writer* Opcodes/AALOAD)]
+        :let [$then (new Label)
+              $end (new Label)
+              _ (doto *writer*
+                  (.visitInsn Opcodes/DUP)
+                  (.visitJumpInsn Opcodes/IFNULL $then)
+                  (.visitInsn Opcodes/POP)
+                  (.visitLdcInsn (int 0))
+                  (.visitInsn Opcodes/ACONST_NULL)
+                  (.visitLdcInsn &/unit-tag)
+                  (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxUtils" "sum_make" "(ILjava/lang/Object;Ljava/lang/Object;)[Ljava/lang/Object;")
+                  (.visitJumpInsn Opcodes/GOTO $end)
+                  (.visitLabel $then)
+                  (.visitLdcInsn (int 1))
+                  (.visitLdcInsn "")
+                  (.visitInsn Opcodes/DUP2_X1) ;; I?2I?
+                  (.visitInsn Opcodes/POP2) ;; I?2
+                  (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxUtils" "sum_make" "(ILjava/lang/Object;Ljava/lang/Object;)[Ljava/lang/Object;")
+                  (.visitLabel $end))]]
+    (return nil)))
+
 (defn compile-host [compile proc-category proc-name ?values]
   (case proc-category
+    "array"
+    (case proc-name
+      "get" (compile-array-get compile ?values))
+    
     "jvm"
     (case proc-name
       "instanceof"      (compile-jvm-instanceof compile ?values)
-- 
cgit v1.2.3