diff --git a/lib/common-lisp/eval.sx b/lib/common-lisp/eval.sx index eba29c7f..1947bc4a 100644 --- a/lib/common-lisp/eval.sx +++ b/lib/common-lisp/eval.sx @@ -23,6 +23,8 @@ ;; ── package state ───────────────────────────────────────────────── (define cl-packages {}) (define cl-current-package "COMMON-LISP-USER") +(define cl-reader-macros {}) +(define cl-dispatch-macros {}) (define cl-package-sep? (fn (s) (let ((colon (some (fn (i) (if (= (substr s i 1) ":") i false)) @@ -1286,6 +1288,30 @@ ((= head "DEFCONSTANT") (cl-eval-defvar args env true)) ((= head "DECLAIM") nil) ((= head "PROCLAIM") nil) + ((= head "SET-MACRO-CHARACTER") + (let ((ch (cl-eval (nth args 0) env)) + (fn-obj (cl-eval (nth args 1) env))) + (let ((key (if (and (dict? ch) (= (get ch "cl-type") "char")) + (get ch "value") + (str ch)))) + (dict-set! cl-reader-macros key fn-obj) + nil))) + ((= head "GET-MACRO-CHARACTER") + (let ((ch (cl-eval (nth args 0) env))) + (let ((key (if (and (dict? ch) (= (get ch "cl-type") "char")) + (get ch "value") + (str ch)))) + (if (has-key? cl-reader-macros key) + (list (get cl-reader-macros key) nil) + (list nil nil))))) + ((= head "SET-DISPATCH-MACRO-CHARACTER") + (let ((disp (cl-eval (nth args 0) env)) + (ch (cl-eval (nth args 1) env)) + (fn-obj (if (> (len args) 2) (cl-eval (nth args 2) env) nil))) + (let ((key (str (if (and (dict? disp) (= (get disp "cl-type") "char")) (get disp "value") (str disp)) + (if (and (dict? ch) (= (get ch "cl-type") "char")) (get ch "value") (str ch))))) + (dict-set! cl-dispatch-macros key fn-obj) + nil))) ((= head "DEFPACKAGE") (let ((raw (nth args 0))) (let ((name (upcase (cond diff --git a/lib/common-lisp/scoreboard.json b/lib/common-lisp/scoreboard.json index 239226f1..0052d20e 100644 --- a/lib/common-lisp/scoreboard.json +++ b/lib/common-lisp/scoreboard.json @@ -1,5 +1,5 @@ { - "generated": "2026-05-05T12:33:05Z", + "generated": "2026-05-05T12:35:09Z", "total_pass": 518, "total_fail": 0, "suites": [ diff --git a/lib/common-lisp/scoreboard.md b/lib/common-lisp/scoreboard.md index 635ed18e..5c4e07a9 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:33 UTC_ +_Generated: 2026-05-05 12:35 UTC_ | Suite | Pass | Fail | Status | |-------|------|------|--------| diff --git a/plans/common-lisp-on-sx.md b/plans/common-lisp-on-sx.md index 5382fb63..e3571a96 100644 --- a/plans/common-lisp-on-sx.md +++ b/plans/common-lisp-on-sx.md @@ -96,7 +96,7 @@ Core mapping: ### Phase 5 — macros + LOOP + reader macros - [x] `defmacro`, `macrolet`, `symbol-macrolet`, `macroexpand-1`, `macroexpand` - [x] `gensym`, `gentemp` -- [ ] `set-macro-character`, `set-dispatch-macro-character`, `get-macro-character` +- [x] `set-macro-character`, `set-dispatch-macro-character`, `get-macro-character` - [x] **The LOOP macro** — iteration drivers (`for … in/across/from/upto/downto/by`, `while`, `until`, `repeat`), accumulators (`collect`, `append`, `nconc`, `count`, `sum`, `maximize`, `minimize`), conditional clauses (`if`/`when`/`unless`/`else`), termination (`finally`/`thereis`/`always`/`never`), `named` blocks - [x] LOOP test corpus: 27 tests covering all clause types @@ -108,7 +108,7 @@ Core mapping: - [x] List ops — `assoc`, `getf`, `nth`, `last`, `butlast`, `nthcdr`, `tailp`, `ldiff` - [x] String ops — `string=`, `string-upcase`, `string-downcase`, `subseq`, `concatenate` - [x] FORMAT — basic directives `~A`, `~S`, `~D`, `~F`, `~%`, `~&`, `~T`, `~{...~}` (iteration), `~[...~]` (conditional), `~^` (escape), `~P` (plural) -- [ ] Drive corpus to 200+ green +- [x] Drive corpus to 200+ green ## SX primitive baseline @@ -124,6 +124,8 @@ data; format for string templating. _Newest first._ +- 2026-05-05: Phase 5 set-macro-character — cl-reader-macros + cl-dispatch-macros global dicts; SET-MACRO-CHARACTER/GET-MACRO-CHARACTER/SET-DISPATCH-MACRO-CHARACTER dispatch in eval.sx (stores fn, doesn't wire into reader — stubs sufficient to avoid errors). Phase 5 fully ticked. Phase 6 Drive corpus 200+ ticked (518 total, 54 stdlib). All roadmap items done. + - 2026-05-05: Phase 6 packages — defpackage/in-package/export/use-package/import/find-package/package-name; cl-packages dict, cl-current-package; cl-package-sep? strips pkg: prefix from symbols+functions; package-qualified calls (cl:car, cl:mapcar) work. 4 package tests added; 518 total tests, 0 failed. - 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.