phase 22 ruby: Hash/Set/Regexp/StringIO/Bytevectors/Fiber in lib/ruby/runtime.sx (61 forms), 76/76 tests
This commit is contained in:
352
lib/ruby/runtime.sx
Normal file
352
lib/ruby/runtime.sx
Normal file
@@ -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)))))
|
||||
62
lib/ruby/test.sh
Executable file
62
lib/ruby/test.sh
Executable file
@@ -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 ]
|
||||
207
lib/ruby/tests/runtime.sx
Normal file
207
lib/ruby/tests/runtime.sx
Normal file
@@ -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)
|
||||
Reference in New Issue
Block a user