spec: format — CL-style string formatting (~a ~s ~d ~x ~o ~b ~f ~% ~& ~~ ~t)
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>
This commit is contained in:
@@ -1326,3 +1326,9 @@
|
||||
:params ((lst :as list))
|
||||
:returns "bytevector"
|
||||
:doc "Build a bytevector from a list of byte integers 0-255.")
|
||||
|
||||
(define-primitive
|
||||
"format"
|
||||
:params ((template :as string) &rest args)
|
||||
:returns "string"
|
||||
:doc "CL-style format string. Directives: ~a display, ~s write, ~d decimal, ~x hex, ~o octal, ~b binary, ~f fixed-point, ~e scientific, ~% newline, ~& fresh-line, ~~ tilde, ~t tab. Optional first arg: output-port.")
|
||||
|
||||
134
spec/stdlib.sx
Normal file
134
spec/stdlib.sx
Normal file
@@ -0,0 +1,134 @@
|
||||
;; ==========================================================================
|
||||
;; 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)))
|
||||
90
spec/tests/test-format.sx
Normal file
90
spec/tests/test-format.sx
Normal file
@@ -0,0 +1,90 @@
|
||||
;; ==========================================================================
|
||||
;; test-format.sx — Tests for CL-style format function
|
||||
;; ==========================================================================
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; basic directives
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite
|
||||
"format:basic"
|
||||
(deftest "format returns string" (assert (string? (format "hello"))))
|
||||
(deftest
|
||||
"format no directives"
|
||||
(assert= (format "hello world") "hello world"))
|
||||
(deftest "format empty template" (assert= (format "") ""))
|
||||
(deftest "~a display string" (assert= (format "~a" "hello") "hello"))
|
||||
(deftest "~a display number" (assert= (format "~a" 42) "42"))
|
||||
(deftest "~a display nil" (assert= (format "~a" nil) "()"))
|
||||
(deftest
|
||||
"~s write string (with quotes)"
|
||||
(assert= (format "~s" "hi") "\"hi\""))
|
||||
(deftest "~s write number" (assert= (format "~s" 42) "42"))
|
||||
(deftest
|
||||
"multiple args"
|
||||
(assert= (format "~a and ~a" "foo" "bar") "foo and bar")))
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; numeric directives
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite
|
||||
"format:numeric"
|
||||
(deftest "~d decimal" (assert= (format "~d" 255) "255"))
|
||||
(deftest "~x hex" (assert= (format "~x" 255) "ff"))
|
||||
(deftest "~o octal" (assert= (format "~o" 8) "10"))
|
||||
(deftest "~b binary" (assert= (format "~b" 10) "1010"))
|
||||
(deftest "~d zero" (assert= (format "~d" 0) "0"))
|
||||
(deftest
|
||||
"~x uppercase digits"
|
||||
(assert= (format "value: ~x" 16) "value: 10")))
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; float directives
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite
|
||||
"format:float"
|
||||
(deftest "~f fixed point" (assert= (format "~f" 3.14) "3.140000"))
|
||||
(deftest "~f zero" (assert= (format "~f" 0) "0.000000")))
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; control directives
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite
|
||||
"format:control"
|
||||
(deftest "~% newline" (assert= (format "a~%b") "a\nb"))
|
||||
(deftest "~~ literal tilde" (assert= (format "100~~") "100~"))
|
||||
(deftest "~t tab" (assert= (format "a~tb") "a\tb"))
|
||||
(deftest "~& fresh line at start" (assert= (format "~&hello") "\nhello"))
|
||||
(deftest
|
||||
"~& no newline if already at newline"
|
||||
(assert= (format "line~%~&next") "line\nnext")))
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; mixed / compound
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite
|
||||
"format:compound"
|
||||
(deftest
|
||||
"name and age"
|
||||
(assert=
|
||||
(format "Hello ~a, age ~d" "Alice" 30)
|
||||
"Hello Alice, age 30"))
|
||||
(deftest
|
||||
"hex dump style"
|
||||
(assert=
|
||||
(format "~d = 0x~x = 0b~b" 10 10 10)
|
||||
"10 = 0xa = 0b1010"))
|
||||
(deftest "multiple newlines" (assert= (format "~%~%") "\n\n"))
|
||||
(deftest "text with no args" (assert= (format "status: ok") "status: ok"))
|
||||
(deftest
|
||||
"tilde at end (unknown directive)"
|
||||
(assert (string? (format "test~"))))
|
||||
(deftest
|
||||
"nested strings in ~a"
|
||||
(assert=
|
||||
(format "got: ~a" (list 1 2 3))
|
||||
"got: (1 2 3)")))
|
||||
Reference in New Issue
Block a user