pull MAKE-PROPSPEC out of PROPS & set SYSTEMS from *HOST*

We want a property application specification expression to be what goes into
DEFPROPSPEC because then we can set the systems slot based on the host to
which the property is applied, rather than looking at *CONSFIG*.

Signed-off-by: Sean Whitton <spwhitton@spwhitton.name>

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