diff options
| author | Eduardo Julian | 2016-04-27 09:18:26 -0400 |
|---|---|---|
| committer | Eduardo Julian | 2016-04-27 09:18:26 -0400 |
| commit | 7dfe345dbc6bf3fc8ab20b34453fb3b8af3fa75c (patch) | |
| tree | fe5da3dec89cbd96d830386e227d5248fadae6fe /src | |
| parent | 9ae1f0fd80f1fd45e242210a039ee12f11345f5b (diff) | |
- Unified dozens of host operations under the _lux_host special form.
Diffstat (limited to 'src')
| -rw-r--r-- | src/lux/analyser.clj | 343 | ||||
| -rw-r--r-- | src/lux/analyser/base.clj | 109 | ||||
| -rw-r--r-- | src/lux/analyser/host.clj | 530 | ||||
| -rw-r--r-- | src/lux/base.clj | 2 | ||||
| -rw-r--r-- | src/lux/compiler.clj | 289 | ||||
| -rw-r--r-- | src/lux/compiler/host.clj | 592 | ||||
| -rw-r--r-- | src/lux/optimizer.clj | 394 |
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))) )) |