coop/rose-ash
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

spec: format — CL-style string formatting (~a ~s ~d ~x ~o ~b ~f ~% ~& ~~ ~t)

Browse Source 
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:
giles
2026-05-01 19:58:54 +00:00
parent 6a34ae3ae1
commit 4d7b3e299c
7 changed files with 243 additions and 2 deletions
Download Patch File Download Diff File Expand all files Collapse all files

2
hosts/javascript/run_tests.js
View File

@@ -344,7 +344,7 @@ if (fs.existsSync(swapPath)) {
}
// Load spec library files (define-library modules imported by tests)
for (const libFile of ["signals.sx", "coroutines.sx"]) {
for (const libFile of ["stdlib.sx", "signals.sx", "coroutines.sx"]) {
const libPath = path.join(projectDir, "spec", libFile);
if (fs.existsSync(libPath)) {
const libSrc = fs.readFileSync(libPath, "utf8");

1
hosts/ocaml/bin/run_tests.ml
View File

@@ -2872,6 +2872,7 @@ let run_spec_tests env test_files =
match sx_vm_execute with
| Some fn -> Sx_ref.cek_call fn (List args)
| None -> Nil)));
load_module "stdlib.sx" spec_dir; (* pure SX stdlib: format etc. *)
load_module "signals.sx" spec_dir; (* core reactive primitives *)
load_module "signals.sx" web_dir; (* web extensions *)
load_module "freeze.sx" lib_dir;

7
hosts/ocaml/lib/sx_primitives.ml
View File

@@ -2806,6 +2806,13 @@ let () =
match args with
| [v] -> String (sx_display_val v)
| _ -> raise (Eval_error "display-to-string: 1 arg"));
register "format-decimal" (fun args ->
match args with
| [Integer n; Integer prec] -> String (Printf.sprintf "%.*f" prec (float_of_int n))
| [Number n; Integer prec] -> String (Printf.sprintf "%.*f" prec n)
| [Integer n; _] -> String (Printf.sprintf "%.6f" (float_of_int n))
| [Number n; _] -> String (Printf.sprintf "%.6f" n)
| _ -> raise (Eval_error "format-decimal: expected number precision"));
register "current-input-port" (fun _ -> Nil);
register "current-output-port" (fun _ -> Nil);
register "current-error-port" (fun _ -> Nil);

5
lib/r7rs.sx
View File

@@ -73,7 +73,10 @@
(define string->symbol make-symbol)
(define number->string (fn (n) (str n)))
(define number->string
(let ((prim-n->s number->string))
(fn (n &rest r)
(if (nil? r) (str n) (prim-n->s n (first r))))))
(define
string->number

6
spec/primitives.sx
View File

@@ -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
View 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
View 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)")))