diff options
| author | Sean Whitton <spwhitton@spwhitton.name> | 2021-03-18 09:05:16 -0700 |
|---|---|---|
| committer | Sean Whitton <spwhitton@spwhitton.name> | 2021-03-18 09:55:57 -0700 |
| commit | 415ce75b066526125c5647e54b0db4821f4ddc54 (patch) | |
| tree | 0022b788862ed97f66c45d93b2d0477eb0f53445 /src | |
| parent | 80b5cee2fdf6c590db0e257b3c5fb67a5aa001d7 (diff) | |
| download | consfigurator-415ce75b066526125c5647e54b0db4821f4ddc54.tar.gz | |
introduce FORM-BEGINNING-WITH
Signed-off-by: Sean Whitton <spwhitton@spwhitton.name>
Diffstat (limited to 'src')
| -rw-r--r-- | src/property.lisp | 4 | ||||
| -rw-r--r-- | src/util.lisp | 5 |
2 files changed, 6 insertions, 3 deletions
diff --git a/src/property.lisp b/src/property.lisp index 2a5cc74..bf62fe5 100644 --- a/src/property.lisp +++ b/src/property.lisp @@ -231,7 +231,7 @@ parsing FORMSV and pushing SETPROP keyword argument pairs to plist SLOTSV." (loop for form in (append (getf ,slotsv :check) (getf ,slotsv :apply)) - when (and (listp form) (eq 'declare (car form))) + when (form-beginning-with declare form) nconc (loop for declaration in (cdr form) @@ -343,7 +343,7 @@ You can usually use DEFPROPLIST instead of DEFPROPSPEC, which see." (setf (getf slots :unapply) '(lambda (plist) (propappunapply (eval-propspec (getf plist :propspec))))) - (when (and (listp (car forms)) (eq :desc (caar forms))) + (when (form-beginning-with :desc (car forms)) (setf (getf slots :desc) `(lambda (plist) (destructuring-bind ,lambda diff --git a/src/util.lisp b/src/util.lisp index 2d35e0c..c4b4df2 100644 --- a/src/util.lisp +++ b/src/util.lisp @@ -79,8 +79,11 @@ supported." ,@(and docstring `(,docstring)) (error ',name :format-control message :format-arguments args)))) +(defmacro form-beginning-with (sym form) + `(and (listp ,form) (eq ',sym (car ,form)))) + (defun strip-declarations (forms) - (loop while (and (listp (car forms)) (eq 'declare (caar forms))) + (loop while (form-beginning-with declare (car forms)) do (pop forms) finally (return forms))) |