- (used-qualities (policy-qualities-used-by expr))
- (binds (mapcar (lambda (name)
- `(,name (policy-quality ,n-policy ',name)))
- used-qualities)))
- `(let* ((,n-policy (%coerce-to-policy ,thing))
- ,@binds)
- ,expr)))
+ (binds (mapcar (lambda (name)
+ `(,name (policy-quality ,n-policy ',name)))
+ *policy-qualities*))
+ (dependent-binds
+ (loop for (name . info) in *policy-dependent-qualities*
+ collect `(,name (let ((,name (policy-quality ,n-policy ',name)))
+ (if (= ,name 1)
+ ,(policy-dependent-quality-expression info)
+ ,name))))))
+ `(let* ((,n-policy (%coerce-to-policy ,thing)))
+ (declare (ignorable ,n-policy))
+ (symbol-macrolet (,@binds
+ ,@dependent-binds)
+ ,expr))))
+
+;;; Dependent qualities
+(defmacro define-optimization-quality
+ (name expression &optional documentation)
+ `(eval-when (:compile-toplevel :load-toplevel :execute)
+ (let ((acons (assoc ',name *policy-dependent-qualities*))
+ (item (make-policy-dependent-quality
+ :name ',name
+ :expression ',expression
+ :getter (lambda (policy) (policy policy ,expression))
+ :values-documentation ',documentation)))
+ (if acons
+ (setf (cdr acons) item)
+ (setf *policy-dependent-qualities*
+ (nconc *policy-dependent-qualities* (list `(,',name . ,item))))))
+ ',name))