diff options
author | Sean Whitton <spwhitton@spwhitton.name> | 2021-03-01 11:15:04 -0700 |
---|---|---|
committer | Sean Whitton <spwhitton@spwhitton.name> | 2021-03-01 14:13:50 -0700 |
commit | 986439442b08b59bb4c44c94fa9f10e12705de66 (patch) | |
tree | 7e4bc96eb20b227487245f1782a5cfe6f5477c9f | |
parent | cb87eeb259ab50cbb136b08516cee49d7b20e240 (diff) | |
download | consfigurator-986439442b08b59bb4c44c94fa9f10e12705de66.tar.gz |
add :PREPROCESS property subroutines
Signed-off-by: Sean Whitton <spwhitton@spwhitton.name>
-rw-r--r-- | doc/properties.rst | 15 | ||||
-rw-r--r-- | src/property.lisp | 13 | ||||
-rw-r--r-- | src/propspec.lisp | 20 |
3 files changed, 42 insertions, 6 deletions
diff --git a/doc/properties.rst b/doc/properties.rst index 7a1c299..ddae56b 100644 --- a/doc/properties.rst +++ b/doc/properties.rst @@ -10,8 +10,19 @@ special meaning in unevaluated property application specifications. Property subroutines -------------------- -A property is composed of four subroutines, which all take the same -arguments. At least one of ``:hostattrs`` or ``:apply`` must be present. +A property is composed of up to five subroutines, which all have the same +lambda list (take the same arguments). At least one of ``:hostattrs``, +``:apply`` or ``:unapply`` must be present. + +``:preprocess`` subroutines +~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +Executed in the root Lisp to modify the arguments that will be passed to the +other subroutines; should return a fresh list of the new arguments. This +subroutine is called on each atomic property application within a property +application specification before the effects of property combinators have been +applied. That is, it is effectively executed on atomic property applications +in isolation from the property application specifications in which they occur. ``:hostattrs`` subroutines ~~~~~~~~~~~~~~~~~~~~~~~~~~ diff --git a/src/property.lisp b/src/property.lisp index 2ba108a..aa6082b 100644 --- a/src/property.lisp +++ b/src/property.lisp @@ -26,7 +26,7 @@ ;; make it a bit more difficult for someone who hasn't read that part of the ;; docs to accidentally violate immutability. -(defun setprop (sym type &key args desc hostattrs check apply unapply) +(defun setprop (sym type &key args desc preprocess hostattrs check apply unapply) ;; use non-keyword keys to avoid clashes with other packages (when type (setf (get sym 'type) type)) @@ -34,6 +34,8 @@ (setf (get sym 'args) args)) (when desc (setf (get sym 'desc) desc)) + (when preprocess + (setf (get sym 'preprocess) preprocess)) (when hostattrs (setf (get sym 'hostattrs) hostattrs)) (when check @@ -49,11 +51,18 @@ apply))) (when unapply (setf (get sym 'unapply) unapply)) + (setf (get sym 'property) t) sym) +(defun isprop (prop) + (and (symbolp prop) (get prop 'property nil))) + (defun proptype (prop) (get prop 'type)) +(defun proppp (prop) + (get prop 'preprocess (lambda (&rest args) args))) + (defun propapptype (propapp) (get (car propapp) 'type)) @@ -96,7 +105,7 @@ (loop for form in forms if (keywordp (car form)) do (setf (getf slots (car form)) (cdr form))) - (loop for kw in '(:hostattrs :check :apply :unapply) + (loop for kw in '(:preprocess :hostattrs :check :apply :unapply) do (if-let ((slot (getf slots kw))) (setf (getf slots kw) ;; inside this lambda we could do some checking of, e.g., diff --git a/src/propspec.lisp b/src/propspec.lisp index 262c147..f63958c 100644 --- a/src/propspec.lisp +++ b/src/propspec.lisp @@ -81,6 +81,21 @@ systems, resolve unapply, onchange etc., and then look in the value cell of each PROPERTY to find a property, and pass each of ARGS to the function in the property's apply slot.")) +(defun make-propspec (&key (systems nil systems-supplied-p) props) + (setq props (copy-tree props)) + (labels ((preprocess (item) + (cond + ((and (listp item) (isprop (car item))) + (rplacd item (apply (proppp (car item)) (cdr item)))) + ((consp item) + (mapc #'preprocess item))))) + (preprocess props)) + (if systems-supplied-p + (make-instance 'propspec :props props :systems systems) + (make-instance 'propspec :props props))) + +;; does not use MAKE-PROPSPEC because we do not want the :PREPROCESS +;; subroutines to be run again when the object is read back in (defmethod print-object ((propspec propspec) stream) (format stream "~S" `(make-instance 'propspec @@ -193,11 +208,12 @@ specification." :test #'string=))) `(list ',first ,@rest) `(list ,@(mapcar #'make-eval-propspec form))))))) - `(make-instance - 'propspec + `(make-propspec ,@(and systems-supplied-p `(:systems ,systems)) :props (list ,@(mapcar #'make-eval-propspec forms))))) +;; doesn't use MAKE-PROPSPEC because each of the propspecs will already have +;; had its :PREPROCESS subroutines run (defmethod append-propspecs ((first propspec) (second propspec)) (make-instance 'propspec :props (append (slot-value first 'applications) |