;; lib/smalltalk/runtime.sx — Smalltalk primitives on SX
;;
;; Provides Smalltalk-idiomatic wrappers over SX built-ins.
;; Primitives used:
;;   make-set/set-add!/set-member?/set-remove!/set->list  (Phase 18)
;;   char->integer/integer->char/list->string             (Phase 5)
;;   bitwise-and/or/xor/not/arithmetic-shift              (Phase 7)
;;   gcd/lcm/quotient/remainder/modulo                    (Phase 15)

;; ---------------------------------------------------------------------------
;; 0. Internal list helpers (used by Array and Dictionary)
;; ---------------------------------------------------------------------------

(define
  (st-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
  (st-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. Numeric helpers
;;    Thin wrappers or direct aliases for Smalltalk Number protocol.
;; ---------------------------------------------------------------------------

(define (st-abs x) (abs x))
(define (st-max a b) (if (> a b) a b))
(define (st-min a b) (if (< a b) a b))
(define (st-gcd a b) (gcd a b))
(define (st-lcm a b) (lcm a b))
(define (st-quo a b) (quotient a b))
(define (st-rem a b) (remainder a b))
(define (st-mod a b) (modulo a b))
(define (st-even? n) (= (remainder n 2) 0))
(define (st-odd? n) (not (st-even? n)))
(define (st-sqrt x) (sqrt x))
(define (st-floor x) (floor x))
(define (st-ceiling x) (ceil x))
(define (st-truncated x) (truncate x))
(define (st-rounded x) (round x))

;; ---------------------------------------------------------------------------
;; 2. Character
;;    Smalltalk $A = char 65. Operations mirror Character class.
;; ---------------------------------------------------------------------------

(define (st-char-value c) (char->integer c))
(define (st-char-from-int n) (integer->char n))
(define (st-char? v) (= (type-of v) "char"))

(define
  (st-char-is-letter? c)
  (let
    ((n (char->integer c)))
    (or
      (and (>= n 65) (<= n 90))
      (and (>= n 97) (<= n 122)))))

(define
  (st-char-is-digit? c)
  (let ((n (char->integer c))) (and (>= n 48) (<= n 57))))

(define
  (st-char-is-uppercase? c)
  (let ((n (char->integer c))) (and (>= n 65) (<= n 90))))

(define
  (st-char-is-lowercase? c)
  (let ((n (char->integer c))) (and (>= n 97) (<= n 122))))

(define
  (st-char-is-separator? c)
  (let
    ((n (char->integer c)))
    (or
      (= n 32)
      (= n 9)
      (= n 10)
      (= n 13))))

(define
  (st-char-as-uppercase c)
  (let
    ((n (char->integer c)))
    (if
      (and (>= n 97) (<= n 122))
      (integer->char (- n 32))
      c)))

(define
  (st-char-as-lowercase c)
  (let
    ((n (char->integer c)))
    (if
      (and (>= n 65) (<= n 90))
      (integer->char (+ n 32))
      c)))

(define (st-char-digit-value c) (- (char->integer c) 48))

;; ---------------------------------------------------------------------------
;; 3. Array (1-indexed, mutable, fixed-size)
;;    Backed as {:__st_array__ true :size N "1" v1 "2" v2 ...}
;;    Unset elements read as nil.
;; ---------------------------------------------------------------------------

(define
  (st-array-new n)
  (let
    ((a (dict)))
    (dict-set! a "__st_array__" true)
    (dict-set! a "size" n)
    a))

(define (st-array? v) (and (dict? v) (dict-has? v "__st_array__")))

(define (st-array-size a) (get a "size"))

(define
  (st-array-at a i)
  (let ((v (get a (str i)))) (if (= v nil) nil v)))

(define (st-array-at-put! a i v) (dict-set! a (str i) v) a)

(define
  (st-array-do a fn)
  (letrec
    ((go (fn (i) (when (<= i (st-array-size a)) (fn (st-array-at a i)) (go (+ i 1))))))
    (go 1)))

(define
  (st-array->list a)
  (letrec
    ((go (fn (i acc) (if (< i 1) acc (go (- i 1) (cons (st-array-at a i) acc))))))
    (go (st-array-size a) (list))))

(define
  (st-list->array xs)
  (let
    ((a (st-array-new (len xs))))
    (letrec
      ((go (fn (ys i) (when (> (len ys) 0) (st-array-at-put! a i (first ys)) (go (rest ys) (+ i 1))))))
      (go xs 1))
    a))

(define
  (st-array-copy-from-to a start stop)
  (let
    ((result (st-array-new (- stop start -1))))
    (letrec
      ((go (fn (i j) (when (<= i stop) (st-array-at-put! result j (st-array-at a i)) (go (+ i 1) (+ j 1))))))
      (go start 1))
    result))

;; ---------------------------------------------------------------------------
;; 4. Dictionary (hash map with any key via linear scan)
;;    {:__st_dict__ true :size N :_pairs ((key val) ...)}
;; ---------------------------------------------------------------------------

(define
  (st-dict-new)
  (let
    ((d (dict)))
    (dict-set! d "__st_dict__" true)
    (dict-set! d "size" 0)
    (dict-set! d "_pairs" (list))
    d))

(define (st-dict? v) (and (dict? v) (dict-has? v "__st_dict__")))

(define (st-dict-size d) (get d "size"))

(define
  (st-dict-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
  (st-dict-at d k)
  (letrec
    ((go (fn (ps) (if (= (len ps) 0) nil (if (= (first (first ps)) k) (nth (first ps) 1) (go (rest ps)))))))
    (go (get d "_pairs"))))

(define
  (st-dict-at-put! d k v)
  (let
    ((pairs (get d "_pairs")) (idx (st-dict-find-idx (get d "_pairs") k)))
    (if
      (= idx -1)
      (begin
        (dict-set! d "_pairs" (append pairs (list (list k v))))
        (dict-set! d "size" (+ (get d "size") 1)))
      (dict-set! d "_pairs" (st-list-set-nth pairs idx (list k v)))))
  d)

(define
  (st-dict-includes-key? d k)
  (not (= (st-dict-find-idx (get d "_pairs") k) -1)))

(define
  (st-dict-at-default d k def)
  (if (st-dict-includes-key? d k) (st-dict-at d k) def))

(define
  (st-dict-remove-key! d k)
  (let
    ((idx (st-dict-find-idx (get d "_pairs") k)))
    (when
      (not (= idx -1))
      (dict-set! d "_pairs" (st-list-remove-nth (get d "_pairs") idx))
      (dict-set! d "size" (- (get d "size") 1))))
  d)

(define (st-dict-keys d) (map first (get d "_pairs")))
(define
  (st-dict-values d)
  (map (fn (p) (nth p 1)) (get d "_pairs")))

(define
  (st-dict-do d fn)
  (for-each (fn (p) (fn (nth p 1))) (get d "_pairs")))

(define
  (st-dict-do-associations d fn)
  (for-each (fn (p) (fn (first p) (nth p 1))) (get d "_pairs")))

;; ---------------------------------------------------------------------------
;; 5. Set (uniqueness via SX make-set)
;;    Note: set-member?/set-add!/set-remove! take (set item) order.
;; ---------------------------------------------------------------------------

(define
  (st-set-new)
  (let
    ((s (dict)))
    (dict-set! s "__st_set__" true)
    (dict-set! s "size" 0)
    (dict-set! s "_set" (make-set))
    s))

(define (st-set? v) (and (dict? v) (dict-has? v "__st_set__")))

(define (st-set-size s) (get s "size"))

(define
  (st-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 (st-set-includes? s v) (set-member? (get s "_set") v))

(define
  (st-set-remove! 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 (st-set->list s) (set->list (get s "_set")))

(define (st-set-do s fn) (for-each fn (st-set->list s)))

;; ---------------------------------------------------------------------------
;; 6. String / Stream utilities
;; ---------------------------------------------------------------------------

;; Join list of strings with separator
(define
  (st-join-strings strs sep)
  (if
    (= (len strs) 0)
    ""
    (letrec
      ((go (fn (ss acc) (if (= (len ss) 0) acc (go (rest ss) (str acc sep (first ss)))))))
      (go (rest strs) (first strs)))))

;; printString — Smalltalk textual representation
(define
  (st-print-string v)
  (cond
    ((= v nil) "nil")
    ((= v true) "true")
    ((= v false) "false")
    ((= (type-of v) "number") (str v))
    ((= (type-of v) "string") (str "'" v "'"))
    ((= (type-of v) "symbol") (str "#" (str v)))
    ((= (type-of v) "char") (str "$" (list->string (list v))))
    ((= (type-of v) "list")
      (str "(" (st-join-strings (map st-print-string v) " ") ")"))
    ((st-array? v)
      (str
        "(#("
        (st-join-strings (map st-print-string (st-array->list v)) " ")
        "))"))
    (else (str v))))

;; WriteStream — accumulates strings/chars to a buffer
(define
  (st-write-stream-new)
  (let
    ((ws (dict)))
    (dict-set! ws "__st_ws__" true)
    (dict-set! ws "contents" "")
    ws))

(define (st-write-stream? v) (and (dict? v) (dict-has? v "__st_ws__")))

(define
  (st-write-stream-put-string! ws s)
  (dict-set! ws "contents" (str (get ws "contents") s))
  ws)

(define
  (st-write-stream-next-put! ws c)
  (st-write-stream-put-string! ws (list->string (list c))))

(define
  (st-write-stream-print! ws v)
  (st-write-stream-put-string! ws (st-print-string v)))

(define (st-write-stream-contents ws) (get ws "contents"))

;; ReadStream — reads characters from a string one at a time
(define
  (st-read-stream-new s)
  (let
    ((rs (dict)))
    (dict-set! rs "__st_rs__" true)
    (dict-set! rs "_chars" (string->list s))
    (dict-set! rs "pos" 0)
    rs))

(define (st-read-stream? v) (and (dict? v) (dict-has? v "__st_rs__")))

(define
  (st-read-stream-at-end? rs)
  (>= (get rs "pos") (len (get rs "_chars"))))

(define
  (st-read-stream-next rs)
  (if
    (st-read-stream-at-end? rs)
    nil
    (let
      ((c (nth (get rs "_chars") (get rs "pos"))))
      (dict-set! rs "pos" (+ (get rs "pos") 1))
      c)))

(define
  (st-read-stream-peek rs)
  (if
    (st-read-stream-at-end? rs)
    nil
    (nth (get rs "_chars") (get rs "pos"))))

(define (st-read-stream-source rs) (list->string (get rs "_chars")))