From 4d7b3e299c4b25b88af6327c160d2e077679dbac Mon Sep 17 00:00:00 2001 From: giles Date: Fri, 1 May 2026 19:58:54 +0000 Subject: [PATCH] =?UTF-8?q?spec:=20format=20=E2=80=94=20CL-style=20string?= =?UTF-8?q?=20formatting=20(~a=20~s=20~d=20~x=20~o=20~b=20~f=20~%=20~&=20~?= =?UTF-8?q?~=20~t)?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit 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 --- hosts/javascript/run_tests.js | 2 +- hosts/ocaml/bin/run_tests.ml | 1 + hosts/ocaml/lib/sx_primitives.ml | 7 ++ lib/r7rs.sx | 5 +- spec/primitives.sx | 6 ++ spec/stdlib.sx | 134 +++++++++++++++++++++++++++++++ spec/tests/test-format.sx | 90 +++++++++++++++++++++ 7 files changed, 243 insertions(+), 2 deletions(-) create mode 100644 spec/stdlib.sx create mode 100644 spec/tests/test-format.sx diff --git a/hosts/javascript/run_tests.js b/hosts/javascript/run_tests.js index eb580306..79a17798 100644 --- a/hosts/javascript/run_tests.js +++ b/hosts/javascript/run_tests.js @@ -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"); diff --git a/hosts/ocaml/bin/run_tests.ml b/hosts/ocaml/bin/run_tests.ml index 37fc6620..cdae24d6 100644 --- a/hosts/ocaml/bin/run_tests.ml +++ b/hosts/ocaml/bin/run_tests.ml @@ -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; diff --git a/hosts/ocaml/lib/sx_primitives.ml b/hosts/ocaml/lib/sx_primitives.ml index 142e15ec..ac03e182 100644 --- a/hosts/ocaml/lib/sx_primitives.ml +++ b/hosts/ocaml/lib/sx_primitives.ml @@ -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); diff --git a/lib/r7rs.sx b/lib/r7rs.sx index 9e157f53..38a91f27 100644 --- a/lib/r7rs.sx +++ b/lib/r7rs.sx @@ -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 diff --git a/spec/primitives.sx b/spec/primitives.sx index 9aee9be7..58cffa5f 100644 --- a/spec/primitives.sx +++ b/spec/primitives.sx @@ -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.") diff --git a/spec/stdlib.sx b/spec/stdlib.sx new file mode 100644 index 00000000..789dfd6c --- /dev/null +++ b/spec/stdlib.sx @@ -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))) diff --git a/spec/tests/test-format.sx b/spec/tests/test-format.sx new file mode 100644 index 00000000..527bac24 --- /dev/null +++ b/spec/tests/test-format.sx @@ -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)")))