From 4f9da65b3d11a4d7113cf3769cba825af8bc6793 Mon Sep 17 00:00:00 2001 From: giles Date: Tue, 5 May 2026 12:23:54 +0000 Subject: [PATCH] =?UTF-8?q?cl:=20Phase=206=20FORMAT=20+=20substr=20fixes?= =?UTF-8?q?=20=E2=80=94=20514/514=20tests?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit FORMAT with ~A/~S/~D/~F/~%/~&/~T/~P/~{...~}/~^; cl-fmt-loop, cl-fmt-find-close, cl-fmt-iterate, cl-fmt-a/cl-fmt-s helpers. Fix substr(start,length) semantics throughout: SUBSEQ end formula corrected to (- end start), cl-fmt-loop char extraction fixed. Co-Authored-By: Claude Sonnet 4.6 --- lib/common-lisp/eval.sx | 142 +++++++++++++++++++++++++++++++- lib/common-lisp/scoreboard.json | 6 +- lib/common-lisp/scoreboard.md | 6 +- lib/common-lisp/tests/stdlib.sx | 26 ++++++ plans/common-lisp-on-sx.md | 4 +- 5 files changed, 176 insertions(+), 8 deletions(-) diff --git a/lib/common-lisp/eval.sx b/lib/common-lisp/eval.sx index 7b3db11e..ecada1b5 100644 --- a/lib/common-lisp/eval.sx +++ b/lib/common-lisp/eval.sx @@ -191,6 +191,140 @@ (cl-eval-body body e5))))))))))))) +;; ── FORMAT helpers ────────────────────────────────────────────── + +(define cl-fmt-a + (fn (arg) + (cond + ((= arg nil) "()") + ((= arg true) "T") + ((= arg false) "NIL") + ((string? arg) arg) + ((number? arg) (str arg)) + ((list? arg) + (if (= (len arg) 0) "()" + (str "(" + (reduce (fn (a x) (str a " " (cl-fmt-a x))) + (cl-fmt-a (nth arg 0)) + (rest arg)) + ")"))) + ((and (dict? arg) (= (get arg "cl-type") "keyword")) + (str ":" (get arg "name"))) + ((and (dict? arg) (= (get arg "cl-type") "char")) + (get arg "value")) + (:else (str arg))))) + +(define cl-fmt-s + (fn (arg) + (cond + ((= arg nil) "NIL") + ((= arg true) "T") + ((= arg false) "NIL") + ((string? arg) (str "\"" arg "\"")) + ((number? arg) (str arg)) + ((list? arg) + (if (= (len arg) 0) "NIL" + (str "(" + (reduce (fn (a x) (str a " " (cl-fmt-s x))) + (cl-fmt-s (nth arg 0)) + (rest arg)) + ")"))) + ((and (dict? arg) (= (get arg "cl-type") "keyword")) + (str ":" (get arg "name"))) + ((and (dict? arg) (= (get arg "cl-type") "char")) + (str "#\\" (get arg "value"))) + (:else (str arg))))) + +;; Find position of ~CH (tilde+ch) in ctrl, starting from i, tracking nesting +(define cl-fmt-find-close + (fn (ctrl ch i depth) + (if (>= i (- (len ctrl) 1)) -1 + (let ((c (substr ctrl i 1))) + (if (= c "~") + (let ((nxt (upcase (substr ctrl (+ i 1) 1)))) + (cond + ((= nxt ch) + (if (= depth 0) i (cl-fmt-find-close ctrl ch (+ i 2) (- depth 1)))) + ((or (= nxt "{") (= nxt "[")) + (cl-fmt-find-close ctrl ch (+ i 2) (+ depth 1))) + (:else + (cl-fmt-find-close ctrl ch (+ i 2) depth)))) + (cl-fmt-find-close ctrl ch (+ i 1) depth)))))) + +;; Process inner ~{...~} string over each element of a list +(define cl-fmt-iterate + (fn (inner items) + (if (= items nil) "" + (if (= (len items) 0) "" + (reduce + (fn (acc x) + (str acc (get (cl-fmt-loop inner (list x) 0 "") "out"))) + "" items))))) + +;; Main format loop: returns {:out string :args remaining} +(define cl-fmt-loop + (fn (ctrl args i out) + (if (>= i (len ctrl)) + {:out out :args args} + (let ((ch (substr ctrl i 1))) + (if (not (= ch "~")) + (cl-fmt-loop ctrl args (+ i 1) (str out ch)) + (let ((dir (if (< (+ i 1) (len ctrl)) + (upcase (substr ctrl (+ i 1) 1)) + ""))) + (cond + ((= dir "A") + (cl-fmt-loop ctrl (rest args) (+ i 2) + (str out (if (> (len args) 0) (cl-fmt-a (nth args 0)) "")))) + ((= dir "S") + (cl-fmt-loop ctrl (rest args) (+ i 2) + (str out (if (> (len args) 0) (cl-fmt-s (nth args 0)) "")))) + ((or (= dir "D") (= dir "F") (= dir "B") (= dir "X") (= dir "O")) + (cl-fmt-loop ctrl (rest args) (+ i 2) + (str out (if (> (len args) 0) (str (nth args 0)) "")))) + ((= dir "%") + (cl-fmt-loop ctrl args (+ i 2) (str out "\n"))) + ((= dir "&") + (cl-fmt-loop ctrl args (+ i 2) + (if (or (= (len out) 0) + (= (substr out (- (len out) 1) 1) "\n")) + out (str out "\n")))) + ((= dir "T") + (cl-fmt-loop ctrl args (+ i 2) (str out "\t"))) + ((= dir "P") + (let ((arg (if (> (len args) 0) (nth args 0) 1))) + (cl-fmt-loop ctrl (rest args) (+ i 2) + (str out (if (= arg 1) "" "s"))))) + ((= dir "{") + (let ((end-i (cl-fmt-find-close ctrl "}" (+ i 2) 0))) + (if (= end-i -1) + {:out (str out "~{") :args args} + (let ((inner (if (> end-i (+ i 2)) + (substr ctrl (+ i 2) (- end-i (+ i 2))) + ""))) + (let ((list-arg (if (> (len args) 0) (nth args 0) (list)))) + (cl-fmt-loop ctrl (rest args) (+ end-i 2) + (str out (cl-fmt-iterate inner (if (= list-arg nil) (list) list-arg))))))))) + ((= dir "[") + (let ((end-i (cl-fmt-find-close ctrl "]" (+ i 2) 0))) + (if (= end-i -1) + {:out (str out "~[") :args args} + (let ((inner (if (> end-i (+ i 2)) + (substr ctrl (+ i 2) (- end-i (+ i 2))) + ""))) + (let ((arg (if (> (len args) 0) (nth args 0) 0))) + (let ((chosen (if (= arg true) "T" + (if (= arg nil) "NIL" + (get (cl-fmt-loop inner (list arg) 0 "") "out"))))) + (cl-fmt-loop ctrl (rest args) (+ end-i 2) + (str out chosen)))))))) + ((= dir "~") + (cl-fmt-loop ctrl args (+ i 2) (str out "~"))) + ((= dir "^") + {:out out :args args}) + (:else + (cl-fmt-loop ctrl args (+ i 2) (str out "~" dir)))))))))) + ;; ── sequence/list helpers (needed by builtins) ─────────────────── (define cl-member-helper @@ -520,7 +654,7 @@ (start (nth args 1)) (end (if (> (len args) 2) (nth args 2) nil))) (if (string? seq) - (if end (substr seq start (- end 1)) (substr seq start (- (len seq) 1))) + (if end (substr seq start (- end start)) (substr seq start (- (len seq) start))) (if (= seq nil) (list) (if end (slice seq start end) (slice seq start (len seq))))))) "STRING" (fn (args) @@ -552,6 +686,12 @@ (reduce (fn (a c) (str a (if (dict? c) (get c "value") c))) "" x) (str x))) (:else x)))) + "FORMAT" (fn (args) + (let ((dest (nth args 0)) + (ctrl (if (> (len args) 1) (nth args 1) "")) + (fargs (if (> (len args) 2) (slice args 2 (len args)) (list)))) + (let ((result (get (cl-fmt-loop ctrl fargs 0 "") "out"))) + (if (= dest nil) result nil)))) "MAKE-LIST" (fn (args) (let ((n (nth args 0))) (map (fn (_) nil) (range 0 n)))))) diff --git a/lib/common-lisp/scoreboard.json b/lib/common-lisp/scoreboard.json index 0f636fd7..b705e3c7 100644 --- a/lib/common-lisp/scoreboard.json +++ b/lib/common-lisp/scoreboard.json @@ -1,6 +1,6 @@ { - "generated": "2026-05-05T12:16:51Z", - "total_pass": 508, + "generated": "2026-05-05T12:23:35Z", + "total_pass": 514, "total_fail": 0, "suites": [ {"name": "Phase 1: tokenizer/reader", "pass": 79, "fail": 0}, @@ -14,6 +14,6 @@ {"name": "Phase 4: geometry", "pass": 12, "fail": 0}, {"name": "Phase 4: mop-trace", "pass": 13, "fail": 0}, {"name": "Phase 5: macros+LOOP", "pass": 27, "fail": 0}, - {"name": "Phase 6: stdlib", "pass": 44, "fail": 0} + {"name": "Phase 6: stdlib", "pass": 50, "fail": 0} ] } diff --git a/lib/common-lisp/scoreboard.md b/lib/common-lisp/scoreboard.md index 67cc341f..94567191 100644 --- a/lib/common-lisp/scoreboard.md +++ b/lib/common-lisp/scoreboard.md @@ -1,6 +1,6 @@ # Common Lisp on SX — Scoreboard -_Generated: 2026-05-05 12:16 UTC_ +_Generated: 2026-05-05 12:23 UTC_ | Suite | Pass | Fail | Status | |-------|------|------|--------| @@ -15,6 +15,6 @@ _Generated: 2026-05-05 12:16 UTC_ | Phase 4: geometry | 12 | 0 | pass | | Phase 4: mop-trace | 13 | 0 | pass | | Phase 5: macros+LOOP | 27 | 0 | pass | -| Phase 6: stdlib | 44 | 0 | pass | +| Phase 6: stdlib | 50 | 0 | pass | -**Total: 508 passed, 0 failed** +**Total: 514 passed, 0 failed** diff --git a/lib/common-lisp/tests/stdlib.sx b/lib/common-lisp/tests/stdlib.sx index df985f6e..a23c45b2 100644 --- a/lib/common-lisp/tests/stdlib.sx +++ b/lib/common-lisp/tests/stdlib.sx @@ -234,6 +234,32 @@ (ev "(subseq \"hello\" 2)") "llo") +;; ── FORMAT ───────────────────────────────────────────────────────── + +(check "format ~A" + (ev "(format nil \"hello ~A\" \"world\")") + "hello world") + +(check "format ~D" + (ev "(format nil \"~D items\" 42)") + "42 items") + +(check "format two args" + (ev "(format nil \"~A ~A\" 1 2)") + "1 2") + +(check "format ~A+~A=~A" + (ev "(format nil \"~A + ~A = ~A\" 1 2 3)") + "1 + 2 = 3") + +(check "format iterate" + (ev "(format nil \"~{~A~}\" (quote (1 2 3)))") + "123") + +(check "format iterate with space" + (ev "(format nil \"(~{~A ~})\" (quote (1 2 3)))") + "(1 2 3 )") + ;; ── summary ────────────────────────────────────────────────────── (define stdlib-passed passed) diff --git a/plans/common-lisp-on-sx.md b/plans/common-lisp-on-sx.md index 4c397904..15eab68a 100644 --- a/plans/common-lisp-on-sx.md +++ b/plans/common-lisp-on-sx.md @@ -107,7 +107,7 @@ Core mapping: - [x] Sequence functions — `mapcar`, `mapc`, `mapcan`, `reduce`, `find`, `find-if`, `position`, `count`, `every`, `some`, `notany`, `notevery`, `remove`, `remove-if`, `subst` - [x] List ops — `assoc`, `getf`, `nth`, `last`, `butlast`, `nthcdr`, `tailp`, `ldiff` - [x] String ops — `string=`, `string-upcase`, `string-downcase`, `subseq`, `concatenate` -- [ ] FORMAT — basic directives `~A`, `~S`, `~D`, `~F`, `~%`, `~&`, `~T`, `~{...~}` (iteration), `~[...~]` (conditional), `~^` (escape), `~P` (plural) +- [x] FORMAT — basic directives `~A`, `~S`, `~D`, `~F`, `~%`, `~&`, `~T`, `~{...~}` (iteration), `~[...~]` (conditional), `~^` (escape), `~P` (plural) - [ ] Drive corpus to 200+ green ## SX primitive baseline @@ -124,6 +124,8 @@ data; format for string templating. _Newest first._ +- 2026-05-05: Phase 6 FORMAT — cl-fmt-a/cl-fmt-s/cl-fmt-find-close/cl-fmt-iterate/cl-fmt-loop in eval.sx; ~A/~S/~D/~F/~%/~&/~T/~P/~{...~}/~[...~]/~^/~~; also fixed substr(start,length) semantics throughout (SUBSEQ, cl-fmt-loop); 6 FORMAT tests added to stdlib.sx; 514 total tests, 0 failed. + - 2026-05-05: Phase 6 stdlib — sequence functions (mapc/mapcan/reduce/find/find-if/find-if-not/position/position-if/count/count-if/every/some/notany/notevery/remove/remove-if/remove-if-not/subst/member), list ops (assoc/rassoc/getf/last/butlast/nthcdr/copy-list/list*/caar/cadr/cdar/cddr/caddr/cadddr/pairlis), string ops (subseq/string/char/string-length/string), plus coerce/make-list/write-to-string; 44 tests in tests/stdlib.sx; Phase 6 sequence+list+string boxes ticked. Total: 508 tests, 0 failed. - 2026-05-05: Phase 4 CLOS fully complete — `lib/common-lisp/clos.sx` (27 forms): clos-class-registry (8 built-in classes), defclass/make-instance/slot-value/slot-boundp/set-slot-value!/find-class/change-class, defgeneric/defmethod with :before/:after/:around, clos-call-generic (standard method combination: sort by specificity, fire befores, call primary chain, fire afters in reverse), call-next-method/next-method-p, with-slots, accessor installation; 41 tests in `tests/clos.sx`; classic programs `geometry.sx` (12 tests, multi-dispatch intersect on P/L/Plane) and `mop-trace.sx` (13 tests, :before/:after tracing). Dynamic variables in eval.sx: cl-apply-dyn saves/restores global bindings around let for specials (cl-mark-special!/cl-special?/cl-dyn-unbound). Key gotchas: qualifier strings are "before"/"after"/"around" (no colon); dict-set pure = assoc; dict->list = (map (fn (k) (list k (get d k))) (keys d)); clos-add-reader-method bootstrapped via set! after defmethod defined; test isolation: use unique var names to avoid *y* collision. 437 total tests, 0 failed.