ocaml: phase 4 bitwise ops land/lor/lxor/lsl/lsr/asr + bits.ml baseline (+5 tests, 607 total)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 24s

The binop precedence table already had land/lor/lxor/lsl/lsr/asr
(iter 0 setup) but eval-op fell through to 'unknown operator' for
all of them. SX doesn't expose host bitwise primitives, so each is
implemented in eval.sx via arithmetic on the host:

  land/lor/lxor:  mask & shift loop, accumulating 1<<k digits
  lsl k:          repeated * 2 k times
  lsr k:          repeated floor (/ 2) k times
  asr:            aliased to lsr (no sign extension at our bit width)

bits.ml baseline: popcount via 'while m > 0 do if m land 1 = 1 then
... ; m := m lsr 1 done'. Sum of popcount(1023, 5, 1024, 0xff) = 10
+ 2 + 1 + 8 = 21.

  5 land 3 = 1
  5 lor 3 = 7
  5 lxor 3 = 6
  1 lsl 8 = 256
  256 lsr 4 = 16

41 baseline programs total.
This commit is contained in:
2026-05-09 09:15:00 +00:00
parent 70b9b4f6cf
commit aaaf054441
5 changed files with 113 additions and 0 deletions

View File

@@ -0,0 +1,12 @@
let popcount n =
let count = ref 0 in
let m = ref n in
while !m > 0 do
if !m land 1 = 1 then count := !count + 1;
m := !m lsr 1
done;
!count
;;
popcount 1023 + popcount 5 + popcount 1024 + popcount 0xff

View File

@@ -2,6 +2,7 @@
"ackermann.ml": 125,
"anagrams.ml": 3,
"bag.ml": 3,
"bits.ml": 21,
"balance.ml": 3,
"bfs.ml": 6,
"btree.ml": 39,

View File

@@ -513,6 +513,79 @@
((= op ">=") (>= lhs rhs))
((= op "&&") (and lhs rhs))
((= op "||") (or lhs rhs))
;; Bitwise ops — implemented via arithmetic since SX doesn't
;; expose host bitwise primitives.
((= op "land")
(let ((r 0) (f 1) (a lhs) (b rhs))
(begin
(define loop
(fn ()
(when (and (> a 0) (> b 0))
(begin
(when (and (= (mod a 2) 1) (= (mod b 2) 1))
(set! r (+ r f)))
(set! a (floor (/ a 2)))
(set! b (floor (/ b 2)))
(set! f (* f 2))
(loop)))))
(loop)
r)))
((= op "lor")
(let ((r 0) (f 1) (a lhs) (b rhs))
(begin
(define loop
(fn ()
(when (or (> a 0) (> b 0))
(begin
(when (or (= (mod a 2) 1) (= (mod b 2) 1))
(set! r (+ r f)))
(set! a (floor (/ a 2)))
(set! b (floor (/ b 2)))
(set! f (* f 2))
(loop)))))
(loop)
r)))
((= op "lxor")
(let ((r 0) (f 1) (a lhs) (b rhs))
(begin
(define loop
(fn ()
(when (or (> a 0) (> b 0))
(begin
(when (not (= (mod a 2) (mod b 2)))
(set! r (+ r f)))
(set! a (floor (/ a 2)))
(set! b (floor (/ b 2)))
(set! f (* f 2))
(loop)))))
(loop)
r)))
((= op "lsl")
(let ((r lhs) (k rhs))
(begin
(define loop
(fn ()
(when (> k 0) (begin (set! r (* r 2)) (set! k (- k 1)) (loop)))))
(loop)
r)))
((= op "lsr")
(let ((r lhs) (k rhs))
(begin
(define loop
(fn ()
(when (> k 0)
(begin (set! r (floor (/ r 2))) (set! k (- k 1)) (loop)))))
(loop)
r)))
((= op "asr")
(let ((r lhs) (k rhs))
(begin
(define loop
(fn ()
(when (> k 0)
(begin (set! r (floor (/ r 2))) (set! k (- k 1)) (loop)))))
(loop)
r)))
((= op "or") (or lhs rhs))
((= op "|>") (rhs lhs))
(else (error (str "ocaml-eval: unknown operator " op))))))

View File

@@ -1504,6 +1504,18 @@ cat > "$TMPFILE" << 'EPOCHS'
(epoch 5253)
(eval "(ocaml-run \"let t = Hashtbl.create 4 in Hashtbl.add t \\\"a\\\" 1; let t2 = Hashtbl.copy t in Hashtbl.add t2 \\\"b\\\" 2; Hashtbl.length t + Hashtbl.length t2\")")
;; ── Bitwise ops land/lor/lxor/lsl/lsr ────────────────────────
(epoch 5260)
(eval "(ocaml-run \"5 land 3\")")
(epoch 5261)
(eval "(ocaml-run \"5 lor 3\")")
(epoch 5262)
(eval "(ocaml-run \"5 lxor 3\")")
(epoch 5263)
(eval "(ocaml-run \"1 lsl 8\")")
(epoch 5264)
(eval "(ocaml-run \"256 lsr 4\")")
EPOCHS
OUTPUT=$(timeout 360 "$SX_SERVER" < "$TMPFILE" 2>/dev/null)
@@ -2392,6 +2404,13 @@ check 5251 "Either.fold Left 7+100" '107'
check 5252 "Either.fold Right 7*10" '70'
check 5253 "Hashtbl.copy independent" '3'
# ── Bitwise ops land/lor/lxor/lsl/lsr ───────────────────────────
check 5260 "5 land 3 = 1" '1'
check 5261 "5 lor 3 = 7" '7'
check 5262 "5 lxor 3 = 6" '6'
check 5263 "1 lsl 8 = 256" '256'
check 5264 "256 lsr 4 = 16" '16'
TOTAL=$((PASS + FAIL))
if [ $FAIL -eq 0 ]; then
echo "ok $PASS/$TOTAL OCaml-on-SX tests passed"

View File

@@ -407,6 +407,14 @@ _Newest first._
binary search tree (`type 'a tree = Leaf | Node of 'a * 'a tree *
'a tree`) with insert + in-order traversal. Tests parametric ADT,
recursive match, List.append, List.fold_left.
- 2026-05-09 Phase 4 — bitwise ops `land`/`lor`/`lxor`/`lsl`/`lsr`/
`asr` + bits.ml baseline (popcount-sum = 21) (+5 tests, 607 total).
The binop precedence table already had these but eval-op fell
through to "unknown operator". Implemented in eval.sx via
arithmetic on the host (mod / floor / div) since SX doesn't expose
bitwise primitives. asr aliased to lsr (no sign extension at our
bit width). bits.ml exercises `m land 1` + `m lsr 1` inside a while
loop. 41 baseline programs total.
- 2026-05-09 Phase 5.1 — ackermann.ml baseline (Ackermann function,
ack(3, 4) = 125). Three-arm recursion: m=0 base, n=0 reduces m,
else doubly-nested recursion `ack (m-1) (ack m (n-1))`. ack(3, 4)