X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fpolicy.lisp;h=d4cd154cd4d1c47147b4a26aa22a0649f3e0ec07;hb=dfa55a883f94470267b626dae77ce7e7dfac3df6;hp=9cd204afad82828193d9e48f96b485cfbae0d274;hpb=fa8962d732057015fbb9a2f8a08ea8d5299b50dd;p=sbcl.git

diff --git a/src/compiler/policy.lisp b/src/compiler/policy.lisp
index 9cd204a..d4cd154 100644
--- a/src/compiler/policy.lisp
+++ b/src/compiler/policy.lisp
@@ -22,41 +22,26 @@
 ;;; alists instead.
 (def!type policy () 'list)
 
-;;; names of recognized optimization qualities which don't have
-;;; special defaulting behavior
-(defvar *policy-basic-qualities*) ; (initialized at cold init)
+;;; names of recognized optimization policy qualities
+(defvar *policy-qualities*) ; (initialized at cold init)
 
-;;; FIXME: I'd like to get rid of DECLAIM OPTIMIZE-INTERFACE in favor
-;;; of e.g. (DECLAIM (OPTIMIZE (INTERFACE-SPEED 2) (INTERFACE-SAFETY 3))).
-#|
-;;; a list of conses (DEFAULTING-QUALITY . DEFAULT-QUALITY) of qualities
-;;; which default to other qualities when undefined, e.g. interface
-;;; speed defaulting to basic speed
-(defvar *policy-defaulting-qualities*)
-|#
-
-(defun optimization-quality-p (name)
-  (or (member name *policy-basic-qualities*)
-      ;; FIXME: Uncomment this when OPTIMIZE-INTERFACE goes away.
-      #|(member name *policy-defaulting-qualities* :key #'car)|#))
+;;; Is X the name of an optimization quality?
+(defun policy-quality-name-p (x)
+  (memq x *policy-qualities*))
 
 ;;; *POLICY* holds the current global compiler policy information, as
 ;;; an alist mapping from optimization quality name to quality value.
 ;;; Inside the scope of declarations, new entries are added at the
 ;;; head of the alist.
-;;;
-;;; *INTERFACE-POLICY* holds global interface policy, represented the
-;;; same way as in *DEFAULT-POLICY*.
-(declaim (type policy *policy* *interface-policy*))
+(declaim (type policy *policy*))
 (defvar *policy*)	   ; initialized in cold init
-(defvar *interface-policy*) ; initialized in cold init
 
 ;;; This is to be called early in cold init to set things up, and may
 ;;; also be called again later in cold init in order to reset default
 ;;; optimization policy back to default values after toplevel PROCLAIM
 ;;; OPTIMIZE forms have messed with it.
 (defun !policy-cold-init-or-resanify ()
-  (setf *policy-basic-qualities*
+  (setf *policy-qualities*
 	'(;; ANSI standard qualities
 	  compilation-speed
 	  debug
@@ -72,28 +57,17 @@
 	  ;; behavior, and should probably become the exact behavior.
 	  ;; Perhaps INHIBIT-NOTES?
 	  inhibit-warnings))
-  #|
-  (setf *policy-defaulting-qualities*
-	'((interface-speed . speed)
-	  (interface-safety . safety)))
-  |#
   (setf *policy*
 	(mapcar (lambda (name)
 		  ;; CMU CL didn't use 1 as the default for everything,
 		  ;; but since ANSI says 1 is the ordinary value, we do.
 		  (cons name 1))
-		*policy-basic-qualities*))
-  (setf *interface-policy*
-	*policy*))
+		*policy-qualities*)))
 ;;; On the cross-compilation host, we initialize immediately (not
 ;;; waiting for "cold init", since cold init doesn't exist on
 ;;; cross-compilation host).
 #+sb-xc-host (!policy-cold-init-or-resanify)
 
-;;; Is X the name of an optimization quality?
-(defun policy-quality-name-p (x)
-  (memq x *policy-basic-qualities*))
-
 ;;; Look up a named optimization quality in POLICY. This is only
 ;;; called by compiler code for known-valid QUALITY-NAMEs, e.g. SPEED;
 ;;; it's an error if it's called for a quality which isn't defined.
@@ -112,6 +86,12 @@
 
 ;;; Return a list of symbols naming the optimization qualities which
 ;;; appear in EXPR.
+;;;
+;;; FIXME: Doing this is slightly flaky (since we can't do it right
+;;; without all the headaches of true code walking), and it shouldn't
+;;; be necessary with modern Python anyway, as long as POLICY-QUALITY
+;;; is properly DEFKNOWNed to have no side-effects so that it can be
+;;; optimized away if unused. So this should probably go away.
 (defun policy-qualities-used-by (expr)
   (let ((result nil))
     (labels ((recurse (x)
@@ -124,21 +104,15 @@
 
 ;;; syntactic sugar for querying optimization policy qualities
 ;;;
-;;; 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 *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))
+;;; 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-"))
 	 (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*)))
+    `(let* ((,n-policy (%coerce-to-policy ,thing))
 	    ,@binds)
        ,expr)))