0.6.9.11:
[sbcl.git] / src / compiler / early-c.lisp
index 4e75b23..9f266bb 100644 (file)
 (def!type sb!kernel::layout-depthoid () '(or index (integer -1 -1)))
 
 ;;; a value for an optimization declaration
-(def!type sb!c::policy-quality () '(or (rational 0 3) null))
+(def!type policy-quality () '(or (rational 0 3) null))
 \f
 ;;;; policy stuff
 
-;;; a map from optimization policy quality to corresponding POLICY
-;;; slot name, used to automatically keep POLICY-related definitions
-;;; in sync even if future maintenance changes POLICY slots
-(eval-when (:compile-toplevel :load-toplevel :execute)
-  (defstruct (policy-quality-slot (:constructor %make-pqs (quality accessor)))
-    ;; the name of the quality
-    (quality (required-argument) :type symbol)
-    ;; the name of the structure slot accessor
-    (accessor (required-argument) :type symbol))
-  (defparameter *policy-quality-slots*
-    (list (%make-pqs 'speed   'policy-speed)
-         (%make-pqs 'space   'policy-space)
-         (%make-pqs 'safety  'policy-safety)
-         (%make-pqs 'cspeed  'policy-cspeed)
-         (%make-pqs 'brevity 'policy-brevity)
-         (%make-pqs 'debug   'policy-debug)))
-  (defun named-policy-quality-slot (name)
-    (find name *policy-quality-slots* :key #'policy-quality-slot-quality)))
-
-;;; A POLICY object holds information about the compilation policy for
-;;; a node. See the LEXENV definition for a description of how it is used.
-#.`(def!struct (policy
-               (:copier nil)) ; (but see DEFUN COPY-POLICY)
-     ,@(mapcar (lambda (pqs)
-                `(,(policy-quality-slot-quality pqs) nil
-                  :type policy-quality))
-              *policy-quality-slots*))
-
-;;; an annoyingly hairy way of doing COPY-STRUCTURE on POLICY objects
-;;;
-;;; (We need this explicit, separate, hairy DEFUN only because we need
-;;; to be able to copy POLICY objects in cold init toplevel forms,
-;;; earlier than the default copier closure created by DEFSTRUCT
-;;; toplevel forms would be available, and earlier than LAYOUT-INFO is
-;;; initialized (which is a prerequisite for COPY-STRUCTURE to work).)
-#.`(defun copy-policy (policy)
-     (make-policy
-      ,@(mapcan (lambda (pqs)
-                 `(,(keywordicate (policy-quality-slot-quality pqs))
-                   (,(policy-quality-slot-accessor pqs) policy)))
-               *policy-quality-slots*)))
+;;; CMU CL used a special STRUCTURE-OBJECT type POLICY to represent
+;;; the state of optimization policy at any point in compilation. This
+;;; became a little unwieldy, especially because of cold init issues
+;;; for structures and structure accessors, so in SBCL we use an alist
+;;; instead.
+(deftype policy () 'list)
+
+;;; names of recognized optimization qualities which don't have
+;;; special defaulting behavior
+(defvar *policy-basic-qualities*)
+
+;;; 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)|#))
 
 ;;; *DEFAULT-POLICY* holds the current global compiler policy
-;;; information. Whenever the policy is changed, we copy the structure
-;;; so that old uses will still get the old values.
+;;; 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.
+;;;
 ;;; *DEFAULT-INTERFACE-POLICY* holds any values specified by an
 ;;; OPTIMIZE-INTERFACE declaration.
 (declaim (type policy *default-policy* *default-interface-policy*))
 (defvar *default-policy*)         ; initialized in cold init
 (defvar *default-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*
+       '(;; ANSI standard qualities
+         compilation-speed
+         debug
+         safety
+         space
+         speed
+         ;; SBCL extensions
+         ;;
+         ;; FIXME: INHIBIT-WARNINGS is a misleading name for this.
+         ;; Perhaps BREVITY would be better. But the ideal name would
+         ;; have connotations of suppressing not warnings but only
+         ;; optimization-related notes, which is already mostly the
+         ;; behavior, and should probably become the exact behavior.
+         ;; Perhaps INHIBIT-NOTES?
+         inhibit-warnings))
+  (setf *policy-defaulting-qualities*
+       '((interface-speed . speed)
+         (interface-safety . safety)))
+  (setf *default-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 *default-interface-policy*
+       *default-policy*))
+;;; On the cross-compilation host, we initialize the compiler immediately.
+#+sb-xc-host (!policy-cold-init-or-resanify)
+
+;;; Is X the name of an optimization quality?
+(defun policy-quality-p (x)
+  (memq x *policy-basic-qualities*))
 \f
 ;;; possible values for the INLINE-ness of a function.
 (deftype inlinep ()