;; ==========================================================================
;; stdlib.sx — Pure SX standard library functions
;;
;; Loaded by test runners after primitives. These functions are implemented
;; in SX and require no host-specific code.
;;
;; IMPORTANT: SX let/when bodies evaluate only the LAST expression.
;;   Multi-step bodies must be wrapped in (do expr1 expr2 ...).
;; ==========================================================================

;; --------------------------------------------------------------------------
;; format — CL-style string formatting
;;
;; Directives:
;;   ~a  display (no quotes)       ~s  write (with quotes)
;;   ~d  decimal  ~x  hex  ~o  octal  ~b  binary
;;   ~f  fixed-point (6dp)          ~%  newline
;;   ~&  fresh line                 ~~  literal tilde
;;   ~t  tab
;;
;; Signature: (format template arg...) -> string
;; --------------------------------------------------------------------------

(define
  (format template &rest args)
  (let
    ((buf (make-string-buffer)) (n (string-length template)))
    (define
      (consume-arg args)
      (if
        (nil? args)
        (list "" nil)
        (list (display-to-string (first args)) (rest args))))
    (define
      (consume-num args radix)
      (if
        (nil? args)
        (list "" nil)
        (list (number->string (first args) radix) (rest args))))
    (define
      (loop i args)
      (cond
        ((>= i n) (string-buffer->string buf))
        ((and (= (substring template i (+ i 1)) "~") (< (+ i 1) n))
          (let
            ((dir (substring template (+ i 1) (+ i 2))))
            (cond
              ((= dir "a")
                (let
                  ((p (consume-arg args)))
                  (do
                    (string-buffer-append! buf (first p))
                    (loop (+ i 2) (first (rest p))))))
              ((= dir "s")
                (if
                  (nil? args)
                  (loop (+ i 2) args)
                  (do
                    (string-buffer-append!
                      buf
                      (write-to-string (first args)))
                    (loop (+ i 2) (rest args)))))
              ((= dir "d")
                (let
                  ((p (consume-num args 10)))
                  (do
                    (string-buffer-append! buf (first p))
                    (loop (+ i 2) (first (rest p))))))
              ((= dir "x")
                (let
                  ((p (consume-num args 16)))
                  (do
                    (string-buffer-append! buf (first p))
                    (loop (+ i 2) (first (rest p))))))
              ((= dir "o")
                (let
                  ((p (consume-num args 8)))
                  (do
                    (string-buffer-append! buf (first p))
                    (loop (+ i 2) (first (rest p))))))
              ((= dir "b")
                (let
                  ((p (consume-num args 2)))
                  (do
                    (string-buffer-append! buf (first p))
                    (loop (+ i 2) (first (rest p))))))
              ((= dir "f")
                (if
                  (nil? args)
                  (loop (+ i 2) args)
                  (do
                    (string-buffer-append!
                      buf
                      (format-decimal (first args) 6))
                    (loop (+ i 2) (rest args)))))
              ((= dir "%")
                (do
                  (string-buffer-append! buf "\n")
                  (loop (+ i 2) args)))
              ((= dir "&")
                (do
                  (let
                    ((so-far (string-buffer->string buf)))
                    (when
                      (or
                        (= (string-length so-far) 0)
                        (not
                          (=
                            (substring
                              so-far
                              (- (string-length so-far) 1)
                              (string-length so-far))
                            "\n")))
                      (string-buffer-append! buf "\n")))
                  (loop (+ i 2) args)))
              ((= dir "~")
                (do
                  (string-buffer-append! buf "~")
                  (loop (+ i 2) args)))
              ((= dir "t")
                (do
                  (string-buffer-append! buf "\t")
                  (loop (+ i 2) args)))
              (else
                (do
                  (string-buffer-append! buf "~")
                  (loop (+ i 1) args))))))
        (else
          (do
            (string-buffer-append!
              buf
              (substring template i (+ i 1)))
            (loop (+ i 1) args)))))
    (loop 0 args)))