src/compiler/lexenv.lisp

   1 ;;;; the representation of a lexical environment
   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 ;;; support for the idiom (in MACROEXPAND and elsewhere) that NIL is
  15 ;;; to be taken as a null lexical environment.
  16 ;;; Of course this is a mostly pointless "idiom" because NIL *is*
  17 ;;; an environment, as far as most environment inquiry functions care.
  18 (defun coerce-to-lexenv (x)
  19   (etypecase x
  20     (null (make-null-lexenv))
  21     (lexenv x)
  22     #!+(and sb-fasteval (host-feature sb-xc))
  23     (sb!interpreter:basic-env (sb!interpreter:lexenv-from-env x))))
  24
  25 ;;; Take the lexenv surrounding an inlined function and extract things
  26 ;;; needed for the inline expansion suitable for dumping into fasls.
  27 ;;; Right now it's MACROLET, SYMBOL-MACROLET, SPECIAL and
  28 ;;; INLINE/NOTINLINE declarations. Upon encountering something else return NIL.
  29 ;;; This is later used by PROCESS-INLINE-LEXENV to reproduce the lexenv.
  30 ;;;
  31 ;;; Previously it just used the functions and vars of the innermost
  32 ;;; lexenv, but the body of macrolet can refer to other macrolets
  33 ;;; defined earlier, so it needs to process all the parent lexenvs to
  34 ;;; recover the proper order.
  35 (defun reconstruct-lexenv (lexenv)
  36   (let (shadowed-funs
  37         shadowed-vars
  38         result)
  39     (loop for env = lexenv then parent
  40           for parent = (lexenv-parent env)
  41           for vars = (lexenv-vars env)
  42           for funs = (lexenv-funs env)
  43           for declarations = nil
  44           for symbol-macros = nil
  45           for macros = nil
  46           do
  47           (loop for binding in vars
  48                 for (name . what) = binding
  49                 unless (and parent
  50                             (find binding (lexenv-vars parent)))
  51                 do (typecase what
  52                      (cons
  53                       (aver (eq (car what) 'macro))
  54                       (push name shadowed-vars)
  55                       (push (list name (cdr what)) symbol-macros))
  56                      (global-var
  57                       (aver (eq (global-var-kind what) :special))
  58                       (push `(special ,name) declarations))
  59                      (t
  60                       (unless (memq name shadowed-vars)
  61                         (return-from reconstruct-lexenv)))))
  62           (loop for binding in funs
  63                 for (name . what) = binding
  64                 unless (and parent
  65                             (find binding (lexenv-funs parent)))
  66                 do
  67                 (typecase what
  68                   (cons
  69                    (push name shadowed-funs)
  70                    (push (cons name (function-lambda-expression (cdr what))) macros))
  71                   ;; FIXME: Is there a good reason for this not to be
  72                   ;; DEFINED-FUN (which :INCLUDEs GLOBAL-VAR, in case
  73                   ;; you're wondering how this ever worked :-)? Maybe
  74                   ;; in conjunction with an AVERrance that it's not an
  75                   ;; (AND GLOBAL-VAR (NOT GLOBAL-FUN))? -- CSR,
  76                   ;; 2002-07-08
  77                   (global-var
  78                    (unless (defined-fun-p what)
  79                      (return-from reconstruct-lexenv))
  80                    (push `(,(car (rassoc (defined-fun-inlinep what)
  81                                          *inlinep-translations*))
  82                            ,name)
  83                          declarations))
  84                   (t
  85                    (unless (memq name shadowed-funs)
  86                      (return-from reconstruct-lexenv)))))
  87           (when declarations
  88             (setf result (list* :declare declarations (and result (list result)))))
  89           (when symbol-macros
  90             (setf result (list* :symbol-macro symbol-macros (and result (list result)))))
  91           (when macros
  92             (setf result (list* :macro macros (and result (list result)))))
  93           while (and parent
  94                      (not (null-lexenv-p parent))))
  95     result))
  96
  97 ;;; Return a sexpr for LAMBDA in LEXENV such that loading it from fasl
  98 ;;; preserves the original lexical environment for inlining.
  99 ;;; Return NIL if the lexical environment is too complicated.
 100 (defun maybe-inline-syntactic-closure (lambda lexenv)
 101   (declare (type list lambda) (type lexenv-designator lexenv))
 102   (aver (eql (first lambda) 'lambda))
 103   ;; We used to have a trivial implementation, verifying that lexenv
 104   ;; was effectively null. However, this fails to take account of the
 105   ;; idiom
 106   ;;
 107   ;; (declaim (inline foo))
 108   ;; (macrolet ((def (x) `(defun ,x () ...)))
 109   ;;   (def foo))
 110   ;;
 111   ;; which, while too complicated for the cross-compiler to handle in
 112   ;; unfriendly foreign lisp environments, would be good to support in
 113   ;; the target compiler. -- CSR, 2002-05-13 and 2002-11-02
 114   (typecase lexenv
 115    (lexenv
 116     (let ((vars (lexenv-vars lexenv))
 117           (funs (lexenv-funs lexenv)))
 118       (acond ((or (lexenv-blocks lexenv) (lexenv-tags lexenv)) nil)
 119              ((and (null vars) (null funs)) lambda)
 120              ;; If the lexenv is too hairy for cross-compilation,
 121              ;; you'll find out later, when trying to perform inlining.
 122              ;; This is fine, because if the inline expansion is only
 123              ;; for the target, it's totally OK to cross-compile this
 124              ;; defining form. The syntactic env is correctly captured.
 125              ((reconstruct-lexenv lexenv)
 126               `(lambda-with-lexenv ,it ,@(cdr lambda))))))
 127    #!+(and sb-fasteval (host-feature sb-xc))
 128    (sb!interpreter:basic-env
 129     (awhen (sb!interpreter::reconstruct-syntactic-closure-env lexenv)
 130       `(lambda-with-lexenv ,it ,@(cdr lambda))))
 131    #!+sb-fasteval
 132    (null lambda))) ; trivial case. Never occurs in the compiler.