GUEST: step 2 — lib/guest/prefix.sx prefix-rename macro (partial)
lib/guest/prefix.sx defines a single (defmacro prefix-rename PREFIX ENTRIES) form that takes a prefix string and a quoted list of entries. Each entry is either a bare symbol (same-name alias: cl-foo = foo) or a 2-element list (alias target) for renames (cl-mod = modulo). Ported lib/common-lisp/runtime.sx: 47 hand-written (define cl-X Y) lines across 13 contiguous groups now collapse into prefix-rename calls. Loaded lib/guest/prefix.sx in the conformance preamble so the macro is available when runtime.sx is parsed. Verification: cl scoreboard 518/518, up from a stale baseline of 309/309 — Phase 2 (evaluator, +182) and Phase 6 (stdlib, +27) had under-counted historical results, not affected by this change. No regressions; baseline updated to reflect true counts. PARTIAL — pending second consumer. lua/runtime.sx (the brief's specified second consumer) has zero pure same-name aliases — every lua- definition wraps custom logic. Step left [partial — pending lua] until a consumer fits, or the second-consumer choice is revisited (js/runtime.sx has 2 candidates: isFinite/isNaN). Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
This commit is contained in:
@@ -30,7 +30,7 @@ run_suite() {
|
|||||||
local name="$1" load_files="$2" pass_var="$3" fail_var="$4" failures_var="$5"
|
local name="$1" load_files="$2" pass_var="$3" fail_var="$4" failures_var="$5"
|
||||||
local TMP; TMP=$(mktemp)
|
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
|
local i=2
|
||||||
for f in $load_files; do
|
for f in $load_files; do
|
||||||
printf '(epoch %d)\n(load "%s")\n' "$i" "$f"
|
printf '(epoch %d)\n(load "%s")\n' "$i" "$f"
|
||||||
|
|||||||
@@ -23,13 +23,19 @@
|
|||||||
(cl-numberp? x)
|
(cl-numberp? x)
|
||||||
(let ((t (type-of x))) (or (= t "number") (= t "rational"))))
|
(let ((t (type-of x))) (or (= t "number") (= t "rational"))))
|
||||||
|
|
||||||
(define cl-integerp? integer?)
|
(prefix-rename "cl-"
|
||||||
(define cl-floatp? float?)
|
'(
|
||||||
(define cl-rationalp? rational?)
|
(integerp? integer?)
|
||||||
|
(floatp? float?)
|
||||||
|
(rationalp? rational?)
|
||||||
|
))
|
||||||
|
|
||||||
(define (cl-realp? x) (or (integer? x) (float? x) (rational? x)))
|
(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-stringp? (fn (x) (= (type-of x) "string")))
|
||||||
(define cl-symbolp? (fn (x) (= (type-of x) "symbol")))
|
(define cl-symbolp? (fn (x) (= (type-of x) "symbol")))
|
||||||
(define cl-keywordp? (fn (x) (= (type-of x) "keyword")))
|
(define cl-keywordp? (fn (x) (= (type-of x) "keyword")))
|
||||||
@@ -44,8 +50,11 @@
|
|||||||
(= t "native-fn")
|
(= t "native-fn")
|
||||||
(= t "component"))))
|
(= t "component"))))
|
||||||
|
|
||||||
(define cl-vectorp? vector?)
|
(prefix-rename "cl-"
|
||||||
(define cl-arrayp? vector?)
|
'(
|
||||||
|
(vectorp? vector?)
|
||||||
|
(arrayp? vector?)
|
||||||
|
))
|
||||||
|
|
||||||
;; sx_server: (rest (list x)) returns () not nil — cl-empty? handles both
|
;; sx_server: (rest (list x)) returns () not nil — cl-empty? handles both
|
||||||
(define
|
(define
|
||||||
@@ -56,19 +65,25 @@
|
|||||||
;; 2. Arithmetic — thin aliases to spec primitives
|
;; 2. Arithmetic — thin aliases to spec primitives
|
||||||
;; ---------------------------------------------------------------------------
|
;; ---------------------------------------------------------------------------
|
||||||
|
|
||||||
(define cl-mod modulo)
|
(prefix-rename "cl-"
|
||||||
(define cl-rem remainder)
|
'(
|
||||||
(define cl-gcd gcd)
|
(mod modulo)
|
||||||
(define cl-lcm lcm)
|
(rem remainder)
|
||||||
(define cl-expt expt)
|
gcd
|
||||||
(define cl-floor floor)
|
lcm
|
||||||
(define cl-ceiling ceil)
|
expt
|
||||||
(define cl-truncate truncate)
|
floor
|
||||||
(define cl-round round)
|
(ceiling ceil)
|
||||||
|
truncate
|
||||||
|
round
|
||||||
|
))
|
||||||
(define cl-abs (fn (x) (if (< x 0) (- 0 x) x)))
|
(define cl-abs (fn (x) (if (< x 0) (- 0 x) x)))
|
||||||
(define cl-min (fn (a b) (if (< a b) a b)))
|
(define cl-min (fn (a b) (if (< a b) a b)))
|
||||||
(define cl-max (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
|
(define
|
||||||
(cl-signum x)
|
(cl-signum x)
|
||||||
@@ -87,21 +102,27 @@
|
|||||||
;; 3. Character functions — alias spec char primitives + CL name mapping
|
;; 3. Character functions — alias spec char primitives + CL name mapping
|
||||||
;; ---------------------------------------------------------------------------
|
;; ---------------------------------------------------------------------------
|
||||||
|
|
||||||
(define cl-char->integer char->integer)
|
(prefix-rename "cl-"
|
||||||
(define cl-integer->char integer->char)
|
'(
|
||||||
(define cl-char-upcase char-upcase)
|
char->integer
|
||||||
(define cl-char-downcase char-downcase)
|
integer->char
|
||||||
(define cl-char-code char->integer)
|
char-upcase
|
||||||
(define cl-code-char integer->char)
|
char-downcase
|
||||||
|
(char-code char->integer)
|
||||||
|
(code-char integer->char)
|
||||||
|
))
|
||||||
|
|
||||||
(define cl-char=? char=?)
|
(prefix-rename "cl-"
|
||||||
(define cl-char<? char<?)
|
'(
|
||||||
(define cl-char>? char>?)
|
char=?
|
||||||
(define cl-char<=? char<=?)
|
char<?
|
||||||
(define cl-char>=? char>=?)
|
char>?
|
||||||
(define cl-char-ci=? char-ci=?)
|
char<=?
|
||||||
(define cl-char-ci<? char-ci<?)
|
char>=?
|
||||||
(define cl-char-ci>? char-ci>?)
|
char-ci=?
|
||||||
|
char-ci<?
|
||||||
|
char-ci>?
|
||||||
|
))
|
||||||
|
|
||||||
;; Inline predicates — char-alphabetic?/char-numeric? unreliable in sx_server
|
;; Inline predicates — char-alphabetic?/char-numeric? unreliable in sx_server
|
||||||
(define
|
(define
|
||||||
@@ -152,8 +173,11 @@
|
|||||||
(cl-format dest template &rest args)
|
(cl-format dest template &rest args)
|
||||||
(let ((s (apply format (cons template args)))) (if (= dest nil) s s)))
|
(let ((s (apply format (cons template args)))) (if (= dest nil) s s)))
|
||||||
|
|
||||||
(define cl-write-to-string write-to-string)
|
(prefix-rename "cl-"
|
||||||
(define cl-princ-to-string display-to-string)
|
'(
|
||||||
|
write-to-string
|
||||||
|
(princ-to-string display-to-string)
|
||||||
|
))
|
||||||
|
|
||||||
;; CL read-from-string: parse value from a string using SX port
|
;; CL read-from-string: parse value from a string using SX port
|
||||||
(define
|
(define
|
||||||
@@ -161,18 +185,27 @@
|
|||||||
(let ((p (open-input-string s))) (read p)))
|
(let ((p (open-input-string s))) (read p)))
|
||||||
|
|
||||||
;; String stream (output)
|
;; String stream (output)
|
||||||
(define cl-make-string-output-stream open-output-string)
|
(prefix-rename "cl-"
|
||||||
(define cl-get-output-stream-string get-output-string)
|
'(
|
||||||
|
(make-string-output-stream open-output-string)
|
||||||
|
(get-output-stream-string get-output-string)
|
||||||
|
))
|
||||||
|
|
||||||
;; String stream (input)
|
;; String stream (input)
|
||||||
(define cl-make-string-input-stream open-input-string)
|
(prefix-rename "cl-"
|
||||||
|
'(
|
||||||
|
(make-string-input-stream open-input-string)
|
||||||
|
))
|
||||||
|
|
||||||
;; ---------------------------------------------------------------------------
|
;; ---------------------------------------------------------------------------
|
||||||
;; 5. Gensym
|
;; 5. Gensym
|
||||||
;; ---------------------------------------------------------------------------
|
;; ---------------------------------------------------------------------------
|
||||||
|
|
||||||
(define cl-gensym gensym)
|
(prefix-rename "cl-"
|
||||||
(define cl-gentemp gensym)
|
'(
|
||||||
|
gensym
|
||||||
|
(gentemp gensym)
|
||||||
|
))
|
||||||
|
|
||||||
;; ---------------------------------------------------------------------------
|
;; ---------------------------------------------------------------------------
|
||||||
;; 6. Multiple values (CL: values / nth-value)
|
;; 6. Multiple values (CL: values / nth-value)
|
||||||
@@ -203,16 +236,19 @@
|
|||||||
;; 7. Sets (CL: adjoin / member / union / intersection / set-difference)
|
;; 7. Sets (CL: adjoin / member / union / intersection / set-difference)
|
||||||
;; ---------------------------------------------------------------------------
|
;; ---------------------------------------------------------------------------
|
||||||
|
|
||||||
(define cl-make-set make-set)
|
(prefix-rename "cl-"
|
||||||
(define cl-set? set?)
|
'(
|
||||||
(define cl-set-add set-add!)
|
make-set
|
||||||
(define cl-set-memberp set-member?)
|
set?
|
||||||
(define cl-set-remove set-remove!)
|
(set-add set-add!)
|
||||||
(define cl-set-union set-union)
|
(set-memberp set-member?)
|
||||||
(define cl-set-intersect set-intersection)
|
(set-remove set-remove!)
|
||||||
(define cl-set-difference set-difference)
|
set-union
|
||||||
(define cl-list->set list->set)
|
(set-intersect set-intersection)
|
||||||
(define cl-set->list set->list)
|
set-difference
|
||||||
|
list->set
|
||||||
|
set->list
|
||||||
|
))
|
||||||
|
|
||||||
;; CL: (member item list) — returns tail starting at item, or nil
|
;; CL: (member item list) — returns tail starting at item, or nil
|
||||||
(define
|
(define
|
||||||
|
|||||||
@@ -1,11 +1,11 @@
|
|||||||
{
|
{
|
||||||
"generated": "2026-05-06T21:07:40Z",
|
"generated": "2026-05-06T22:55:42Z",
|
||||||
"total_pass": 309,
|
"total_pass": 518,
|
||||||
"total_fail": 0,
|
"total_fail": 0,
|
||||||
"suites": [
|
"suites": [
|
||||||
{"name": "Phase 1: tokenizer/reader", "pass": 79, "fail": 0},
|
{"name": "Phase 1: tokenizer/reader", "pass": 79, "fail": 0},
|
||||||
{"name": "Phase 1: parser/lambda-lists", "pass": 31, "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: condition system", "pass": 59, "fail": 0},
|
||||||
{"name": "Phase 3: restart-demo", "pass": 7, "fail": 0},
|
{"name": "Phase 3: restart-demo", "pass": 7, "fail": 0},
|
||||||
{"name": "Phase 3: parse-recover", "pass": 6, "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: CLOS", "pass": 41, "fail": 0},
|
||||||
{"name": "Phase 4: geometry", "pass": 12, "fail": 0},
|
{"name": "Phase 4: geometry", "pass": 12, "fail": 0},
|
||||||
{"name": "Phase 4: mop-trace", "pass": 13, "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}
|
{"name": "Phase 6: stdlib", "pass": 54, "fail": 0}
|
||||||
]
|
]
|
||||||
}
|
}
|
||||||
|
|||||||
@@ -1,12 +1,12 @@
|
|||||||
# Common Lisp on SX — Scoreboard
|
# Common Lisp on SX — Scoreboard
|
||||||
|
|
||||||
_Generated: 2026-05-06 21:07 UTC_
|
_Generated: 2026-05-06 22:55 UTC_
|
||||||
|
|
||||||
| Suite | Pass | Fail | Status |
|
| Suite | Pass | Fail | Status |
|
||||||
|-------|------|------|--------|
|
|-------|------|------|--------|
|
||||||
| Phase 1: tokenizer/reader | 79 | 0 | pass |
|
| Phase 1: tokenizer/reader | 79 | 0 | pass |
|
||||||
| Phase 1: parser/lambda-lists | 31 | 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: condition system | 59 | 0 | pass |
|
||||||
| Phase 3: restart-demo | 7 | 0 | pass |
|
| Phase 3: restart-demo | 7 | 0 | pass |
|
||||||
| Phase 3: parse-recover | 6 | 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: CLOS | 41 | 0 | pass |
|
||||||
| Phase 4: geometry | 12 | 0 | pass |
|
| Phase 4: geometry | 12 | 0 | pass |
|
||||||
| Phase 4: mop-trace | 13 | 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 |
|
| Phase 6: stdlib | 54 | 0 | pass |
|
||||||
|
|
||||||
**Total: 309 passed, 0 failed**
|
**Total: 518 passed, 0 failed**
|
||||||
|
|||||||
@@ -1,11 +1,11 @@
|
|||||||
{
|
{
|
||||||
"lang": "common-lisp",
|
"lang": "common-lisp",
|
||||||
"captured": "2026-05-06T22:01:00Z",
|
"captured": "2026-05-06T22:59:46Z",
|
||||||
"suite_command": "bash lib/common-lisp/conformance.sh",
|
"suite_command": "bash lib/common-lisp/conformance.sh",
|
||||||
"totals": {
|
"totals": {
|
||||||
"pass": 309,
|
"pass": 518,
|
||||||
"fail": 0,
|
"fail": 0,
|
||||||
"total": 309
|
"total": 518
|
||||||
},
|
},
|
||||||
"suites": [
|
"suites": [
|
||||||
{
|
{
|
||||||
@@ -22,9 +22,9 @@
|
|||||||
},
|
},
|
||||||
{
|
{
|
||||||
"name": "Phase 2: evaluator",
|
"name": "Phase 2: evaluator",
|
||||||
"pass": 0,
|
"pass": 182,
|
||||||
"fail": 0,
|
"fail": 0,
|
||||||
"total": 0
|
"total": 182
|
||||||
},
|
},
|
||||||
{
|
{
|
||||||
"name": "Phase 3: condition system",
|
"name": "Phase 3: condition system",
|
||||||
@@ -70,9 +70,9 @@
|
|||||||
},
|
},
|
||||||
{
|
{
|
||||||
"name": "Phase 5: macros+LOOP",
|
"name": "Phase 5: macros+LOOP",
|
||||||
"pass": 0,
|
"pass": 27,
|
||||||
"fail": 0,
|
"fail": 0,
|
||||||
"total": 0
|
"total": 27
|
||||||
},
|
},
|
||||||
{
|
{
|
||||||
"name": "Phase 6: stdlib",
|
"name": "Phase 6: stdlib",
|
||||||
@@ -81,5 +81,6 @@
|
|||||||
"total": 54
|
"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."
|
||||||
}
|
}
|
||||||
|
|||||||
46
lib/guest/prefix.sx
Normal file
46
lib/guest/prefix.sx
Normal file
@@ -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))))
|
||||||
Reference in New Issue
Block a user