diff options
| -rw-r--r-- | src/combinator.lisp | 29 | ||||
| -rw-r--r-- | src/package.lisp | 2 | ||||
| -rw-r--r-- | src/property.lisp | 4 |
3 files changed, 35 insertions, 0 deletions
diff --git a/src/combinator.lisp b/src/combinator.lisp index 68ae61e..4dcd878 100644 --- a/src/combinator.lisp +++ b/src/combinator.lisp @@ -248,3 +248,32 @@ FLAGFILE exists, PROPAPPS are assumed to all be already applied." (prog1 (propappunapply propapp) (mrun "rm" flagfile))) :args (cdr propapp))) + +(define-function-property-combinator with-unapply (&rest propapps) + "As ESEQPROPS, except that if :UNAPPLY appears in PROPAPPS, then return a +property which applies the elements of PROPAPPS prior to :UNAPPLY, but which +when unapplied ignores the elements of PROPAPPS prior to :UNAPPLY, and instead +applies the elements of PROPAPPS appearing after :UNAPPLY. + +Analogously to how DEFPROPLIST/DEFPROPSPEC allow you to define a property +which works by calling other properties, this combinator allows you to define +an :UNAPPLY subroutine for a property which works by calling other properties." + (let* ((apply (loop for propapp in propapps + until (eql propapp :unapply) collect propapp)) + (unapply (member :unapply propapps)) + (apply-propapp + (if (cdr apply) (apply #'eseqprops apply) (car apply))) + (unapply-propapp (if (cddr unapply) + (apply #'eseqprops (cdr unapply)) + (cadr unapply)))) + (if unapply + (:retprop :type (collapse-propapp-types apply (cdr unapply)) + :hostattrs (lambda-ignoring-args + (propappattrs apply-propapp) + ;; as in definition of UNAPPLY combinator + (with-preserve-hostattrs + (propappattrs unapply-propapp))) + :apply (lambda-ignoring-args (propappapply apply-propapp)) + :unapply (lambda-ignoring-args + (propappapply unapply-propapp))) + apply-propapp))) diff --git a/src/package.lisp b/src/package.lisp index 4af1b15..ba500ef 100644 --- a/src/package.lisp +++ b/src/package.lisp @@ -140,6 +140,7 @@ #:propattrs #:propunapply #:collapse-types + #:collapse-propapp-types #:propapptype #:propappdesc #:propappattrs @@ -194,6 +195,7 @@ #:on-change #:as #:with-flagfile + #:with-unapply ;; host.lisp #:host diff --git a/src/property.lisp b/src/property.lisp index 2ef9f5d..499e061 100644 --- a/src/property.lisp +++ b/src/property.lisp @@ -66,6 +66,10 @@ (defun collapse-types (&rest lists) (if (member :posix (flatten lists)) :posix :lisp)) +(defun collapse-propapp-types (&rest lists) + (if (member :posix (mapcan (curry #'mapcar #'propapptype) lists)) + :posix :lisp)) + (defun propdesc (prop &rest args) (apply (get prop 'desc #'noop) args)) |