From 1c3833bc75b9b7bfa1a658e63ceb11d4e4707ce4 Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Wed, 13 Jul 2016 01:55:15 -0400
Subject: - Added bitwise operations.

---
 src/lux/analyser/host.clj | 39 +++++++++++++++++++++++++++++++++++++++
 src/lux/compiler/host.clj | 47 +++++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 86 insertions(+)

(limited to 'src')

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))
-- 
cgit v1.2.3