-;;; Evaluate EXPR in terms of the current optimization policy for
-;;; NODE, or if NODE is NIL, in terms of the current policy as defined
-;;; by *DEFAULT-POLICY* and *CURRENT-POLICY*. (Using NODE=NIL is only
-;;; well-defined during IR1 conversion.)
-;;;
-;;; EXPR is a form which accesses the policy values by referring to
-;;; them by name, e.g. (> SPEED SPACE).
-(defmacro policy (node expr)
- (let* ((n-policy (gensym))
- (used-qualities (policy-qualities-used-by expr))
- (binds (mapcar (lambda (name)
- `(,name (policy-quality ,n-policy ',name)))
- used-qualities)))
- `(let* ((,n-policy (lexenv-policy ,(if node
- `(node-lexenv ,node)
- '*lexenv*)))
- ,@binds)
+;;; Evaluate EXPR in terms of the optimization policy associated with
+;;; THING. EXPR is a form which accesses optimization qualities by
+;;; referring to them by name, e.g. (> SPEED SPACE).
+(defmacro policy (thing expr)
+ (let* ((n-policy (gensym "N-POLICY-"))
+ (binds (mapcar (lambda (name)
+ `(,name (policy-quality ,n-policy ',name)))
+ *policy-qualities*))
+ (dependent-binds
+ (loop for (name . info) in *policy-dependent-qualities*
+ collect `(,name (policy-quality ,n-policy ',name))
+ collect `(,name (if (= ,name 1)
+ ,(policy-dependent-quality-expression info)
+ ,name)))))
+ `(let* ((,n-policy (%coerce-to-policy ,thing))
+ ,@binds
+ ,@dependent-binds)
+ (declare (ignorable ,@*policy-qualities*
+ ,@(mapcar #'car *policy-dependent-qualities*)))