rose-ash/lib/ruby/runtime.sx

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