X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Flexenv.lisp;h=54ef200368d60dd651376b1c94d8edefe80091cf;hb=a4882e3023fdd5e777169a4cbede33605281173c;hp=34f37ba430d73b867a77ff8e5cf6adb1f5729fe8;hpb=7ce2c42adf3d62f03086de940adaee48e6161a40;p=sbcl.git diff --git a/src/compiler/lexenv.lisp b/src/compiler/lexenv.lisp index 34f37ba..54ef200 100644 --- a/src/compiler/lexenv.lisp +++ b/src/compiler/lexenv.lisp @@ -11,25 +11,17 @@ (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) - '(speed . 1) - '(space . 1) - '(debug . 1) - '(inhibit-warnings . 1))))) - (:constructor internal-make-lexenv - (funs vars blocks tags + (:print-function print-lexenv) + (:constructor make-null-lexenv ()) + (:constructor internal-make-lexenv + (funs vars blocks tags type-restrictions - weakend-type-restrictions - lambda cleanup policy))) + lambda cleanup handled-conditions + disabled-package-locks %policy))) ;; 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 @@ -48,26 +40,37 @@ (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) - (weakend-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 + ;; the lexically enclosing cleanup, or NIL if none enclosing within LAMBDA (cleanup nil) - ;; the current OPTIMIZE policy - (policy *policy* :type policy)) + ;; condition types we handle with a handler around the compiler + (handled-conditions *handled-conditions*) + ;; lexically disabled package locks (list of symbols) + (disabled-package-locks *disabled-package-locks*) + ;; the current OPTIMIZE policy. this is null in the null environment, + ;; and the global policy is stored in *POLICY*. (Because we want to + ;; be able to affect it from :WITH-COMPILATION-UNIT.) NIL here also + ;; works as a convenient null-lexenv identifier. + (%policy nil :type policy)) + +(defun lexenv-policy (lexenv) + (or (lexenv-%policy lexenv) *policy*)) + +(defun null-lexenv-p (lexenv) + (not (lexenv-%policy lexenv))) ;;; support for the idiom (in MACROEXPAND and elsewhere) that NIL is ;;; to be taken as a null lexical environment @@ -76,21 +79,87 @@ (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 print-lexenv (lexenv stream level) + (if (null-lexenv-p lexenv) + (print-unreadable-object (lexenv stream) + (write-string "NULL-LEXENV" stream)) + (default-structure-print lexenv stream level))) + +(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-vars lexenv)) - (null (lexenv-funs 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))))))) +