;; lib/common-lisp/runtime.sx — CL built-ins using SX spec primitives
;;
;; Provides CL-specific wrappers and helpers. Deliberately thin: wherever
;; an SX spec primitive already does the job, we alias it rather than
;; reinventing it.
;;
;; Primitives used from spec:
;;   char/char->integer/integer->char/char-upcase/char-downcase
;;   format   (Phase 21 — must be loaded before this file)
;;   gensym   (Phase 12)
;;   rational/rational?  (Phase 16)
;;   make-set/set-member?/set-union/etc  (Phase 18)
;;   open-input-string/read-char/etc  (Phase 14)
;;   modulo/remainder/quotient/gcd/lcm/expt  (Phase 2 / Phase 15)
;;   number->string with radix  (Phase 15)

;; ---------------------------------------------------------------------------
;; 1.  Type predicates
;; ---------------------------------------------------------------------------

(define (cl-null? x) (= x nil))
(define (cl-consp? x) (and (list? x) (not (cl-empty? x))))
(define (cl-listp? x) (or (cl-empty? x) (list? x)))
(define (cl-atom? x) (not (cl-consp? x)))

(define
  (cl-numberp? x)
  (let ((t (type-of x))) (or (= t "number") (= t "rational"))))

(define cl-integerp? integer?)
(define cl-floatp? float?)
(define cl-rationalp? rational?)

(define (cl-realp? x) (or (integer? x) (float? x) (rational? x)))

(define cl-characterp? char?)
(define cl-stringp? (fn (x) (= (type-of x) "string")))
(define cl-symbolp? (fn (x) (= (type-of x) "symbol")))
(define cl-keywordp? (fn (x) (= (type-of x) "keyword")))

(define
  (cl-functionp? x)
  (let
    ((t (type-of x)))
    (or
      (= t "function")
      (= t "lambda")
      (= t "native-fn")
      (= t "component"))))

(define cl-vectorp? vector?)
(define cl-arrayp? vector?)

;; sx_server: (rest (list x)) returns () not nil — cl-empty? handles both
(define
  (cl-empty? x)
  (or (nil? x) (and (list? x) (= (len x) 0))))

;; ---------------------------------------------------------------------------
;; 2.  Arithmetic — thin aliases to spec primitives
;; ---------------------------------------------------------------------------

(define cl-mod modulo)
(define cl-rem remainder)
(define cl-gcd gcd)
(define cl-lcm lcm)
(define cl-expt expt)
(define cl-floor floor)
(define cl-ceiling ceil)
(define cl-truncate truncate)
(define cl-round round)
(define cl-abs (fn (x) (if (< x 0) (- 0 x) x)))
(define cl-min (fn (a b) (if (< a b) a b)))
(define cl-max (fn (a b) (if (> a b) a b)))
(define cl-quotient quotient)

(define
  (cl-signum x)
  (cond
    ((> x 0) 1)
    ((< x 0) -1)
    (else 0)))

(define (cl-evenp? n) (= (modulo n 2) 0))
(define (cl-oddp? n) (= (modulo n 2) 1))
(define (cl-zerop? n) (= n 0))
(define (cl-plusp? n) (> n 0))
(define (cl-minusp? n) (< n 0))

;; ---------------------------------------------------------------------------
;; 3.  Character functions — alias spec char primitives + CL name mapping
;; ---------------------------------------------------------------------------

(define cl-char->integer char->integer)
(define cl-integer->char integer->char)
(define cl-char-upcase char-upcase)
(define cl-char-downcase char-downcase)
(define cl-char-code char->integer)
(define cl-code-char integer->char)

(define cl-char=? char=?)
(define cl-char<? char<?)
(define cl-char>? char>?)
(define cl-char<=? char<=?)
(define cl-char>=? char>=?)
(define cl-char-ci=? char-ci=?)
(define cl-char-ci<? char-ci<?)
(define cl-char-ci>? char-ci>?)

;; Inline predicates — char-alphabetic?/char-numeric? unreliable in sx_server
(define
  (cl-alpha-char-p c)
  (let
    ((n (char->integer c)))
    (or
      (and (>= n 65) (<= n 90))
      (and (>= n 97) (<= n 122)))))

(define
  (cl-digit-char-p c)
  (let ((n (char->integer c))) (and (>= n 48) (<= n 57))))

(define
  (cl-alphanumericp c)
  (let
    ((n (char->integer c)))
    (or
      (and (>= n 48) (<= n 57))
      (and (>= n 65) (<= n 90))
      (and (>= n 97) (<= n 122)))))

(define
  (cl-upper-case-p c)
  (let ((n (char->integer c))) (and (>= n 65) (<= n 90))))

(define
  (cl-lower-case-p c)
  (let ((n (char->integer c))) (and (>= n 97) (<= n 122))))

;; Named character constants
(define cl-char-space (integer->char 32))
(define cl-char-newline (integer->char 10))
(define cl-char-tab (integer->char 9))
(define cl-char-backspace (integer->char 8))
(define cl-char-return (integer->char 13))
(define cl-char-null (integer->char 0))
(define cl-char-escape (integer->char 27))
(define cl-char-delete (integer->char 127))

;; ---------------------------------------------------------------------------
;; 4.  String + IO — use spec format and ports
;; ---------------------------------------------------------------------------

;; CL format: (cl-format nil "~a ~a" x y) — nil destination means return string
(define
  (cl-format dest template &rest args)
  (let ((s (apply format (cons template args)))) (if (= dest nil) s s)))

(define cl-write-to-string write-to-string)
(define cl-princ-to-string display-to-string)

;; CL read-from-string: parse value from a string using SX port
(define
  (cl-read-from-string s)
  (let ((p (open-input-string s))) (read p)))

;; String stream (output)
(define cl-make-string-output-stream open-output-string)
(define cl-get-output-stream-string get-output-string)

;; String stream (input)
(define cl-make-string-input-stream open-input-string)

;; ---------------------------------------------------------------------------
;; 5.  Gensym
;; ---------------------------------------------------------------------------

(define cl-gensym gensym)
(define cl-gentemp gensym)

;; ---------------------------------------------------------------------------
;; 6.  Multiple values (CL: values / nth-value)
;; ---------------------------------------------------------------------------

(define (cl-values &rest args) {:_values true :_list args})

(define
  (cl-call-with-values producer consumer)
  (let
    ((mv (producer)))
    (if
      (and (dict? mv) (get mv :_values))
      (apply consumer (get mv :_list))
      (consumer mv))))

(define
  (cl-nth-value n mv)
  (cond
    ((and (dict? mv) (get mv :_values))
      (let
        ((lst (get mv :_list)))
        (if (>= n (len lst)) nil (nth lst n))))
    ((= n 0) mv)
    (else nil)))

;; ---------------------------------------------------------------------------
;; 7.  Sets (CL: adjoin / member / union / intersection / set-difference)
;; ---------------------------------------------------------------------------

(define cl-make-set make-set)
(define cl-set? set?)
(define cl-set-add set-add!)
(define cl-set-memberp set-member?)
(define cl-set-remove set-remove!)
(define cl-set-union set-union)
(define cl-set-intersect set-intersection)
(define cl-set-difference set-difference)
(define cl-list->set list->set)
(define cl-set->list set->list)

;; CL: (member item list) — returns tail starting at item, or nil
(define
  (cl-member item lst)
  (cond
    ((cl-empty? lst) nil)
    ((equal? item (first lst)) lst)
    (else (cl-member item (rest lst)))))

;; CL: (adjoin item list) — cons only if not already present
(define (cl-adjoin item lst) (if (cl-member item lst) lst (cons item lst)))

;; ---------------------------------------------------------------------------
;; 8.  Radix formatting  (CL: (write-to-string n :base radix))
;; ---------------------------------------------------------------------------

(define (cl-integer-to-string n radix) (number->string n radix))

(define (cl-string-to-integer s radix) (string->number s radix))

;; CL ~R directive helpers
(define (cl-format-binary n) (number->string n 2))
(define (cl-format-octal n) (number->string n 8))
(define (cl-format-hex n) (number->string n 16))
(define (cl-format-decimal n) (number->string n 10))

;; ---------------------------------------------------------------------------
;; 9.  List utilities — cl-empty? guards against () from rest
;; ---------------------------------------------------------------------------

(define
  (cl-last lst)
  (cond
    ((cl-empty? lst) nil)
    ((cl-empty? (rest lst)) lst)
    (else (cl-last (rest lst)))))

(define
  (cl-butlast lst)
  (if
    (or (cl-empty? lst) (cl-empty? (rest lst)))
    nil
    (cons (first lst) (cl-butlast (rest lst)))))

(define
  (cl-nthcdr n lst)
  (if (= n 0) lst (cl-nthcdr (- n 1) (rest lst))))

(define (cl-nth n lst) (first (cl-nthcdr n lst)))

(define (cl-list-length lst) (len lst))

(define
  (cl-copy-list lst)
  (if (cl-empty? lst) nil (cons (first lst) (cl-copy-list (rest lst)))))

(define
  (cl-flatten lst)
  (cond
    ((cl-empty? lst) nil)
    ((list? (first lst))
      (append (cl-flatten (first lst)) (cl-flatten (rest lst))))
    (else (cons (first lst) (cl-flatten (rest lst))))))

;; CL: (assoc key alist) — returns matching pair or nil
(define
  (cl-assoc key alist)
  (cond
    ((cl-empty? alist) nil)
    ((equal? key (first (first alist))) (first alist))
    (else (cl-assoc key (rest alist)))))

;; CL: (rassoc val alist) — reverse assoc (match on second element)
(define
  (cl-rassoc val alist)
  (cond
    ((cl-empty? alist) nil)
    ((equal? val (first (rest (first alist)))) (first alist))
    (else (cl-rassoc val (rest alist)))))

;; CL: (getf plist key) — property list lookup
(define
  (cl-getf plist key)
  (cond
    ((or (cl-empty? plist) (cl-empty? (rest plist))) nil)
    ((equal? (first plist) key) (first (rest plist)))
    (else (cl-getf (rest (rest plist)) key))))