diff options
author | Nikodemus Siivola <nikodemus@random-state.net> | 2005-04-01 12:57:28 +0000 |
---|---|---|
committer | Nikodemus Siivola <nikodemus@random-state.net> | 2005-04-01 12:57:28 +0000 |
commit | 0220b66ca721bc9515ebf2dedab69407850ff518 (patch) | |
tree | cd6eff2455cc2b5179555fb284fbe798a6868fbd /src | |
parent | 902ac256ae170e23dc5e69788e6f2c96ee8b0a3d (diff) |
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.
Diffstat (limited to 'src')
-rw-r--r-- | src/code/cross-condition.lisp | 9 | ||||
-rw-r--r-- | src/compiler/lexenv.lisp | 12 |
2 files changed, 20 insertions, 1 deletions
diff --git a/src/code/cross-condition.lisp b/src/code/cross-condition.lisp index e74fc3c2f..5c2f82145 100644 --- a/src/code/cross-condition.lisp +++ b/src/code/cross-condition.lisp @@ -31,6 +31,15 @@ (define-condition reference-condition () ((references :initarg :references :reader reference-condition-references))) +;;; KLUDGE: yet another OAOOM. +;;; +;;; FIXME: This is clearly one OAOOM KLUDGE too many in a row. When tempted +;;; to add another one invent DEF!CONDITION or whatever seems necessary, +;;; and replace these. +(define-condition type-warning (reference-condition simple-warning) + () + (:default-initargs :references (list '(:sbcl :node "Handling of Types")))) + (define-condition bug (simple-error) () (:report diff --git a/src/compiler/lexenv.lisp b/src/compiler/lexenv.lisp index 34b4a59e7..5eba1faba 100644 --- a/src/compiler/lexenv.lisp +++ b/src/compiler/lexenv.lisp @@ -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)) |