aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--src/lux/analyser/host.clj39
-rw-r--r--src/lux/compiler/host.clj47
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))