diff options
| author | Sean Whitton <spwhitton@spwhitton.name> | 2021-03-01 13:00:54 -0700 |
|---|---|---|
| committer | Sean Whitton <spwhitton@spwhitton.name> | 2021-03-01 14:47:27 -0700 |
| commit | a480000c3dc483e21f7d60f0889891c745d346c8 (patch) | |
| tree | def592c6d2f25572be5f75e666a406279f2fb2a1 | |
| parent | 27d73167ae319284d83d6c48baf23e834e8dfe0c (diff) | |
| download | consfigurator-a480000c3dc483e21f7d60f0889891c745d346c8.tar.gz | |
implement special evaluation rules when symbol ends with a period
Signed-off-by: Sean Whitton <spwhitton@spwhitton.name>
| -rw-r--r-- | src/package.lisp | 2 | ||||
| -rw-r--r-- | src/propspec.lisp | 25 |
2 files changed, 22 insertions, 5 deletions
diff --git a/src/package.lisp b/src/package.lisp index 8496124..86bb7cb 100644 --- a/src/package.lisp +++ b/src/package.lisp @@ -7,6 +7,7 @@ #:strcat #:string-prefix-p #:split-string + #:last-char #:escape-sh-command #:escape-sh-token #:run-program @@ -26,6 +27,7 @@ #:strcat #:string-prefix-p #:split-string + #:last-char #:escape-sh-command #:escape-sh-token #:run-program diff --git a/src/propspec.lisp b/src/propspec.lisp index 4524501..45f4f18 100644 --- a/src/propspec.lisp +++ b/src/propspec.lisp @@ -227,15 +227,30 @@ that the returned code should produce. Intended for use by macros which allow the user to provide expressions instead of values as the arguments to properties when building a property application specification." - (labels ((make-eval-propspec (form) + (labels ((dedot-symbol (s) + (let ((n (symbol-name s))) + (intern (subseq n 0 (1- (length n))) (symbol-package s)))) + (special-eval (args) + (let ((first (if (and (listp (car args)) + (or (keywordp (caar args)) + (and (listp (caar args)) + (keywordp (caaar args))))) + `(quote ,(car args)) + (car args))) + (rest (nreverse (cdr (reverse (cdr args)))))) + `(,first ,@rest ,(props (lastcar args))))) + (make-eval-propspec (form) (if (atom form) `(quote ,form) (destructuring-bind (first . rest) form (if (and (symbolp first) - (not (member (symbol-name first) - '("UNAPPLY") - :test #'string=))) - `(list ',first ,@rest) + (not (member (symbol-name first) + '("UNAPPLY") + :test #'string=))) + (if (char= #\. (last-char (symbol-name first))) + `(list ',(dedot-symbol first) + ,@(special-eval rest)) + `(list ',first ,@rest)) `(list ,@(mapcar #'make-eval-propspec form))))))) `(make-propspec ,@(and systems-supplied-p `(:systems ,systems)) |