diff options
| -rw-r--r-- | src/lux/analyser/host.clj | 39 | ||||
| -rw-r--r-- | src/lux/compiler/host.clj | 47 |
2 files changed, 86 insertions, 0 deletions
diff --git a/src/lux/analyser/host.clj b/src/lux/analyser/host.clj index a7b467564..cc136b066 100644 --- a/src/lux/analyser/host.clj +++ b/src/lux/analyser/host.clj @@ -1005,9 +1005,48 @@ ))) )))) +(do-template [<name> <op>] + (defn <name> [analyse exo-type ?values] + (|do [:let [(&/$Cons input (&/$Cons mask (&/$Nil))) ?values] + =mask (&&/analyse-1 analyse &type/Int mask) + =input (&&/analyse-1 analyse &type/Int input) + _ (&type/check exo-type &type/Int) + _cursor &/cursor] + (return (&/|list (&&/|meta exo-type _cursor + (&&/$proc (&/T ["bit" <op>]) (&/|list =input =mask) (&/|list))))))) + + ^:private analyse-bit-and "and" + ^:private analyse-bit-or "or" + ^:private analyse-bit-xor "xor" + ) + +(do-template [<name> <op>] + (defn <name> [analyse exo-type ?values] + (|do [:let [(&/$Cons input (&/$Cons shift (&/$Nil))) ?values] + =shift (&&/analyse-1 analyse &type/Int shift) + =input (&&/analyse-1 analyse &type/Int input) + _ (&type/check exo-type &type/Int) + _cursor &/cursor] + (return (&/|list (&&/|meta exo-type _cursor + (&&/$proc (&/T ["bit" <op>]) (&/|list =input =shift) (&/|list))))))) + + ^:private analyse-bit-shift-left "shift-left" + ^:private analyse-bit-shift-right "shift-right" + ^:private analyse-bit-unsigned-shift-right "unsigned-shift-right" + ) + (defn analyse-host [analyse exo-type compilers category proc ?values] (|let [[_ _ compile-class compile-interface] compilers] (case category + "bit" + (case proc + "and" (analyse-bit-and analyse exo-type ?values) + "or" (analyse-bit-or analyse exo-type ?values) + "xor" (analyse-bit-xor analyse exo-type ?values) + "shift-left" (analyse-bit-shift-left analyse exo-type ?values) + "shift-right" (analyse-bit-shift-right analyse exo-type ?values) + "unsigned-shift-right" (analyse-bit-unsigned-shift-right analyse exo-type ?values)) + "array" (case proc "new" (analyse-array-new analyse exo-type ?values) diff --git a/src/lux/compiler/host.clj b/src/lux/compiler/host.clj index ceb270ac1..29c58e056 100644 --- a/src/lux/compiler/host.clj +++ b/src/lux/compiler/host.clj @@ -1340,8 +1340,55 @@ (.visitLabel $end))]] (return nil))) +(do-template [<name> <op>] + (defn <name> [compile ?values special-args] + (|do [:let [(&/$Cons ?input (&/$Cons ?mask (&/$Nil))) ?values] + ^MethodVisitor *writer* &/get-writer + _ (compile ?input) + :let [_ (&&/unwrap-long *writer*)] + _ (compile ?mask) + :let [_ (&&/unwrap-long *writer*)] + :let [_ (doto *writer* + (.visitInsn <op>) + &&/wrap-long)]] + (return nil))) + + ^:private compile-bit-and Opcodes/LAND + ^:private compile-bit-or Opcodes/LOR + ^:private compile-bit-xor Opcodes/LXOR + ) + +(do-template [<name> <op>] + (defn <name> [compile ?values special-args] + (|do [:let [(&/$Cons ?input (&/$Cons ?shift (&/$Nil))) ?values] + ^MethodVisitor *writer* &/get-writer + _ (compile ?input) + :let [_ (&&/unwrap-long *writer*)] + _ (compile ?shift) + :let [_ (doto *writer* + &&/unwrap-long + (.visitInsn Opcodes/L2I))] + :let [_ (doto *writer* + (.visitInsn <op>) + &&/wrap-long)]] + (return nil))) + + ^:private compile-bit-shift-left Opcodes/LSHL + ^:private compile-bit-shift-right Opcodes/LSHR + ^:private compile-bit-unsigned-shift-right Opcodes/LUSHR + ) + (defn compile-host [compile proc-category proc-name ?values special-args] (case proc-category + "bit" + (case proc-name + "and" (compile-bit-and compile ?values special-args) + "or" (compile-bit-or compile ?values special-args) + "xor" (compile-bit-xor compile ?values special-args) + "shift-left" (compile-bit-shift-left compile ?values special-args) + "shift-right" (compile-bit-shift-right compile ?values special-args) + "unsigned-shift-right" (compile-bit-unsigned-shift-right compile ?values special-args)) + "array" (case proc-name "get" (compile-array-get compile ?values special-args)) |