js-on-sx: bitwise ops & | ^ << >> (+ compound assigns)

lib/js/runtime.sx

@@ -1667,6 +1667,67 @@
         (shift (modulo (js-math-trunc (js-to-number r)) 32)))
       (floor (/ lu32 (js-math-pow 2 shift))))))
 
+(define
+  js-to-uint32
+  (fn (n) (modulo (js-math-trunc (js-to-number n)) 4294967296)))
+
+(define
+  js-uint32-to-int32
+  (fn (u) (if (>= u 2147483648) (- u 4294967296) u)))
+
+(define js-to-int32 (fn (n) (js-uint32-to-int32 (js-to-uint32 n))))
+
+(define
+  js-bitwise-loop
+  (fn
+    (op au bu i acc bit)
+    (if
+      (>= i 32)
+      acc
+      (let
+        ((abit (modulo (floor (/ au bit)) 2))
+          (bbit (modulo (floor (/ bu bit)) 2)))
+        (let
+          ((rbit
+             (cond
+               ((= op "and") (* abit bbit))
+               ((= op "or") (if (or (= abit 1) (= bbit 1)) 1 0))
+               ((= op "xor") (if (= abit bbit) 0 1))
+               (else 0))))
+          (js-bitwise-loop
+            op au bu (+ i 1) (+ acc (* rbit bit)) (* bit 2)))))))
+
+(define
+  js-bitwise-binop
+  (fn
+    (op a b)
+    (js-uint32-to-int32
+      (js-bitwise-loop op (js-to-uint32 a) (js-to-uint32 b) 0 0 1))))
+
+(define js-bitand (fn (a b) (js-bitwise-binop "and" a b)))
+
+(define js-bitor (fn (a b) (js-bitwise-binop "or" a b)))
+
+(define js-bitxor (fn (a b) (js-bitwise-binop "xor" a b)))
+
+(define
+  js-shl
+  (fn
+    (a b)
+    (let
+      ((au (js-to-uint32 a))
+        (sh (modulo (js-math-trunc (js-to-number b)) 32)))
+      (js-uint32-to-int32 (modulo (* au (js-math-pow 2 sh)) 4294967296)))))
+
+(define
+  js-shr
+  (fn
+    (a b)
+    (let
+      ((ai (js-to-int32 a))
+        (sh (modulo (js-math-trunc (js-to-number b)) 32)))
+      (if (= sh 0) ai (floor (/ ai (js-math-pow 2 sh)))))))
+
 (define js-pow (fn (a b) (pow (js-to-number a) (js-to-number b))))
 
 (define js-neg (fn (a) (* -1 (exact->inexact (js-to-number a)))))

lib/js/transpile.sx

@@ -303,6 +303,16 @@
           (js-sym "js-unsigned-rshift")
           (js-transpile l)
           (js-transpile r)))
+      ((= op "<<")
+        (list (js-sym "js-shl") (js-transpile l) (js-transpile r)))
+      ((= op ">>")
+        (list (js-sym "js-shr") (js-transpile l) (js-transpile r)))
+      ((= op "&")
+        (list (js-sym "js-bitand") (js-transpile l) (js-transpile r)))
+      ((= op "|")
+        (list (js-sym "js-bitor") (js-transpile l) (js-transpile r)))
+      ((= op "^")
+        (list (js-sym "js-bitxor") (js-transpile l) (js-transpile r)))
       (else (error (str "js-transpile-binop: unsupported op: " op))))))
 
 ;; ── Object literal ────────────────────────────────────────────────
@@ -674,6 +684,12 @@
             (list (js-sym "js-undefined?") lhs-expr))
           rhs-expr
           lhs-expr))
+      ((= op "<<=") (list (js-sym "js-shl") lhs-expr rhs-expr))
+      ((= op ">>=") (list (js-sym "js-shr") lhs-expr rhs-expr))
+      ((= op ">>>=") (list (js-sym "js-unsigned-rshift") lhs-expr rhs-expr))
+      ((= op "&=") (list (js-sym "js-bitand") lhs-expr rhs-expr))
+      ((= op "|=") (list (js-sym "js-bitor") lhs-expr rhs-expr))
+      ((= op "^=") (list (js-sym "js-bitxor") lhs-expr rhs-expr))
       (else (error (str "js-compound-update: unsupported op: " op))))))
 
 (define