-(defun make-sub-operation (o type)
- (let ((args (operation-original-initargs o)))
- (apply #'make-instance type :parent o :original-initargs args args)))
+
+(defun make-sub-operation (c o dep-c dep-o)
+ (let* ((args (copy-list (operation-original-initargs o)))
+ (force-p (getf args :force)))
+ ;; note explicit comparison with T: any other non-NIL force value
+ ;; (e.g. :recursive) will pass through
+ (cond ((and (null (component-parent c))
+ (null (component-parent dep-c))
+ (not (eql c dep-c)))
+ (when (eql force-p t)
+ (setf (getf args :force) nil))
+ (apply #'make-instance dep-o
+ :parent o
+ :original-initargs args args))
+ ((subtypep (type-of o) dep-o)
+ o)
+ (t
+ (apply #'make-instance dep-o
+ :parent o :original-initargs args args)))))
+