giles
4d7b3e299c
28 tests, passes on both JS and OCaml. - spec/stdlib.sx: pure SX format function - spec/primitives.sx: format primitive declaration - lib/r7rs.sx: fix number->string to support optional radix arg - hosts/ocaml: add format-decimal primitive, load stdlib.sx in test runner - hosts/javascript: load stdlib.sx in test runner Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
135 lines
4.6 KiB
Plaintext
135 lines
4.6 KiB
Plaintext
;; ==========================================================================
|
|
;; 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)))
|