cl: Phase 1 lambda-list parser + 31 tests (172 total green)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Has been cancelled

Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
This commit is contained in:
2026-04-25 18:26:58 +00:00
parent bcf6057ac5
commit cdee007185
3 changed files with 325 additions and 2 deletions

View File

@@ -227,6 +227,124 @@
(get item "rest")
(concat acc (list (get item "form"))))))))))))
;; ── lambda-list parser ───────────────────────────────────────────
;;
;; (cl-parse-lambda-list forms) — parse a list of CL forms (already read)
;; into a structured dict:
;; {:required (list sym ...)
;; :optional (list {:name N :default D :supplied S} ...)
;; :rest nil | "SYM"
;; :key (list {:name N :keyword K :default D :supplied S} ...)
;; :allow-other-keys false | true
;; :aux (list {:name N :init I} ...)}
;;
;; Symbols arrive as SX strings (upcase). &-markers are strings like "&OPTIONAL".
;; Key params: keyword is the upcase name string; caller uses it as :keyword.
;; Supplied-p: nil when absent.
(define
cl-parse-opt-spec
(fn
(spec)
(if
(list? spec)
{:name (nth spec 0)
:default (if (> (len spec) 1) (nth spec 1) nil)
:supplied (if (> (len spec) 2) (nth spec 2) nil)}
{:name spec :default nil :supplied nil})))
(define
cl-parse-key-spec
(fn
(spec)
(if
(list? spec)
(let
((first (nth spec 0)))
(if
(list? first)
;; ((:keyword var) default supplied-p)
{:name (nth first 1)
:keyword (get first "name")
:default (if (> (len spec) 1) (nth spec 1) nil)
:supplied (if (> (len spec) 2) (nth spec 2) nil)}
;; (var default supplied-p)
{:name first
:keyword first
:default (if (> (len spec) 1) (nth spec 1) nil)
:supplied (if (> (len spec) 2) (nth spec 2) nil)}))
{:name spec :keyword spec :default nil :supplied nil})))
(define
cl-parse-aux-spec
(fn
(spec)
(if
(list? spec)
{:name (nth spec 0) :init (if (> (len spec) 1) (nth spec 1) nil)}
{:name spec :init nil})))
(define
cl-parse-lambda-list
(fn
(forms)
(let
((state "required")
(required (list))
(optional (list))
(rest-name nil)
(key (list))
(allow-other-keys false)
(aux (list)))
(define
scan
(fn
(items)
(when
(> (len items) 0)
(let
((item (nth items 0)) (tail (rest items)))
(cond
((= item "&OPTIONAL")
(do (set! state "optional") (scan tail)))
((= item "&REST")
(do (set! state "rest") (scan tail)))
((= item "&BODY")
(do (set! state "rest") (scan tail)))
((= item "&KEY")
(do (set! state "key") (scan tail)))
((= item "&AUX")
(do (set! state "aux") (scan tail)))
((= item "&ALLOW-OTHER-KEYS")
(do (set! allow-other-keys true) (scan tail)))
((= state "required")
(do (append! required item) (scan tail)))
((= state "optional")
(do (append! optional (cl-parse-opt-spec item)) (scan tail)))
((= state "rest")
(do (set! rest-name item) (set! state "done") (scan tail)))
((= state "key")
(do (append! key (cl-parse-key-spec item)) (scan tail)))
((= state "aux")
(do (append! aux (cl-parse-aux-spec item)) (scan tail)))
(:else (scan tail)))))))
(scan forms)
{:required required
:optional optional
:rest rest-name
:key key
:allow-other-keys allow-other-keys
:aux aux})))
;; Convenience: parse lambda list from a CL source string
(define
cl-parse-lambda-list-str
(fn
(src)
(cl-parse-lambda-list (cl-read src))))
;; ── public API ────────────────────────────────────────────────────
(define