From 182e6f63ef4ec8914446e2c589d4797c0087b1e6 Mon Sep 17 00:00:00 2001 From: giles Date: Fri, 1 May 2026 23:18:04 +0000 Subject: [PATCH] phase 22 ruby: Hash/Set/Regexp/StringIO/Bytevectors/Fiber in lib/ruby/runtime.sx (61 forms), 76/76 tests --- lib/ruby/runtime.sx | 352 ++++++++++++++++++++++++++++++++++++++ lib/ruby/test.sh | 62 +++++++ lib/ruby/tests/runtime.sx | 207 ++++++++++++++++++++++ 3 files changed, 621 insertions(+) create mode 100644 lib/ruby/runtime.sx create mode 100755 lib/ruby/test.sh create mode 100644 lib/ruby/tests/runtime.sx diff --git a/lib/ruby/runtime.sx b/lib/ruby/runtime.sx new file mode 100644 index 00000000..b74c2c99 --- /dev/null +++ b/lib/ruby/runtime.sx @@ -0,0 +1,352 @@ +;; lib/ruby/runtime.sx — Ruby primitives on SX +;; +;; Provides Ruby-idiomatic wrappers over SX built-ins. +;; Primitives used: +;; call/cc (core evaluator) +;; make-set/set-add!/set-member?/set-remove!/set->list (Phase 18) +;; make-regexp/regexp-match/regexp-match-all/... (Phase 19) +;; make-bytevector/bytevector-u8-ref/... (Phase 20) + +;; --------------------------------------------------------------------------- +;; 0. Internal list helpers +;; --------------------------------------------------------------------------- + +(define + (rb-list-set-nth lst i newval) + (letrec + ((go (fn (ps j) (if (= (len ps) 0) (list) (cons (if (= j i) newval (first ps)) (go (rest ps) (+ j 1))))))) + (go lst 0))) + +(define + (rb-list-remove-nth lst i) + (letrec + ((go (fn (ps j) (if (= (len ps) 0) (list) (if (= j i) (go (rest ps) (+ j 1)) (cons (first ps) (go (rest ps) (+ j 1)))))))) + (go lst 0))) + +;; --------------------------------------------------------------------------- +;; 1. Hash (mutable, any-key, dict-backed list-of-pairs) +;; --------------------------------------------------------------------------- + +(define + (rb-hash-new) + (let + ((h (dict))) + (dict-set! h "_rb_hash" true) + (dict-set! h "_pairs" (list)) + (dict-set! h "_size" 0) + h)) + +(define (rb-hash? v) (and (dict? v) (dict-has? v "_rb_hash"))) + +(define (rb-hash-size h) (get h "_size")) + +(define + (rb-hash-find-idx pairs k) + (letrec + ((go (fn (ps i) (cond ((= (len ps) 0) -1) ((= (first (first ps)) k) i) (else (go (rest ps) (+ i 1))))))) + (go pairs 0))) + +(define + (rb-hash-at h k) + (letrec + ((go (fn (ps) (if (= (len ps) 0) nil (if (= (first (first ps)) k) (nth (first ps) 1) (go (rest ps))))))) + (go (get h "_pairs")))) + +(define + (rb-hash-at-or h k default) + (if (rb-hash-has-key? h k) (rb-hash-at h k) default)) + +(define + (rb-hash-at-put! h k v) + (let + ((pairs (get h "_pairs")) (idx (rb-hash-find-idx (get h "_pairs") k))) + (if + (= idx -1) + (begin + (dict-set! h "_pairs" (append pairs (list (list k v)))) + (dict-set! h "_size" (+ (get h "_size") 1))) + (dict-set! h "_pairs" (rb-list-set-nth pairs idx (list k v))))) + h) + +(define + (rb-hash-has-key? h k) + (not (= (rb-hash-find-idx (get h "_pairs") k) -1))) + +(define + (rb-hash-delete! h k) + (let + ((idx (rb-hash-find-idx (get h "_pairs") k))) + (when + (not (= idx -1)) + (dict-set! h "_pairs" (rb-list-remove-nth (get h "_pairs") idx)) + (dict-set! h "_size" (- (get h "_size") 1)))) + h) + +(define (rb-hash-keys h) (map first (get h "_pairs"))) + +(define + (rb-hash-values h) + (map (fn (p) (nth p 1)) (get h "_pairs"))) + +(define + (rb-hash-each h callback) + (for-each + (fn (p) (callback (first p) (nth p 1))) + (get h "_pairs"))) + +(define (rb-hash->list h) (get h "_pairs")) + +(define + (rb-list->hash pairs) + (let + ((h (rb-hash-new))) + (for-each + (fn (p) (rb-hash-at-put! h (first p) (nth p 1))) + pairs) + h)) + +(define + (rb-hash-merge h1 h2) + (let + ((result (rb-hash-new))) + (for-each + (fn (p) (rb-hash-at-put! result (first p) (nth p 1))) + (get h1 "_pairs")) + (for-each + (fn (p) (rb-hash-at-put! result (first p) (nth p 1))) + (get h2 "_pairs")) + result)) + +;; --------------------------------------------------------------------------- +;; 2. Set (uniqueness collection backed by SX make-set) +;; Note: set-member?/set-add!/set-remove! take (set item) order. +;; --------------------------------------------------------------------------- + +(define + (rb-set-new) + (let + ((s (dict))) + (dict-set! s "_rb_set" true) + (dict-set! s "_set" (make-set)) + (dict-set! s "_size" 0) + s)) + +(define (rb-set? v) (and (dict? v) (dict-has? v "_rb_set"))) + +(define (rb-set-size s) (get s "_size")) + +(define + (rb-set-add! s v) + (let + ((sx (get s "_set"))) + (when + (not (set-member? sx v)) + (set-add! sx v) + (dict-set! s "_size" (+ (get s "_size") 1)))) + s) + +(define (rb-set-include? s v) (set-member? (get s "_set") v)) + +(define + (rb-set-delete! s v) + (let + ((sx (get s "_set"))) + (when + (set-member? sx v) + (set-remove! sx v) + (dict-set! s "_size" (- (get s "_size") 1)))) + s) + +(define (rb-set->list s) (set->list (get s "_set"))) + +(define + (rb-set-each s callback) + (for-each callback (set->list (get s "_set")))) + +(define + (rb-set-union s1 s2) + (let + ((result (rb-set-new))) + (for-each (fn (v) (rb-set-add! result v)) (rb-set->list s1)) + (for-each (fn (v) (rb-set-add! result v)) (rb-set->list s2)) + result)) + +(define + (rb-set-intersection s1 s2) + (let + ((result (rb-set-new))) + (for-each + (fn (v) (when (rb-set-include? s2 v) (rb-set-add! result v))) + (rb-set->list s1)) + result)) + +(define + (rb-set-difference s1 s2) + (let + ((result (rb-set-new))) + (for-each + (fn (v) (when (not (rb-set-include? s2 v)) (rb-set-add! result v))) + (rb-set->list s1)) + result)) + +;; --------------------------------------------------------------------------- +;; 3. Regexp (thin wrappers over Phase-19 make-regexp primitives) +;; --------------------------------------------------------------------------- + +(define + (rb-regexp-new pattern flags) + (make-regexp pattern (if (= flags nil) "" flags))) + +(define (rb-regexp? v) (regexp? v)) + +(define (rb-regexp-match rx str) (regexp-match rx str)) + +(define (rb-regexp-match-all rx str) (regexp-match-all rx str)) + +(define (rb-regexp-match? rx str) (not (= (regexp-match rx str) nil))) + +(define + (rb-regexp-replace rx str replacement) + (regexp-replace rx str replacement)) + +(define + (rb-regexp-replace-all rx str replacement) + (regexp-replace-all rx str replacement)) + +(define (rb-regexp-split rx str) (regexp-split rx str)) + +;; --------------------------------------------------------------------------- +;; 4. StringIO (write buffer + char-by-char read after rewind) +;; --------------------------------------------------------------------------- + +(define + (rb-string-io-new) + (let + ((io (dict))) + (dict-set! io "_rb_string_io" true) + (dict-set! io "_buf" "") + (dict-set! io "_chars" (list)) + (dict-set! io "_pos" 0) + io)) + +(define (rb-string-io? v) (and (dict? v) (dict-has? v "_rb_string_io"))) + +(define + (rb-string-io-write! io s) + (dict-set! io "_buf" (str (get io "_buf") s)) + io) + +(define (rb-string-io-string io) (get io "_buf")) + +(define + (rb-string-io-rewind! io) + (dict-set! io "_chars" (string->list (get io "_buf"))) + (dict-set! io "_pos" 0) + io) + +(define + (rb-string-io-eof? io) + (>= (get io "_pos") (len (get io "_chars")))) + +(define + (rb-string-io-read-char io) + (if + (rb-string-io-eof? io) + nil + (let + ((c (nth (get io "_chars") (get io "_pos")))) + (dict-set! io "_pos" (+ (get io "_pos") 1)) + c))) + +(define + (rb-string-io-read io) + (letrec + ((go (fn (acc) (let ((c (rb-string-io-read-char io))) (if (= c nil) (list->string (reverse acc)) (go (cons c acc))))))) + (go (list)))) + +;; --------------------------------------------------------------------------- +;; 5. Bytevectors (thin wrappers over Phase-20 bytevector primitives) +;; --------------------------------------------------------------------------- + +(define + (rb-bytes-new n fill) + (make-bytevector n (if (= fill nil) 0 fill))) + +(define (rb-bytes? v) (bytevector? v)) + +(define (rb-bytes-length v) (bytevector-length v)) + +(define (rb-bytes-get v i) (bytevector-u8-ref v i)) + +(define (rb-bytes-set! v i b) (bytevector-u8-set! v i b) v) + +(define (rb-bytes-copy v) (bytevector-copy v)) + +(define (rb-bytes-append v1 v2) (bytevector-append v1 v2)) + +(define (rb-bytes-to-string v) (utf8->string v)) + +(define (rb-bytes-from-string s) (string->utf8 s)) + +(define (rb-bytes->list v) (bytevector->list v)) + +(define (rb-list->bytes lst) (list->bytevector lst)) + +;; --------------------------------------------------------------------------- +;; 6. Fiber (call/cc coroutines) +;; Body wrapped so completion always routes through _resumer, ensuring +;; rb-fiber-resume always returns via the captured continuation. +;; --------------------------------------------------------------------------- + +(define rb-current-fiber nil) + +(define + (rb-fiber-new body) + (let + ((f (dict))) + (dict-set! f "_rb_fiber" true) + (dict-set! f "_state" "new") + (dict-set! f "_cont" nil) + (dict-set! f "_resumer" nil) + (dict-set! f "_parent" nil) + (dict-set! + f + "_body" + (fn + () + (let + ((result (body))) + (dict-set! f "_state" "dead") + (set! rb-current-fiber (get f "_parent")) + ((get f "_resumer") result)))) + f)) + +(define (rb-fiber? v) (and (dict? v) (dict-has? v "_rb_fiber"))) + +(define (rb-fiber-alive? f) (not (= (get f "_state") "dead"))) + +(define + (rb-fiber-yield val) + (call/cc + (fn + (resume-k) + (let + ((cur rb-current-fiber)) + (dict-set! cur "_cont" resume-k) + (dict-set! cur "_state" "suspended") + (set! rb-current-fiber (get cur "_parent")) + ((get cur "_resumer") val))))) + +(define + (rb-fiber-resume f) + (call/cc + (fn + (return-k) + (dict-set! f "_parent" rb-current-fiber) + (dict-set! f "_resumer" return-k) + (set! rb-current-fiber f) + (dict-set! f "_state" "running") + (if + (= (get f "_cont") nil) + ((get f "_body")) + ((get f "_cont") nil))))) diff --git a/lib/ruby/test.sh b/lib/ruby/test.sh new file mode 100755 index 00000000..654221ce --- /dev/null +++ b/lib/ruby/test.sh @@ -0,0 +1,62 @@ +#!/usr/bin/env bash +# lib/ruby/test.sh — smoke-test the Ruby runtime layer. + +set -uo pipefail +cd "$(git rev-parse --show-toplevel)" + +SX_SERVER="${SX_SERVER:-hosts/ocaml/_build/default/bin/sx_server.exe}" +if [ ! -x "$SX_SERVER" ]; then + SX_SERVER="/root/rose-ash/hosts/ocaml/_build/default/bin/sx_server.exe" +fi +if [ ! -x "$SX_SERVER" ]; then + echo "ERROR: sx_server.exe not found." + exit 1 +fi + +TMPFILE=$(mktemp); trap "rm -f $TMPFILE" EXIT + +cat > "$TMPFILE" << 'EPOCHS' +(epoch 1) +(load "lib/ruby/runtime.sx") +(epoch 2) +(load "lib/ruby/tests/runtime.sx") +(epoch 3) +(eval "(list rb-test-pass rb-test-fail)") +EPOCHS + +OUTPUT=$(timeout 60 "$SX_SERVER" < "$TMPFILE" 2>/dev/null) + +LINE=$(echo "$OUTPUT" | awk '/^\(ok-len 3 / {getline; print; exit}') +if [ -z "$LINE" ]; then + LINE=$(echo "$OUTPUT" | grep -E '^\(ok 3 \([0-9]+ [0-9]+\)\)' | tail -1 \ + | sed -E 's/^\(ok 3 //; s/\)$//') +fi +if [ -z "$LINE" ]; then + echo "ERROR: could not extract summary" + echo "$OUTPUT" | tail -20 + exit 1 +fi + +P=$(echo "$LINE" | sed -E 's/^\(([0-9]+) ([0-9]+)\).*/\1/') +F=$(echo "$LINE" | sed -E 's/^\(([0-9]+) ([0-9]+)\).*/\2/') +TOTAL=$((P + F)) + +if [ "$F" -eq 0 ]; then + echo "ok $P/$TOTAL lib/ruby tests passed" +else + echo "FAIL $P/$TOTAL passed, $F failed" + TMPFILE2=$(mktemp) + cat > "$TMPFILE2" << 'EPOCHS2' +(epoch 1) +(load "lib/ruby/runtime.sx") +(epoch 2) +(load "lib/ruby/tests/runtime.sx") +(epoch 3) +(eval "(map (fn (f) (get f \"name\")) rb-test-fails)") +EPOCHS2 + FAILS=$(timeout 60 "$SX_SERVER" < "$TMPFILE2" 2>/dev/null | grep -E '^\(ok 3 ' || true) + echo " Failed: $FAILS" + rm -f "$TMPFILE2" +fi + +[ "$F" -eq 0 ] diff --git a/lib/ruby/tests/runtime.sx b/lib/ruby/tests/runtime.sx new file mode 100644 index 00000000..d6906f55 --- /dev/null +++ b/lib/ruby/tests/runtime.sx @@ -0,0 +1,207 @@ +;; lib/ruby/tests/runtime.sx — Tests for lib/ruby/runtime.sx + +(define rb-test-pass 0) +(define rb-test-fail 0) +(define rb-test-fails (list)) + +(define + (rb-test name got expected) + (if + (= got expected) + (set! rb-test-pass (+ rb-test-pass 1)) + (begin + (set! rb-test-fail (+ rb-test-fail 1)) + (set! rb-test-fails (append rb-test-fails (list {:got got :expected expected :name name})))))) + +;; --------------------------------------------------------------------------- +;; 1. Hash +;; --------------------------------------------------------------------------- + +(define h1 (rb-hash-new)) +(rb-test "hash? new" (rb-hash? h1) true) +(rb-test "hash? non-hash" (rb-hash? 42) false) +(rb-test "hash size empty" (rb-hash-size h1) 0) +(rb-hash-at-put! h1 "a" 1) +(rb-hash-at-put! h1 "b" 2) +(rb-hash-at-put! h1 "c" 3) +(rb-test "hash at a" (rb-hash-at h1 "a") 1) +(rb-test "hash at b" (rb-hash-at h1 "b") 2) +(rb-test "hash at missing" (rb-hash-at h1 "z") nil) +(rb-test "hash at-or default" (rb-hash-at-or h1 "z" 99) 99) +(rb-test "hash has-key yes" (rb-hash-has-key? h1 "a") true) +(rb-test "hash has-key no" (rb-hash-has-key? h1 "z") false) +(rb-test "hash size after inserts" (rb-hash-size h1) 3) +(rb-hash-at-put! h1 "a" 10) +(rb-test "hash at-put update" (rb-hash-at h1 "a") 10) +(rb-test "hash size unchanged after update" (rb-hash-size h1) 3) +(rb-hash-delete! h1 "b") +(rb-test "hash delete" (rb-hash-has-key? h1 "b") false) +(rb-test "hash size after delete" (rb-hash-size h1) 2) +(rb-test "hash keys" (rb-hash-keys h1) (list "a" "c")) +(rb-test "hash values" (rb-hash-values h1) (list 10 3)) + +(define + h2 + (rb-list->hash (list (list "x" 7) (list "y" 8)))) +(rb-test "list->hash x" (rb-hash-at h2 "x") 7) +(rb-test "list->hash y" (rb-hash-at h2 "y") 8) + +(define h3 (rb-hash-merge h1 h2)) +(rb-test "hash-merge a" (rb-hash-at h3 "a") 10) +(rb-test "hash-merge x" (rb-hash-at h3 "x") 7) +(rb-test "hash-merge size" (rb-hash-size h3) 4) + +;; --------------------------------------------------------------------------- +;; 2. Set +;; --------------------------------------------------------------------------- + +(define s1 (rb-set-new)) +(rb-test "set? new" (rb-set? s1) true) +(rb-test "set? non-set" (rb-set? "hello") false) +(rb-test "set size empty" (rb-set-size s1) 0) +(rb-set-add! s1 1) +(rb-set-add! s1 2) +(rb-set-add! s1 3) +(rb-set-add! s1 2) +(rb-test "set include yes" (rb-set-include? s1 1) true) +(rb-test "set include no" (rb-set-include? s1 9) false) +(rb-test "set size dedup" (rb-set-size s1) 3) +(rb-set-delete! s1 2) +(rb-test "set delete" (rb-set-include? s1 2) false) +(rb-test "set size after delete" (rb-set-size s1) 2) + +(define s2 (rb-set-new)) +(rb-set-add! s2 2) +(rb-set-add! s2 3) +(rb-set-add! s2 4) + +(define su (rb-set-union s1 s2)) +(rb-test "set union includes 1" (rb-set-include? su 1) true) +(rb-test "set union includes 4" (rb-set-include? su 4) true) +(rb-test "set union size" (rb-set-size su) 4) + +(define si (rb-set-intersection s1 s2)) +(rb-test "set intersection includes 3" (rb-set-include? si 3) true) +(rb-test "set intersection excludes 1" (rb-set-include? si 1) false) +(rb-test "set intersection size" (rb-set-size si) 1) + +(define sd (rb-set-difference s1 s2)) +(rb-test "set difference includes 1" (rb-set-include? sd 1) true) +(rb-test "set difference excludes 3" (rb-set-include? sd 3) false) + +;; --------------------------------------------------------------------------- +;; 3. Regexp +;; --------------------------------------------------------------------------- + +(define rx1 (rb-regexp-new "hel+" "")) +(rb-test "regexp?" (rb-regexp? rx1) true) +(rb-test "regexp match? yes" (rb-regexp-match? rx1 "say hello") true) +(rb-test "regexp match? no" (rb-regexp-match? rx1 "goodbye") false) + +(define m1 (rb-regexp-match rx1 "say hello world")) +(rb-test "regexp match :match" (get m1 "match") "hell") + +(define rx2 (rb-regexp-new "[0-9]+" "")) +(define all (rb-regexp-match-all rx2 "a1b22c333")) +(rb-test "regexp match-all count" (len all) 3) +(rb-test "regexp match-all first" (get (first all) "match") "1") + +(rb-test "regexp replace" (rb-regexp-replace rx2 "a1b2" "N") "aNb2") +(rb-test "regexp replace-all" (rb-regexp-replace-all rx2 "a1b2" "N") "aNbN") +(rb-test + "regexp split" + (rb-regexp-split (rb-regexp-new "," "") "a,b,c") + (list "a" "b" "c")) + +;; --------------------------------------------------------------------------- +;; 4. StringIO +;; --------------------------------------------------------------------------- + +(define sio1 (rb-string-io-new)) +(rb-test "string-io?" (rb-string-io? sio1) true) +(rb-string-io-write! sio1 "hello") +(rb-string-io-write! sio1 " world") +(rb-test "string-io string" (rb-string-io-string sio1) "hello world") +(rb-string-io-rewind! sio1) +(rb-test "string-io eof? no" (rb-string-io-eof? sio1) false) +(define ch1 (rb-string-io-read-char sio1)) +(define ch2 (rb-string-io-read-char sio1)) +;; Compare char codepoints since = uses reference equality for chars +(rb-test "string-io read-char h" (char->integer ch1) 104) +(rb-test "string-io read-char e" (char->integer ch2) 101) +(rb-test "string-io read rest" (rb-string-io-read sio1) "llo world") +(rb-test "string-io eof? yes" (rb-string-io-eof? sio1) true) +(rb-test "string-io read at eof" (rb-string-io-read sio1) "") + +;; --------------------------------------------------------------------------- +;; 5. Bytevectors +;; --------------------------------------------------------------------------- + +(define bv1 (rb-bytes-new 4 0)) +(rb-test "bytes?" (rb-bytes? bv1) true) +(rb-test "bytes length" (rb-bytes-length bv1) 4) +(rb-test "bytes get zero" (rb-bytes-get bv1 0) 0) +(rb-bytes-set! bv1 0 65) +(rb-bytes-set! bv1 1 66) +(rb-test "bytes get A" (rb-bytes-get bv1 0) 65) +(rb-test "bytes get B" (rb-bytes-get bv1 1) 66) +(define bv2 (rb-bytes-from-string "hi")) +(rb-test "bytes from-string length" (rb-bytes-length bv2) 2) +(rb-test "bytes to-string" (rb-bytes-to-string bv2) "hi") +(define + bv3 + (rb-bytes-append (rb-bytes-from-string "foo") (rb-bytes-from-string "bar"))) +(rb-test "bytes append" (rb-bytes-to-string bv3) "foobar") +(rb-test + "bytes->list" + (rb-bytes->list (rb-bytes-from-string "AB")) + (list 65 66)) +(rb-test + "list->bytes" + (rb-bytes-to-string (rb-list->bytes (list 72 105))) + "Hi") + +;; --------------------------------------------------------------------------- +;; 6. Fiber +;; Note: rb-fiber-yield from inside a letrec (JIT-compiled) doesn't +;; properly escape via call/cc continuations. Use top-level helper fns +;; or explicit sequential yields instead of letrec-bound recursion. +;; --------------------------------------------------------------------------- + +(define + fib1 + (rb-fiber-new + (fn + () + (rb-fiber-yield 10) + (rb-fiber-yield 20) + 30))) + +(rb-test "fiber?" (rb-fiber? fib1) true) +(rb-test "fiber alive? before" (rb-fiber-alive? fib1) true) +(define fr1 (rb-fiber-resume fib1)) +(rb-test "fiber resume 1" fr1 10) +(rb-test "fiber alive? mid" (rb-fiber-alive? fib1) true) +(define fr2 (rb-fiber-resume fib1)) +(rb-test "fiber resume 2" fr2 20) +(define fr3 (rb-fiber-resume fib1)) +(rb-test "fiber resume 3 (completion)" fr3 30) +(rb-test "fiber alive? dead" (rb-fiber-alive? fib1) false) + +;; Loop via a top-level helper (avoid letrec — see note above) +(define + (rb-fiber-loop-helper i) + (when + (<= i 3) + (rb-fiber-yield i) + (rb-fiber-loop-helper (+ i 1)))) + +(define + fib2 + (rb-fiber-new (fn () (rb-fiber-loop-helper 1) "done"))) + +(rb-test "fiber loop resume 1" (rb-fiber-resume fib2) 1) +(rb-test "fiber loop resume 2" (rb-fiber-resume fib2) 2) +(rb-test "fiber loop resume 3" (rb-fiber-resume fib2) 3) +(rb-test "fiber loop resume done" (rb-fiber-resume fib2) "done") +(rb-test "fiber loop dead" (rb-fiber-alive? fib2) false)