src/compiler/early-lexenv.lisp

   1 ;;;; This file contains early compiler-related structure definitions.
   2
   3 ;;;; This software is part of the SBCL system. See the README file for
   4 ;;;; more information.
   5 ;;;;
   6 ;;;; This software is derived from the CMU CL system, which was
   7 ;;;; written at Carnegie Mellon University and released into the
   8 ;;;; public domain. The software is in the public domain and is
   9 ;;;; provided with absolutely no warranty. See the COPYING and CREDITS
  10 ;;;; files for more information.
  11
  12 (in-package "SB!C")
  13
  14 (declaim (simple-vector **policy-primary-qualities**))
  15 (!defglobal **policy-primary-qualities**
  16         #(;; ANSI standard qualities
  17           compilation-speed
  18           debug
  19           safety
  20           space
  21           speed
  22           ;; SBCL extensions
  23           ;;
  24           ;; FIXME: INHIBIT-WARNINGS is a misleading name for this.
  25           ;; Perhaps BREVITY would be better. But the ideal name would
  26           ;; have connotations of suppressing not warnings but only
  27           ;; optimization-related notes, which is already mostly the
  28           ;; behavior, and should probably become the exact behavior.
  29           ;; Perhaps INHIBIT-NOTES?
  30           inhibit-warnings))
  31
  32 (eval-when (:compile-toplevel :load-toplevel :execute)
  33   (defconstant n-policy-primary-qualities (length **policy-primary-qualities**))
  34   ;; 1 bit per quality is stored to indicate whether it was explicitly given
  35   ;; a value in a lexical policy. In addition to the 5 ANSI-standard qualities,
  36   ;; SBCL defines one more "primary" quality and 16 dependent qualities.
  37   ;; Both kinds take up 1 bit in the mask of specified qualities.
  38   (defconstant max-policy-qualities 32))
  39
  40 ;; Each primary and dependent quality policy is assigned a small integer index.
  41 ;; The POLICY struct represents a set of policies in an order-insensitive way
  42 ;; that facilitates quicker lookup than scanning an alist.
  43 (defstruct (policy (:constructor make-policy
  44                                  (primary-qualities &optional presence-bits)))
  45   ;; Mask with a 1 for each quality that has an explicit value in this policy.
  46   ;; Primary qualities fill the mask from left-to-right and dependent qualities
  47   ;; from right-to-left.
  48   ;; xc has trouble folding this MASK-FIELD, but it works when host-evaluated.
  49   (presence-bits #.(mask-field
  50                     (byte n-policy-primary-qualities
  51                           (- max-policy-qualities n-policy-primary-qualities))
  52                     -1)
  53                  :type (unsigned-byte #.max-policy-qualities))
  54   ;; For efficiency, primary qualities are segregated because there are few
  55   ;; enough of them to fit in a fixnum.
  56   (primary-qualities 0 :type (unsigned-byte #.(* 2 n-policy-primary-qualities)))
  57   ;; 2 bits per dependent quality is a fixnum on 64-bit build, not on 32-bit.
  58   ;; It would certainly be possible to constrain this to storing exactly
  59   ;; the 16 currently defined dependent qualities,
  60   ;; but that would be overly limiting.
  61   (dependent-qualities 0
  62    :type (unsigned-byte #.(* (- max-policy-qualities n-policy-primary-qualities)
  63                              2))))
  64
  65 (defvar *handled-conditions* nil)
  66 (defvar *disabled-package-locks* nil)
  67
  68 ;;; The LEXENV represents the lexical environment used for IR1 conversion.
  69 ;;; (This is also what shows up as an ENVIRONMENT value in macroexpansion.)
  70 #!-sb-fluid (declaim (inline internal-make-lexenv)) ; only called in one place
  71 (defstruct (lexenv
  72              (:include abstract-lexenv)
  73              #-no-ansi-print-object
  74              (:print-function
  75               (lambda (lexenv stream depth)
  76                 (if (null-lexenv-p lexenv)
  77                     (print-unreadable-object (lexenv stream)
  78                       (write-string "NULL-LEXENV" stream))
  79                     (default-structure-print lexenv stream depth))))
  80              (:constructor make-null-lexenv ())
  81              (:constructor make-almost-null-lexenv (%policy handled-conditions))
  82              (:constructor make-package-lock-lexenv
  83                            (disabled-package-locks %policy
  84                             &aux (handled-conditions nil)))
  85              (:constructor internal-make-lexenv
  86                            (funs vars blocks tags
  87                             type-restrictions
  88                             lambda cleanup handled-conditions
  89                             disabled-package-locks %policy user-data
  90                             parent)))
  91   ;; an alist of (NAME . WHAT), where WHAT is either a FUNCTIONAL (a
  92   ;; local function), a DEFINED-FUN, representing an
  93   ;; INLINE/NOTINLINE declaration, or a list (MACRO . <function>) (a
  94   ;; local macro, with the specifier expander). Note that NAME may be
  95   ;; a (SETF <name>) list, not necessarily a single symbol.
  96   (funs nil :type list)
  97   ;; an alist translating variable names to LEAF structures. A special
  98   ;; binding is indicated by a :SPECIAL GLOBAL-VAR leaf. Each special
  99   ;; binding within the code gets a distinct leaf structure, as does
 100   ;; the current "global" value on entry to the code compiled.
 101   ;; (locally (special ...)) is handled by adding the most recent
 102   ;; special binding to the front of the list.
 103   ;;
 104   ;; If the CDR is (MACRO . <exp>), then <exp> is the expansion of a
 105   ;; symbol macro.
 106   (vars nil :type list)
 107   ;; BLOCKS and TAGS are alists from block and go-tag names to 2-lists
 108   ;; of the form (<entry> <continuation>), where <continuation> is the
 109   ;; continuation to exit to, and <entry> is the corresponding ENTRY
 110   ;; node.
 111   (blocks nil :type list)
 112   (tags nil :type list)
 113   ;; an alist (THING . CTYPE) which is used to keep track of
 114   ;; "pervasive" type declarations. When THING is a leaf, this is for
 115   ;; type declarations that pertain to the type in a syntactic extent
 116   ;; which does not correspond to a binding of the affected name.
 117   (type-restrictions nil :type list)
 118   ;; the lexically enclosing lambda, if any
 119   ;;
 120   ;; FIXME: This should be :TYPE (OR CLAMBDA NULL), but it was too hard
 121   ;; to get CLAMBDA defined in time for the cross-compiler.
 122   (lambda nil)
 123   ;; the lexically enclosing cleanup, or NIL if none enclosing within LAMBDA
 124   (cleanup nil)
 125   ;; condition types we handle with a handler around the compiler
 126   (handled-conditions *handled-conditions*)
 127   ;; lexically disabled package locks (list of symbols)
 128   (disabled-package-locks *disabled-package-locks*)
 129   ;; the current OPTIMIZE policy. this is null in the null environment,
 130   ;; and the global policy is stored in *POLICY*. (Because we want to
 131   ;; be able to affect it from :WITH-COMPILATION-UNIT.) NIL here also
 132   ;; works as a convenient null-lexenv identifier.
 133   (%policy nil :type (or null policy))
 134   ;; A list associating extra user info to symbols.  The entries
 135   ;; are of the form (:declare name . value),
 136   ;; (:variable name key . value), or (:function name key . value)
 137   (user-data nil :type list)
 138   parent
 139   ;; Cache of all visible variables, including the ones coming from
 140   ;; (call-lexenv lambda)
 141   ;; Used for LEAF-VISIBLE-TO-DEBUGGER-P
 142   (var-cache nil :type (or null hash-table)))
 143
 144 ;;; the lexical environment we are currently converting in
 145 (defvar *lexenv*)
 146 (declaim (type lexenv *lexenv*))
 147
 148 ;;; an object suitable for input to standard functions that accept
 149 ;;; "environment objects" (of the ANSI glossary)
 150 (def!type lexenv-designator () '(or abstract-lexenv null))
 151
 152 (defvar *policy*)
 153 (defun lexenv-policy (lexenv)
 154   (or (lexenv-%policy lexenv) *policy*))
 155
 156 (defun null-lexenv-p (lexenv)
 157   (not (lexenv-%policy lexenv)))