From: Nikodemus S. <de...@us...> - 2005-04-01 12:57:44
|
Update of /cvsroot/sbcl/sbcl/src/compiler In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv5858/src/compiler Modified Files: lexenv.lisp Log Message: 0.8.21.11: * print null lexenvs as #<NULL-LEXENV>, making for more compact backtraces. Non-null lexenvs still print as structures. * add TYPE-WARNING to cross-conditions for comfort, and try to embarrass the next one to diddle there into solving the larger issue. Index: lexenv.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/compiler/lexenv.lisp,v retrieving revision 1.20 retrieving revision 1.21 diff -u -d -r1.20 -r1.21 --- lexenv.lisp 9 Mar 2005 18:49:45 -0000 1.20 +++ lexenv.lisp 1 Apr 2005 12:57:34 -0000 1.21 @@ -15,7 +15,8 @@ ;;; (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 ()) + (:print-function print-lexenv) + (:constructor make-null-lexenv ()) (:constructor internal-make-lexenv (funs vars blocks tags type-restrictions @@ -69,6 +70,15 @@ (null (make-null-lexenv)) (lexenv x))) +(defun null-lexenv-p (lexenv) + (equalp (coerce-to-lexenv lexenv) (make-null-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)) |