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
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:
@@ -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
|
||||
|
||||
Reference in New Issue
Block a user