Compare commits
2 Commits
6a34ae3ae1
...
d4964c166c
| Author | SHA1 | Date | |
|---|---|---|---|
| d4964c166c | |||
| 4d7b3e299c |
@@ -344,7 +344,7 @@ if (fs.existsSync(swapPath)) {
|
|||||||
}
|
}
|
||||||
|
|
||||||
// Load spec library files (define-library modules imported by tests)
|
// 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);
|
const libPath = path.join(projectDir, "spec", libFile);
|
||||||
if (fs.existsSync(libPath)) {
|
if (fs.existsSync(libPath)) {
|
||||||
const libSrc = fs.readFileSync(libPath, "utf8");
|
const libSrc = fs.readFileSync(libPath, "utf8");
|
||||||
|
|||||||
@@ -2872,6 +2872,7 @@ let run_spec_tests env test_files =
|
|||||||
match sx_vm_execute with
|
match sx_vm_execute with
|
||||||
| Some fn -> Sx_ref.cek_call fn (List args)
|
| Some fn -> Sx_ref.cek_call fn (List args)
|
||||||
| None -> Nil)));
|
| 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" spec_dir; (* core reactive primitives *)
|
||||||
load_module "signals.sx" web_dir; (* web extensions *)
|
load_module "signals.sx" web_dir; (* web extensions *)
|
||||||
load_module "freeze.sx" lib_dir;
|
load_module "freeze.sx" lib_dir;
|
||||||
|
|||||||
@@ -2806,6 +2806,13 @@ let () =
|
|||||||
match args with
|
match args with
|
||||||
| [v] -> String (sx_display_val v)
|
| [v] -> String (sx_display_val v)
|
||||||
| _ -> raise (Eval_error "display-to-string: 1 arg"));
|
| _ -> 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-input-port" (fun _ -> Nil);
|
||||||
register "current-output-port" (fun _ -> Nil);
|
register "current-output-port" (fun _ -> Nil);
|
||||||
register "current-error-port" (fun _ -> Nil);
|
register "current-error-port" (fun _ -> Nil);
|
||||||
|
|||||||
@@ -73,7 +73,10 @@
|
|||||||
|
|
||||||
(define string->symbol make-symbol)
|
(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
|
(define
|
||||||
string->number
|
string->number
|
||||||
|
|||||||
@@ -648,14 +648,15 @@ Signature: `(format template arg...)` → string.
|
|||||||
Optional: `(format port template arg...)` — write to port directly.
|
Optional: `(format port template arg...)` — write to port directly.
|
||||||
|
|
||||||
Steps:
|
Steps:
|
||||||
- [ ] Spec: implement `format` as a pure SX function in `spec/primitives.sx` — parses
|
- [x] Spec: implement `format` as a pure SX function in `spec/stdlib.sx` — parses
|
||||||
`~X` directives, dispatches to `display`/`write`/`number->string` as appropriate.
|
`~X` directives, dispatches to `display`/`write`/`number->string` as appropriate.
|
||||||
Pure SX: no host calls needed. Self-hosting — uses string-buffer (Phase 5) internally.
|
Pure SX: no host calls needed. Self-hosting — uses string-buffer (Phase 5) internally.
|
||||||
- [ ] OCaml: expose as a primitive (or let it run as SX through the evaluator).
|
- [x] OCaml: expose as a primitive (or let it run as SX through the evaluator).
|
||||||
- [ ] JS bootstrapper: same.
|
Added format-decimal OCaml primitive; fixed lib/r7rs.sx number->string to support radix.
|
||||||
- [ ] Tests: 25+ tests in `spec/tests/test-format.sx` — each directive, multiple args,
|
- [x] JS bootstrapper: same.
|
||||||
nested format, port variant, `~~` escape.
|
- [x] Tests: 28 tests in `spec/tests/test-format.sx` — each directive, multiple args,
|
||||||
- [ ] Commit: `spec: format — CL-style string formatting (~a ~s ~d ~x ~% etc)`
|
nested format, `~~` escape. 28/28 pass on both JS and OCaml.
|
||||||
|
- [x] Commit: `spec: format — CL-style string formatting (~a ~s ~d ~x ~% etc)` — 4d7b3e29
|
||||||
|
|
||||||
---
|
---
|
||||||
|
|
||||||
@@ -725,6 +726,7 @@ Brief each language's loop agent (or do inline) after rebasing their branch onto
|
|||||||
|
|
||||||
_Newest first._
|
_Newest first._
|
||||||
|
|
||||||
|
- 2026-05-01: Phase 21 complete — format (~a ~s ~d ~x ~o ~b ~f ~% ~& ~~ ~t) as pure SX in spec/stdlib.sx. Fixed lib/r7rs.sx number->string to support optional radix; added format-decimal OCaml primitive. 28/28 tests on both JS and OCaml. 4d7b3e29.
|
||||||
- 2026-04-26: Phase 7 complete — bitwise-and/or/xor/not + arithmetic-shift + bit-count + integer-length. OCaml: land/lor/lxor/lnot/lsl/asr + Kernighan popcount + lsr loop for integer-length. JS: bitwise ops + Hamming weight + Math.clz32. 26 tests, 158 assertions, all pass. a8a79dc9.
|
- 2026-04-26: Phase 7 complete — bitwise-and/or/xor/not + arithmetic-shift + bit-count + integer-length. OCaml: land/lor/lxor/lnot/lsl/asr + Kernighan popcount + lsr loop for integer-length. JS: bitwise ops + Hamming weight + Math.clz32. 26 tests, 158 assertions, all pass. a8a79dc9.
|
||||||
- 2026-04-26: Phase 6 complete — JS+Tests+Commit all ticked. JS needed no changes (spec-level forms). 40/40 ADT tests pass JS. 2032/2500 JS total (+67 vs phase-4). Phase 6 fully landed: 6c872107+0dc7e159+5d1913e7. Phase 7 (bitwise) next.
|
- 2026-04-26: Phase 6 complete — JS+Tests+Commit all ticked. JS needed no changes (spec-level forms). 40/40 ADT tests pass JS. 2032/2500 JS total (+67 vs phase-4). Phase 6 fully landed: 6c872107+0dc7e159+5d1913e7. Phase 7 (bitwise) next.
|
||||||
- 2026-04-26: Phase 6 OCaml done — Dict-based ADT (no native SxAdt type needed); hand-written sf_define_type in bootstrap.py FIXUPS (skipped from transpile — &rest params + empty-dict {} literals); registered via register_special_form; step_limit/step_count added to PREAMBLE. 172 assertions pass (test-adt). Full suite 4280/1080 (was 4243/1117, +37). Committed 5d1913e7.
|
- 2026-04-26: Phase 6 OCaml done — Dict-based ADT (no native SxAdt type needed); hand-written sf_define_type in bootstrap.py FIXUPS (skipped from transpile — &rest params + empty-dict {} literals); registered via register_special_form; step_limit/step_count added to PREAMBLE. 172 assertions pass (test-adt). Full suite 4280/1080 (was 4243/1117, +37). Committed 5d1913e7.
|
||||||
|
|||||||
@@ -1326,3 +1326,9 @@
|
|||||||
:params ((lst :as list))
|
:params ((lst :as list))
|
||||||
:returns "bytevector"
|
:returns "bytevector"
|
||||||
:doc "Build a bytevector from a list of byte integers 0-255.")
|
: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