X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Flexenv.lisp;h=f89df357b97163ceaf12c608d5c727a622abded5;hb=0794cd3908a441222f430ba0cf3bb7c3e1a96c63;hp=37b9ca6ec36a03c8eafae920c0ffd8e77518df72;hpb=416152f084604094445a758ff399871132dff2bd;p=sbcl.git diff --git a/src/compiler/lexenv.lisp b/src/compiler/lexenv.lisp index 37b9ca6..f89df35 100644 --- a/src/compiler/lexenv.lisp +++ b/src/compiler/lexenv.lisp @@ -11,22 +11,29 @@ (in-package "SB!C") -#!-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 (:constructor make-null-lexenv ()) + (:constructor make-null-interactive-lexenv + (&aux (policy (list '(safety . 3) + '(compilation-speed . 2) + '(debug . 2) + '(speed . 1) + '(space . 1) + '(inhibit-warnings . 1))))) (:constructor internal-make-lexenv - (functions variables blocks tags type-restrictions - lambda cleanup policy options))) + (funs vars blocks tags + type-restrictions + lambda cleanup handled-conditions + policy))) ;; an alist of (NAME . WHAT), where WHAT is either a FUNCTIONAL (a - ;; local function), a DEFINED-FUNCTION, representing an + ;; 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. - (functions nil :type list) + (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 @@ -36,31 +43,29 @@ ;; ;; If the CDR is (MACRO . ), then is the expansion of a ;; symbol macro. - (variables nil :type list) + (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. + ;; 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. + ;; which does not correspond to a binding of the affected name. (type-restrictions nil :type list) ;; 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 + (lambda nil) + ;; the lexically enclosing cleanup, or NIL if none enclosing within LAMBDA (cleanup nil) + ;; condition types we handle with a handler around the compiler + (handled-conditions *handled-conditions*) ;; the current OPTIMIZE policy - (policy *policy* :type policy) - ;; an alist of miscellaneous options that are associated with the - ;; lexical environment - (options nil :type list)) + (policy *policy* :type policy)) ;;; support for the idiom (in MACROEXPAND and elsewhere) that NIL is ;;; to be taken as a null lexical environment @@ -69,21 +74,81 @@ (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) +(defun maybe-inline-syntactic-closure (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-variables lexenv)) - (null (lexenv-functions lexenv)))) + (aver (eql (first lambda) 'lambda)) + ;; We used to have a trivial implementation, verifying that lexenv + ;; was effectively null. However, this fails to take account of the + ;; idiom + ;; + ;; (declaim (inline foo)) + ;; (macrolet ((def (x) `(defun ,x () ...))) + ;; (def foo)) + ;; + ;; which, while too complicated for the cross-compiler to handle in + ;; unfriendly foreign lisp environments, would be good to support in + ;; the target compiler. -- CSR, 2002-05-13 and 2002-11-02 + (let ((vars (lexenv-vars lexenv)) + (funs (lexenv-funs lexenv))) + (collect ((decls) (macros) (symbol-macros)) + (cond + ((or (lexenv-blocks lexenv) (lexenv-tags lexenv)) nil) + ((and (null vars) (null funs)) `(lambda-with-lexenv + nil nil nil + ,@(cdr lambda))) + ((dolist (x vars nil) + #+sb-xc-host + ;; KLUDGE: too complicated for cross-compilation + (return t) + #-sb-xc-host + (let ((name (car x)) + (what (cdr x))) + ;; only worry about the innermost binding + (when (eq x (assoc name vars :test #'eq)) + (typecase what + (cons + (aver (eq (car what) 'macro)) + (symbol-macros x)) + (global-var + ;; A global should not appear in the lexical + ;; environment? Is this true? FIXME! + (aver (eq (global-var-kind what) :special)) + (decls `(special ,name))) + (t + ;; we can't inline in the presence of this object + (return t)))))) + nil) + ((dolist (x funs nil) + #+sb-xc-host + ;; KLUDGE: too complicated for cross-compilation (and + ;; failure of OAOO in comments, *sigh*) + (return t) + #-sb-xc-host + (let ((name (car x)) + (what (cdr x))) + ;; again, only worry about the innermost binding, but + ;; functions can have name (SETF FOO) so we need to use + ;; EQUAL for the test. + (when (eq x (assoc name funs :test #'equal)) + (typecase what + (cons + (macros (cons name (function-lambda-expression (cdr what))))) + ;; FIXME: Is there a good reason for this not to be + ;; DEFINED-FUN (which :INCLUDEs GLOBAL-VAR, in case + ;; you're wondering how this ever worked :-)? Maybe + ;; in conjunction with an AVERrance that it's not an + ;; (AND GLOBAL-VAR (NOT GLOBAL-FUN))? -- CSR, + ;; 2002-07-08 + (global-var + (when (defined-fun-p what) + (decls `(,(car (rassoc (defined-fun-inlinep what) + *inlinep-translations*)) + ,name)))) + (t (return t)))))) + nil) + (t + ;; if we get this far, we've successfully dealt with + ;; everything in FUNS and VARS, so: + `(lambda-with-lexenv ,(decls) ,(macros) ,(symbol-macros) + ,@(cdr lambda))))))) +