From 46536b5196769896670e0bd8f923c9f99501a3ff Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Mon, 1 Mar 2021 11:58:20 -0700 Subject: rework executing :HOSTATTRS subroutines Signed-off-by: Sean Whitton --- src/host.lisp | 35 +++++++++++++++++------------------ 1 file changed, 17 insertions(+), 18 deletions(-) (limited to 'src/host.lisp') diff --git a/src/host.lisp b/src/host.lisp index e55f601..1f2c22a 100644 --- a/src/host.lisp +++ b/src/host.lisp @@ -19,6 +19,9 @@ ;;;; Hosts +;; note that we expect any host object to be such that the :HOSTATTRS +;; subroutines of its propspec has already been run. so, run them when +;; instantiating a new object, as DEFHOST does. (defclass host () ((hostattrs :initarg :attrs @@ -56,21 +59,17 @@ in the order specified here, so later properties implicitly depend on earlier ones. In addition, static informational attributes set by later properties are allowed to override any attributes with the same name set by earlier entries." - (with-gensyms (propspec) - (let (hostname-sym attrs) - (etypecase hostname - (string (setq hostname-sym (intern hostname))) - (symbol (setq hostname-sym hostname - hostname (string-downcase (symbol-name hostname))))) - (push hostname (getf attrs :hostname)) - (when (stringp (car properties)) - (push (pop properties) (getf attrs :desc))) - `(progn - (declaim (type host ,hostname-sym)) - (defparameter ,hostname-sym - (let* ((,propspec ,(props properties)) - (*host* - (make-instance 'host :attrs ',attrs :props ,propspec))) - (eval-propspec-hostattrs ,propspec) - *host*) - ,(car (getf attrs :desc))))))) + (let (hostname-sym attrs) + (etypecase hostname + (string (setq hostname-sym (intern hostname))) + (symbol (setq hostname-sym hostname + hostname (string-downcase (symbol-name hostname))))) + (push hostname (getf attrs :hostname)) + (when (stringp (car properties)) + (push (pop properties) (getf attrs :desc))) + `(progn + (declaim (type host ,hostname-sym)) + (defparameter ,hostname-sym + (%replace-propspec-into-host (make-instance 'host :attrs ',attrs) + ,(props properties)) + ,(car (getf attrs :desc)))))) -- cgit v1.2.3