X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Flexenv.lisp;h=0b1f956ee4c2d13d868b5bb10046e62fc07ed20f;hb=104ee7ee303efa16e415f5e75df635ac54dba733;hp=580a6469d1abf9c5b11312229f449042267a74c5;hpb=a530bbe337109d898d5b4a001fc8f1afa3b5dc39;p=sbcl.git diff --git a/src/compiler/lexenv.lisp b/src/compiler/lexenv.lisp index 580a646..0b1f956 100644 --- a/src/compiler/lexenv.lisp +++ b/src/compiler/lexenv.lisp @@ -11,63 +11,79 @@ (in-package "SB!C") -(file-comment - "$Header$") - #!-sb-fluid (declaim (inline internal-make-lexenv)) ; only called in one place ;;; The LEXENV represents the lexical environment used for IR1 conversion. ;;; (This is also what shows up as an ENVIRONMENT value in macroexpansion.) #!-sb-fluid (declaim (inline internal-make-lexenv)) ; only called in one place (def!struct (lexenv - ;; FIXME: should probably be called MAKE-EMPTY-LEXENV or - ;; MAKE-NULL-LEXENV (:constructor make-null-lexenv ()) (:constructor internal-make-lexenv - (functions variables blocks tags type-restrictions - lambda cleanup cookie - interface-cookie options))) - ;; Alist (name . what), where What is either a Functional (a local function), - ;; a DEFINED-FUNCTION, representing an INLINE/NOTINLINE declaration, or - ;; a list (MACRO . ) (a local macro, with the specifier - ;; expander.) Note that Name may be a (SETF ) function. - (functions nil :type list) - ;; An alist translating variable names to Leaf structures. A special binding - ;; is indicated by a :Special Global-Var leaf. Each special binding within - ;; the code gets a distinct leaf structure, as does the current "global" - ;; value on entry to the code compiled. (locally (special ...)) is handled - ;; by adding the most recent special binding to the front of the list. + (funs vars blocks tags type-restrictions + lambda cleanup policy options))) + ;; an alist of (NAME . WHAT), where WHAT is either a FUNCTIONAL (a + ;; local function), a DEFINED-FUN, representing an + ;; INLINE/NOTINLINE declaration, or a list (MACRO . ) (a + ;; local macro, with the specifier expander). Note that NAME may be + ;; a (SETF ) list, not necessarily a single symbol. + (funs nil :type list) + ;; an alist translating variable names to LEAF structures. A special + ;; binding is indicated by a :SPECIAL GLOBAL-VAR leaf. Each special + ;; binding within the code gets a distinct leaf structure, as does + ;; the current "global" value on entry to the code compiled. + ;; (locally (special ...)) is handled by adding the most recent + ;; special binding to the front of the list. ;; - ;; If the CDR is (MACRO . ), then is the expansion of a symbol - ;; macro. - (variables nil :type list) - ;; Blocks and Tags are alists from block and go-tag names to 2-lists of the - ;; form ( ), where is the continuation to - ;; exit to, and is the corresponding Entry node. + ;; If the CDR is (MACRO . ), then is the expansion of a + ;; symbol macro. + (vars nil :type list) + ;; BLOCKS and TAGS are alists from block and go-tag names to 2-lists + ;; of the form ( ), where is the + ;; continuation to exit to, and is the corresponding ENTRY node. (blocks nil :type list) (tags nil :type list) - ;; An alist (Thing . CType) which is used to keep track of "pervasive" type - ;; declarations. When Thing is a leaf, this is for type declarations that - ;; pertain to the type in a syntactic extent which does not correspond to a - ;; binding of the affected name. When Thing is a continuation, this is used - ;; to track the innermost THE type declaration. + ;; an alist (THING . CTYPE) which is used to keep track of + ;; "pervasive" type declarations. When THING is a leaf, this is for + ;; type declarations that pertain to the type in a syntactic extent + ;; which does not correspond to a binding of the affected name. When + ;; THING is a continuation, this is used to track the innermost THE + ;; type declaration. (type-restrictions nil :type list) - ;; The lexically enclosing lambda, if any. + ;; the lexically enclosing lambda, if any ;; ;; FIXME: This should be :TYPE (OR CLAMBDA NULL), but it was too hard ;; to get CLAMBDA defined in time for the cross-compiler. (lambda nil) - ;; The lexically enclosing cleanup, or NIL if none enclosing within Lambda. - ;; - ;; FIXME: This should be :TYPE (OR CLEANUP NULL), but it was too hard - ;; to get CLEANUP defined in time for the cross-compiler. + ;; the lexically enclosing cleanup, or NIL if none enclosing within Lambda (cleanup nil) - ;; The representation of the current OPTIMIZE policy. - (cookie *default-cookie* :type cookie) - ;; The policy that takes effect in XEPs and related syntax parsing functions. - ;; Slots in this cookie may be null to indicate that the normal value in - ;; effect. - (interface-cookie *default-interface-cookie* :type cookie) - ;; an alist of miscellaneous options that are associated with the lexical - ;; environment + ;; the current OPTIMIZE policy + (policy *policy* :type policy) + ;; an alist of miscellaneous options that are associated with the + ;; lexical environment (options nil :type list)) + +;;; support for the idiom (in MACROEXPAND and elsewhere) that NIL is +;;; to be taken as a null lexical environment +(defun coerce-to-lexenv (x) + (etypecase x + (null (make-null-lexenv)) + (lexenv x))) + +;;; Is it safe to just grab the lambda expression LAMBDA in isolation, +;;; ignoring the LEXENV? +;;; +;;; Note: The corresponding CMU CL code did something hairier so that +;;; it could save inline definitions of DEFUNs in nontrivial lexical +;;; environments. If it's ever important to try to do that, take a +;;; look at the old CMU CL #'INLINE-SYNTACTIC-CLOSURE. +(defun lambda-independent-of-lexenv-p (lambda lexenv) + (declare (type list lambda) (type lexenv lexenv)) + (aver (eql (first lambda) 'lambda)) ; basic sanity check + ;; This is a trivial implementation that just makes sure that LEXENV + ;; doesn't have anything interesting in it. A more sophisticated + ;; implementation could skip things in LEXENV which aren't captured + ;; by LAMBDA, but this implementation doesn't try. + (and (null (lexenv-blocks lexenv)) + (null (lexenv-tags lexenv)) + (null (lexenv-vars lexenv)) + (null (lexenv-funs lexenv))))