- (when (typep c 'module)
- (let ((at-least-one nil)
- (forced nil)
- (error nil))
- (loop for kid in (module-components c)
- do (handler-case
- (appendf forced (traverse operation kid ))
- (missing-dependency (condition)
- (if (eq (module-if-component-dep-fails c) :fail)
- (error condition))
- (setf error condition))
- (:no-error (c)
- (declare (ignore c))
- (setf at-least-one t))))
- (when (and (eq (module-if-component-dep-fails c) :try-next)
- (not at-least-one))
- (error error))
- forced))))
- ;; now the thing itself
- (when (or forced module-ops
- (operation-forced-p (operation-ancestor operation))
- (not (operation-done-p operation c)))
- (let ((do-first (cdr (assoc (class-name (class-of operation))
- (slot-value c 'do-first)))))
- (loop for (required-op . deps) in do-first
- do (do-dep required-op deps)))
- (setf forced (append (delete 'pruned-op forced :key #'car)
- (delete 'pruned-op module-ops :key #'car)
- (list (cons operation c))))))
+ (when (typep c 'module)
+ (let ((at-least-one nil)
+ (forced nil)
+ (error nil))
+ (loop for kid in (module-components c)
+ do (handler-case
+ (appendf forced (traverse operation kid ))
+ (missing-dependency (condition)
+ (if (eq (module-if-component-dep-fails c) :fail)
+ (error condition))
+ (setf error condition))
+ (:no-error (c)
+ (declare (ignore c))
+ (setf at-least-one t))))
+ (when (and (eq (module-if-component-dep-fails c) :try-next)
+ (not at-least-one))
+ (error error))
+ forced))))
+ ;; now the thing itself
+ (when (or forced module-ops
+ (not (operation-done-p operation c))
+ (let ((f (operation-forced (operation-ancestor operation))))
+ (and f (or (not (consp f))
+ (member (component-name
+ (operation-ancestor operation))
+ (mapcar #'coerce-name f)
+ :test #'string=)))))
+ (let ((do-first (cdr (assoc (class-name (class-of operation))
+ (slot-value c 'do-first)))))
+ (loop for (required-op . deps) in do-first
+ do (do-dep required-op deps)))
+ (setf forced (append (delete 'pruned-op forced :key #'car)
+ (delete 'pruned-op module-ops :key #'car)
+ (list (cons operation c))))))