aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/lux/analyser.clj343
-rw-r--r--src/lux/analyser/base.clj109
-rw-r--r--src/lux/analyser/host.clj530
-rw-r--r--src/lux/base.clj2
-rw-r--r--src/lux/compiler.clj289
-rw-r--r--src/lux/compiler/host.clj592
-rw-r--r--src/lux/optimizer.clj394
7 files changed, 683 insertions, 1576 deletions
diff --git a/src/lux/analyser.clj b/src/lux/analyser.clj
index 73a1dcb07..3256f6902 100644
--- a/src/lux/analyser.clj
+++ b/src/lux/analyser.clj
@@ -54,110 +54,7 @@
(fn [state]
(fail* (add-loc (&/get$ &/$cursor state) msg))))
-(defn ^:private aba10 [analyse eval! compile-module compile-token exo-type token]
- (|case token
- ;; Arrays
- (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_znewarray")] (&/$Cons ?length (&/$Nil))))
- (&&host/analyse-jvm-znewarray analyse exo-type ?length)
-
- (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_zastore")] (&/$Cons ?array (&/$Cons ?idx (&/$Cons ?elem (&/$Nil))))))
- (&&host/analyse-jvm-zastore analyse exo-type ?array ?idx ?elem)
-
- (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_zaload")] (&/$Cons ?array (&/$Cons ?idx (&/$Nil)))))
- (&&host/analyse-jvm-zaload analyse exo-type ?array ?idx)
-
- (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_bnewarray")] (&/$Cons ?length (&/$Nil))))
- (&&host/analyse-jvm-bnewarray analyse exo-type ?length)
-
- (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_bastore")] (&/$Cons ?array (&/$Cons ?idx (&/$Cons ?elem (&/$Nil))))))
- (&&host/analyse-jvm-bastore analyse exo-type ?array ?idx ?elem)
-
- (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_baload")] (&/$Cons ?array (&/$Cons ?idx (&/$Nil)))))
- (&&host/analyse-jvm-baload analyse exo-type ?array ?idx)
-
- (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_snewarray")] (&/$Cons ?length (&/$Nil))))
- (&&host/analyse-jvm-snewarray analyse exo-type ?length)
-
- (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_sastore")] (&/$Cons ?array (&/$Cons ?idx (&/$Cons ?elem (&/$Nil))))))
- (&&host/analyse-jvm-sastore analyse exo-type ?array ?idx ?elem)
-
- (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_saload")] (&/$Cons ?array (&/$Cons ?idx (&/$Nil)))))
- (&&host/analyse-jvm-saload analyse exo-type ?array ?idx)
-
- (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_inewarray")] (&/$Cons ?length (&/$Nil))))
- (&&host/analyse-jvm-inewarray analyse exo-type ?length)
-
- (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_iastore")] (&/$Cons ?array (&/$Cons ?idx (&/$Cons ?elem (&/$Nil))))))
- (&&host/analyse-jvm-iastore analyse exo-type ?array ?idx ?elem)
-
- (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_iaload")] (&/$Cons ?array (&/$Cons ?idx (&/$Nil)))))
- (&&host/analyse-jvm-iaload analyse exo-type ?array ?idx)
-
- (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_lnewarray")] (&/$Cons ?length (&/$Nil))))
- (&&host/analyse-jvm-lnewarray analyse exo-type ?length)
-
- (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_lastore")] (&/$Cons ?array (&/$Cons ?idx (&/$Cons ?elem (&/$Nil))))))
- (&&host/analyse-jvm-lastore analyse exo-type ?array ?idx ?elem)
-
- (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_laload")] (&/$Cons ?array (&/$Cons ?idx (&/$Nil)))))
- (&&host/analyse-jvm-laload analyse exo-type ?array ?idx)
-
- _
- (fail-with-loc (str "[Analyser Error] Unknown syntax: " (prn-str (&/show-ast (&/T [(&/T ["" -1 -1]) token])))))))
-
-(defn ^:private aba9 [analyse eval! compile-module compile-token exo-type token]
- (|case token
- ;; Arrays
- (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_fnewarray")] (&/$Cons ?length (&/$Nil))))
- (&&host/analyse-jvm-fnewarray analyse exo-type ?length)
-
- (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_fastore")] (&/$Cons ?array (&/$Cons ?idx (&/$Cons ?elem (&/$Nil))))))
- (&&host/analyse-jvm-fastore analyse exo-type ?array ?idx ?elem)
-
- (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_faload")] (&/$Cons ?array (&/$Cons ?idx (&/$Nil)))))
- (&&host/analyse-jvm-faload analyse exo-type ?array ?idx)
-
- (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_dnewarray")] (&/$Cons ?length (&/$Nil))))
- (&&host/analyse-jvm-dnewarray analyse exo-type ?length)
-
- (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_dastore")] (&/$Cons ?array (&/$Cons ?idx (&/$Cons ?elem (&/$Nil))))))
- (&&host/analyse-jvm-dastore analyse exo-type ?array ?idx ?elem)
-
- (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_daload")] (&/$Cons ?array (&/$Cons ?idx (&/$Nil)))))
- (&&host/analyse-jvm-daload analyse exo-type ?array ?idx)
-
- (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_cnewarray")] (&/$Cons ?length (&/$Nil))))
- (&&host/analyse-jvm-cnewarray analyse exo-type ?length)
-
- (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_castore")] (&/$Cons ?array (&/$Cons ?idx (&/$Cons ?elem (&/$Nil))))))
- (&&host/analyse-jvm-castore analyse exo-type ?array ?idx ?elem)
-
- (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_caload")] (&/$Cons ?array (&/$Cons ?idx (&/$Nil)))))
- (&&host/analyse-jvm-caload analyse exo-type ?array ?idx)
-
- _
- (aba10 analyse eval! compile-module compile-token exo-type token)))
-
-(defn ^:private aba8 [analyse eval! compile-module compile-token exo-type token]
- (|case token
- ;; Arrays
- (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_anewarray")] (&/$Cons gtype (&/$Cons ?length (&/$Nil)))))
- (|do [=gtype (&&a-parser/parse-gclass gtype)]
- (&&host/analyse-jvm-anewarray analyse exo-type =gtype ?length))
-
- (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_aastore")] (&/$Cons ?array (&/$Cons ?idx (&/$Cons ?elem (&/$Nil))))))
- (&&host/analyse-jvm-aastore analyse exo-type ?array ?idx ?elem)
-
- (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_aaload")] (&/$Cons ?array (&/$Cons ?idx (&/$Nil)))))
- (&&host/analyse-jvm-aaload analyse exo-type ?array ?idx)
-
- (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_arraylength")] (&/$Cons ?array (&/$Nil))))
- (&&host/analyse-jvm-arraylength analyse exo-type ?array)
-
- _
- (aba9 analyse eval! compile-module compile-token exo-type token)))
-
-(defn ^:private aba7 [analyse eval! compile-module compile-token exo-type token]
+(defn ^:private aba4 [analyse eval! compile-module compile-token exo-type token]
(|case token
;; Classes & interfaces
(&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_class")]
@@ -209,114 +106,9 @@
(&&host/analyse-jvm-program analyse compile-token ?args ?body)
_
- (aba8 analyse eval! compile-module compile-token exo-type token)))
-
-(defn ^:private aba6 [analyse eval! compile-module compile-token exo-type token]
- (|case token
- ;; Bitwise operators
- (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_iand")] (&/$Cons ?x (&/$Cons ?y (&/$Nil)))))
- (&&host/analyse-jvm-iand analyse exo-type ?x ?y)
-
- (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_ior")] (&/$Cons ?x (&/$Cons ?y (&/$Nil)))))
- (&&host/analyse-jvm-ior analyse exo-type ?x ?y)
-
- (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_ixor")] (&/$Cons ?x (&/$Cons ?y (&/$Nil)))))
- (&&host/analyse-jvm-ixor analyse exo-type ?x ?y)
-
- (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_ishl")] (&/$Cons ?x (&/$Cons ?y (&/$Nil)))))
- (&&host/analyse-jvm-ishl analyse exo-type ?x ?y)
-
- (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_ishr")] (&/$Cons ?x (&/$Cons ?y (&/$Nil)))))
- (&&host/analyse-jvm-ishr analyse exo-type ?x ?y)
-
- (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_iushr")] (&/$Cons ?x (&/$Cons ?y (&/$Nil)))))
- (&&host/analyse-jvm-iushr analyse exo-type ?x ?y)
-
- (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_land")] (&/$Cons ?x (&/$Cons ?y (&/$Nil)))))
- (&&host/analyse-jvm-land analyse exo-type ?x ?y)
-
- (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_lor")] (&/$Cons ?x (&/$Cons ?y (&/$Nil)))))
- (&&host/analyse-jvm-lor analyse exo-type ?x ?y)
-
- (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_lxor")] (&/$Cons ?x (&/$Cons ?y (&/$Nil)))))
- (&&host/analyse-jvm-lxor analyse exo-type ?x ?y)
-
- (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_lshl")] (&/$Cons ?x (&/$Cons ?y (&/$Nil)))))
- (&&host/analyse-jvm-lshl analyse exo-type ?x ?y)
-
- (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_lshr")] (&/$Cons ?x (&/$Cons ?y (&/$Nil)))))
- (&&host/analyse-jvm-lshr analyse exo-type ?x ?y)
-
- (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_lushr")] (&/$Cons ?x (&/$Cons ?y (&/$Nil)))))
- (&&host/analyse-jvm-lushr analyse exo-type ?x ?y)
-
- _
- (aba7 analyse eval! compile-module compile-token exo-type token)))
-
-(defn ^:private aba5_5 [analyse eval! compile-module compile-token exo-type token]
- (|case token
- ;; Primitive conversions
- (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_d2f")] (&/$Cons ?value (&/$Nil))))
- (&&host/analyse-jvm-d2f analyse exo-type ?value)
-
- (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_d2i")] (&/$Cons ?value (&/$Nil))))
- (&&host/analyse-jvm-d2i analyse exo-type ?value)
-
- (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_d2l")] (&/$Cons ?value (&/$Nil))))
- (&&host/analyse-jvm-d2l analyse exo-type ?value)
-
- (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_f2d")] (&/$Cons ?value (&/$Nil))))
- (&&host/analyse-jvm-f2d analyse exo-type ?value)
-
- (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_f2i")] (&/$Cons ?value (&/$Nil))))
- (&&host/analyse-jvm-f2i analyse exo-type ?value)
-
- (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_f2l")] (&/$Cons ?value (&/$Nil))))
- (&&host/analyse-jvm-f2l analyse exo-type ?value)
-
- (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_i2b")] (&/$Cons ?value (&/$Nil))))
- (&&host/analyse-jvm-i2b analyse exo-type ?value)
-
- (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_i2c")] (&/$Cons ?value (&/$Nil))))
- (&&host/analyse-jvm-i2c analyse exo-type ?value)
-
- (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_i2d")] (&/$Cons ?value (&/$Nil))))
- (&&host/analyse-jvm-i2d analyse exo-type ?value)
-
- (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_i2f")] (&/$Cons ?value (&/$Nil))))
- (&&host/analyse-jvm-i2f analyse exo-type ?value)
-
- (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_i2l")] (&/$Cons ?value (&/$Nil))))
- (&&host/analyse-jvm-i2l analyse exo-type ?value)
-
- (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_i2s")] (&/$Cons ?value (&/$Nil))))
- (&&host/analyse-jvm-i2s analyse exo-type ?value)
-
- (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_l2d")] (&/$Cons ?value (&/$Nil))))
- (&&host/analyse-jvm-l2d analyse exo-type ?value)
-
- (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_l2f")] (&/$Cons ?value (&/$Nil))))
- (&&host/analyse-jvm-l2f analyse exo-type ?value)
-
- (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_l2i")] (&/$Cons ?value (&/$Nil))))
- (&&host/analyse-jvm-l2i analyse exo-type ?value)
-
- (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_c2b")] (&/$Cons ?value (&/$Nil))))
- (&&host/analyse-jvm-c2b analyse exo-type ?value)
-
- (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_c2s")] (&/$Cons ?value (&/$Nil))))
- (&&host/analyse-jvm-c2s analyse exo-type ?value)
-
- (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_c2i")] (&/$Cons ?value (&/$Nil))))
- (&&host/analyse-jvm-c2i analyse exo-type ?value)
-
- (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_c2l")] (&/$Cons ?value (&/$Nil))))
- (&&host/analyse-jvm-c2l analyse exo-type ?value)
-
- _
- (aba6 analyse eval! compile-module compile-token exo-type token)))
+ (fail-with-loc (str "[Analyser Error] Unknown syntax: " (prn-str (&/show-ast (&/T [(&/T ["" -1 -1]) token])))))))
-(defn ^:private aba5 [analyse eval! compile-module compile-token exo-type token]
+(defn ^:private aba3 [analyse eval! compile-module compile-token exo-type token]
(|case token
;; Objects
(&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_null")] (&/$Nil)))
@@ -432,127 +224,6 @@
(&&host/analyse-jvm-monitorexit analyse exo-type ?monitor)
_
- (aba5_5 analyse eval! compile-module compile-token exo-type token)))
-
-(defn ^:private aba4 [analyse eval! compile-module compile-token exo-type token]
- (|case token
- ;; Float arithmetic
- (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_fadd")] (&/$Cons ?x (&/$Cons ?y (&/$Nil)))))
- (&&host/analyse-jvm-fadd analyse exo-type ?x ?y)
-
- (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_fsub")] (&/$Cons ?x (&/$Cons ?y (&/$Nil)))))
- (&&host/analyse-jvm-fsub analyse exo-type ?x ?y)
-
- (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_fmul")] (&/$Cons ?x (&/$Cons ?y (&/$Nil)))))
- (&&host/analyse-jvm-fmul analyse exo-type ?x ?y)
-
- (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_fdiv")] (&/$Cons ?x (&/$Cons ?y (&/$Nil)))))
- (&&host/analyse-jvm-fdiv analyse exo-type ?x ?y)
-
- (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_frem")] (&/$Cons ?x (&/$Cons ?y (&/$Nil)))))
- (&&host/analyse-jvm-frem analyse exo-type ?x ?y)
-
- (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_feq")] (&/$Cons ?x (&/$Cons ?y (&/$Nil)))))
- (&&host/analyse-jvm-feq analyse exo-type ?x ?y)
-
- (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_flt")] (&/$Cons ?x (&/$Cons ?y (&/$Nil)))))
- (&&host/analyse-jvm-flt analyse exo-type ?x ?y)
-
- (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_fgt")] (&/$Cons ?x (&/$Cons ?y (&/$Nil)))))
- (&&host/analyse-jvm-fgt analyse exo-type ?x ?y)
-
- ;; Double arithmetic
- (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_dadd")] (&/$Cons ?x (&/$Cons ?y (&/$Nil)))))
- (&&host/analyse-jvm-dadd analyse exo-type ?x ?y)
-
- (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_dsub")] (&/$Cons ?x (&/$Cons ?y (&/$Nil)))))
- (&&host/analyse-jvm-dsub analyse exo-type ?x ?y)
-
- (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_dmul")] (&/$Cons ?x (&/$Cons ?y (&/$Nil)))))
- (&&host/analyse-jvm-dmul analyse exo-type ?x ?y)
-
- (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_ddiv")] (&/$Cons ?x (&/$Cons ?y (&/$Nil)))))
- (&&host/analyse-jvm-ddiv analyse exo-type ?x ?y)
-
- (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_drem")] (&/$Cons ?x (&/$Cons ?y (&/$Nil)))))
- (&&host/analyse-jvm-drem analyse exo-type ?x ?y)
-
- (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_deq")] (&/$Cons ?x (&/$Cons ?y (&/$Nil)))))
- (&&host/analyse-jvm-deq analyse exo-type ?x ?y)
-
- (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_dlt")] (&/$Cons ?x (&/$Cons ?y (&/$Nil)))))
- (&&host/analyse-jvm-dlt analyse exo-type ?x ?y)
-
- (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_dgt")] (&/$Cons ?x (&/$Cons ?y (&/$Nil)))))
- (&&host/analyse-jvm-dgt analyse exo-type ?x ?y)
-
- _
- (aba5 analyse eval! compile-module compile-token exo-type token)))
-
-(defn ^:private aba3 [analyse eval! compile-module compile-token exo-type token]
- (|case token
- ;; Host special forms
- ;; Characters
- (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_ceq")] (&/$Cons ?x (&/$Cons ?y (&/$Nil)))))
- (&&host/analyse-jvm-ceq analyse exo-type ?x ?y)
-
- (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_clt")] (&/$Cons ?x (&/$Cons ?y (&/$Nil)))))
- (&&host/analyse-jvm-clt analyse exo-type ?x ?y)
-
- (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_cgt")] (&/$Cons ?x (&/$Cons ?y (&/$Nil)))))
- (&&host/analyse-jvm-cgt analyse exo-type ?x ?y)
-
- ;; Integer arithmetic
- (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_iadd")] (&/$Cons ?x (&/$Cons ?y (&/$Nil)))))
- (&&host/analyse-jvm-iadd analyse exo-type ?x ?y)
-
- (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_isub")] (&/$Cons ?x (&/$Cons ?y (&/$Nil)))))
- (&&host/analyse-jvm-isub analyse exo-type ?x ?y)
-
- (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_imul")] (&/$Cons ?x (&/$Cons ?y (&/$Nil)))))
- (&&host/analyse-jvm-imul analyse exo-type ?x ?y)
-
- (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_idiv")] (&/$Cons ?x (&/$Cons ?y (&/$Nil)))))
- (&&host/analyse-jvm-idiv analyse exo-type ?x ?y)
-
- (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_irem")] (&/$Cons ?x (&/$Cons ?y (&/$Nil)))))
- (&&host/analyse-jvm-irem analyse exo-type ?x ?y)
-
- (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_ieq")] (&/$Cons ?x (&/$Cons ?y (&/$Nil)))))
- (&&host/analyse-jvm-ieq analyse exo-type ?x ?y)
-
- (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_ilt")] (&/$Cons ?x (&/$Cons ?y (&/$Nil)))))
- (&&host/analyse-jvm-ilt analyse exo-type ?x ?y)
-
- (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_igt")] (&/$Cons ?x (&/$Cons ?y (&/$Nil)))))
- (&&host/analyse-jvm-igt analyse exo-type ?x ?y)
-
- ;; Long arithmetic
- (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_ladd")] (&/$Cons ?x (&/$Cons ?y (&/$Nil)))))
- (&&host/analyse-jvm-ladd analyse exo-type ?x ?y)
-
- (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_lsub")] (&/$Cons ?x (&/$Cons ?y (&/$Nil)))))
- (&&host/analyse-jvm-lsub analyse exo-type ?x ?y)
-
- (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_lmul")] (&/$Cons ?x (&/$Cons ?y (&/$Nil)))))
- (&&host/analyse-jvm-lmul analyse exo-type ?x ?y)
-
- (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_ldiv")] (&/$Cons ?x (&/$Cons ?y (&/$Nil)))))
- (&&host/analyse-jvm-ldiv analyse exo-type ?x ?y)
-
- (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_lrem")] (&/$Cons ?x (&/$Cons ?y (&/$Nil)))))
- (&&host/analyse-jvm-lrem analyse exo-type ?x ?y)
-
- (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_leq")] (&/$Cons ?x (&/$Cons ?y (&/$Nil)))))
- (&&host/analyse-jvm-leq analyse exo-type ?x ?y)
-
- (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_llt")] (&/$Cons ?x (&/$Cons ?y (&/$Nil)))))
- (&&host/analyse-jvm-llt analyse exo-type ?x ?y)
-
- (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_lgt")] (&/$Cons ?x (&/$Cons ?y (&/$Nil)))))
- (&&host/analyse-jvm-lgt analyse exo-type ?x ?y)
-
- _
(aba4 analyse eval! compile-module compile-token exo-type token)))
(defn ^:private aba2 [analyse eval! compile-module compile-token exo-type token]
@@ -598,6 +269,14 @@
(&/$Cons [_ (&/$TextS ?module)]
(&/$Nil)))))
(&&lux/analyse-alias analyse compile-token ?alias ?module)
+
+ (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_lux_host")]
+ (&/$Cons [_ (&/$TupleS (&/$Cons [_ (&/$TextS ?category)]
+ (&/$Cons [_ (&/$TextS ?proc)]
+ (&/$Nil))))]
+ (&/$Cons [_ (&/$TupleS ?args)]
+ (&/$Nil)))))
+ (&&host/analyse-host analyse exo-type ?category ?proc ?args)
_
(aba3 analyse eval! compile-module compile-token exo-type token)))
diff --git a/src/lux/analyser/base.clj b/src/lux/analyser/base.clj
index bb835a524..c76274e76 100644
--- a/src/lux/analyser/base.clj
+++ b/src/lux/analyser/base.clj
@@ -27,6 +27,7 @@
("declare-macro" 1)
("var" 1)
("captured" 1)
+ ("host" 2)
("jvm-getstatic" 1)
("jvm-getfield" 1)
@@ -47,113 +48,7 @@
("jvm-monitorenter" 1)
("jvm-monitorexit" 1)
("jvm-program" 1)
-
- ("jvm-znewarray" 1)
- ("jvm-zastore" 1)
- ("jvm-zaload" 1)
- ("jvm-bnewarray" 1)
- ("jvm-bastore" 1)
- ("jvm-baload" 1)
- ("jvm-snewarray" 1)
- ("jvm-sastore" 1)
- ("jvm-saload" 1)
- ("jvm-inewarray" 1)
- ("jvm-iastore" 1)
- ("jvm-iaload" 1)
- ("jvm-lnewarray" 1)
- ("jvm-lastore" 1)
- ("jvm-laload" 1)
- ("jvm-fnewarray" 1)
- ("jvm-fastore" 1)
- ("jvm-faload" 1)
- ("jvm-dnewarray" 1)
- ("jvm-dastore" 1)
- ("jvm-daload" 1)
- ("jvm-cnewarray" 1)
- ("jvm-castore" 1)
- ("jvm-caload" 1)
- ("jvm-anewarray" 1)
- ("jvm-aastore" 1)
- ("jvm-aaload" 1)
- ("jvm-arraylength" 1)
-
- ("jvm-iadd" 1)
- ("jvm-isub" 1)
- ("jvm-imul" 1)
- ("jvm-idiv" 1)
- ("jvm-irem" 1)
- ("jvm-ieq" 1)
- ("jvm-ilt" 1)
- ("jvm-igt" 1)
-
- ("jvm-ceq" 1)
- ("jvm-clt" 1)
- ("jvm-cgt" 1)
-
- ("jvm-ladd" 1)
- ("jvm-lsub" 1)
- ("jvm-lmul" 1)
- ("jvm-ldiv" 1)
- ("jvm-lrem" 1)
- ("jvm-leq" 1)
- ("jvm-llt" 1)
- ("jvm-lgt" 1)
-
- ("jvm-fadd" 1)
- ("jvm-fsub" 1)
- ("jvm-fmul" 1)
- ("jvm-fdiv" 1)
- ("jvm-frem" 1)
- ("jvm-feq" 1)
- ("jvm-flt" 1)
- ("jvm-fgt" 1)
-
- ("jvm-dadd" 1)
- ("jvm-dsub" 1)
- ("jvm-dmul" 1)
- ("jvm-ddiv" 1)
- ("jvm-drem" 1)
- ("jvm-deq" 1)
- ("jvm-dlt" 1)
- ("jvm-dgt" 1)
-
- ("jvm-d2f" 1)
- ("jvm-d2i" 1)
- ("jvm-d2l" 1)
-
- ("jvm-f2d" 1)
- ("jvm-f2i" 1)
- ("jvm-f2l" 1)
-
- ("jvm-i2b" 1)
- ("jvm-i2c" 1)
- ("jvm-i2d" 1)
- ("jvm-i2f" 1)
- ("jvm-i2l" 1)
- ("jvm-i2s" 1)
-
- ("jvm-l2d" 1)
- ("jvm-l2f" 1)
- ("jvm-l2i" 1)
-
- ("jvm-c2b" 1)
- ("jvm-c2s" 1)
- ("jvm-c2i" 1)
- ("jvm-c2l" 1)
-
- ("jvm-iand" 1)
- ("jvm-ior" 1)
- ("jvm-ixor" 1)
- ("jvm-ishl" 1)
- ("jvm-ishr" 1)
- ("jvm-iushr" 1)
-
- ("jvm-land" 1)
- ("jvm-lor" 1)
- ("jvm-lxor" 1)
- ("jvm-lshl" 1)
- ("jvm-lshr" 1)
- ("jvm-lushr" 1))
+ )
;; [Exports]
(defn expr-type* [analysis]
diff --git a/src/lux/analyser/host.clj b/src/lux/analyser/host.clj
index edd3babc4..00b3a68c7 100644
--- a/src/lux/analyser/host.clj
+++ b/src/lux/analyser/host.clj
@@ -146,58 +146,6 @@
type-args))
;; [Resources]
-(do-template [<name> <output-tag> <input-class> <output-class>]
- (let [input-type (&/$DataT <input-class> &/$Nil)
- output-type (&/$DataT <output-class> &/$Nil)]
- (defn <name> [analyse exo-type x y]
- (|do [=x (&&/analyse-1 analyse input-type x)
- =y (&&/analyse-1 analyse input-type y)
- _ (&type/check exo-type output-type)
- _cursor &/cursor]
- (return (&/|list (&&/|meta output-type _cursor
- (<output-tag> (&/T [=x =y]))))))))
-
- analyse-jvm-iadd &&/$jvm-iadd "java.lang.Integer" "java.lang.Integer"
- analyse-jvm-isub &&/$jvm-isub "java.lang.Integer" "java.lang.Integer"
- analyse-jvm-imul &&/$jvm-imul "java.lang.Integer" "java.lang.Integer"
- analyse-jvm-idiv &&/$jvm-idiv "java.lang.Integer" "java.lang.Integer"
- analyse-jvm-irem &&/$jvm-irem "java.lang.Integer" "java.lang.Integer"
- analyse-jvm-ieq &&/$jvm-ieq "java.lang.Integer" "java.lang.Boolean"
- analyse-jvm-ilt &&/$jvm-ilt "java.lang.Integer" "java.lang.Boolean"
- analyse-jvm-igt &&/$jvm-igt "java.lang.Integer" "java.lang.Boolean"
-
- analyse-jvm-ceq &&/$jvm-ceq "java.lang.Character" "java.lang.Boolean"
- analyse-jvm-clt &&/$jvm-clt "java.lang.Character" "java.lang.Boolean"
- analyse-jvm-cgt &&/$jvm-cgt "java.lang.Character" "java.lang.Boolean"
-
- analyse-jvm-ladd &&/$jvm-ladd "java.lang.Long" "java.lang.Long"
- analyse-jvm-lsub &&/$jvm-lsub "java.lang.Long" "java.lang.Long"
- analyse-jvm-lmul &&/$jvm-lmul "java.lang.Long" "java.lang.Long"
- analyse-jvm-ldiv &&/$jvm-ldiv "java.lang.Long" "java.lang.Long"
- analyse-jvm-lrem &&/$jvm-lrem "java.lang.Long" "java.lang.Long"
- analyse-jvm-leq &&/$jvm-leq "java.lang.Long" "java.lang.Boolean"
- analyse-jvm-llt &&/$jvm-llt "java.lang.Long" "java.lang.Boolean"
- analyse-jvm-lgt &&/$jvm-lgt "java.lang.Long" "java.lang.Boolean"
-
- analyse-jvm-fadd &&/$jvm-fadd "java.lang.Float" "java.lang.Float"
- analyse-jvm-fsub &&/$jvm-fsub "java.lang.Float" "java.lang.Float"
- analyse-jvm-fmul &&/$jvm-fmul "java.lang.Float" "java.lang.Float"
- analyse-jvm-fdiv &&/$jvm-fdiv "java.lang.Float" "java.lang.Float"
- analyse-jvm-frem &&/$jvm-frem "java.lang.Float" "java.lang.Float"
- analyse-jvm-feq &&/$jvm-feq "java.lang.Float" "java.lang.Boolean"
- analyse-jvm-flt &&/$jvm-flt "java.lang.Float" "java.lang.Boolean"
- analyse-jvm-fgt &&/$jvm-fgt "java.lang.Float" "java.lang.Boolean"
-
- analyse-jvm-dadd &&/$jvm-dadd "java.lang.Double" "java.lang.Double"
- analyse-jvm-dsub &&/$jvm-dsub "java.lang.Double" "java.lang.Double"
- analyse-jvm-dmul &&/$jvm-dmul "java.lang.Double" "java.lang.Double"
- analyse-jvm-ddiv &&/$jvm-ddiv "java.lang.Double" "java.lang.Double"
- analyse-jvm-drem &&/$jvm-drem "java.lang.Double" "java.lang.Double"
- analyse-jvm-deq &&/$jvm-deq "java.lang.Double" "java.lang.Boolean"
- analyse-jvm-dlt &&/$jvm-dlt "java.lang.Double" "java.lang.Boolean"
- analyse-jvm-dgt &&/$jvm-dgt "java.lang.Double" "java.lang.Boolean"
- )
-
(defn ^:private analyse-field-access-helper [obj-type gvars gtype]
"(-> Type (List (^ java.lang.reflect.Type)) (^ java.lang.reflect.Type) (Lux Type))"
(|case obj-type
@@ -334,22 +282,6 @@
(return (&/|list (&&/|meta exo-type _cursor
(&&/$jvm-invokestatic (&/T [class method classes =args output-type])))))))
-(defn analyse-jvm-null? [analyse exo-type object]
- (|do [=object (&&/analyse-1+ analyse object)
- _ (ensure-object (&&/expr-type* =object))
- :let [output-type &type/Bool]
- _ (&type/check exo-type output-type)
- _cursor &/cursor]
- (return (&/|list (&&/|meta output-type _cursor
- (&&/$jvm-null? =object))))))
-
-(defn analyse-jvm-null [analyse exo-type]
- (|do [:let [output-type (&/$DataT &host-type/null-data-tag &/$Nil)]
- _ (&type/check exo-type output-type)
- _cursor &/cursor]
- (return (&/|list (&&/|meta output-type _cursor
- &&/$jvm-null)))))
-
(defn ^:private analyse-jvm-new-helper [analyse gtype gtype-env gtype-vars gtype-args args]
(|case gtype-vars
(&/$Nil)
@@ -379,99 +311,6 @@
(return (&/|list (&&/|meta exo-type _cursor
(&&/$jvm-new (&/T [class classes =args])))))))
-(let [length-type &type/Int
- idx-type &type/Int]
- (do-template [<elem-class> <array-class> <new-name> <new-tag> <load-name> <load-tag> <store-name> <store-tag>]
- (let [elem-type (&/$DataT <elem-class> &/$Nil)
- array-type (&/$DataT <array-class> &/$Nil)]
- (defn <new-name> [analyse exo-type length]
- (|do [=length (&&/analyse-1 analyse length-type length)
- _ (&type/check exo-type array-type)
- _cursor &/cursor]
- (return (&/|list (&&/|meta exo-type _cursor
- (<new-tag> =length))))))
-
- (defn <load-name> [analyse exo-type array idx]
- (|do [=array (&&/analyse-1 analyse array-type array)
- =idx (&&/analyse-1 analyse idx-type idx)
- _ (&type/check exo-type elem-type)
- _cursor &/cursor]
- (return (&/|list (&&/|meta exo-type _cursor
- (<load-tag> (&/T [=array =idx])))))))
-
- (defn <store-name> [analyse exo-type array idx elem]
- (|do [=array (&&/analyse-1 analyse array-type array)
- =idx (&&/analyse-1 analyse idx-type idx)
- =elem (&&/analyse-1 analyse elem-type elem)
- _ (&type/check exo-type array-type)
- _cursor &/cursor]
- (return (&/|list (&&/|meta exo-type _cursor
- (<store-tag> (&/T [=array =idx =elem])))))))
- )
-
- "java.lang.Boolean" "[Z" analyse-jvm-znewarray &&/$jvm-znewarray analyse-jvm-zaload &&/$jvm-zaload analyse-jvm-zastore &&/$jvm-zastore
- "java.lang.Byte" "[B" analyse-jvm-bnewarray &&/$jvm-bnewarray analyse-jvm-baload &&/$jvm-baload analyse-jvm-bastore &&/$jvm-bastore
- "java.lang.Short" "[S" analyse-jvm-snewarray &&/$jvm-snewarray analyse-jvm-saload &&/$jvm-saload analyse-jvm-sastore &&/$jvm-sastore
- "java.lang.Integer" "[I" analyse-jvm-inewarray &&/$jvm-inewarray analyse-jvm-iaload &&/$jvm-iaload analyse-jvm-iastore &&/$jvm-iastore
- "java.lang.Long" "[J" analyse-jvm-lnewarray &&/$jvm-lnewarray analyse-jvm-laload &&/$jvm-laload analyse-jvm-lastore &&/$jvm-lastore
- "java.lang.Float" "[F" analyse-jvm-fnewarray &&/$jvm-fnewarray analyse-jvm-faload &&/$jvm-faload analyse-jvm-fastore &&/$jvm-fastore
- "java.lang.Double" "[D" analyse-jvm-dnewarray &&/$jvm-dnewarray analyse-jvm-daload &&/$jvm-daload analyse-jvm-dastore &&/$jvm-dastore
- "java.lang.Character" "[C" analyse-jvm-cnewarray &&/$jvm-cnewarray analyse-jvm-caload &&/$jvm-caload analyse-jvm-castore &&/$jvm-castore
- ))
-
-(defn array-class? [class-name]
- (or (= &host-type/array-data-tag class-name)
- (case class-name
- ("[Z" "[B" "[S" "[I" "[J" "[F" "[D" "[C") true
- ;; else
- false)))
-
-(let [length-type &type/Int
- idx-type &type/Int]
- (defn analyse-jvm-anewarray [analyse exo-type gclass length]
- (|do [gtype-env &/get-type-env
- =gclass (&host-type/instance-gtype &type/existential gtype-env gclass)
- :let [array-type (&/$DataT &host-type/array-data-tag (&/|list =gclass))]
- =length (&&/analyse-1 analyse length-type length)
- _ (&type/check exo-type array-type)
- _cursor &/cursor]
- (return (&/|list (&&/|meta exo-type _cursor
- (&&/$jvm-anewarray (&/T [gclass =length gtype-env])))))))
-
- (defn analyse-jvm-aaload [analyse exo-type array idx]
- (|do [=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 inner-arr-type)
- _cursor &/cursor]
- (return (&/|list (&&/|meta exo-type _cursor
- (&&/$jvm-aaload (&/T [=array =idx])))))))
-
- (defn analyse-jvm-aastore [analyse exo-type array idx elem]
- (|do [=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)
- =elem (&&/analyse-1 analyse inner-arr-type elem)
- _ (&type/check exo-type array-type)
- _cursor &/cursor]
- (return (&/|list (&&/|meta exo-type _cursor
- (&&/$jvm-aastore (&/T [=array =idx =elem]))))))))
-
-(defn analyse-jvm-arraylength [analyse exo-type array]
- (|do [=array (&&/analyse-1+ analyse array)
- [arr-class arr-params] (ensure-object (&&/expr-type* =array))
- _ (&/assert! (array-class? arr-class) (str "[Analyser Error] Expected array. Instead got: " arr-class))
- _ (&type/check exo-type &type/Int)
- _cursor &/cursor]
- (return (&/|list (&&/|meta exo-type _cursor
- (&&/$jvm-arraylength =array)
- )))))
-
(defn generic-class->simple-class [gclass]
"(-> GenericClass Text)"
(|case gclass
@@ -826,6 +665,235 @@
(return (&/|list (&&/|meta exo-type _cursor
(&&/$jvm-try (&/T [=body =catches =finally])))))))
+(do-template [<name> <proc> <from-class> <to-class>]
+ (let [output-type (&/$DataT <to-class> &/$Nil)]
+ (defn <name> [analyse exo-type _?value]
+ (|do [:let [(&/$Cons ?value (&/$Nil)) _?value]
+ =value (&&/analyse-1 analyse (&/$DataT <from-class> &/$Nil) ?value)
+ _ (&type/check exo-type output-type)
+ _cursor &/cursor]
+ (return (&/|list (&&/|meta output-type _cursor (&&/$host (&/T ["jvm" <proc>]) (&/|list =value))))))))
+
+ ^:private analyse-jvm-d2f "d2f" "java.lang.Double" "java.lang.Float"
+ ^:private analyse-jvm-d2i "d2i" "java.lang.Double" "java.lang.Integer"
+ ^:private analyse-jvm-d2l "d2l" "java.lang.Double" "java.lang.Long"
+
+ ^:private analyse-jvm-f2d "f2d" "java.lang.Float" "java.lang.Double"
+ ^:private analyse-jvm-f2i "f2i" "java.lang.Float" "java.lang.Integer"
+ ^:private analyse-jvm-f2l "f2l" "java.lang.Float" "java.lang.Long"
+
+ ^:private analyse-jvm-i2b "i2b" "java.lang.Integer" "java.lang.Byte"
+ ^:private analyse-jvm-i2c "i2c" "java.lang.Integer" "java.lang.Character"
+ ^:private analyse-jvm-i2d "i2d" "java.lang.Integer" "java.lang.Double"
+ ^:private analyse-jvm-i2f "i2f" "java.lang.Integer" "java.lang.Float"
+ ^:private analyse-jvm-i2l "i2l" "java.lang.Integer" "java.lang.Long"
+ ^:private analyse-jvm-i2s "i2s" "java.lang.Integer" "java.lang.Short"
+
+ ^:private analyse-jvm-l2d "l2d" "java.lang.Long" "java.lang.Double"
+ ^:private analyse-jvm-l2f "l2f" "java.lang.Long" "java.lang.Float"
+ ^:private analyse-jvm-l2i "l2i" "java.lang.Long" "java.lang.Integer"
+
+ ^:private analyse-jvm-c2b "c2b" "java.lang.Character" "java.lang.Byte"
+ ^:private analyse-jvm-c2s "c2s" "java.lang.Character" "java.lang.Short"
+ ^:private analyse-jvm-c2i "c2i" "java.lang.Character" "java.lang.Integer"
+ ^:private analyse-jvm-c2l "c2l" "java.lang.Character" "java.lang.Long"
+ )
+
+(do-template [<name> <proc> <v1-class> <v2-class> <to-class>]
+ (let [output-type (&/$DataT <to-class> &/$Nil)]
+ (defn <name> [analyse exo-type ?values]
+ (|do [:let [(&/$Cons ?value1 (&/$Cons ?value2 (&/$Nil))) ?values]
+ =value1 (&&/analyse-1 analyse (&/$DataT <v1-class> &/$Nil) ?value1)
+ =value2 (&&/analyse-1 analyse (&/$DataT <v2-class> &/$Nil) ?value2)
+ _ (&type/check exo-type output-type)
+ _cursor &/cursor]
+ (return (&/|list (&&/|meta output-type _cursor (&&/$host (&/T ["jvm" <proc>]) (&/|list =value1 =value2))))))))
+
+ ^:private analyse-jvm-iand "iand" "java.lang.Integer" "java.lang.Integer" "java.lang.Integer"
+ ^:private analyse-jvm-ior "ior" "java.lang.Integer" "java.lang.Integer" "java.lang.Integer"
+ ^:private analyse-jvm-ixor "ixor" "java.lang.Integer" "java.lang.Integer" "java.lang.Integer"
+ ^:private analyse-jvm-ishl "ishl" "java.lang.Integer" "java.lang.Integer" "java.lang.Integer"
+ ^:private analyse-jvm-ishr "ishr" "java.lang.Integer" "java.lang.Integer" "java.lang.Integer"
+ ^:private analyse-jvm-iushr "iushr" "java.lang.Integer" "java.lang.Integer" "java.lang.Integer"
+
+ ^:private analyse-jvm-land "land" "java.lang.Long" "java.lang.Long" "java.lang.Long"
+ ^:private analyse-jvm-lor "lor" "java.lang.Long" "java.lang.Long" "java.lang.Long"
+ ^:private analyse-jvm-lxor "lxor" "java.lang.Long" "java.lang.Long" "java.lang.Long"
+ ^:private analyse-jvm-lshl "lshl" "java.lang.Long" "java.lang.Integer" "java.lang.Long"
+ ^:private analyse-jvm-lshr "lshr" "java.lang.Long" "java.lang.Integer" "java.lang.Long"
+ ^:private analyse-jvm-lushr "lushr" "java.lang.Long" "java.lang.Integer" "java.lang.Long"
+ )
+
+(do-template [<name> <proc> <input-class> <output-class>]
+ (let [input-type (&/$DataT <input-class> &/$Nil)
+ output-type (&/$DataT <output-class> &/$Nil)]
+ (defn <name> [analyse exo-type ?values]
+ (|do [:let [(&/$Cons x (&/$Cons y (&/$Nil))) ?values]
+ =x (&&/analyse-1 analyse input-type x)
+ =y (&&/analyse-1 analyse input-type y)
+ _ (&type/check exo-type output-type)
+ _cursor &/cursor]
+ (return (&/|list (&&/|meta output-type _cursor
+ (&&/$host (&/T ["jvm" <proc>]) (&/|list =x =y))))))))
+
+ ^:private analyse-jvm-iadd "iadd" "java.lang.Integer" "java.lang.Integer"
+ ^:private analyse-jvm-isub "isub" "java.lang.Integer" "java.lang.Integer"
+ ^:private analyse-jvm-imul "imul" "java.lang.Integer" "java.lang.Integer"
+ ^:private analyse-jvm-idiv "idiv" "java.lang.Integer" "java.lang.Integer"
+ ^:private analyse-jvm-irem "irem" "java.lang.Integer" "java.lang.Integer"
+ ^:private analyse-jvm-ieq "ieq" "java.lang.Integer" "java.lang.Boolean"
+ ^:private analyse-jvm-ilt "ilt" "java.lang.Integer" "java.lang.Boolean"
+ ^:private analyse-jvm-igt "igt" "java.lang.Integer" "java.lang.Boolean"
+
+ ^:private analyse-jvm-ceq "ceq" "java.lang.Character" "java.lang.Boolean"
+ ^:private analyse-jvm-clt "clt" "java.lang.Character" "java.lang.Boolean"
+ ^:private analyse-jvm-cgt "cgt" "java.lang.Character" "java.lang.Boolean"
+
+ ^:private analyse-jvm-ladd "ladd" "java.lang.Long" "java.lang.Long"
+ ^:private analyse-jvm-lsub "lsub" "java.lang.Long" "java.lang.Long"
+ ^:private analyse-jvm-lmul "lmul" "java.lang.Long" "java.lang.Long"
+ ^:private analyse-jvm-ldiv "ldiv" "java.lang.Long" "java.lang.Long"
+ ^:private analyse-jvm-lrem "lrem" "java.lang.Long" "java.lang.Long"
+ ^:private analyse-jvm-leq "leq" "java.lang.Long" "java.lang.Boolean"
+ ^:private analyse-jvm-llt "llt" "java.lang.Long" "java.lang.Boolean"
+ ^:private analyse-jvm-lgt "lgt" "java.lang.Long" "java.lang.Boolean"
+
+ ^:private analyse-jvm-fadd "fadd" "java.lang.Float" "java.lang.Float"
+ ^:private analyse-jvm-fsub "fsub" "java.lang.Float" "java.lang.Float"
+ ^:private analyse-jvm-fmul "fmul" "java.lang.Float" "java.lang.Float"
+ ^:private analyse-jvm-fdiv "fdiv" "java.lang.Float" "java.lang.Float"
+ ^:private analyse-jvm-frem "frem" "java.lang.Float" "java.lang.Float"
+ ^:private analyse-jvm-feq "feq" "java.lang.Float" "java.lang.Boolean"
+ ^:private analyse-jvm-flt "flt" "java.lang.Float" "java.lang.Boolean"
+ ^:private analyse-jvm-fgt "fgt" "java.lang.Float" "java.lang.Boolean"
+
+ ^:private analyse-jvm-dadd "dadd" "java.lang.Double" "java.lang.Double"
+ ^:private analyse-jvm-dsub "dsub" "java.lang.Double" "java.lang.Double"
+ ^:private analyse-jvm-dmul "dmul" "java.lang.Double" "java.lang.Double"
+ ^:private analyse-jvm-ddiv "ddiv" "java.lang.Double" "java.lang.Double"
+ ^:private analyse-jvm-drem "drem" "java.lang.Double" "java.lang.Double"
+ ^:private analyse-jvm-deq "deq" "java.lang.Double" "java.lang.Boolean"
+ ^:private analyse-jvm-dlt "dlt" "java.lang.Double" "java.lang.Boolean"
+ ^:private analyse-jvm-dgt "dgt" "java.lang.Double" "java.lang.Boolean"
+ )
+
+(let [length-type &type/Int
+ idx-type &type/Int]
+ (do-template [<elem-class> <array-class> <new-name> <new-tag> <load-name> <load-tag> <store-name> <store-tag>]
+ (let [elem-type (&/$DataT <elem-class> &/$Nil)
+ array-type (&/$DataT <array-class> &/$Nil)]
+ (defn <new-name> [analyse exo-type ?values]
+ (|do [:let [(&/$Cons length (&/$Nil)) ?values]
+ =length (&&/analyse-1 analyse length-type length)
+ _ (&type/check exo-type array-type)
+ _cursor &/cursor]
+ (return (&/|list (&&/|meta exo-type _cursor
+ (&&/$host (&/T ["jvm" <new-tag>]) (&/|list =length)))))))
+
+ (defn <load-name> [analyse exo-type ?values]
+ (|do [:let [(&/$Cons array (&/$Cons idx (&/$Nil))) ?values]
+ =array (&&/analyse-1 analyse array-type array)
+ =idx (&&/analyse-1 analyse idx-type idx)
+ _ (&type/check exo-type elem-type)
+ _cursor &/cursor]
+ (return (&/|list (&&/|meta exo-type _cursor
+ (&&/$host (&/T ["jvm" <load-tag>]) (&/|list =array =idx)))))))
+
+ (defn <store-name> [analyse exo-type ?values]
+ (|do [:let [(&/$Cons array (&/$Cons idx (&/$Cons elem (&/$Nil)))) ?values]
+ =array (&&/analyse-1 analyse array-type array)
+ =idx (&&/analyse-1 analyse idx-type idx)
+ =elem (&&/analyse-1 analyse elem-type elem)
+ _ (&type/check exo-type array-type)
+ _cursor &/cursor]
+ (return (&/|list (&&/|meta exo-type _cursor
+ (&&/$host (&/T ["jvm" <store-tag>]) (&/|list =array =idx =elem)))))))
+ )
+
+ "java.lang.Boolean" "[Z" ^:private analyse-jvm-znewarray "znewarray" analyse-jvm-zaload "zaload" analyse-jvm-zastore "zastore"
+ "java.lang.Byte" "[B" ^:private analyse-jvm-bnewarray "bnewarray" analyse-jvm-baload "baload" analyse-jvm-bastore "bastore"
+ "java.lang.Short" "[S" ^:private analyse-jvm-snewarray "snewarray" analyse-jvm-saload "saload" analyse-jvm-sastore "sastore"
+ "java.lang.Integer" "[I" ^:private analyse-jvm-inewarray "inewarray" analyse-jvm-iaload "iaload" analyse-jvm-iastore "iastore"
+ "java.lang.Long" "[J" ^:private analyse-jvm-lnewarray "lnewarray" analyse-jvm-laload "laload" analyse-jvm-lastore "lastore"
+ "java.lang.Float" "[F" ^:private analyse-jvm-fnewarray "fnewarray" analyse-jvm-faload "faload" analyse-jvm-fastore "fastore"
+ "java.lang.Double" "[D" ^:private analyse-jvm-dnewarray "dnewarray" analyse-jvm-daload "daload" analyse-jvm-dastore "dastore"
+ "java.lang.Character" "[C" ^:private analyse-jvm-cnewarray "cnewarray" analyse-jvm-caload "caload" analyse-jvm-castore "castore"
+ ))
+
+(defn ^:private array-class? [class-name]
+ (or (= &host-type/array-data-tag class-name)
+ (case class-name
+ ("[Z" "[B" "[S" "[I" "[J" "[F" "[D" "[C") true
+ ;; else
+ false)))
+
+(let [length-type &type/Int
+ idx-type &type/Int]
+ (defn ^:private analyse-jvm-anewarray [analyse exo-type ?values]
+ (|do [:let [(&/$Cons _gclass (&/$Cons length (&/$Nil))) ?values]
+ gclass (&&a-parser/parse-gclass _gclass)
+ gtype-env &/get-type-env
+ =gclass (&host-type/instance-gtype &type/existential gtype-env gclass)
+ :let [array-type (&/$DataT &host-type/array-data-tag (&/|list =gclass))]
+ =length (&&/analyse-1 analyse length-type length)
+ _ (&type/check exo-type array-type)
+ _cursor &/cursor]
+ (return (&/|list (&&/|meta exo-type _cursor
+ (&&/$host (&/T ["jvm" "anewarray"]) (&/|list gclass =length gtype-env)))))))
+
+ (defn ^:private analyse-jvm-aaload [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 inner-arr-type)
+ _cursor &/cursor]
+ (return (&/|list (&&/|meta exo-type _cursor
+ (&&/$host (&/T ["jvm" "aaload"]) (&/|list =array =idx)))))))
+
+ (defn ^:private analyse-jvm-aastore [analyse exo-type ?values]
+ (|do [:let [(&/$Cons array (&/$Cons idx (&/$Cons elem (&/$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)
+ =elem (&&/analyse-1 analyse inner-arr-type elem)
+ _ (&type/check exo-type array-type)
+ _cursor &/cursor]
+ (return (&/|list (&&/|meta exo-type _cursor
+ (&&/$host (&/T ["jvm" "aastore"]) (&/|list =array =idx =elem))))))))
+
+(defn ^:private analyse-jvm-arraylength [analyse exo-type ?values]
+ (|do [:let [(&/$Cons array (&/$Nil)) ?values]
+ =array (&&/analyse-1+ analyse array)
+ [arr-class arr-params] (ensure-object (&&/expr-type* =array))
+ _ (&/assert! (array-class? arr-class) (str "[Analyser Error] Expected array. Instead got: " arr-class))
+ _ (&type/check exo-type &type/Int)
+ _cursor &/cursor]
+ (return (&/|list (&&/|meta exo-type _cursor
+ (&&/$host (&/T ["jvm" "arraylength"]) (&/|list =array))
+ )))))
+
+(defn analyse-jvm-null? [analyse exo-type object]
+ (|do [=object (&&/analyse-1+ analyse object)
+ _ (ensure-object (&&/expr-type* =object))
+ :let [output-type &type/Bool]
+ _ (&type/check exo-type output-type)
+ _cursor &/cursor]
+ (return (&/|list (&&/|meta output-type _cursor
+ (&&/$jvm-null? =object))))))
+
+(defn analyse-jvm-null [analyse exo-type]
+ (|do [:let [output-type (&/$DataT &host-type/null-data-tag &/$Nil)]
+ _ (&type/check exo-type output-type)
+ _cursor &/cursor]
+ (return (&/|list (&&/|meta output-type _cursor
+ &&/$jvm-null)))))
+
(defn analyse-jvm-throw [analyse exo-type ?ex]
(|do [=ex (&&/analyse-1 analyse (&/$DataT "java.lang.Throwable" &/$Nil) ?ex)
_cursor &/cursor
@@ -845,61 +913,93 @@
analyse-jvm-monitorexit &&/$jvm-monitorexit
)
-(do-template [<name> <tag> <from-class> <to-class>]
- (let [output-type (&/$DataT <to-class> &/$Nil)]
- (defn <name> [analyse exo-type ?value]
- (|do [=value (&&/analyse-1 analyse (&/$DataT <from-class> &/$Nil) ?value)
- _ (&type/check exo-type output-type)
- _cursor &/cursor]
- (return (&/|list (&&/|meta output-type _cursor (<tag> =value)))))))
-
- analyse-jvm-d2f &&/$jvm-d2f "java.lang.Double" "java.lang.Float"
- analyse-jvm-d2i &&/$jvm-d2i "java.lang.Double" "java.lang.Integer"
- analyse-jvm-d2l &&/$jvm-d2l "java.lang.Double" "java.lang.Long"
-
- analyse-jvm-f2d &&/$jvm-f2d "java.lang.Float" "java.lang.Double"
- analyse-jvm-f2i &&/$jvm-f2i "java.lang.Float" "java.lang.Integer"
- analyse-jvm-f2l &&/$jvm-f2l "java.lang.Float" "java.lang.Long"
-
- analyse-jvm-i2b &&/$jvm-i2b "java.lang.Integer" "java.lang.Byte"
- analyse-jvm-i2c &&/$jvm-i2c "java.lang.Integer" "java.lang.Character"
- analyse-jvm-i2d &&/$jvm-i2d "java.lang.Integer" "java.lang.Double"
- analyse-jvm-i2f &&/$jvm-i2f "java.lang.Integer" "java.lang.Float"
- analyse-jvm-i2l &&/$jvm-i2l "java.lang.Integer" "java.lang.Long"
- analyse-jvm-i2s &&/$jvm-i2s "java.lang.Integer" "java.lang.Short"
-
- analyse-jvm-l2d &&/$jvm-l2d "java.lang.Long" "java.lang.Double"
- analyse-jvm-l2f &&/$jvm-l2f "java.lang.Long" "java.lang.Float"
- analyse-jvm-l2i &&/$jvm-l2i "java.lang.Long" "java.lang.Integer"
-
- analyse-jvm-c2b &&/$jvm-c2b "java.lang.Character" "java.lang.Byte"
- analyse-jvm-c2s &&/$jvm-c2s "java.lang.Character" "java.lang.Short"
- analyse-jvm-c2i &&/$jvm-c2i "java.lang.Character" "java.lang.Integer"
- analyse-jvm-c2l &&/$jvm-c2l "java.lang.Character" "java.lang.Long"
- )
+(defn analyse-host [analyse exo-type category proc ?values]
+ (case category
+ "jvm"
+ (case proc
+ "anewarray" (analyse-jvm-anewarray analyse exo-type ?values)
+ "aaload" (analyse-jvm-aaload analyse exo-type ?values)
+ "aastore" (analyse-jvm-aastore analyse exo-type ?values)
+ "arraylength" (analyse-jvm-arraylength analyse exo-type ?values)
+ "znewarray" (analyse-jvm-znewarray analyse exo-type ?values)
+ "bnewarray" (analyse-jvm-bnewarray analyse exo-type ?values)
+ "snewarray" (analyse-jvm-snewarray analyse exo-type ?values)
+ "inewarray" (analyse-jvm-inewarray analyse exo-type ?values)
+ "lnewarray" (analyse-jvm-lnewarray analyse exo-type ?values)
+ "fnewarray" (analyse-jvm-fnewarray analyse exo-type ?values)
+ "dnewarray" (analyse-jvm-dnewarray analyse exo-type ?values)
+ "cnewarray" (analyse-jvm-cnewarray analyse exo-type ?values)
+ "iadd" (analyse-jvm-iadd analyse exo-type ?values)
+ "isub" (analyse-jvm-isub analyse exo-type ?values)
+ "imul" (analyse-jvm-imul analyse exo-type ?values)
+ "idiv" (analyse-jvm-idiv analyse exo-type ?values)
+ "irem" (analyse-jvm-irem analyse exo-type ?values)
+ "ieq" (analyse-jvm-ieq analyse exo-type ?values)
+ "ilt" (analyse-jvm-ilt analyse exo-type ?values)
+ "igt" (analyse-jvm-igt analyse exo-type ?values)
+ "ceq" (analyse-jvm-ceq analyse exo-type ?values)
+ "clt" (analyse-jvm-clt analyse exo-type ?values)
+ "cgt" (analyse-jvm-cgt analyse exo-type ?values)
+ "ladd" (analyse-jvm-ladd analyse exo-type ?values)
+ "lsub" (analyse-jvm-lsub analyse exo-type ?values)
+ "lmul" (analyse-jvm-lmul analyse exo-type ?values)
+ "ldiv" (analyse-jvm-ldiv analyse exo-type ?values)
+ "lrem" (analyse-jvm-lrem analyse exo-type ?values)
+ "leq" (analyse-jvm-leq analyse exo-type ?values)
+ "llt" (analyse-jvm-llt analyse exo-type ?values)
+ "lgt" (analyse-jvm-lgt analyse exo-type ?values)
+ "fadd" (analyse-jvm-fadd analyse exo-type ?values)
+ "fsub" (analyse-jvm-fsub analyse exo-type ?values)
+ "fmul" (analyse-jvm-fmul analyse exo-type ?values)
+ "fdiv" (analyse-jvm-fdiv analyse exo-type ?values)
+ "frem" (analyse-jvm-frem analyse exo-type ?values)
+ "feq" (analyse-jvm-feq analyse exo-type ?values)
+ "flt" (analyse-jvm-flt analyse exo-type ?values)
+ "fgt" (analyse-jvm-fgt analyse exo-type ?values)
+ "dadd" (analyse-jvm-dadd analyse exo-type ?values)
+ "dsub" (analyse-jvm-dsub analyse exo-type ?values)
+ "dmul" (analyse-jvm-dmul analyse exo-type ?values)
+ "ddiv" (analyse-jvm-ddiv analyse exo-type ?values)
+ "drem" (analyse-jvm-drem analyse exo-type ?values)
+ "deq" (analyse-jvm-deq analyse exo-type ?values)
+ "dlt" (analyse-jvm-dlt analyse exo-type ?values)
+ "dgt" (analyse-jvm-dgt analyse exo-type ?values)
+ "iand" (analyse-jvm-iand analyse exo-type ?values)
+ "ior" (analyse-jvm-ior analyse exo-type ?values)
+ "ixor" (analyse-jvm-ixor analyse exo-type ?values)
+ "ishl" (analyse-jvm-ishl analyse exo-type ?values)
+ "ishr" (analyse-jvm-ishr analyse exo-type ?values)
+ "iushr" (analyse-jvm-iushr analyse exo-type ?values)
+ "land" (analyse-jvm-land analyse exo-type ?values)
+ "lor" (analyse-jvm-lor analyse exo-type ?values)
+ "lxor" (analyse-jvm-lxor analyse exo-type ?values)
+ "lshl" (analyse-jvm-lshl analyse exo-type ?values)
+ "lshr" (analyse-jvm-lshr analyse exo-type ?values)
+ "lushr" (analyse-jvm-lushr analyse exo-type ?values)
+ "d2f" (analyse-jvm-d2f analyse exo-type ?values)
+ "d2i" (analyse-jvm-d2i analyse exo-type ?values)
+ "d2l" (analyse-jvm-d2l analyse exo-type ?values)
+ "f2d" (analyse-jvm-f2d analyse exo-type ?values)
+ "f2i" (analyse-jvm-f2i analyse exo-type ?values)
+ "f2l" (analyse-jvm-f2l analyse exo-type ?values)
+ "i2b" (analyse-jvm-i2b analyse exo-type ?values)
+ "i2c" (analyse-jvm-i2c analyse exo-type ?values)
+ "i2d" (analyse-jvm-i2d analyse exo-type ?values)
+ "i2f" (analyse-jvm-i2f analyse exo-type ?values)
+ "i2l" (analyse-jvm-i2l analyse exo-type ?values)
+ "i2s" (analyse-jvm-i2s analyse exo-type ?values)
+ "l2d" (analyse-jvm-l2d analyse exo-type ?values)
+ "l2f" (analyse-jvm-l2f analyse exo-type ?values)
+ "l2i" (analyse-jvm-l2i analyse exo-type ?values)
+ "c2b" (analyse-jvm-c2b analyse exo-type ?values)
+ "c2s" (analyse-jvm-c2s analyse exo-type ?values)
+ "c2i" (analyse-jvm-c2i analyse exo-type ?values)
+ "c2l" (analyse-jvm-c2l analyse exo-type ?values)
+ ;; else
+ (fail (str "[Analyser Error] Unknown host procedure: " [category proc])))
-(do-template [<name> <tag> <from-class> <to-class>]
- (let [output-type (&/$DataT <to-class> &/$Nil)]
- (defn <name> [analyse exo-type ?value]
- (|do [=value (&&/analyse-1 analyse (&/$DataT <from-class> &/$Nil) ?value)
- _ (&type/check exo-type output-type)
- _cursor &/cursor]
- (return (&/|list (&&/|meta output-type _cursor (<tag> =value)))))))
-
- analyse-jvm-iand &&/$jvm-iand "java.lang.Integer" "java.lang.Integer"
- analyse-jvm-ior &&/$jvm-ior "java.lang.Integer" "java.lang.Integer"
- analyse-jvm-ixor &&/$jvm-ixor "java.lang.Integer" "java.lang.Integer"
- analyse-jvm-ishl &&/$jvm-ishl "java.lang.Integer" "java.lang.Integer"
- analyse-jvm-ishr &&/$jvm-ishr "java.lang.Integer" "java.lang.Integer"
- analyse-jvm-iushr &&/$jvm-iushr "java.lang.Integer" "java.lang.Integer"
-
- analyse-jvm-land &&/$jvm-land "java.lang.Long" "java.lang.Long"
- analyse-jvm-lor &&/$jvm-lor "java.lang.Long" "java.lang.Long"
- analyse-jvm-lxor &&/$jvm-lxor "java.lang.Long" "java.lang.Long"
- analyse-jvm-lshl &&/$jvm-lshl "java.lang.Long" "java.lang.Integer"
- analyse-jvm-lshr &&/$jvm-lshr "java.lang.Long" "java.lang.Integer"
- analyse-jvm-lushr &&/$jvm-lushr "java.lang.Long" "java.lang.Integer"
- )
+ ;; else
+ (fail (str "[Analyser Error] Unknown host procedure: " [category proc]))))
(let [input-type (&/$AppT &type/List &type/Text)
output-type (&/$AppT &type/IO &/$UnitT)]
diff --git a/src/lux/base.clj b/src/lux/base.clj
index e82143521..68683e5d3 100644
--- a/src/lux/base.clj
+++ b/src/lux/base.clj
@@ -233,7 +233,7 @@
(def +name-separator+ ";")
(def ^String compiler-name "Lux/JVM")
-(def ^String compiler-version "0.3.3")
+(def ^String compiler-version "0.4.0")
;; Constructors
(def empty-cursor (T ["" -1 -1]))
diff --git a/src/lux/compiler.clj b/src/lux/compiler.clj
index 91be286de..e42f58f3f 100644
--- a/src/lux/compiler.clj
+++ b/src/lux/compiler.clj
@@ -94,116 +94,10 @@
(&o/$coerce ?value-ex ?type-ex ?value-type)
(&&lux/compile-coerce compile-expression ?value-ex ?type-ex ?value-type)
- ;; Characters
- (&o/$jvm-ceq ?x ?y)
- (&&host/compile-jvm-ceq compile-expression ?x ?y)
-
- (&o/$jvm-clt ?x ?y)
- (&&host/compile-jvm-clt compile-expression ?x ?y)
-
- (&o/$jvm-cgt ?x ?y)
- (&&host/compile-jvm-cgt compile-expression ?x ?y)
-
- ;; Integer arithmetic
- (&o/$jvm-iadd ?x ?y)
- (&&host/compile-jvm-iadd compile-expression ?x ?y)
-
- (&o/$jvm-isub ?x ?y)
- (&&host/compile-jvm-isub compile-expression ?x ?y)
-
- (&o/$jvm-imul ?x ?y)
- (&&host/compile-jvm-imul compile-expression ?x ?y)
-
- (&o/$jvm-idiv ?x ?y)
- (&&host/compile-jvm-idiv compile-expression ?x ?y)
-
- (&o/$jvm-irem ?x ?y)
- (&&host/compile-jvm-irem compile-expression ?x ?y)
-
- (&o/$jvm-ieq ?x ?y)
- (&&host/compile-jvm-ieq compile-expression ?x ?y)
-
- (&o/$jvm-ilt ?x ?y)
- (&&host/compile-jvm-ilt compile-expression ?x ?y)
-
- (&o/$jvm-igt ?x ?y)
- (&&host/compile-jvm-igt compile-expression ?x ?y)
-
- ;; Long arithmetic
- (&o/$jvm-ladd ?x ?y)
- (&&host/compile-jvm-ladd compile-expression ?x ?y)
-
- (&o/$jvm-lsub ?x ?y)
- (&&host/compile-jvm-lsub compile-expression ?x ?y)
-
- (&o/$jvm-lmul ?x ?y)
- (&&host/compile-jvm-lmul compile-expression ?x ?y)
-
- (&o/$jvm-ldiv ?x ?y)
- (&&host/compile-jvm-ldiv compile-expression ?x ?y)
-
- (&o/$jvm-lrem ?x ?y)
- (&&host/compile-jvm-lrem compile-expression ?x ?y)
-
- (&o/$jvm-leq ?x ?y)
- (&&host/compile-jvm-leq compile-expression ?x ?y)
-
- (&o/$jvm-llt ?x ?y)
- (&&host/compile-jvm-llt compile-expression ?x ?y)
-
- (&o/$jvm-lgt ?x ?y)
- (&&host/compile-jvm-lgt compile-expression ?x ?y)
-
- ;; Float arithmetic
- (&o/$jvm-fadd ?x ?y)
- (&&host/compile-jvm-fadd compile-expression ?x ?y)
-
- (&o/$jvm-fsub ?x ?y)
- (&&host/compile-jvm-fsub compile-expression ?x ?y)
-
- (&o/$jvm-fmul ?x ?y)
- (&&host/compile-jvm-fmul compile-expression ?x ?y)
-
- (&o/$jvm-fdiv ?x ?y)
- (&&host/compile-jvm-fdiv compile-expression ?x ?y)
-
- (&o/$jvm-frem ?x ?y)
- (&&host/compile-jvm-frem compile-expression ?x ?y)
-
- (&o/$jvm-feq ?x ?y)
- (&&host/compile-jvm-feq compile-expression ?x ?y)
-
- (&o/$jvm-flt ?x ?y)
- (&&host/compile-jvm-flt compile-expression ?x ?y)
-
- (&o/$jvm-fgt ?x ?y)
- (&&host/compile-jvm-fgt compile-expression ?x ?y)
-
- ;; Double arithmetic
- (&o/$jvm-dadd ?x ?y)
- (&&host/compile-jvm-dadd compile-expression ?x ?y)
-
- (&o/$jvm-dsub ?x ?y)
- (&&host/compile-jvm-dsub compile-expression ?x ?y)
-
- (&o/$jvm-dmul ?x ?y)
- (&&host/compile-jvm-dmul compile-expression ?x ?y)
-
- (&o/$jvm-ddiv ?x ?y)
- (&&host/compile-jvm-ddiv compile-expression ?x ?y)
-
- (&o/$jvm-drem ?x ?y)
- (&&host/compile-jvm-drem compile-expression ?x ?y)
-
- (&o/$jvm-deq ?x ?y)
- (&&host/compile-jvm-deq compile-expression ?x ?y)
-
- (&o/$jvm-dlt ?x ?y)
- (&&host/compile-jvm-dlt compile-expression ?x ?y)
-
- (&o/$jvm-dgt ?x ?y)
- (&&host/compile-jvm-dgt compile-expression ?x ?y)
+ (&o/$host [?proc-category ?proc-name] ?args)
+ (&&host/compile-host compile-expression ?proc-category ?proc-name ?args)
+ ;; JVM
(&o/$jvm-null _)
(&&host/compile-jvm-null compile-expression)
@@ -237,90 +131,6 @@
(&o/$jvm-invokespecial ?class ?method ?classes ?object ?args ?output-type)
(&&host/compile-jvm-invokespecial compile-expression ?class ?method ?classes ?object ?args ?output-type)
- (&o/$jvm-znewarray ?length)
- (&&host/compile-jvm-znewarray compile-expression ?length)
-
- (&o/$jvm-zastore ?array ?idx ?elem)
- (&&host/compile-jvm-zastore compile-expression ?array ?idx ?elem)
-
- (&o/$jvm-zaload ?array ?idx)
- (&&host/compile-jvm-zaload compile-expression ?array ?idx)
-
- (&o/$jvm-bnewarray ?length)
- (&&host/compile-jvm-bnewarray compile-expression ?length)
-
- (&o/$jvm-bastore ?array ?idx ?elem)
- (&&host/compile-jvm-bastore compile-expression ?array ?idx ?elem)
-
- (&o/$jvm-baload ?array ?idx)
- (&&host/compile-jvm-baload compile-expression ?array ?idx)
-
- (&o/$jvm-snewarray ?length)
- (&&host/compile-jvm-snewarray compile-expression ?length)
-
- (&o/$jvm-sastore ?array ?idx ?elem)
- (&&host/compile-jvm-sastore compile-expression ?array ?idx ?elem)
-
- (&o/$jvm-saload ?array ?idx)
- (&&host/compile-jvm-saload compile-expression ?array ?idx)
-
- (&o/$jvm-inewarray ?length)
- (&&host/compile-jvm-inewarray compile-expression ?length)
-
- (&o/$jvm-iastore ?array ?idx ?elem)
- (&&host/compile-jvm-iastore compile-expression ?array ?idx ?elem)
-
- (&o/$jvm-iaload ?array ?idx)
- (&&host/compile-jvm-iaload compile-expression ?array ?idx)
-
- (&o/$jvm-lnewarray ?length)
- (&&host/compile-jvm-lnewarray compile-expression ?length)
-
- (&o/$jvm-lastore ?array ?idx ?elem)
- (&&host/compile-jvm-lastore compile-expression ?array ?idx ?elem)
-
- (&o/$jvm-laload ?array ?idx)
- (&&host/compile-jvm-laload compile-expression ?array ?idx)
-
- (&o/$jvm-fnewarray ?length)
- (&&host/compile-jvm-fnewarray compile-expression ?length)
-
- (&o/$jvm-fastore ?array ?idx ?elem)
- (&&host/compile-jvm-fastore compile-expression ?array ?idx ?elem)
-
- (&o/$jvm-faload ?array ?idx)
- (&&host/compile-jvm-faload compile-expression ?array ?idx)
-
- (&o/$jvm-dnewarray ?length)
- (&&host/compile-jvm-dnewarray compile-expression ?length)
-
- (&o/$jvm-dastore ?array ?idx ?elem)
- (&&host/compile-jvm-dastore compile-expression ?array ?idx ?elem)
-
- (&o/$jvm-daload ?array ?idx)
- (&&host/compile-jvm-daload compile-expression ?array ?idx)
-
- (&o/$jvm-cnewarray ?length)
- (&&host/compile-jvm-cnewarray compile-expression ?length)
-
- (&o/$jvm-castore ?array ?idx ?elem)
- (&&host/compile-jvm-castore compile-expression ?array ?idx ?elem)
-
- (&o/$jvm-caload ?array ?idx)
- (&&host/compile-jvm-caload compile-expression ?array ?idx)
-
- (&o/$jvm-anewarray ?class ?length gtype-env)
- (&&host/compile-jvm-anewarray compile-expression ?class ?length gtype-env)
-
- (&o/$jvm-aastore ?array ?idx ?elem)
- (&&host/compile-jvm-aastore compile-expression ?array ?idx ?elem)
-
- (&o/$jvm-aaload ?array ?idx)
- (&&host/compile-jvm-aaload compile-expression ?array ?idx)
-
- (&o/$jvm-arraylength ?array)
- (&&host/compile-jvm-arraylength compile-expression ?array)
-
(&o/$jvm-try ?body ?catches ?finally)
(&&host/compile-jvm-try compile-expression ?body ?catches ?finally)
@@ -333,99 +143,6 @@
(&o/$jvm-monitorexit ?monitor)
(&&host/compile-jvm-monitorexit compile-expression ?monitor)
- (&o/$jvm-d2f ?value)
- (&&host/compile-jvm-d2f compile-expression ?value)
-
- (&o/$jvm-d2i ?value)
- (&&host/compile-jvm-d2i compile-expression ?value)
-
- (&o/$jvm-d2l ?value)
- (&&host/compile-jvm-d2l compile-expression ?value)
-
- (&o/$jvm-f2d ?value)
- (&&host/compile-jvm-f2d compile-expression ?value)
-
- (&o/$jvm-f2i ?value)
- (&&host/compile-jvm-f2i compile-expression ?value)
-
- (&o/$jvm-f2l ?value)
- (&&host/compile-jvm-f2l compile-expression ?value)
-
- (&o/$jvm-i2b ?value)
- (&&host/compile-jvm-i2b compile-expression ?value)
-
- (&o/$jvm-i2c ?value)
- (&&host/compile-jvm-i2c compile-expression ?value)
-
- (&o/$jvm-i2d ?value)
- (&&host/compile-jvm-i2d compile-expression ?value)
-
- (&o/$jvm-i2f ?value)
- (&&host/compile-jvm-i2f compile-expression ?value)
-
- (&o/$jvm-i2l ?value)
- (&&host/compile-jvm-i2l compile-expression ?value)
-
- (&o/$jvm-i2s ?value)
- (&&host/compile-jvm-i2s compile-expression ?value)
-
- (&o/$jvm-l2d ?value)
- (&&host/compile-jvm-l2d compile-expression ?value)
-
- (&o/$jvm-l2f ?value)
- (&&host/compile-jvm-l2f compile-expression ?value)
-
- (&o/$jvm-l2i ?value)
- (&&host/compile-jvm-l2i compile-expression ?value)
-
- (&o/$jvm-c2b ?value)
- (&&host/compile-jvm-c2b compile-expression ?value)
-
- (&o/$jvm-c2s ?value)
- (&&host/compile-jvm-c2s compile-expression ?value)
-
- (&o/$jvm-c2i ?value)
- (&&host/compile-jvm-c2i compile-expression ?value)
-
- (&o/$jvm-c2l ?value)
- (&&host/compile-jvm-c2l compile-expression ?value)
-
- (&o/$jvm-iand ?x ?y)
- (&&host/compile-jvm-iand compile-expression ?x ?y)
-
- (&o/$jvm-ior ?x ?y)
- (&&host/compile-jvm-ior compile-expression ?x ?y)
-
- (&o/$jvm-ixor ?x ?y)
- (&&host/compile-jvm-ixor compile-expression ?x ?y)
-
- (&o/$jvm-ishl ?x ?y)
- (&&host/compile-jvm-ishl compile-expression ?x ?y)
-
- (&o/$jvm-ishr ?x ?y)
- (&&host/compile-jvm-ishr compile-expression ?x ?y)
-
- (&o/$jvm-iushr ?x ?y)
- (&&host/compile-jvm-iushr compile-expression ?x ?y)
-
- (&o/$jvm-land ?x ?y)
- (&&host/compile-jvm-land compile-expression ?x ?y)
-
- (&o/$jvm-lor ?x ?y)
- (&&host/compile-jvm-lor compile-expression ?x ?y)
-
- (&o/$jvm-lxor ?x ?y)
- (&&host/compile-jvm-lxor compile-expression ?x ?y)
-
- (&o/$jvm-lshl ?x ?y)
- (&&host/compile-jvm-lshl compile-expression ?x ?y)
-
- (&o/$jvm-lshr ?x ?y)
- (&&host/compile-jvm-lshr compile-expression ?x ?y)
-
- (&o/$jvm-lushr ?x ?y)
- (&&host/compile-jvm-lushr compile-expression ?x ?y)
-
(&o/$jvm-instanceof ?class ?object)
(&&host/compile-jvm-instanceof compile-expression ?class ?object)
diff --git a/src/lux/compiler/host.clj b/src/lux/compiler/host.clj
index c01548798..9df678fd0 100644
--- a/src/lux/compiler/host.clj
+++ b/src/lux/compiler/host.clj
@@ -94,118 +94,6 @@
*writer*))
;; [Resources]
-(do-template [<name> <opcode> <wrapper-class> <value-method> <value-method-sig> <wrap>]
- (defn <name> [compile ?x ?y]
- (|do [:let [+wrapper-class+ (&host-generics/->bytecode-class-name <wrapper-class>)]
- ^MethodVisitor *writer* &/get-writer
- _ (compile ?x)
- :let [_ (doto *writer*
- (.visitTypeInsn Opcodes/CHECKCAST +wrapper-class+)
- (.visitMethodInsn Opcodes/INVOKEVIRTUAL +wrapper-class+ <value-method> <value-method-sig>))]
- _ (compile ?y)
- :let [_ (doto *writer*
- (.visitTypeInsn Opcodes/CHECKCAST +wrapper-class+)
- (.visitMethodInsn Opcodes/INVOKEVIRTUAL +wrapper-class+ <value-method> <value-method-sig>))
- _ (doto *writer*
- (.visitInsn <opcode>)
- (<wrap>))]]
- (return nil)))
-
- compile-jvm-iadd Opcodes/IADD "java.lang.Integer" "intValue" "()I" &&/wrap-int
- compile-jvm-isub Opcodes/ISUB "java.lang.Integer" "intValue" "()I" &&/wrap-int
- compile-jvm-imul Opcodes/IMUL "java.lang.Integer" "intValue" "()I" &&/wrap-int
- compile-jvm-idiv Opcodes/IDIV "java.lang.Integer" "intValue" "()I" &&/wrap-int
- compile-jvm-irem Opcodes/IREM "java.lang.Integer" "intValue" "()I" &&/wrap-int
-
- compile-jvm-ladd Opcodes/LADD "java.lang.Long" "longValue" "()J" &&/wrap-long
- compile-jvm-lsub Opcodes/LSUB "java.lang.Long" "longValue" "()J" &&/wrap-long
- compile-jvm-lmul Opcodes/LMUL "java.lang.Long" "longValue" "()J" &&/wrap-long
- compile-jvm-ldiv Opcodes/LDIV "java.lang.Long" "longValue" "()J" &&/wrap-long
- compile-jvm-lrem Opcodes/LREM "java.lang.Long" "longValue" "()J" &&/wrap-long
-
- compile-jvm-fadd Opcodes/FADD "java.lang.Float" "floatValue" "()F" &&/wrap-float
- compile-jvm-fsub Opcodes/FSUB "java.lang.Float" "floatValue" "()F" &&/wrap-float
- compile-jvm-fmul Opcodes/FMUL "java.lang.Float" "floatValue" "()F" &&/wrap-float
- compile-jvm-fdiv Opcodes/FDIV "java.lang.Float" "floatValue" "()F" &&/wrap-float
- compile-jvm-frem Opcodes/FREM "java.lang.Float" "floatValue" "()F" &&/wrap-float
-
- compile-jvm-dadd Opcodes/DADD "java.lang.Double" "doubleValue" "()D" &&/wrap-double
- compile-jvm-dsub Opcodes/DSUB "java.lang.Double" "doubleValue" "()D" &&/wrap-double
- compile-jvm-dmul Opcodes/DMUL "java.lang.Double" "doubleValue" "()D" &&/wrap-double
- compile-jvm-ddiv Opcodes/DDIV "java.lang.Double" "doubleValue" "()D" &&/wrap-double
- compile-jvm-drem Opcodes/DREM "java.lang.Double" "doubleValue" "()D" &&/wrap-double
- )
-
-(do-template [<name> <opcode> <wrapper-class> <value-method> <value-method-sig>]
- (defn <name> [compile ?x ?y]
- (|do [:let [+wrapper-class+ (&host-generics/->bytecode-class-name <wrapper-class>)]
- ^MethodVisitor *writer* &/get-writer
- _ (compile ?x)
- :let [_ (doto *writer*
- (.visitTypeInsn Opcodes/CHECKCAST +wrapper-class+)
- (.visitMethodInsn Opcodes/INVOKEVIRTUAL +wrapper-class+ <value-method> <value-method-sig>))]
- _ (compile ?y)
- :let [_ (doto *writer*
- (.visitTypeInsn Opcodes/CHECKCAST +wrapper-class+)
- (.visitMethodInsn Opcodes/INVOKEVIRTUAL +wrapper-class+ <value-method> <value-method-sig>))
- $then (new Label)
- $end (new Label)
- _ (doto *writer*
- (.visitJumpInsn <opcode> $then)
- (.visitFieldInsn Opcodes/GETSTATIC (&host-generics/->bytecode-class-name "java.lang.Boolean") "FALSE" (&host-generics/->type-signature "java.lang.Boolean"))
- (.visitJumpInsn Opcodes/GOTO $end)
- (.visitLabel $then)
- (.visitFieldInsn Opcodes/GETSTATIC (&host-generics/->bytecode-class-name "java.lang.Boolean") "TRUE" (&host-generics/->type-signature "java.lang.Boolean"))
- (.visitLabel $end))]]
- (return nil)))
-
- compile-jvm-ieq Opcodes/IF_ICMPEQ "java.lang.Integer" "intValue" "()I"
- compile-jvm-ilt Opcodes/IF_ICMPLT "java.lang.Integer" "intValue" "()I"
- compile-jvm-igt Opcodes/IF_ICMPGT "java.lang.Integer" "intValue" "()I"
-
- compile-jvm-ceq Opcodes/IF_ICMPEQ "java.lang.Character" "charValue" "()C"
- compile-jvm-clt Opcodes/IF_ICMPLT "java.lang.Character" "charValue" "()C"
- compile-jvm-cgt Opcodes/IF_ICMPGT "java.lang.Character" "charValue" "()C"
- )
-
-(do-template [<name> <cmpcode> <cmp-output> <wrapper-class> <value-method> <value-method-sig>]
- (defn <name> [compile ?x ?y]
- (|do [:let [+wrapper-class+ (&host-generics/->bytecode-class-name <wrapper-class>)]
- ^MethodVisitor *writer* &/get-writer
- _ (compile ?x)
- :let [_ (doto *writer*
- (.visitTypeInsn Opcodes/CHECKCAST +wrapper-class+)
- (.visitMethodInsn Opcodes/INVOKEVIRTUAL +wrapper-class+ <value-method> <value-method-sig>))]
- _ (compile ?y)
- :let [_ (doto *writer*
- (.visitTypeInsn Opcodes/CHECKCAST +wrapper-class+)
- (.visitMethodInsn Opcodes/INVOKEVIRTUAL +wrapper-class+ <value-method> <value-method-sig>))
- $then (new Label)
- $end (new Label)
- _ (doto *writer*
- (.visitInsn <cmpcode>)
- (.visitLdcInsn (int <cmp-output>))
- (.visitJumpInsn Opcodes/IF_ICMPEQ $then)
- (.visitFieldInsn Opcodes/GETSTATIC (&host-generics/->bytecode-class-name "java.lang.Boolean") "FALSE" (&host-generics/->type-signature "java.lang.Boolean"))
- (.visitJumpInsn Opcodes/GOTO $end)
- (.visitLabel $then)
- (.visitFieldInsn Opcodes/GETSTATIC (&host-generics/->bytecode-class-name "java.lang.Boolean") "TRUE" (&host-generics/->type-signature "java.lang.Boolean"))
- (.visitLabel $end))]]
- (return nil)))
-
- compile-jvm-leq Opcodes/LCMP 0 "java.lang.Long" "longValue" "()J"
- compile-jvm-llt Opcodes/LCMP -1 "java.lang.Long" "longValue" "()J"
- compile-jvm-lgt Opcodes/LCMP 1 "java.lang.Long" "longValue" "()J"
-
- compile-jvm-feq Opcodes/FCMPG 0 "java.lang.Float" "floatValue" "()F"
- compile-jvm-flt Opcodes/FCMPG -1 "java.lang.Float" "floatValue" "()F"
- compile-jvm-fgt Opcodes/FCMPG 1 "java.lang.Float" "floatValue" "()F"
-
- compile-jvm-deq Opcodes/DCMPG 0 "java.lang.Double" "doubleValue" "()D"
- compile-jvm-dlt Opcodes/DCMPG -1 "java.lang.Double" "doubleValue" "()D"
- compile-jvm-dgt Opcodes/DCMPG 1 "java.lang.Double" "doubleValue" "()D"
- )
-
(defn compile-jvm-invokestatic [compile ?class ?method ?classes ?args ?output-type]
(|do [^MethodVisitor *writer* &/get-writer
=output-type (&host/->java-sig ?output-type)
@@ -280,101 +168,6 @@
(.visitMethodInsn Opcodes/INVOKESPECIAL class* "<init>" init-sig))]]
(return nil)))
-(do-template [<prim-type> <array-type> <new-name> <load-name> <load-op> <store-name> <store-op> <wrapper> <unwrapper>]
- (do (defn <new-name> [compile ?length]
- (|do [^MethodVisitor *writer* &/get-writer
- _ (compile ?length)
- :let [_ (doto *writer*
- &&/unwrap-long
- (.visitInsn Opcodes/L2I))]
- :let [_ (.visitIntInsn *writer* Opcodes/NEWARRAY <prim-type>)]]
- (return nil)))
-
- (defn <load-name> [compile ?array ?idx]
- (|do [^MethodVisitor *writer* &/get-writer
- _ (compile ?array)
- :let [_ (.visitTypeInsn *writer* Opcodes/CHECKCAST <array-type>)]
- _ (compile ?idx)
- :let [_ (doto *writer*
- &&/unwrap-long
- (.visitInsn Opcodes/L2I))]
- :let [_ (doto *writer*
- (.visitInsn <load-op>)
- <wrapper>)]]
- (return nil)))
-
- (defn <store-name> [compile ?array ?idx ?elem]
- (|do [^MethodVisitor *writer* &/get-writer
- _ (compile ?array)
- :let [_ (.visitTypeInsn *writer* Opcodes/CHECKCAST <array-type>)]
- :let [_ (.visitInsn *writer* Opcodes/DUP)]
- _ (compile ?idx)
- :let [_ (doto *writer*
- &&/unwrap-long
- (.visitInsn Opcodes/L2I))]
- _ (compile ?elem)
- :let [_ (doto *writer*
- <unwrapper>
- (.visitInsn <store-op>))]]
- (return nil)))
- )
-
- Opcodes/T_BOOLEAN "[Z" compile-jvm-znewarray compile-jvm-zaload Opcodes/BALOAD compile-jvm-zastore Opcodes/BASTORE &&/wrap-boolean &&/unwrap-boolean
- Opcodes/T_BYTE "[B" compile-jvm-bnewarray compile-jvm-baload Opcodes/BALOAD compile-jvm-bastore Opcodes/BASTORE &&/wrap-byte &&/unwrap-byte
- Opcodes/T_SHORT "[S" compile-jvm-snewarray compile-jvm-saload Opcodes/SALOAD compile-jvm-sastore Opcodes/SASTORE &&/wrap-short &&/unwrap-short
- Opcodes/T_INT "[I" compile-jvm-inewarray compile-jvm-iaload Opcodes/IALOAD compile-jvm-iastore Opcodes/IASTORE &&/wrap-int &&/unwrap-int
- Opcodes/T_LONG "[J" compile-jvm-lnewarray compile-jvm-laload Opcodes/LALOAD compile-jvm-lastore Opcodes/LASTORE &&/wrap-long &&/unwrap-long
- Opcodes/T_FLOAT "[F" compile-jvm-fnewarray compile-jvm-faload Opcodes/FALOAD compile-jvm-fastore Opcodes/FASTORE &&/wrap-float &&/unwrap-float
- Opcodes/T_DOUBLE "[D" compile-jvm-dnewarray compile-jvm-daload Opcodes/DALOAD compile-jvm-dastore Opcodes/DASTORE &&/wrap-double &&/unwrap-double
- Opcodes/T_CHAR "[C" compile-jvm-cnewarray compile-jvm-caload Opcodes/CALOAD compile-jvm-castore Opcodes/CASTORE &&/wrap-char &&/unwrap-char
- )
-
-(defn compile-jvm-anewarray [compile ?gclass ?length type-env]
- (|do [^MethodVisitor *writer* &/get-writer
- _ (compile ?length)
- :let [_ (doto *writer*
- &&/unwrap-long
- (.visitInsn Opcodes/L2I))]
- :let [_ (.visitTypeInsn *writer* Opcodes/ANEWARRAY (&host-generics/gclass->bytecode-class-name* ?gclass type-env))]]
- (return nil)))
-
-(defn compile-jvm-aaload [compile ?array ?idx]
- (|do [^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)]]
- (return nil)))
-
-(defn compile-jvm-aastore [compile ?array ?idx ?elem]
- (|do [^MethodVisitor *writer* &/get-writer
- array-type (&host/->java-sig (&a/expr-type* ?array))
- _ (compile ?array)
- :let [_ (.visitTypeInsn *writer* Opcodes/CHECKCAST array-type)]
- :let [_ (.visitInsn *writer* Opcodes/DUP)]
- _ (compile ?idx)
- :let [_ (doto *writer*
- &&/unwrap-long
- (.visitInsn Opcodes/L2I))]
- _ (compile ?elem)
- :let [_ (.visitInsn *writer* Opcodes/AASTORE)]]
- (return nil)))
-
-(defn compile-jvm-arraylength [compile ?array]
- (|do [^MethodVisitor *writer* &/get-writer
- array-type (&host/->java-sig (&a/expr-type* ?array))
- _ (compile ?array)
- :let [_ (.visitTypeInsn *writer* Opcodes/CHECKCAST array-type)]
- :let [_ (doto *writer*
- (.visitInsn Opcodes/ARRAYLENGTH)
- (.visitInsn Opcodes/I2L)
- &&/wrap-long)]]
- (return nil)))
-
(defn compile-jvm-getstatic [compile ?class ?field ?output-type]
(|do [^MethodVisitor *writer* &/get-writer
=output-type (&host/->java-sig ?output-type)
@@ -1127,8 +920,9 @@
)
(do-template [<name> <op> <from-class> <from-method> <from-sig> <to-class> <to-sig>]
- (defn <name> [compile ?value]
- (|do [^MethodVisitor *writer* &/get-writer
+ (defn <name> [compile _?value]
+ (|do [:let [(&/$Cons ?value (&/$Nil)) _?value]
+ ^MethodVisitor *writer* &/get-writer
:let [_ (doto *writer*
(.visitTypeInsn Opcodes/NEW (&host-generics/->bytecode-class-name <to-class>))
(.visitInsn Opcodes/DUP))]
@@ -1140,34 +934,35 @@
(.visitMethodInsn Opcodes/INVOKESPECIAL (&host-generics/->bytecode-class-name <to-class>) init-method <to-sig>))]]
(return nil)))
- compile-jvm-d2f Opcodes/D2F "java.lang.Double" "doubleValue" "()D" "java.lang.Float" "(F)V"
- compile-jvm-d2i Opcodes/D2I "java.lang.Double" "doubleValue" "()D" "java.lang.Integer" "(I)V"
- compile-jvm-d2l Opcodes/D2L "java.lang.Double" "doubleValue" "()D" "java.lang.Long" "(J)V"
-
- compile-jvm-f2d Opcodes/F2D "java.lang.Float" "floatValue" "()F" "java.lang.Double" "(D)V"
- compile-jvm-f2i Opcodes/F2I "java.lang.Float" "floatValue" "()F" "java.lang.Integer" "(I)V"
- compile-jvm-f2l Opcodes/F2L "java.lang.Float" "floatValue" "()F" "java.lang.Long" "(J)V"
-
- compile-jvm-i2b Opcodes/I2B "java.lang.Integer" "intValue" "()I" "java.lang.Byte" "(B)V"
- compile-jvm-i2c Opcodes/I2C "java.lang.Integer" "intValue" "()I" "java.lang.Character" "(C)V"
- compile-jvm-i2d Opcodes/I2D "java.lang.Integer" "intValue" "()I" "java.lang.Double" "(D)V"
- compile-jvm-i2f Opcodes/I2F "java.lang.Integer" "intValue" "()I" "java.lang.Float" "(F)V"
- compile-jvm-i2l Opcodes/I2L "java.lang.Integer" "intValue" "()I" "java.lang.Long" "(J)V"
- compile-jvm-i2s Opcodes/I2S "java.lang.Integer" "intValue" "()I" "java.lang.Short" "(S)V"
-
- compile-jvm-l2d Opcodes/L2D "java.lang.Long" "longValue" "()J" "java.lang.Double" "(D)V"
- compile-jvm-l2f Opcodes/L2F "java.lang.Long" "longValue" "()J" "java.lang.Float" "(F)V"
- compile-jvm-l2i Opcodes/L2I "java.lang.Long" "longValue" "()J" "java.lang.Integer" "(I)V"
-
- compile-jvm-c2b Opcodes/I2B "java.lang.Character" "charValue" "()C" "java.lang.Byte" "(B)V"
- compile-jvm-c2s Opcodes/I2S "java.lang.Character" "charValue" "()C" "java.lang.Short" "(S)V"
- compile-jvm-c2i Opcodes/NOP "java.lang.Character" "charValue" "()C" "java.lang.Integer" "(I)V"
- compile-jvm-c2l Opcodes/I2L "java.lang.Character" "charValue" "()C" "java.lang.Long" "(J)V"
+ ^:private compile-jvm-d2f Opcodes/D2F "java.lang.Double" "doubleValue" "()D" "java.lang.Float" "(F)V"
+ ^:private compile-jvm-d2i Opcodes/D2I "java.lang.Double" "doubleValue" "()D" "java.lang.Integer" "(I)V"
+ ^:private compile-jvm-d2l Opcodes/D2L "java.lang.Double" "doubleValue" "()D" "java.lang.Long" "(J)V"
+
+ ^:private compile-jvm-f2d Opcodes/F2D "java.lang.Float" "floatValue" "()F" "java.lang.Double" "(D)V"
+ ^:private compile-jvm-f2i Opcodes/F2I "java.lang.Float" "floatValue" "()F" "java.lang.Integer" "(I)V"
+ ^:private compile-jvm-f2l Opcodes/F2L "java.lang.Float" "floatValue" "()F" "java.lang.Long" "(J)V"
+
+ ^:private compile-jvm-i2b Opcodes/I2B "java.lang.Integer" "intValue" "()I" "java.lang.Byte" "(B)V"
+ ^:private compile-jvm-i2c Opcodes/I2C "java.lang.Integer" "intValue" "()I" "java.lang.Character" "(C)V"
+ ^:private compile-jvm-i2d Opcodes/I2D "java.lang.Integer" "intValue" "()I" "java.lang.Double" "(D)V"
+ ^:private compile-jvm-i2f Opcodes/I2F "java.lang.Integer" "intValue" "()I" "java.lang.Float" "(F)V"
+ ^:private compile-jvm-i2l Opcodes/I2L "java.lang.Integer" "intValue" "()I" "java.lang.Long" "(J)V"
+ ^:private compile-jvm-i2s Opcodes/I2S "java.lang.Integer" "intValue" "()I" "java.lang.Short" "(S)V"
+
+ ^:private compile-jvm-l2d Opcodes/L2D "java.lang.Long" "longValue" "()J" "java.lang.Double" "(D)V"
+ ^:private compile-jvm-l2f Opcodes/L2F "java.lang.Long" "longValue" "()J" "java.lang.Float" "(F)V"
+ ^:private compile-jvm-l2i Opcodes/L2I "java.lang.Long" "longValue" "()J" "java.lang.Integer" "(I)V"
+
+ ^:private compile-jvm-c2b Opcodes/I2B "java.lang.Character" "charValue" "()C" "java.lang.Byte" "(B)V"
+ ^:private compile-jvm-c2s Opcodes/I2S "java.lang.Character" "charValue" "()C" "java.lang.Short" "(S)V"
+ ^:private compile-jvm-c2i Opcodes/NOP "java.lang.Character" "charValue" "()C" "java.lang.Integer" "(I)V"
+ ^:private compile-jvm-c2l Opcodes/I2L "java.lang.Character" "charValue" "()C" "java.lang.Long" "(J)V"
)
(do-template [<name> <op> <from1-method> <from1-sig> <from1-class> <from2-method> <from2-sig> <from2-class> <to-class> <to-sig>]
- (defn <name> [compile ?x ?y]
- (|do [^MethodVisitor *writer* &/get-writer
+ (defn <name> [compile ?values]
+ (|do [:let [(&/$Cons ?x (&/$Cons ?y (&/$Nil))) ?values]
+ ^MethodVisitor *writer* &/get-writer
:let [_ (doto *writer*
(.visitTypeInsn Opcodes/NEW (&host-generics/->bytecode-class-name <to-class>))
(.visitInsn Opcodes/DUP))]
@@ -1184,21 +979,326 @@
(.visitMethodInsn Opcodes/INVOKESPECIAL (&host-generics/->bytecode-class-name <to-class>) init-method <to-sig>))]]
(return nil)))
- compile-jvm-iand Opcodes/IAND "intValue" "()I" "java.lang.Integer" "intValue" "()I" "java.lang.Integer" "java.lang.Integer" "(I)V"
- compile-jvm-ior Opcodes/IOR "intValue" "()I" "java.lang.Integer" "intValue" "()I" "java.lang.Integer" "java.lang.Integer" "(I)V"
- compile-jvm-ixor Opcodes/IXOR "intValue" "()I" "java.lang.Integer" "intValue" "()I" "java.lang.Integer" "java.lang.Integer" "(I)V"
- compile-jvm-ishl Opcodes/ISHL "intValue" "()I" "java.lang.Integer" "intValue" "()I" "java.lang.Integer" "java.lang.Integer" "(I)V"
- compile-jvm-ishr Opcodes/ISHR "intValue" "()I" "java.lang.Integer" "intValue" "()I" "java.lang.Integer" "java.lang.Integer" "(I)V"
- compile-jvm-iushr Opcodes/IUSHR "intValue" "()I" "java.lang.Integer" "intValue" "()I" "java.lang.Integer" "java.lang.Integer" "(I)V"
+ ^:private compile-jvm-iand Opcodes/IAND "intValue" "()I" "java.lang.Integer" "intValue" "()I" "java.lang.Integer" "java.lang.Integer" "(I)V"
+ ^:private compile-jvm-ior Opcodes/IOR "intValue" "()I" "java.lang.Integer" "intValue" "()I" "java.lang.Integer" "java.lang.Integer" "(I)V"
+ ^:private compile-jvm-ixor Opcodes/IXOR "intValue" "()I" "java.lang.Integer" "intValue" "()I" "java.lang.Integer" "java.lang.Integer" "(I)V"
+ ^:private compile-jvm-ishl Opcodes/ISHL "intValue" "()I" "java.lang.Integer" "intValue" "()I" "java.lang.Integer" "java.lang.Integer" "(I)V"
+ ^:private compile-jvm-ishr Opcodes/ISHR "intValue" "()I" "java.lang.Integer" "intValue" "()I" "java.lang.Integer" "java.lang.Integer" "(I)V"
+ ^:private compile-jvm-iushr Opcodes/IUSHR "intValue" "()I" "java.lang.Integer" "intValue" "()I" "java.lang.Integer" "java.lang.Integer" "(I)V"
- compile-jvm-land Opcodes/LAND "longValue" "()J" "java.lang.Long" "longValue" "()J" "java.lang.Long" "java.lang.Long" "(J)V"
- compile-jvm-lor Opcodes/LOR "longValue" "()J" "java.lang.Long" "longValue" "()J" "java.lang.Long" "java.lang.Long" "(J)V"
- compile-jvm-lxor Opcodes/LXOR "longValue" "()J" "java.lang.Long" "longValue" "()J" "java.lang.Long" "java.lang.Long" "(J)V"
- compile-jvm-lshl Opcodes/LSHL "longValue" "()J" "java.lang.Long" "intValue" "()I" "java.lang.Integer" "java.lang.Long" "(J)V"
- compile-jvm-lshr Opcodes/LSHR "longValue" "()J" "java.lang.Long" "intValue" "()I" "java.lang.Integer" "java.lang.Long" "(J)V"
- compile-jvm-lushr Opcodes/LUSHR "longValue" "()J" "java.lang.Long" "intValue" "()I" "java.lang.Integer" "java.lang.Long" "(J)V"
+ ^:private compile-jvm-land Opcodes/LAND "longValue" "()J" "java.lang.Long" "longValue" "()J" "java.lang.Long" "java.lang.Long" "(J)V"
+ ^:private compile-jvm-lor Opcodes/LOR "longValue" "()J" "java.lang.Long" "longValue" "()J" "java.lang.Long" "java.lang.Long" "(J)V"
+ ^:private compile-jvm-lxor Opcodes/LXOR "longValue" "()J" "java.lang.Long" "longValue" "()J" "java.lang.Long" "java.lang.Long" "(J)V"
+ ^:private compile-jvm-lshl Opcodes/LSHL "longValue" "()J" "java.lang.Long" "intValue" "()I" "java.lang.Integer" "java.lang.Long" "(J)V"
+ ^:private compile-jvm-lshr Opcodes/LSHR "longValue" "()J" "java.lang.Long" "intValue" "()I" "java.lang.Integer" "java.lang.Long" "(J)V"
+ ^:private compile-jvm-lushr Opcodes/LUSHR "longValue" "()J" "java.lang.Long" "intValue" "()I" "java.lang.Integer" "java.lang.Long" "(J)V"
)
+(do-template [<name> <opcode> <wrapper-class> <value-method> <value-method-sig> <wrap>]
+ (defn <name> [compile ?values]
+ (|do [:let [(&/$Cons ?x (&/$Cons ?y (&/$Nil))) ?values]
+ :let [+wrapper-class+ (&host-generics/->bytecode-class-name <wrapper-class>)]
+ ^MethodVisitor *writer* &/get-writer
+ _ (compile ?x)
+ :let [_ (doto *writer*
+ (.visitTypeInsn Opcodes/CHECKCAST +wrapper-class+)
+ (.visitMethodInsn Opcodes/INVOKEVIRTUAL +wrapper-class+ <value-method> <value-method-sig>))]
+ _ (compile ?y)
+ :let [_ (doto *writer*
+ (.visitTypeInsn Opcodes/CHECKCAST +wrapper-class+)
+ (.visitMethodInsn Opcodes/INVOKEVIRTUAL +wrapper-class+ <value-method> <value-method-sig>))
+ _ (doto *writer*
+ (.visitInsn <opcode>)
+ (<wrap>))]]
+ (return nil)))
+
+ ^:private compile-jvm-iadd Opcodes/IADD "java.lang.Integer" "intValue" "()I" &&/wrap-int
+ ^:private compile-jvm-isub Opcodes/ISUB "java.lang.Integer" "intValue" "()I" &&/wrap-int
+ ^:private compile-jvm-imul Opcodes/IMUL "java.lang.Integer" "intValue" "()I" &&/wrap-int
+ ^:private compile-jvm-idiv Opcodes/IDIV "java.lang.Integer" "intValue" "()I" &&/wrap-int
+ ^:private compile-jvm-irem Opcodes/IREM "java.lang.Integer" "intValue" "()I" &&/wrap-int
+
+ ^:private compile-jvm-ladd Opcodes/LADD "java.lang.Long" "longValue" "()J" &&/wrap-long
+ ^:private compile-jvm-lsub Opcodes/LSUB "java.lang.Long" "longValue" "()J" &&/wrap-long
+ ^:private compile-jvm-lmul Opcodes/LMUL "java.lang.Long" "longValue" "()J" &&/wrap-long
+ ^:private compile-jvm-ldiv Opcodes/LDIV "java.lang.Long" "longValue" "()J" &&/wrap-long
+ ^:private compile-jvm-lrem Opcodes/LREM "java.lang.Long" "longValue" "()J" &&/wrap-long
+
+ ^:private compile-jvm-fadd Opcodes/FADD "java.lang.Float" "floatValue" "()F" &&/wrap-float
+ ^:private compile-jvm-fsub Opcodes/FSUB "java.lang.Float" "floatValue" "()F" &&/wrap-float
+ ^:private compile-jvm-fmul Opcodes/FMUL "java.lang.Float" "floatValue" "()F" &&/wrap-float
+ ^:private compile-jvm-fdiv Opcodes/FDIV "java.lang.Float" "floatValue" "()F" &&/wrap-float
+ ^:private compile-jvm-frem Opcodes/FREM "java.lang.Float" "floatValue" "()F" &&/wrap-float
+
+ ^:private compile-jvm-dadd Opcodes/DADD "java.lang.Double" "doubleValue" "()D" &&/wrap-double
+ ^:private compile-jvm-dsub Opcodes/DSUB "java.lang.Double" "doubleValue" "()D" &&/wrap-double
+ ^:private compile-jvm-dmul Opcodes/DMUL "java.lang.Double" "doubleValue" "()D" &&/wrap-double
+ ^:private compile-jvm-ddiv Opcodes/DDIV "java.lang.Double" "doubleValue" "()D" &&/wrap-double
+ ^:private compile-jvm-drem Opcodes/DREM "java.lang.Double" "doubleValue" "()D" &&/wrap-double
+ )
+
+(do-template [<name> <opcode> <wrapper-class> <value-method> <value-method-sig>]
+ (defn <name> [compile ?values]
+ (|do [:let [(&/$Cons ?x (&/$Cons ?y (&/$Nil))) ?values]
+ :let [+wrapper-class+ (&host-generics/->bytecode-class-name <wrapper-class>)]
+ ^MethodVisitor *writer* &/get-writer
+ _ (compile ?x)
+ :let [_ (doto *writer*
+ (.visitTypeInsn Opcodes/CHECKCAST +wrapper-class+)
+ (.visitMethodInsn Opcodes/INVOKEVIRTUAL +wrapper-class+ <value-method> <value-method-sig>))]
+ _ (compile ?y)
+ :let [_ (doto *writer*
+ (.visitTypeInsn Opcodes/CHECKCAST +wrapper-class+)
+ (.visitMethodInsn Opcodes/INVOKEVIRTUAL +wrapper-class+ <value-method> <value-method-sig>))
+ $then (new Label)
+ $end (new Label)
+ _ (doto *writer*
+ (.visitJumpInsn <opcode> $then)
+ (.visitFieldInsn Opcodes/GETSTATIC (&host-generics/->bytecode-class-name "java.lang.Boolean") "FALSE" (&host-generics/->type-signature "java.lang.Boolean"))
+ (.visitJumpInsn Opcodes/GOTO $end)
+ (.visitLabel $then)
+ (.visitFieldInsn Opcodes/GETSTATIC (&host-generics/->bytecode-class-name "java.lang.Boolean") "TRUE" (&host-generics/->type-signature "java.lang.Boolean"))
+ (.visitLabel $end))]]
+ (return nil)))
+
+ ^:private compile-jvm-ieq Opcodes/IF_ICMPEQ "java.lang.Integer" "intValue" "()I"
+ ^:private compile-jvm-ilt Opcodes/IF_ICMPLT "java.lang.Integer" "intValue" "()I"
+ ^:private compile-jvm-igt Opcodes/IF_ICMPGT "java.lang.Integer" "intValue" "()I"
+
+ ^:private compile-jvm-ceq Opcodes/IF_ICMPEQ "java.lang.Character" "charValue" "()C"
+ ^:private compile-jvm-clt Opcodes/IF_ICMPLT "java.lang.Character" "charValue" "()C"
+ ^:private compile-jvm-cgt Opcodes/IF_ICMPGT "java.lang.Character" "charValue" "()C"
+ )
+
+(do-template [<name> <cmpcode> <cmp-output> <wrapper-class> <value-method> <value-method-sig>]
+ (defn <name> [compile ?values]
+ (|do [:let [(&/$Cons ?x (&/$Cons ?y (&/$Nil))) ?values]
+ :let [+wrapper-class+ (&host-generics/->bytecode-class-name <wrapper-class>)]
+ ^MethodVisitor *writer* &/get-writer
+ _ (compile ?x)
+ :let [_ (doto *writer*
+ (.visitTypeInsn Opcodes/CHECKCAST +wrapper-class+)
+ (.visitMethodInsn Opcodes/INVOKEVIRTUAL +wrapper-class+ <value-method> <value-method-sig>))]
+ _ (compile ?y)
+ :let [_ (doto *writer*
+ (.visitTypeInsn Opcodes/CHECKCAST +wrapper-class+)
+ (.visitMethodInsn Opcodes/INVOKEVIRTUAL +wrapper-class+ <value-method> <value-method-sig>))
+ $then (new Label)
+ $end (new Label)
+ _ (doto *writer*
+ (.visitInsn <cmpcode>)
+ (.visitLdcInsn (int <cmp-output>))
+ (.visitJumpInsn Opcodes/IF_ICMPEQ $then)
+ (.visitFieldInsn Opcodes/GETSTATIC (&host-generics/->bytecode-class-name "java.lang.Boolean") "FALSE" (&host-generics/->type-signature "java.lang.Boolean"))
+ (.visitJumpInsn Opcodes/GOTO $end)
+ (.visitLabel $then)
+ (.visitFieldInsn Opcodes/GETSTATIC (&host-generics/->bytecode-class-name "java.lang.Boolean") "TRUE" (&host-generics/->type-signature "java.lang.Boolean"))
+ (.visitLabel $end))]]
+ (return nil)))
+
+ ^:private compile-jvm-leq Opcodes/LCMP 0 "java.lang.Long" "longValue" "()J"
+ ^:private compile-jvm-llt Opcodes/LCMP -1 "java.lang.Long" "longValue" "()J"
+ ^:private compile-jvm-lgt Opcodes/LCMP 1 "java.lang.Long" "longValue" "()J"
+
+ ^:private compile-jvm-feq Opcodes/FCMPG 0 "java.lang.Float" "floatValue" "()F"
+ ^:private compile-jvm-flt Opcodes/FCMPG -1 "java.lang.Float" "floatValue" "()F"
+ ^:private compile-jvm-fgt Opcodes/FCMPG 1 "java.lang.Float" "floatValue" "()F"
+
+ ^:private compile-jvm-deq Opcodes/DCMPG 0 "java.lang.Double" "doubleValue" "()D"
+ ^:private compile-jvm-dlt Opcodes/DCMPG -1 "java.lang.Double" "doubleValue" "()D"
+ ^:private compile-jvm-dgt Opcodes/DCMPG 1 "java.lang.Double" "doubleValue" "()D"
+ )
+
+(do-template [<prim-type> <array-type> <new-name> <load-name> <load-op> <store-name> <store-op> <wrapper> <unwrapper>]
+ (do (defn <new-name> [compile ?values]
+ (|do [:let [(&/$Cons ?length (&/$Nil)) ?values]
+ ^MethodVisitor *writer* &/get-writer
+ _ (compile ?length)
+ :let [_ (doto *writer*
+ &&/unwrap-long
+ (.visitInsn Opcodes/L2I))]
+ :let [_ (.visitIntInsn *writer* Opcodes/NEWARRAY <prim-type>)]]
+ (return nil)))
+
+ (defn <load-name> [compile ?values]
+ (|do [:let [(&/$Cons ?array (&/$Cons ?idx (&/$Nil))) ?values]
+ ^MethodVisitor *writer* &/get-writer
+ _ (compile ?array)
+ :let [_ (.visitTypeInsn *writer* Opcodes/CHECKCAST <array-type>)]
+ _ (compile ?idx)
+ :let [_ (doto *writer*
+ &&/unwrap-long
+ (.visitInsn Opcodes/L2I))]
+ :let [_ (doto *writer*
+ (.visitInsn <load-op>)
+ <wrapper>)]]
+ (return nil)))
+
+ (defn <store-name> [compile ?values]
+ (|do [:let [(&/$Cons ?array (&/$Cons ?idx (&/$Cons ?elem (&/$Nil)))) ?values]
+ ^MethodVisitor *writer* &/get-writer
+ _ (compile ?array)
+ :let [_ (.visitTypeInsn *writer* Opcodes/CHECKCAST <array-type>)]
+ :let [_ (.visitInsn *writer* Opcodes/DUP)]
+ _ (compile ?idx)
+ :let [_ (doto *writer*
+ &&/unwrap-long
+ (.visitInsn Opcodes/L2I))]
+ _ (compile ?elem)
+ :let [_ (doto *writer*
+ <unwrapper>
+ (.visitInsn <store-op>))]]
+ (return nil)))
+ )
+
+ Opcodes/T_BOOLEAN "[Z" ^:private compile-jvm-znewarray compile-jvm-zaload Opcodes/BALOAD compile-jvm-zastore Opcodes/BASTORE &&/wrap-boolean &&/unwrap-boolean
+ Opcodes/T_BYTE "[B" ^:private compile-jvm-bnewarray compile-jvm-baload Opcodes/BALOAD compile-jvm-bastore Opcodes/BASTORE &&/wrap-byte &&/unwrap-byte
+ Opcodes/T_SHORT "[S" ^:private compile-jvm-snewarray compile-jvm-saload Opcodes/SALOAD compile-jvm-sastore Opcodes/SASTORE &&/wrap-short &&/unwrap-short
+ Opcodes/T_INT "[I" ^:private compile-jvm-inewarray compile-jvm-iaload Opcodes/IALOAD compile-jvm-iastore Opcodes/IASTORE &&/wrap-int &&/unwrap-int
+ Opcodes/T_LONG "[J" ^:private compile-jvm-lnewarray compile-jvm-laload Opcodes/LALOAD compile-jvm-lastore Opcodes/LASTORE &&/wrap-long &&/unwrap-long
+ Opcodes/T_FLOAT "[F" ^:private compile-jvm-fnewarray compile-jvm-faload Opcodes/FALOAD compile-jvm-fastore Opcodes/FASTORE &&/wrap-float &&/unwrap-float
+ Opcodes/T_DOUBLE "[D" ^:private compile-jvm-dnewarray compile-jvm-daload Opcodes/DALOAD compile-jvm-dastore Opcodes/DASTORE &&/wrap-double &&/unwrap-double
+ Opcodes/T_CHAR "[C" ^:private compile-jvm-cnewarray compile-jvm-caload Opcodes/CALOAD compile-jvm-castore Opcodes/CASTORE &&/wrap-char &&/unwrap-char
+ )
+
+(defn ^:private compile-jvm-anewarray [compile ?values]
+ (|do [:let [(&/$Cons ?gclass (&/$Cons ?length (&/$Cons type-env (&/$Nil)))) ?values]
+ ^MethodVisitor *writer* &/get-writer
+ _ (compile ?length)
+ :let [_ (doto *writer*
+ &&/unwrap-long
+ (.visitInsn Opcodes/L2I))]
+ :let [_ (.visitTypeInsn *writer* Opcodes/ANEWARRAY (&host-generics/gclass->bytecode-class-name* ?gclass type-env))]]
+ (return nil)))
+
+(defn ^:private compile-jvm-aaload [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)]]
+ (return nil)))
+
+(defn ^:private compile-jvm-aastore [compile ?values]
+ (|do [:let [(&/$Cons ?array (&/$Cons ?idx (&/$Cons ?elem (&/$Nil)))) ?values]
+ ^MethodVisitor *writer* &/get-writer
+ array-type (&host/->java-sig (&a/expr-type* ?array))
+ _ (compile ?array)
+ :let [_ (.visitTypeInsn *writer* Opcodes/CHECKCAST array-type)]
+ :let [_ (.visitInsn *writer* Opcodes/DUP)]
+ _ (compile ?idx)
+ :let [_ (doto *writer*
+ &&/unwrap-long
+ (.visitInsn Opcodes/L2I))]
+ _ (compile ?elem)
+ :let [_ (.visitInsn *writer* Opcodes/AASTORE)]]
+ (return nil)))
+
+(defn ^:private compile-jvm-arraylength [compile ?values]
+ (|do [:let [(&/$Cons ?array (&/$Nil)) ?values]
+ ^MethodVisitor *writer* &/get-writer
+ array-type (&host/->java-sig (&a/expr-type* ?array))
+ _ (compile ?array)
+ :let [_ (.visitTypeInsn *writer* Opcodes/CHECKCAST array-type)]
+ :let [_ (doto *writer*
+ (.visitInsn Opcodes/ARRAYLENGTH)
+ (.visitInsn Opcodes/I2L)
+ &&/wrap-long)]]
+ (return nil)))
+
+(defn compile-host [compile proc-category proc-name ?values]
+ (case proc-category
+ "jvm"
+ (case proc-name
+ "anewarray" (compile-jvm-anewarray compile ?values)
+ "aaload" (compile-jvm-aaload compile ?values)
+ "aastore" (compile-jvm-aastore compile ?values)
+ "arraylength" (compile-jvm-arraylength compile ?values)
+ "znewarray" (compile-jvm-znewarray compile ?values)
+ "bnewarray" (compile-jvm-bnewarray compile ?values)
+ "snewarray" (compile-jvm-snewarray compile ?values)
+ "inewarray" (compile-jvm-inewarray compile ?values)
+ "lnewarray" (compile-jvm-lnewarray compile ?values)
+ "fnewarray" (compile-jvm-fnewarray compile ?values)
+ "dnewarray" (compile-jvm-dnewarray compile ?values)
+ "cnewarray" (compile-jvm-cnewarray compile ?values)
+ "iadd" (compile-jvm-iadd compile ?values)
+ "isub" (compile-jvm-isub compile ?values)
+ "imul" (compile-jvm-imul compile ?values)
+ "idiv" (compile-jvm-idiv compile ?values)
+ "irem" (compile-jvm-irem compile ?values)
+ "ieq" (compile-jvm-ieq compile ?values)
+ "ilt" (compile-jvm-ilt compile ?values)
+ "igt" (compile-jvm-igt compile ?values)
+ "ceq" (compile-jvm-ceq compile ?values)
+ "clt" (compile-jvm-clt compile ?values)
+ "cgt" (compile-jvm-cgt compile ?values)
+ "ladd" (compile-jvm-ladd compile ?values)
+ "lsub" (compile-jvm-lsub compile ?values)
+ "lmul" (compile-jvm-lmul compile ?values)
+ "ldiv" (compile-jvm-ldiv compile ?values)
+ "lrem" (compile-jvm-lrem compile ?values)
+ "leq" (compile-jvm-leq compile ?values)
+ "llt" (compile-jvm-llt compile ?values)
+ "lgt" (compile-jvm-lgt compile ?values)
+ "fadd" (compile-jvm-fadd compile ?values)
+ "fsub" (compile-jvm-fsub compile ?values)
+ "fmul" (compile-jvm-fmul compile ?values)
+ "fdiv" (compile-jvm-fdiv compile ?values)
+ "frem" (compile-jvm-frem compile ?values)
+ "feq" (compile-jvm-feq compile ?values)
+ "flt" (compile-jvm-flt compile ?values)
+ "fgt" (compile-jvm-fgt compile ?values)
+ "dadd" (compile-jvm-dadd compile ?values)
+ "dsub" (compile-jvm-dsub compile ?values)
+ "dmul" (compile-jvm-dmul compile ?values)
+ "ddiv" (compile-jvm-ddiv compile ?values)
+ "drem" (compile-jvm-drem compile ?values)
+ "deq" (compile-jvm-deq compile ?values)
+ "dlt" (compile-jvm-dlt compile ?values)
+ "dgt" (compile-jvm-dgt compile ?values)
+ "iand" (compile-jvm-iand compile ?values)
+ "ior" (compile-jvm-ior compile ?values)
+ "ixor" (compile-jvm-ixor compile ?values)
+ "ishl" (compile-jvm-ishl compile ?values)
+ "ishr" (compile-jvm-ishr compile ?values)
+ "iushr" (compile-jvm-iushr compile ?values)
+ "land" (compile-jvm-land compile ?values)
+ "lor" (compile-jvm-lor compile ?values)
+ "lxor" (compile-jvm-lxor compile ?values)
+ "lshl" (compile-jvm-lshl compile ?values)
+ "lshr" (compile-jvm-lshr compile ?values)
+ "lushr" (compile-jvm-lushr compile ?values)
+ "d2f" (compile-jvm-d2f compile ?values)
+ "d2i" (compile-jvm-d2i compile ?values)
+ "d2l" (compile-jvm-d2l compile ?values)
+ "f2d" (compile-jvm-f2d compile ?values)
+ "f2i" (compile-jvm-f2i compile ?values)
+ "f2l" (compile-jvm-f2l compile ?values)
+ "i2b" (compile-jvm-i2b compile ?values)
+ "i2c" (compile-jvm-i2c compile ?values)
+ "i2d" (compile-jvm-i2d compile ?values)
+ "i2f" (compile-jvm-i2f compile ?values)
+ "i2l" (compile-jvm-i2l compile ?values)
+ "i2s" (compile-jvm-i2s compile ?values)
+ "l2d" (compile-jvm-l2d compile ?values)
+ "l2f" (compile-jvm-l2f compile ?values)
+ "l2i" (compile-jvm-l2i compile ?values)
+ "c2b" (compile-jvm-c2b compile ?values)
+ "c2s" (compile-jvm-c2s compile ?values)
+ "c2i" (compile-jvm-c2i compile ?values)
+ "c2l" (compile-jvm-c2l compile ?values)
+ ;; else
+ (fail (str "[Compiler Error] Unknown host procedure: " [proc-category proc-name])))
+
+ ;; else
+ (fail (str "[Compiler Error] Unknown host procedure: " [proc-category proc-name]))))
+
(defn compile-jvm-program [compile ?body]
(|do [module-name &/get-module-name
^ClassWriter *writer* &/get-writer]
diff --git a/src/lux/optimizer.clj b/src/lux/optimizer.clj
index 6f4fd27bd..09faa73fb 100644
--- a/src/lux/optimizer.clj
+++ b/src/lux/optimizer.clj
@@ -26,6 +26,7 @@
("declare-macro" 1)
("var" 1)
("captured" 1)
+ ("host" 2)
("jvm-getstatic" 1)
("jvm-getfield" 1)
@@ -46,113 +47,7 @@
("jvm-monitorenter" 1)
("jvm-monitorexit" 1)
("jvm-program" 1)
-
- ("jvm-znewarray" 1)
- ("jvm-zastore" 1)
- ("jvm-zaload" 1)
- ("jvm-bnewarray" 1)
- ("jvm-bastore" 1)
- ("jvm-baload" 1)
- ("jvm-snewarray" 1)
- ("jvm-sastore" 1)
- ("jvm-saload" 1)
- ("jvm-inewarray" 1)
- ("jvm-iastore" 1)
- ("jvm-iaload" 1)
- ("jvm-lnewarray" 1)
- ("jvm-lastore" 1)
- ("jvm-laload" 1)
- ("jvm-fnewarray" 1)
- ("jvm-fastore" 1)
- ("jvm-faload" 1)
- ("jvm-dnewarray" 1)
- ("jvm-dastore" 1)
- ("jvm-daload" 1)
- ("jvm-cnewarray" 1)
- ("jvm-castore" 1)
- ("jvm-caload" 1)
- ("jvm-anewarray" 1)
- ("jvm-aastore" 1)
- ("jvm-aaload" 1)
- ("jvm-arraylength" 1)
-
- ("jvm-iadd" 1)
- ("jvm-isub" 1)
- ("jvm-imul" 1)
- ("jvm-idiv" 1)
- ("jvm-irem" 1)
- ("jvm-ieq" 1)
- ("jvm-ilt" 1)
- ("jvm-igt" 1)
-
- ("jvm-ceq" 1)
- ("jvm-clt" 1)
- ("jvm-cgt" 1)
-
- ("jvm-ladd" 1)
- ("jvm-lsub" 1)
- ("jvm-lmul" 1)
- ("jvm-ldiv" 1)
- ("jvm-lrem" 1)
- ("jvm-leq" 1)
- ("jvm-llt" 1)
- ("jvm-lgt" 1)
-
- ("jvm-fadd" 1)
- ("jvm-fsub" 1)
- ("jvm-fmul" 1)
- ("jvm-fdiv" 1)
- ("jvm-frem" 1)
- ("jvm-feq" 1)
- ("jvm-flt" 1)
- ("jvm-fgt" 1)
-
- ("jvm-dadd" 1)
- ("jvm-dsub" 1)
- ("jvm-dmul" 1)
- ("jvm-ddiv" 1)
- ("jvm-drem" 1)
- ("jvm-deq" 1)
- ("jvm-dlt" 1)
- ("jvm-dgt" 1)
-
- ("jvm-d2f" 1)
- ("jvm-d2i" 1)
- ("jvm-d2l" 1)
-
- ("jvm-f2d" 1)
- ("jvm-f2i" 1)
- ("jvm-f2l" 1)
-
- ("jvm-i2b" 1)
- ("jvm-i2c" 1)
- ("jvm-i2d" 1)
- ("jvm-i2f" 1)
- ("jvm-i2l" 1)
- ("jvm-i2s" 1)
-
- ("jvm-l2d" 1)
- ("jvm-l2f" 1)
- ("jvm-l2i" 1)
-
- ("jvm-c2b" 1)
- ("jvm-c2s" 1)
- ("jvm-c2i" 1)
- ("jvm-c2l" 1)
-
- ("jvm-iand" 1)
- ("jvm-ior" 1)
- ("jvm-ixor" 1)
- ("jvm-ishl" 1)
- ("jvm-ishr" 1)
- ("jvm-iushr" 1)
-
- ("jvm-land" 1)
- ("jvm-lor" 1)
- ("jvm-lxor" 1)
- ("jvm-lshl" 1)
- ("jvm-lshr" 1)
- ("jvm-lushr" 1))
+ )
;; [Exports]
(defn optimize-token [analysis]
@@ -205,6 +100,9 @@
(&-base/$captured value)
(return ($captured value))
+
+ (&-base/$host ?proc-ident ?args)
+ (return ($host ?proc-ident ?args))
(&-base/$jvm-getstatic value)
(return ($jvm-getstatic value))
@@ -263,288 +161,6 @@
(&-base/$jvm-program value)
(return ($jvm-program value))
- (&-base/$jvm-znewarray value)
- (return ($jvm-znewarray value))
-
- (&-base/$jvm-zastore value)
- (return ($jvm-zastore value))
-
- (&-base/$jvm-zaload value)
- (return ($jvm-zaload value))
-
- (&-base/$jvm-bnewarray value)
- (return ($jvm-bnewarray value))
-
- (&-base/$jvm-bastore value)
- (return ($jvm-bastore value))
-
- (&-base/$jvm-baload value)
- (return ($jvm-baload value))
-
- (&-base/$jvm-snewarray value)
- (return ($jvm-snewarray value))
-
- (&-base/$jvm-sastore value)
- (return ($jvm-sastore value))
-
- (&-base/$jvm-saload value)
- (return ($jvm-saload value))
-
- (&-base/$jvm-inewarray value)
- (return ($jvm-inewarray value))
-
- (&-base/$jvm-iastore value)
- (return ($jvm-iastore value))
-
- (&-base/$jvm-iaload value)
- (return ($jvm-iaload value))
-
- (&-base/$jvm-lnewarray value)
- (return ($jvm-lnewarray value))
-
- (&-base/$jvm-lastore value)
- (return ($jvm-lastore value))
-
- (&-base/$jvm-laload value)
- (return ($jvm-laload value))
-
- (&-base/$jvm-fnewarray value)
- (return ($jvm-fnewarray value))
-
- (&-base/$jvm-fastore value)
- (return ($jvm-fastore value))
-
- (&-base/$jvm-faload value)
- (return ($jvm-faload value))
-
- (&-base/$jvm-dnewarray value)
- (return ($jvm-dnewarray value))
-
- (&-base/$jvm-dastore value)
- (return ($jvm-dastore value))
-
- (&-base/$jvm-daload value)
- (return ($jvm-daload value))
-
- (&-base/$jvm-cnewarray value)
- (return ($jvm-cnewarray value))
-
- (&-base/$jvm-castore value)
- (return ($jvm-castore value))
-
- (&-base/$jvm-caload value)
- (return ($jvm-caload value))
-
- (&-base/$jvm-anewarray value)
- (return ($jvm-anewarray value))
-
- (&-base/$jvm-aastore value)
- (return ($jvm-aastore value))
-
- (&-base/$jvm-aaload value)
- (return ($jvm-aaload value))
-
- (&-base/$jvm-arraylength value)
- (return ($jvm-arraylength value))
-
- (&-base/$jvm-iadd value)
- (return ($jvm-iadd value))
-
- (&-base/$jvm-isub value)
- (return ($jvm-isub value))
-
- (&-base/$jvm-imul value)
- (return ($jvm-imul value))
-
- (&-base/$jvm-idiv value)
- (return ($jvm-idiv value))
-
- (&-base/$jvm-irem value)
- (return ($jvm-irem value))
-
- (&-base/$jvm-ieq value)
- (return ($jvm-ieq value))
-
- (&-base/$jvm-ilt value)
- (return ($jvm-ilt value))
-
- (&-base/$jvm-igt value)
- (return ($jvm-igt value))
-
- (&-base/$jvm-ceq value)
- (return ($jvm-ceq value))
-
- (&-base/$jvm-clt value)
- (return ($jvm-clt value))
-
- (&-base/$jvm-cgt value)
- (return ($jvm-cgt value))
-
- (&-base/$jvm-ladd value)
- (return ($jvm-ladd value))
-
- (&-base/$jvm-lsub value)
- (return ($jvm-lsub value))
-
- (&-base/$jvm-lmul value)
- (return ($jvm-lmul value))
-
- (&-base/$jvm-ldiv value)
- (return ($jvm-ldiv value))
-
- (&-base/$jvm-lrem value)
- (return ($jvm-lrem value))
-
- (&-base/$jvm-leq value)
- (return ($jvm-leq value))
-
- (&-base/$jvm-llt value)
- (return ($jvm-llt value))
-
- (&-base/$jvm-lgt value)
- (return ($jvm-lgt value))
-
- (&-base/$jvm-fadd value)
- (return ($jvm-fadd value))
-
- (&-base/$jvm-fsub value)
- (return ($jvm-fsub value))
-
- (&-base/$jvm-fmul value)
- (return ($jvm-fmul value))
-
- (&-base/$jvm-fdiv value)
- (return ($jvm-fdiv value))
-
- (&-base/$jvm-frem value)
- (return ($jvm-frem value))
-
- (&-base/$jvm-feq value)
- (return ($jvm-feq value))
-
- (&-base/$jvm-flt value)
- (return ($jvm-flt value))
-
- (&-base/$jvm-fgt value)
- (return ($jvm-fgt value))
-
- (&-base/$jvm-dadd value)
- (return ($jvm-dadd value))
-
- (&-base/$jvm-dsub value)
- (return ($jvm-dsub value))
-
- (&-base/$jvm-dmul value)
- (return ($jvm-dmul value))
-
- (&-base/$jvm-ddiv value)
- (return ($jvm-ddiv value))
-
- (&-base/$jvm-drem value)
- (return ($jvm-drem value))
-
- (&-base/$jvm-deq value)
- (return ($jvm-deq value))
-
- (&-base/$jvm-dlt value)
- (return ($jvm-dlt value))
-
- (&-base/$jvm-dgt value)
- (return ($jvm-dgt value))
-
- (&-base/$jvm-d2f value)
- (return ($jvm-d2f value))
-
- (&-base/$jvm-d2i value)
- (return ($jvm-d2i value))
-
- (&-base/$jvm-d2l value)
- (return ($jvm-d2l value))
-
- (&-base/$jvm-f2d value)
- (return ($jvm-f2d value))
-
- (&-base/$jvm-f2i value)
- (return ($jvm-f2i value))
-
- (&-base/$jvm-f2l value)
- (return ($jvm-f2l value))
-
- (&-base/$jvm-i2b value)
- (return ($jvm-i2b value))
-
- (&-base/$jvm-i2c value)
- (return ($jvm-i2c value))
-
- (&-base/$jvm-i2d value)
- (return ($jvm-i2d value))
-
- (&-base/$jvm-i2f value)
- (return ($jvm-i2f value))
-
- (&-base/$jvm-i2l value)
- (return ($jvm-i2l value))
-
- (&-base/$jvm-i2s value)
- (return ($jvm-i2s value))
-
- (&-base/$jvm-l2d value)
- (return ($jvm-l2d value))
-
- (&-base/$jvm-l2f value)
- (return ($jvm-l2f value))
-
- (&-base/$jvm-l2i value)
- (return ($jvm-l2i value))
-
- (&-base/$jvm-c2b value)
- (return ($jvm-c2b value))
-
- (&-base/$jvm-c2s value)
- (return ($jvm-c2s value))
-
- (&-base/$jvm-c2i value)
- (return ($jvm-c2i value))
-
- (&-base/$jvm-c2l value)
- (return ($jvm-c2l value))
-
- (&-base/$jvm-iand value)
- (return ($jvm-iand value))
-
- (&-base/$jvm-ior value)
- (return ($jvm-ior value))
-
- (&-base/$jvm-ixor value)
- (return ($jvm-ixor value))
-
- (&-base/$jvm-ishl value)
- (return ($jvm-ishl value))
-
- (&-base/$jvm-ishr value)
- (return ($jvm-ishr value))
-
- (&-base/$jvm-iushr value)
- (return ($jvm-iushr value))
-
- (&-base/$jvm-land value)
- (return ($jvm-land value))
-
- (&-base/$jvm-lor value)
- (return ($jvm-lor value))
-
- (&-base/$jvm-lxor value)
- (return ($jvm-lxor value))
-
- (&-base/$jvm-lshl value)
- (return ($jvm-lshl value))
-
- (&-base/$jvm-lshr value)
- (return ($jvm-lshr value))
-
- (&-base/$jvm-lushr value)
- (return ($jvm-lushr value))
-
_
(assert false (prn-str 'optimize-token (&/adt->text analysis)))
))