diff options
Diffstat (limited to '')
-rw-r--r-- | src/lux/analyser/host.clj | 48 | ||||
-rw-r--r-- | src/lux/compiler/host.clj | 35 |
2 files changed, 83 insertions, 0 deletions
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) |