diff options
-rw-r--r-- | src/deployment.lisp | 6 | ||||
-rw-r--r-- | src/host.lisp | 4 | ||||
-rw-r--r-- | src/property.lisp | 22 | ||||
-rw-r--r-- | src/propspec.lisp | 17 |
4 files changed, 28 insertions, 21 deletions
diff --git a/src/deployment.lisp b/src/deployment.lisp index ebef6f4..693afb9 100644 --- a/src/deployment.lisp +++ b/src/deployment.lisp @@ -109,7 +109,8 @@ ADDITIONAL-PROPERTIES may set additional hostattrs)." `(deploy* ',connections ,host (let ((*host* (shallow-copy-host ,host))) - (props eseqprops ,@additional-properties))))) + (make-propspec + :propspec (props eseqprops ,@additional-properties)))))) (defmacro deploy-these (connections host &body properties) "Like DEPLOY, except apply each of the properties specified by PROPERTIES, @@ -137,7 +138,8 @@ set additional hostattrs)." `(deploy-these* ',connections ,host (let ((*host* (shallow-copy-host ,host))) - (props eseqprops ,@properties))))) + (make-propspec + :propspec (props eseqprops ,@properties)))))) (defmacro defdeploy (name (connections host) &body additional-properties) "Define a function which does (DEPLOY CONNECTIONS HOST ADDITIONAL-PROPERTIES). diff --git a/src/host.lisp b/src/host.lisp index 8e4c42e..cbc756d 100644 --- a/src/host.lisp +++ b/src/host.lisp @@ -132,7 +132,9 @@ entries." `(progn (declaim (type host ,hostname-sym)) (defparameter ,hostname-sym - (make-host :hostattrs ',attrs :propspec (props seqprops ,@properties)) + (make-host :hostattrs ',attrs + :propspec (make-propspec + :propspec (props seqprops ,@properties))) ,(car (getf attrs :desc))) ,@(and deploy `((defdeploy ,hostname-sym (,deploy ,hostname-sym))))))) diff --git a/src/property.lisp b/src/property.lisp index d08b60d..1adebb4 100644 --- a/src/property.lisp +++ b/src/property.lisp @@ -192,9 +192,11 @@ dotted name alongside NAME." `(defmacro ,(format-symbol (symbol-package name) "~A." name) ,new-args ,@(cond ((and first will-props) - `(`(,',name ,,first ,,@middle (props eseqprops ,@,rest)))) + `(`(,',name ,,first ,,@middle (make-propspec + :propspec (props eseqprops ,@,rest))))) (will-props - `(`(,',name ,,@middle (props eseqprops ,@,rest)))) + `(`(,',name ,,@middle (make-propspec + :propspec (props eseqprops ,@,rest))))) (first `((declare (ignore ,@(cdr (ordinary-ll-variable-names (ordinary-ll-without-&aux args))))) @@ -323,10 +325,10 @@ docstring for the resulting property. If the first element of the body after any such string is a list beginning with :DESC, the remainder will be used as the :DESC subroutine for the resulting property, like DEFPROP. Otherwise, the body defines a function of the arguments specified by the lambda list which -returns the propspec to be evaluated and applied. It should be a pure -function aside from retrieving hostattrs (as set by other properties applied -to the hosts to which the resulting property is applied, not as set by the -properties in the returned propspec). +returns the property application specification expression to be evaluated and +applied. It should be a pure function aside from retrieving hostattrs (as set +by other properties applied to the hosts to which the resulting property is +applied, not as set by the properties in the returned propspec). You can usually use DEFPROPLIST instead of DEFPROPSPEC, which see." ;; This is implemented by effectively pushing a null pointer to the front of @@ -353,9 +355,11 @@ You can usually use DEFPROPLIST instead of DEFPROPSPEC, which see." (setf (getf slots :hostattrs) `(lambda (plist) (let ((propspec (preprocess-propspec - (destructuring-bind ,lambda - (getf plist :orig-args) - ,@forms)))) + (make-propspec + :systems (propspec-systems (host-propspec *host*)) + :propspec (destructuring-bind ,lambda + (getf plist :orig-args) + ,@forms))))) (setf (getf plist :propspec) propspec) (propappattrs (eval-propspec propspec)))))) diff --git a/src/propspec.lisp b/src/propspec.lisp index 13204d9..0c395dd 100644 --- a/src/propspec.lisp +++ b/src/propspec.lisp @@ -250,17 +250,16 @@ processed." (defmacro props (combinator &rest forms) "Apply variadic COMBINATOR to FORMS and convert from an unevaluated property -application specification expression to a property application specification." +application specification expression to a property application specification +expression." (flet ((evaluate (propapp) `(list ',(car propapp) ,@(cdr propapp)))) - (let ((propspec - (handler-case - (map-propspec-propapps #'evaluate (cons combinator forms) t) - (ambiguous-propspec (c) - ;; resignal with a more specific error message - (error 'ambiguous-unevaluated-propspec - :name (cell-error-name c)))))) - `(make-propspec :propspec ,propspec)))) + (handler-case + (map-propspec-propapps #'evaluate (cons combinator forms) t) + (ambiguous-propspec (c) + ;; resignal with a more specific error message + (error 'ambiguous-unevaluated-propspec + :name (cell-error-name c)))))) ;;;; Property combinators |