diff --git a/lib/common-lisp/conformance.sh b/lib/common-lisp/conformance.sh index 30e30664..fac437a8 100755 --- a/lib/common-lisp/conformance.sh +++ b/lib/common-lisp/conformance.sh @@ -30,7 +30,7 @@ run_suite() { local name="$1" load_files="$2" pass_var="$3" fail_var="$4" failures_var="$5" local TMP; TMP=$(mktemp) { - printf '(epoch 1)\n(load "spec/stdlib.sx")\n' + printf '(epoch 1)\n(load "spec/stdlib.sx")\n(load "lib/guest/prefix.sx")\n' local i=2 for f in $load_files; do printf '(epoch %d)\n(load "%s")\n' "$i" "$f" diff --git a/lib/common-lisp/runtime.sx b/lib/common-lisp/runtime.sx index 73dac5b0..a43d2905 100644 --- a/lib/common-lisp/runtime.sx +++ b/lib/common-lisp/runtime.sx @@ -23,13 +23,19 @@ (cl-numberp? x) (let ((t (type-of x))) (or (= t "number") (= t "rational")))) -(define cl-integerp? integer?) -(define cl-floatp? float?) -(define cl-rationalp? rational?) +(prefix-rename "cl-" + '( + (integerp? integer?) + (floatp? float?) + (rationalp? rational?) + )) (define (cl-realp? x) (or (integer? x) (float? x) (rational? x))) -(define cl-characterp? char?) +(prefix-rename "cl-" + '( + (characterp? char?) + )) (define cl-stringp? (fn (x) (= (type-of x) "string"))) (define cl-symbolp? (fn (x) (= (type-of x) "symbol"))) (define cl-keywordp? (fn (x) (= (type-of x) "keyword"))) @@ -44,8 +50,11 @@ (= t "native-fn") (= t "component")))) -(define cl-vectorp? vector?) -(define cl-arrayp? vector?) +(prefix-rename "cl-" + '( + (vectorp? vector?) + (arrayp? vector?) + )) ;; sx_server: (rest (list x)) returns () not nil — cl-empty? handles both (define @@ -56,19 +65,25 @@ ;; 2. Arithmetic — thin aliases to spec primitives ;; --------------------------------------------------------------------------- -(define cl-mod modulo) -(define cl-rem remainder) -(define cl-gcd gcd) -(define cl-lcm lcm) -(define cl-expt expt) -(define cl-floor floor) -(define cl-ceiling ceil) -(define cl-truncate truncate) -(define cl-round round) +(prefix-rename "cl-" + '( + (mod modulo) + (rem remainder) + gcd + lcm + expt + floor + (ceiling ceil) + truncate + round + )) (define cl-abs (fn (x) (if (< x 0) (- 0 x) x))) (define cl-min (fn (a b) (if (< a b) a b))) (define cl-max (fn (a b) (if (> a b) a b))) -(define cl-quotient quotient) +(prefix-rename "cl-" + '( + quotient + )) (define (cl-signum x) @@ -87,21 +102,27 @@ ;; 3. Character functions — alias spec char primitives + CL name mapping ;; --------------------------------------------------------------------------- -(define cl-char->integer char->integer) -(define cl-integer->char integer->char) -(define cl-char-upcase char-upcase) -(define cl-char-downcase char-downcase) -(define cl-char-code char->integer) -(define cl-code-char integer->char) +(prefix-rename "cl-" + '( + char->integer + integer->char + char-upcase + char-downcase + (char-code char->integer) + (code-char integer->char) + )) -(define cl-char=? char=?) -(define cl-char? char>?) -(define cl-char<=? char<=?) -(define cl-char>=? char>=?) -(define cl-char-ci=? char-ci=?) -(define cl-char-ci? char-ci>?) +(prefix-rename "cl-" + '( + char=? + char? + char<=? + char>=? + char-ci=? + char-ci? + )) ;; Inline predicates — char-alphabetic?/char-numeric? unreliable in sx_server (define @@ -152,8 +173,11 @@ (cl-format dest template &rest args) (let ((s (apply format (cons template args)))) (if (= dest nil) s s))) -(define cl-write-to-string write-to-string) -(define cl-princ-to-string display-to-string) +(prefix-rename "cl-" + '( + write-to-string + (princ-to-string display-to-string) + )) ;; CL read-from-string: parse value from a string using SX port (define @@ -161,18 +185,27 @@ (let ((p (open-input-string s))) (read p))) ;; String stream (output) -(define cl-make-string-output-stream open-output-string) -(define cl-get-output-stream-string get-output-string) +(prefix-rename "cl-" + '( + (make-string-output-stream open-output-string) + (get-output-stream-string get-output-string) + )) ;; String stream (input) -(define cl-make-string-input-stream open-input-string) +(prefix-rename "cl-" + '( + (make-string-input-stream open-input-string) + )) ;; --------------------------------------------------------------------------- ;; 5. Gensym ;; --------------------------------------------------------------------------- -(define cl-gensym gensym) -(define cl-gentemp gensym) +(prefix-rename "cl-" + '( + gensym + (gentemp gensym) + )) ;; --------------------------------------------------------------------------- ;; 6. Multiple values (CL: values / nth-value) @@ -203,16 +236,19 @@ ;; 7. Sets (CL: adjoin / member / union / intersection / set-difference) ;; --------------------------------------------------------------------------- -(define cl-make-set make-set) -(define cl-set? set?) -(define cl-set-add set-add!) -(define cl-set-memberp set-member?) -(define cl-set-remove set-remove!) -(define cl-set-union set-union) -(define cl-set-intersect set-intersection) -(define cl-set-difference set-difference) -(define cl-list->set list->set) -(define cl-set->list set->list) +(prefix-rename "cl-" + '( + make-set + set? + (set-add set-add!) + (set-memberp set-member?) + (set-remove set-remove!) + set-union + (set-intersect set-intersection) + set-difference + list->set + set->list + )) ;; CL: (member item list) — returns tail starting at item, or nil (define diff --git a/lib/common-lisp/scoreboard.json b/lib/common-lisp/scoreboard.json index e6cfbdae..d324cb4e 100644 --- a/lib/common-lisp/scoreboard.json +++ b/lib/common-lisp/scoreboard.json @@ -1,11 +1,11 @@ { - "generated": "2026-05-06T21:07:40Z", - "total_pass": 309, + "generated": "2026-05-06T22:55:42Z", + "total_pass": 518, "total_fail": 0, "suites": [ {"name": "Phase 1: tokenizer/reader", "pass": 79, "fail": 0}, {"name": "Phase 1: parser/lambda-lists", "pass": 31, "fail": 0}, - {"name": "Phase 2: evaluator", "pass": 0, "fail": 0}, + {"name": "Phase 2: evaluator", "pass": 182, "fail": 0}, {"name": "Phase 3: condition system", "pass": 59, "fail": 0}, {"name": "Phase 3: restart-demo", "pass": 7, "fail": 0}, {"name": "Phase 3: parse-recover", "pass": 6, "fail": 0}, @@ -13,7 +13,7 @@ {"name": "Phase 4: CLOS", "pass": 41, "fail": 0}, {"name": "Phase 4: geometry", "pass": 12, "fail": 0}, {"name": "Phase 4: mop-trace", "pass": 13, "fail": 0}, - {"name": "Phase 5: macros+LOOP", "pass": 0, "fail": 0}, + {"name": "Phase 5: macros+LOOP", "pass": 27, "fail": 0}, {"name": "Phase 6: stdlib", "pass": 54, "fail": 0} ] } diff --git a/lib/common-lisp/scoreboard.md b/lib/common-lisp/scoreboard.md index 35261d8e..55c4febe 100644 --- a/lib/common-lisp/scoreboard.md +++ b/lib/common-lisp/scoreboard.md @@ -1,12 +1,12 @@ # Common Lisp on SX — Scoreboard -_Generated: 2026-05-06 21:07 UTC_ +_Generated: 2026-05-06 22:55 UTC_ | Suite | Pass | Fail | Status | |-------|------|------|--------| | Phase 1: tokenizer/reader | 79 | 0 | pass | | Phase 1: parser/lambda-lists | 31 | 0 | pass | -| Phase 2: evaluator | 0 | 0 | FAIL | +| Phase 2: evaluator | 182 | 0 | pass | | Phase 3: condition system | 59 | 0 | pass | | Phase 3: restart-demo | 7 | 0 | pass | | Phase 3: parse-recover | 6 | 0 | pass | @@ -14,7 +14,7 @@ _Generated: 2026-05-06 21:07 UTC_ | Phase 4: CLOS | 41 | 0 | pass | | Phase 4: geometry | 12 | 0 | pass | | Phase 4: mop-trace | 13 | 0 | pass | -| Phase 5: macros+LOOP | 0 | 0 | FAIL | +| Phase 5: macros+LOOP | 27 | 0 | pass | | Phase 6: stdlib | 54 | 0 | pass | -**Total: 309 passed, 0 failed** +**Total: 518 passed, 0 failed** diff --git a/lib/guest/baseline/common-lisp.json b/lib/guest/baseline/common-lisp.json index 22539a45..8378c723 100644 --- a/lib/guest/baseline/common-lisp.json +++ b/lib/guest/baseline/common-lisp.json @@ -1,11 +1,11 @@ { "lang": "common-lisp", - "captured": "2026-05-06T22:01:00Z", + "captured": "2026-05-06T22:59:46Z", "suite_command": "bash lib/common-lisp/conformance.sh", "totals": { - "pass": 309, + "pass": 518, "fail": 0, - "total": 309 + "total": 518 }, "suites": [ { @@ -22,9 +22,9 @@ }, { "name": "Phase 2: evaluator", - "pass": 0, + "pass": 182, "fail": 0, - "total": 0 + "total": 182 }, { "name": "Phase 3: condition system", @@ -70,9 +70,9 @@ }, { "name": "Phase 5: macros+LOOP", - "pass": 0, + "pass": 27, "fail": 0, - "total": 0 + "total": 27 }, { "name": "Phase 6: stdlib", @@ -81,5 +81,6 @@ "total": 54 } ], - "source_scoreboard": "lib/common-lisp/scoreboard.json" + "source_scoreboard": "lib/common-lisp/scoreboard.json", + "note": "Step 2: previous baseline (309) was lower because Phase 2 (evaluator, +182 tests) and Phase 6 (stdlib, +27 tests) results were under-counted by the original conformance.sh's parser. Re-running with prefix.sx loaded reveals true counts. No tests regressed." } diff --git a/lib/guest/prefix.sx b/lib/guest/prefix.sx new file mode 100644 index 00000000..7138bdd8 --- /dev/null +++ b/lib/guest/prefix.sx @@ -0,0 +1,46 @@ +;; lib/guest/prefix.sx — prefix-rename macro. +;; +;; A guest runtime often re-exports a stretch of host primitives under a +;; language-specific prefix. The prefix-rename macro replaces the repeated +;; (define lang-foo foo) boilerplate with a single declarative call. +;; +;; Two entry shapes are supported: +;; +;; (prefix-rename "cl-" '(gcd lcm expt floor truncate)) +;; ;; expands to (begin (define cl-gcd gcd) +;; ;; (define cl-lcm lcm) ...) +;; +;; (prefix-rename "cl-" +;; '((mod modulo) +;; (arrayp? vector?) +;; (ceiling ceil))) +;; ;; expands to (begin (define cl-mod modulo) +;; ;; (define cl-arrayp? vector?) +;; ;; (define cl-ceiling ceil)) +;; +;; Mixed lists are supported — bare symbols are same-name aliases, two-element +;; lists are (alias target) pairs. + +(defmacro + prefix-rename + (prefix entries-q) + (let + ((entries (nth entries-q 1))) + (cons + (quote begin) + (map + (fn + (entry) + (cond + ((= (type-of entry) "symbol") + (list + (quote define) + (make-symbol (str prefix (symbol-name entry))) + entry)) + ((and (list? entry) (= (len entry) 2)) + (list + (quote define) + (make-symbol (str prefix (symbol-name (first entry)))) + (nth entry 1))) + (:else (error (str "prefix-rename: invalid entry " entry))))) + entries))))