rose-ash/spec/stdlib.sx

;; ==========================================================================
;; stdlib.sx — Standard library functions
;;
;; Every function here is expressed in SX using the irreducible primitive
;; set. They are library functions — in band, auditable, portable.
;;
;; Depends on: evaluator.sx (special forms)
;; Must load before: render.sx, freeze.sx, types.sx, user code
;; ==========================================================================


;; Logic + comparison: not, !=, <=, >= stay as primitives.
;; Replacing them with SX lambdas changes behavior inside shift/reset
;; because the transpiled evaluator code uses them directly.

(define eq?    (fn (a b) (= a b)))
(define eqv?   (fn (a b) (= a b)))
(define equal? (fn (a b) (= a b)))


;; --------------------------------------------------------------------------
;; Type predicates
;; --------------------------------------------------------------------------

;; nil? stays as primitive — host's type-of uses it internally.

(define boolean?
  (fn (x) (= (type-of x) "boolean")))

(define number?
  (fn (x) (= (type-of x) "number")))

(define string?
  (fn (x) (= (type-of x) "string")))

(define list?
  (fn (x) (= (type-of x) "list")))

(define dict?
  (fn (x) (= (type-of x) "dict")))

(define continuation?
  (fn (x) (= (type-of x) "continuation")))

(define zero?
  (fn (n) (= n 0)))

(define odd?
  (fn (n) (= (mod n 2) 1)))

(define even?
  (fn (n) (= (mod n 2) 0)))

(define empty?
  (fn (coll) (or (nil? coll) (= (len coll) 0))))


;; --------------------------------------------------------------------------
;; Arithmetic
;; --------------------------------------------------------------------------

;; inc and dec stay as primitives — used inside continuation contexts.

(define abs
  (fn (x) (if (< x 0) (- x) x)))

(define ceil
  (fn (x)
    (let ((f (floor x)))
      (if (= x f) f (+ f 1)))))

(define round
  (fn (x ndigits)
    (if (nil? ndigits)
      (floor (+ x 0.5))
      (let ((f (pow 10 ndigits)))
        (/ (floor (+ (* x f) 0.5)) f)))))

(define min
  (fn (a b) (if (< a b) a b)))

(define max
  (fn (a b) (if (> a b) a b)))

(define clamp
  (fn (x lo hi) (max lo (min hi x))))


;; --------------------------------------------------------------------------
;; Collection accessors
;; --------------------------------------------------------------------------

(define first
  (fn (coll)
    (if (and coll (> (len coll) 0)) (get coll 0) nil)))

(define last
  (fn (coll)
    (if (and coll (> (len coll) 0))
      (get coll (- (len coll) 1))
      nil)))

(define rest
  (fn (coll) (if coll (slice coll 1) (list))))

(define nth
  (fn (coll n)
    (if (and coll (>= n 0) (< n (len coll)))
      (get coll n)
      nil)))

(define cons
  (fn (x coll) (concat (list x) (or coll (list)))))

(define append
  (fn (coll x)
    (if (list? x) (concat coll x) (concat coll (list x)))))


;; --------------------------------------------------------------------------
;; Collection transforms
;; --------------------------------------------------------------------------

(define reverse
  (fn (coll)
    (reduce (fn (acc x) (cons x acc)) (list) coll)))

(define flatten
  (fn (coll)
    (reduce
      (fn (acc x)
        (if (list? x) (concat acc x) (concat acc (list x))))
      (list) coll)))

(define range
  (fn (start end step)
    (let ((s (if (nil? step) 1 step))
          (result (list)))
      (let loop ((i start))
        (when (< i end)
          (append! result i)
          (loop (+ i s))))
      result)))

(define chunk-every
  (fn (coll n)
    (let ((result (list))
          (clen (len coll)))
      (let loop ((i 0))
        (when (< i clen)
          (append! result (slice coll i (min (+ i n) clen)))
          (loop (+ i n))))
      result)))

(define zip-pairs
  (fn (coll)
    (let ((result (list))
          (clen (len coll)))
      (let loop ((i 0))
        (when (< i (- clen 1))
          (append! result (list (get coll i) (get coll (+ i 1))))
          (loop (+ i 1))))
      result)))


;; --------------------------------------------------------------------------
;; Dict operations
;; --------------------------------------------------------------------------

(define vals
  (fn (d)
    (map (fn (k) (get d k)) (keys d))))

(define has-key?
  (fn (d key)
    (some (fn (k) (= k key)) (keys d))))

(define assoc
  (fn (d key val)
    (let ((result (merge d (dict))))
      (dict-set! result key val)
      result)))

(define dissoc
  (fn (d key)
    (let ((result (dict)))
      (for-each
        (fn (k)
          (when (!= k key)
            (dict-set! result k (get d k))))
        (keys d))
      result)))

(define into
  (fn (target coll)
    (cond
      (list? target)
        (if (list? coll)
          (concat coll (list))
          (let ((result (list)))
            (for-each (fn (k) (append! result (list k (get coll k)))) (keys coll))
            result))
      (dict? target)
        (let ((result (dict)))
          (for-each
            (fn (pair)
              (when (and (list? pair) (>= (len pair) 2))
                (dict-set! result (get pair 0) (get pair 1))))
            coll)
          result)
      :else target)))


;; --------------------------------------------------------------------------
;; String operations
;; --------------------------------------------------------------------------

(define upcase (fn (s) (upper s)))
(define downcase (fn (s) (lower s)))
(define string-length (fn (s) (len s)))
(define substring (fn (s start end) (slice s start end)))

(define string-contains?
  (fn (s needle) (!= (index-of s needle) -1)))

(define starts-with?
  (fn (s prefix) (= (index-of s prefix) 0)))

(define ends-with?
  (fn (s suffix)
    (let ((slen (len s))
          (plen (len suffix)))
      (if (< slen plen) false
        (= (slice s (- slen plen)) suffix)))))

;; split, join, replace stay as primitives — the stdlib versions cause
;; stack overflows due to PRIMITIVES entry shadowing in the transpiled output.

(define contains?
  (fn (coll key)
    (cond
      (string? coll) (!= (index-of coll (str key)) -1)
      (dict? coll) (has-key? coll key)
      (list? coll) (some (fn (x) (= x key)) coll)
      :else false)))


;; --------------------------------------------------------------------------
;; Text utilities
;; --------------------------------------------------------------------------

(define pluralize
  (fn (count singular plural)
    (if (= count 1)
      (or singular "")
      (or plural "s"))))

(define escape
  (fn (s)
    (let ((r (str s)))
      (set! r (replace r "&" "&amp;"))
      (set! r (replace r "<" "&lt;"))
      (set! r (replace r ">" "&gt;"))
      (set! r (replace r "\"" "&quot;"))
      (set! r (replace r "'" "&#x27;"))
      r)))

(define parse-datetime
  (fn (s) (if s (str s) nil)))

(define assert
  (fn (condition message)
    (when (not condition)
      (error (or message "Assertion failed")))
    true))