;; 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)))))