aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorEduardo Julian2015-09-12 17:28:30 -0400
committerEduardo Julian2015-09-12 17:28:30 -0400
commit3c1e63b8ea119601f6ba2c9eb709877c76683a8c (patch)
treef1e6dcaef89e27eca1a030ffc48afc38aaa0276f
parent5fd179352bbf25bbe4000ae51132fd5553ba256a (diff)
- Added full support for arrays.
Diffstat (limited to '')
-rw-r--r--source/lux/host/jvm.lux14
-rw-r--r--src/lux/analyser.clj97
-rw-r--r--src/lux/analyser/base.clj33
-rw-r--r--src/lux/analyser/host.clj64
-rw-r--r--src/lux/compiler.clj87
-rw-r--r--src/lux/compiler/base.clj37
-rw-r--r--src/lux/compiler/host.clj59
7 files changed, 325 insertions, 66 deletions
diff --git a/source/lux/host/jvm.lux b/source/lux/host/jvm.lux
index c1e122bb6..ba29925a7 100644
--- a/source/lux/host/jvm.lux
+++ b/source/lux/host/jvm.lux
@@ -7,9 +7,9 @@
(lux (control (monoid #as m)
(functor #as F)
(monad #as M #refer (#only do)))
- (data (list #as l #refer #all #open ("" List/Functor))
- (text #as text)
- number/int)
+ (data (list #refer #all #open ("" List/Functor List/Fold))
+ (number/int #refer #all #open ("i:" Int/Ord))
+ maybe)
(meta lux
ast
syntax)))
@@ -107,3 +107,11 @@
(emit (@list (` (;_jvm_try (#;Right (~ expr))
(~ (' (_jvm_catch "java.lang.Exception" e
(#;Left (_jvm_invokevirtual "java.lang.Throwable" "getMessage" [] e []))))))))))
+
+(defsyntax #export (Array [dimensions (?^ int^)] type)
+ (let [dimensions (? 1 dimensions)]
+ (if (i:> dimensions 0)
+ (emit (@list (foldL (lambda [inner _] (` (#;DataT "Array" (@list (~ inner)))))
+ type
+ (repeat dimensions []))))
+ (fail "Array must have positive dimension."))))
diff --git a/src/lux/analyser.clj b/src/lux/analyser.clj
index a9689a9d0..bd0957bdf 100644
--- a/src/lux/analyser.clj
+++ b/src/lux/analyser.clj
@@ -63,24 +63,89 @@
(defn ^:private aba7 [analyse eval! compile-module compile-token exo-type token]
(|case token
;; Arrays
- (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_new-array")]
- (&/$Cons [_ (&/$SymbolS _ ?class)]
- (&/$Cons [_ (&/$IntS ?length)]
- (&/$Nil)))))
- (&&host/analyse-jvm-new-array analyse ?class ?length)
+ (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_znewarray")] (&/$Cons [_ (&/$IntS ?length)] (&/$Nil))))
+ (&&host/analyse-jvm-znewarray analyse ?length)
+
+ (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_zastore")] (&/$Cons ?array (&/$Cons [_ (&/$IntS ?idx)] (&/$Cons ?elem (&/$Nil))))))
+ (&&host/analyse-jvm-zastore analyse ?array ?idx ?elem)
- (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_aastore")]
- (&/$Cons ?array
- (&/$Cons [_ (&/$IntS ?idx)]
- (&/$Cons ?elem
- (&/$Nil))))))
- (&&host/analyse-jvm-aastore analyse ?array ?idx ?elem)
+ (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_zaload")] (&/$Cons ?array (&/$Cons [_ (&/$IntS ?idx)] (&/$Nil)))))
+ (&&host/analyse-jvm-zaload analyse ?array ?idx)
- (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_aaload")]
- (&/$Cons ?array
- (&/$Cons [_ (&/$IntS ?idx)]
- (&/$Nil)))))
- (&&host/analyse-jvm-aaload analyse ?array ?idx)
+ (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_bnewarray")] (&/$Cons [_ (&/$SymbolS _ ?class)] (&/$Cons [_ (&/$IntS ?length)] (&/$Nil)))))
+ (&&host/analyse-jvm-bnewarray analyse ?length)
+
+ (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_bastore")] (&/$Cons ?array (&/$Cons [_ (&/$IntS ?idx)] (&/$Cons ?elem (&/$Nil))))))
+ (&&host/analyse-jvm-bastore analyse ?array ?idx ?elem)
+
+ (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_baload")] (&/$Cons ?array (&/$Cons [_ (&/$IntS ?idx)] (&/$Nil)))))
+ (&&host/analyse-jvm-baload analyse ?array ?idx)
+
+ (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_snewarray")] (&/$Cons [_ (&/$SymbolS _ ?class)] (&/$Cons [_ (&/$IntS ?length)] (&/$Nil)))))
+ (&&host/analyse-jvm-snewarray analyse ?length)
+
+ (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_sastore")] (&/$Cons ?array (&/$Cons [_ (&/$IntS ?idx)] (&/$Cons ?elem (&/$Nil))))))
+ (&&host/analyse-jvm-sastore analyse ?array ?idx ?elem)
+
+ (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_saload")] (&/$Cons ?array (&/$Cons [_ (&/$IntS ?idx)] (&/$Nil)))))
+ (&&host/analyse-jvm-saload analyse ?array ?idx)
+
+ (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_inewarray")] (&/$Cons [_ (&/$SymbolS _ ?class)] (&/$Cons [_ (&/$IntS ?length)] (&/$Nil)))))
+ (&&host/analyse-jvm-inewarray analyse ?length)
+
+ (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_iastore")] (&/$Cons ?array (&/$Cons [_ (&/$IntS ?idx)] (&/$Cons ?elem (&/$Nil))))))
+ (&&host/analyse-jvm-iastore analyse ?array ?idx ?elem)
+
+ (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_iaload")] (&/$Cons ?array (&/$Cons [_ (&/$IntS ?idx)] (&/$Nil)))))
+ (&&host/analyse-jvm-iaload analyse ?array ?idx)
+
+ (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_lnewarray")] (&/$Cons [_ (&/$SymbolS _ ?class)] (&/$Cons [_ (&/$IntS ?length)] (&/$Nil)))))
+ (&&host/analyse-jvm-lnewarray analyse ?length)
+
+ (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_lastore")] (&/$Cons ?array (&/$Cons [_ (&/$IntS ?idx)] (&/$Cons ?elem (&/$Nil))))))
+ (&&host/analyse-jvm-lastore analyse ?array ?idx ?elem)
+
+ (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_laload")] (&/$Cons ?array (&/$Cons [_ (&/$IntS ?idx)] (&/$Nil)))))
+ (&&host/analyse-jvm-laload analyse ?array ?idx)
+
+ (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_fnewarray")] (&/$Cons [_ (&/$SymbolS _ ?class)] (&/$Cons [_ (&/$IntS ?length)] (&/$Nil)))))
+ (&&host/analyse-jvm-fnewarray analyse ?length)
+
+ (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_fastore")] (&/$Cons ?array (&/$Cons [_ (&/$IntS ?idx)] (&/$Cons ?elem (&/$Nil))))))
+ (&&host/analyse-jvm-fastore analyse ?array ?idx ?elem)
+
+ (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_faload")] (&/$Cons ?array (&/$Cons [_ (&/$IntS ?idx)] (&/$Nil)))))
+ (&&host/analyse-jvm-faload analyse ?array ?idx)
+
+ (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_dnewarray")] (&/$Cons [_ (&/$SymbolS _ ?class)] (&/$Cons [_ (&/$IntS ?length)] (&/$Nil)))))
+ (&&host/analyse-jvm-dnewarray analyse ?length)
+
+ (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_dastore")] (&/$Cons ?array (&/$Cons [_ (&/$IntS ?idx)] (&/$Cons ?elem (&/$Nil))))))
+ (&&host/analyse-jvm-dastore analyse ?array ?idx ?elem)
+
+ (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_daload")] (&/$Cons ?array (&/$Cons [_ (&/$IntS ?idx)] (&/$Nil)))))
+ (&&host/analyse-jvm-daload analyse ?array ?idx)
+
+ (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_cnewarray")] (&/$Cons [_ (&/$SymbolS _ ?class)] (&/$Cons [_ (&/$IntS ?length)] (&/$Nil)))))
+ (&&host/analyse-jvm-cnewarray analyse ?length)
+
+ (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_castore")] (&/$Cons ?array (&/$Cons [_ (&/$IntS ?idx)] (&/$Cons ?elem (&/$Nil))))))
+ (&&host/analyse-jvm-castore analyse ?array ?idx ?elem)
+
+ (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_caload")] (&/$Cons ?array (&/$Cons [_ (&/$IntS ?idx)] (&/$Nil)))))
+ (&&host/analyse-jvm-caload analyse ?array ?idx)
+
+ (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_anewarray")] (&/$Cons [_ (&/$TextS ?class)] (&/$Cons [_ (&/$IntS ?length)] (&/$Nil)))))
+ (&&host/analyse-jvm-anewarray analyse ?class ?length)
+
+ (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_aastore")] (&/$Cons [_ (&/$TextS ?class)] (&/$Cons ?array (&/$Cons [_ (&/$IntS ?idx)] (&/$Cons ?elem (&/$Nil)))))))
+ (&&host/analyse-jvm-aastore analyse ?class ?array ?idx ?elem)
+
+ (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_aaload")] (&/$Cons [_ (&/$TextS ?class)] (&/$Cons ?array (&/$Cons [_ (&/$IntS ?idx)] (&/$Nil))))))
+ (&&host/analyse-jvm-aaload analyse ?class ?array ?idx)
+
+ (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_arraylength")] (&/$Cons ?array (&/$Nil))))
+ (&&host/analyse-jvm-arraylength analyse ?array)
;; Classes & interfaces
(&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_class")]
diff --git a/src/lux/analyser/base.clj b/src/lux/analyser/base.clj
index 0bb40c71b..8df7f23b2 100644
--- a/src/lux/analyser/base.clj
+++ b/src/lux/analyser/base.clj
@@ -39,9 +39,6 @@
"jvm-null?"
"jvm-null"
"jvm-new"
- "jvm-new-array"
- "jvm-aastore"
- "jvm-aaload"
"jvm-class"
"jvm-interface"
"jvm-try"
@@ -50,6 +47,36 @@
"jvm-monitorexit"
"jvm-program"
+
+ "jvm-znewarray"
+ "jvm-zastore"
+ "jvm-zaload"
+ "jvm-bnewarray"
+ "jvm-bastore"
+ "jvm-baload"
+ "jvm-snewarray"
+ "jvm-sastore"
+ "jvm-saload"
+ "jvm-inewarray"
+ "jvm-iastore"
+ "jvm-iaload"
+ "jvm-lnewarray"
+ "jvm-lastore"
+ "jvm-laload"
+ "jvm-fnewarray"
+ "jvm-fastore"
+ "jvm-faload"
+ "jvm-dnewarray"
+ "jvm-dastore"
+ "jvm-daload"
+ "jvm-cnewarray"
+ "jvm-castore"
+ "jvm-caload"
+ "jvm-anewarray"
+ "jvm-aastore"
+ "jvm-aaload"
+ "jvm-arraylength"
+
"jvm-iadd"
"jvm-isub"
"jvm-imul"
diff --git a/src/lux/analyser/host.clj b/src/lux/analyser/host.clj
index 610f3c660..4fbd67fdb 100644
--- a/src/lux/analyser/host.clj
+++ b/src/lux/analyser/host.clj
@@ -226,18 +226,58 @@
_ (&type/check exo-type output-type)]
(return (&/|list (&/T (&/V &&/$jvm-new (&/T ?class =classes =args)) output-type)))))
-(defn analyse-jvm-new-array [analyse ?class ?length]
- (return (&/|list (&/T (&/V &&/$jvm-new-array (&/T ?class ?length)) (&/V "array" (&/T (&type/Data$ ?class (&/|list))
- (&/V &/$Nil nil)))))))
-
-(defn analyse-jvm-aastore [analyse ?array ?idx ?elem]
- (|do [=array (analyse-1+ analyse ?array)
- =elem (analyse-1+ analyse ?elem)]
- (return (&/|list (&/T (&/V &&/$jvm-aastore (&/T =array ?idx =elem)) (&&/expr-type* =array))))))
-
-(defn analyse-jvm-aaload [analyse ?array ?idx]
- (|do [=array (analyse-1+ analyse ?array)]
- (return (&/|list (&/T (&/V &&/$jvm-aaload (&/T =array ?idx)) (&&/expr-type* =array))))))
+(do-template [<class> <new-name> <new-tag> <load-name> <load-tag> <store-name> <store-tag>]
+ (let [elem-type (&type/Data$ <class> (&/|list))
+ array-type (&type/Data$ "Array" (&/|list elem-type))]
+ (defn <new-name> [analyse length]
+ (return (&/|list (&/T (&/V <new-tag> length) array-type))))
+
+ (defn <load-name> [analyse array idx]
+ (|do [=array (&&/analyse-1 analyse array-type array)]
+ (return (&/|list (&/T (&/V <load-tag> (&/T =array idx)) elem-type)))))
+
+ (defn <store-name> [analyse array idx elem]
+ (|do [=array (&&/analyse-1 analyse array-type array)
+ =elem (&&/analyse-1 analyse elem-type elem)]
+ (return (&/|list (&/T (&/V <store-tag> (&/T =array idx =elem)) array-type)))))
+ )
+
+ "java.lang.Boolean" analyse-jvm-znewarray &&/$jvm-znewarray analyse-jvm-zaload &&/$jvm-zaload analyse-jvm-zastore &&/$jvm-zastore
+ "java.lang.Byte" analyse-jvm-bnewarray &&/$jvm-bnewarray analyse-jvm-baload &&/$jvm-baload analyse-jvm-bastore &&/$jvm-bastore
+ "java.lang.Short" analyse-jvm-snewarray &&/$jvm-snewarray analyse-jvm-saload &&/$jvm-saload analyse-jvm-sastore &&/$jvm-sastore
+ "java.lang.Integer" analyse-jvm-inewarray &&/$jvm-inewarray analyse-jvm-iaload &&/$jvm-iaload analyse-jvm-iastore &&/$jvm-iastore
+ "java.lang.Long" analyse-jvm-lnewarray &&/$jvm-lnewarray analyse-jvm-laload &&/$jvm-laload analyse-jvm-lastore &&/$jvm-lastore
+ "java.lang.Float" analyse-jvm-fnewarray &&/$jvm-fnewarray analyse-jvm-faload &&/$jvm-faload analyse-jvm-fastore &&/$jvm-fastore
+ "java.lang.Double" analyse-jvm-dnewarray &&/$jvm-dnewarray analyse-jvm-daload &&/$jvm-daload analyse-jvm-dastore &&/$jvm-dastore
+ "java.lang.Character" analyse-jvm-cnewarray &&/$jvm-cnewarray analyse-jvm-caload &&/$jvm-caload analyse-jvm-castore &&/$jvm-castore
+ )
+
+(defn analyse-jvm-anewarray [analyse class length]
+ (let [elem-type (&type/Data$ class (&/|list))
+ array-type (&type/Data$ "Array" (&/|list elem-type))]
+ (return (&/|list (&/T (&/V &&/$jvm-anewarray (&/T class length)) array-type)))))
+
+(defn analyse-jvm-aaload [analyse class array idx]
+ (let [elem-type (&type/Data$ class (&/|list))
+ array-type (&type/Data$ "Array" (&/|list elem-type))]
+ (|do [=array (&&/analyse-1 analyse array-type array)]
+ (return (&/|list (&/T (&/V &&/$jvm-aaload (&/T class =array idx)) elem-type))))))
+
+(defn analyse-jvm-aastore [analyse class array idx elem]
+ (let [elem-type (&type/Data$ class (&/|list))
+ array-type (&type/Data$ "Array" (&/|list elem-type))]
+ (|do [=array (&&/analyse-1 analyse array-type array)
+ =elem (&&/analyse-1 analyse elem-type elem)]
+ (return (&/|list (&/T (&/V &&/$jvm-aastore (&/T class =array idx =elem)) array-type))))))
+
+(let [length-type (&type/Data$ "java.lang.Long" (&/|list))]
+ (defn analyse-jvm-arraylength [analyse array]
+ (&type/with-var
+ (fn [$var]
+ (let [elem-type $var
+ array-type (&type/Data$ "Array" (&/|list elem-type))]
+ (|do [=array (&&/analyse-1 analyse array-type array)]
+ (return (&/|list (&/T (&/V &&/$jvm-arraylength =array) length-type)))))))))
(defn ^:private analyse-modifiers [modifiers]
(&/fold% (fn [so-far modif]
diff --git a/src/lux/compiler.clj b/src/lux/compiler.clj
index da9896bd5..759fc98fc 100644
--- a/src/lux/compiler.clj
+++ b/src/lux/compiler.clj
@@ -223,14 +223,89 @@
(&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)
+ (&a/$jvm-znewarray ?length)
+ (&&host/compile-jvm-znewarray compile-expression ?type ?length)
- (&a/$jvm-aastore ?array ?idx ?elem)
- (&&host/compile-jvm-aastore compile-expression ?type ?array ?idx ?elem)
+ (&a/$jvm-zastore ?array ?idx ?elem)
+ (&&host/compile-jvm-zastore compile-expression ?type ?array ?idx ?elem)
- (&a/$jvm-aaload ?array ?idx)
- (&&host/compile-jvm-aaload compile-expression ?type ?array ?idx)
+ (&a/$jvm-zaload ?array ?idx)
+ (&&host/compile-jvm-zaload compile-expression ?type ?array ?idx)
+
+ (&a/$jvm-bnewarray ?length)
+ (&&host/compile-jvm-bnewarray compile-expression ?type ?length)
+
+ (&a/$jvm-bastore ?array ?idx ?elem)
+ (&&host/compile-jvm-bastore compile-expression ?type ?array ?idx ?elem)
+
+ (&a/$jvm-baload ?array ?idx)
+ (&&host/compile-jvm-baload compile-expression ?type ?array ?idx)
+
+ (&a/$jvm-snewarray ?length)
+ (&&host/compile-jvm-snewarray compile-expression ?type ?length)
+
+ (&a/$jvm-sastore ?array ?idx ?elem)
+ (&&host/compile-jvm-sastore compile-expression ?type ?array ?idx ?elem)
+
+ (&a/$jvm-saload ?array ?idx)
+ (&&host/compile-jvm-saload compile-expression ?type ?array ?idx)
+
+ (&a/$jvm-inewarray ?length)
+ (&&host/compile-jvm-inewarray compile-expression ?type ?length)
+
+ (&a/$jvm-iastore ?array ?idx ?elem)
+ (&&host/compile-jvm-iastore compile-expression ?type ?array ?idx ?elem)
+
+ (&a/$jvm-iaload ?array ?idx)
+ (&&host/compile-jvm-iaload compile-expression ?type ?array ?idx)
+
+ (&a/$jvm-lnewarray ?length)
+ (&&host/compile-jvm-lnewarray compile-expression ?type ?length)
+
+ (&a/$jvm-lastore ?array ?idx ?elem)
+ (&&host/compile-jvm-lastore compile-expression ?type ?array ?idx ?elem)
+
+ (&a/$jvm-laload ?array ?idx)
+ (&&host/compile-jvm-laload compile-expression ?type ?array ?idx)
+
+ (&a/$jvm-fnewarray ?length)
+ (&&host/compile-jvm-fnewarray compile-expression ?type ?length)
+
+ (&a/$jvm-fastore ?array ?idx ?elem)
+ (&&host/compile-jvm-fastore compile-expression ?type ?array ?idx ?elem)
+
+ (&a/$jvm-faload ?array ?idx)
+ (&&host/compile-jvm-faload compile-expression ?type ?array ?idx)
+
+ (&a/$jvm-dnewarray ?length)
+ (&&host/compile-jvm-dnewarray compile-expression ?type ?length)
+
+ (&a/$jvm-dastore ?array ?idx ?elem)
+ (&&host/compile-jvm-dastore compile-expression ?type ?array ?idx ?elem)
+
+ (&a/$jvm-daload ?array ?idx)
+ (&&host/compile-jvm-daload compile-expression ?type ?array ?idx)
+
+ (&a/$jvm-cnewarray ?length)
+ (&&host/compile-jvm-cnewarray compile-expression ?type ?length)
+
+ (&a/$jvm-castore ?array ?idx ?elem)
+ (&&host/compile-jvm-castore compile-expression ?type ?array ?idx ?elem)
+
+ (&a/$jvm-caload ?array ?idx)
+ (&&host/compile-jvm-caload compile-expression ?type ?array ?idx)
+
+ (&a/$jvm-anewarray ?class ?length)
+ (&&host/compile-jvm-anewarray compile-expression ?type ?class ?length)
+
+ (&a/$jvm-aastore ?class ?array ?idx ?elem)
+ (&&host/compile-jvm-aastore compile-expression ?type ?class ?array ?idx ?elem)
+
+ (&a/$jvm-aaload ?class ?array ?idx)
+ (&&host/compile-jvm-aaload compile-expression ?type ?class ?array ?idx)
+
+ (&a/$jvm-arraylength ?array)
+ (&&host/compile-jvm-arraylength compile-expression ?type ?array)
(&a/$jvm-try ?body ?catches ?finally)
(&&host/compile-jvm-try compile-expression ?type ?body ?catches ?finally)
diff --git a/src/lux/compiler/base.clj b/src/lux/compiler/base.clj
index 7c1297aad..7825bef94 100644
--- a/src/lux/compiler/base.clj
+++ b/src/lux/compiler/base.clj
@@ -76,26 +76,21 @@
_ (load-class! loader real-name)]]
(return nil)))
-(do-template [<name> <class> <sig> <dup>]
- (defn <name> [^MethodVisitor writer]
- (doto writer
- (.visitMethodInsn Opcodes/INVOKESTATIC <class> "valueOf" (str <sig> (&host/->type-signature <class>))))
- ;; (doto writer
- ;; ;; X
- ;; (.visitTypeInsn Opcodes/NEW <class>) ;; XW
- ;; (.visitInsn <dup>) ;; WXW
- ;; (.visitInsn <dup>) ;; WWXW
- ;; (.visitInsn Opcodes/POP) ;; WWX
- ;; (.visitMethodInsn Opcodes/INVOKESPECIAL <class> "<init>" <sig>) ;; W
- ;; )
- )
+(do-template [<wrap-name> <unwrap-name> <class> <unwrap-method> <prim> <dup>]
+ (do (defn <wrap-name> [^MethodVisitor writer]
+ (doto writer
+ (.visitMethodInsn Opcodes/INVOKESTATIC <class> "valueOf" (str "(" <prim> ")" (&host/->type-signature <class>)))))
+ (defn <unwrap-name> [^MethodVisitor writer]
+ (doto writer
+ (.visitTypeInsn Opcodes/CHECKCAST <class>)
+ (.visitMethodInsn Opcodes/INVOKEVIRTUAL <class> <unwrap-method> (str "()" <prim>)))))
- wrap-boolean "java/lang/Boolean" "(Z)" Opcodes/DUP_X1
- wrap-byte "java/lang/Byte" "(B)" Opcodes/DUP_X1
- wrap-short "java/lang/Short" "(S)" Opcodes/DUP_X1
- wrap-int "java/lang/Integer" "(I)" Opcodes/DUP_X1
- wrap-long "java/lang/Long" "(J)" Opcodes/DUP_X2
- wrap-float "java/lang/Float" "(F)" Opcodes/DUP_X1
- wrap-double "java/lang/Double" "(D)" Opcodes/DUP_X2
- wrap-char "java/lang/Character" "(C)" Opcodes/DUP_X1
+ wrap-boolean unwrap-boolean "java/lang/Boolean" "booleanValue" "Z" Opcodes/DUP_X1
+ wrap-byte unwrap-byte "java/lang/Byte" "byteValue" "B" Opcodes/DUP_X1
+ wrap-short unwrap-short "java/lang/Short" "shortValue" "S" Opcodes/DUP_X1
+ wrap-int unwrap-int "java/lang/Integer" "intValue" "I" Opcodes/DUP_X1
+ wrap-long unwrap-long "java/lang/Long" "longValue" "J" Opcodes/DUP_X2
+ wrap-float unwrap-float "java/lang/Float" "floatValue" "F" Opcodes/DUP_X1
+ wrap-double unwrap-double "java/lang/Double" "doubleValue" "D" Opcodes/DUP_X2
+ wrap-char unwrap-char "java/lang/Character" "charValue" "C" Opcodes/DUP_X1
)
diff --git a/src/lux/compiler/host.clj b/src/lux/compiler/host.clj
index db54af8ac..83c769b4b 100644
--- a/src/lux/compiler/host.clj
+++ b/src/lux/compiler/host.clj
@@ -287,14 +287,62 @@
(.visitMethodInsn Opcodes/INVOKESPECIAL class* "<init>" init-sig))]]
(return nil)))
-(defn compile-jvm-new-array [compile *type* ?class ?length]
+(do-template [<prim-type> <new-name> <load-name> <load-op> <store-name> <store-op> <wrapper> <unwrapper>]
+ (do (defn <new-name> [compile *type* ?length]
+ (|do [^MethodVisitor *writer* &/get-writer
+ :let [_ (doto *writer*
+ (.visitLdcInsn (int ?length))
+ (.visitIntInsn Opcodes/NEWARRAY <prim-type>))]]
+ (return nil)))
+
+ (defn <load-name> [compile *type* ?array ?idx]
+ (|do [^MethodVisitor *writer* &/get-writer
+ _ (compile ?array)
+ :let [_ (doto *writer*
+ (.visitLdcInsn (int ?idx))
+ (.visitInsn <load-op>)
+ <wrapper>)]]
+ (return nil)))
+
+ (defn <store-name> [compile *type* ?array ?idx ?elem]
+ (|do [^MethodVisitor *writer* &/get-writer
+ _ (compile ?array)
+ :let [_ (doto *writer*
+ (.visitInsn Opcodes/DUP)
+ (.visitLdcInsn (int ?idx)))]
+ _ (compile ?elem)
+ :let [_ (doto *writer*
+ <unwrapper>
+ (.visitInsn <store-op>))]]
+ (return nil)))
+ )
+
+ Opcodes/T_BOOLEAN compile-jvm-znewarray compile-jvm-zaload Opcodes/BALOAD compile-jvm-zastore Opcodes/BASTORE &&/wrap-boolean &&/unwrap-boolean
+ Opcodes/T_BYTE compile-jvm-bnewarray compile-jvm-baload Opcodes/BALOAD compile-jvm-bastore Opcodes/BASTORE &&/wrap-byte &&/unwrap-byte
+ Opcodes/T_SHORT compile-jvm-snewarray compile-jvm-saload Opcodes/SALOAD compile-jvm-sastore Opcodes/SASTORE &&/wrap-short &&/unwrap-short
+ Opcodes/T_INT compile-jvm-inewarray compile-jvm-iaload Opcodes/IALOAD compile-jvm-iastore Opcodes/IASTORE &&/wrap-int &&/unwrap-int
+ Opcodes/T_LONG compile-jvm-lnewarray compile-jvm-laload Opcodes/LALOAD compile-jvm-lastore Opcodes/LASTORE &&/wrap-long &&/unwrap-long
+ Opcodes/T_FLOAT compile-jvm-fnewarray compile-jvm-faload Opcodes/FALOAD compile-jvm-fastore Opcodes/FASTORE &&/wrap-float &&/unwrap-float
+ Opcodes/T_DOUBLE compile-jvm-dnewarray compile-jvm-daload Opcodes/DALOAD compile-jvm-dastore Opcodes/DASTORE &&/wrap-double &&/unwrap-double
+ Opcodes/T_CHAR compile-jvm-cnewarray compile-jvm-caload Opcodes/CALOAD compile-jvm-castore Opcodes/CASTORE &&/wrap-char &&/unwrap-char
+ )
+
+(defn compile-jvm-anewarray [compile *type* ?class ?length]
(|do [^MethodVisitor *writer* &/get-writer
:let [_ (doto *writer*
(.visitLdcInsn (int ?length))
(.visitTypeInsn Opcodes/ANEWARRAY (&host/->class ?class)))]]
(return nil)))
-(defn compile-jvm-aastore [compile *type* ?array ?idx ?elem]
+(defn compile-jvm-aaload [compile *type* ?class ?array ?idx]
+ (|do [^MethodVisitor *writer* &/get-writer
+ _ (compile ?array)
+ :let [_ (doto *writer*
+ (.visitLdcInsn (int ?idx))
+ (.visitInsn Opcodes/AALOAD))]]
+ (return nil)))
+
+(defn compile-jvm-aastore [compile *type* ?class ?array ?idx ?elem]
(|do [^MethodVisitor *writer* &/get-writer
_ (compile ?array)
:let [_ (doto *writer*
@@ -304,12 +352,13 @@
:let [_ (.visitInsn *writer* Opcodes/AASTORE)]]
(return nil)))
-(defn compile-jvm-aaload [compile *type* ?array ?idx]
+(defn compile-jvm-arraylength [compile *type* ?array]
(|do [^MethodVisitor *writer* &/get-writer
_ (compile ?array)
:let [_ (doto *writer*
- (.visitLdcInsn (int ?idx))
- (.visitInsn Opcodes/AALOAD))]]
+ (.visitInsn Opcodes/ARRAYLENGTH)
+ (.visitInsn Opcodes/I2L)
+ &&/wrap-long)]]
(return nil)))
(defn compile-jvm-getstatic [compile *type* ?class ?field]