cl: Phase 6 FORMAT + substr fixes — 514/514 tests
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 39s
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 39s
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 <noreply@anthropic.com>
This commit is contained in:
@@ -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))))))
|
||||
|
||||
@@ -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}
|
||||
]
|
||||
}
|
||||
|
||||
@@ -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**
|
||||
|
||||
@@ -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)
|
||||
|
||||
Reference in New Issue
Block a user