X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fcondition.lisp;h=098ec4eec1eb9229524d4ce2e1499a6bdb788ea5;hb=1fca8fbb946ba06cedf777c3a6927f14d24cfae5;hp=ae934684ebe9fd914bc30ab96e78dcbce114a9ff;hpb=88e9e177e7ca72d660a3335d63895a1e0f71a5f8;p=sbcl.git diff --git a/src/code/condition.lisp b/src/code/condition.lisp index ae93468..098ec4e 100644 --- a/src/code/condition.lisp +++ b/src/code/condition.lisp @@ -41,7 +41,7 @@ (/show0 "condition.lisp 24") -(def!struct (condition-classoid (:include slot-classoid) +(def!struct (condition-classoid (:include classoid) (:constructor make-condition-classoid)) ;; list of CONDITION-SLOT structures for the direct slots of this ;; class @@ -529,8 +529,8 @@ :initform-p ',initform-p :documentation ',documentation :initform - ,(if (constantp initform) - `',(eval initform) + ,(if (sb!xc:constantp initform) + `',(constant-form-value initform) `#'(lambda () ,initform))))))) (dolist (option options) @@ -553,8 +553,8 @@ (let ((val (second initargs))) (setq default-initargs (list* `',(first initargs) - (if (constantp val) - `',(eval val) + (if (sb!xc:constantp val) + `',(constant-form-value val) `#'(lambda () ,val)) default-initargs))))) (t @@ -835,10 +835,13 @@ (format stream ", ") (destructuring-bind (type data) (cdr reference) (ecase type + (:readers "Readers for ~:(~A~) Metaobjects" + (substitute #\ #\- (symbol-name data))) (:initialization (format stream "Initialization of ~:(~A~) Metaobjects" (substitute #\ #\- (symbol-name data)))) (:generic-function (format stream "Generic Function ~S" data)) + (:function (format stream "Function ~S" data)) (:section (format stream "Section ~{~D~^.~}" data))))) (:ansi-cl (format stream "The ANSI Standard") @@ -1167,6 +1170,7 @@ SB-EXT:PACKAGE-LOCKED-ERROR-SYMBOL.")) (define-condition step-condition () ((form :initarg :form :reader step-condition-form)) + #!+sb-doc (:documentation "Common base class of single-stepping conditions. STEP-CONDITION-FORM holds a string representation of the form being @@ -1177,8 +1181,18 @@ stepped.")) "Form associated with the STEP-CONDITION.") (define-condition step-form-condition (step-condition) - ((source-path :initarg :source-path :reader step-condition-source-path) - (pathname :initarg :pathname :reader step-condition-pathname)) + ((args :initarg :args :reader step-condition-args)) + (:report + (lambda (condition stream) + (let ((*print-circle* t) + (*print-pretty* t) + (*print-readably* nil)) + (format stream + "Evaluating call:~%~< ~@;~A~:>~%~ + ~:[With arguments:~%~{ ~S~%~}~;With unknown arguments~]~%" + (list (step-condition-form condition)) + (eq (step-condition-args condition) :unknown) + (step-condition-args condition))))) #!+sb-doc (:documentation "Condition signalled by code compiled with single-stepping information when about to execute a form. @@ -1212,13 +1226,14 @@ single-stepping information after executing a form. STEP-CONDITION-FORM holds the form, and STEP-CONDITION-RESULT holds the values returned by the form as a list. No associated restarts.")) -(define-condition step-variable-condition (step-result-condition) +(define-condition step-finished-condition (step-condition) () + (:report + (lambda (condition stream) + (declare (ignore condition)) + (format stream "Returning from STEP"))) #!+sb-doc - (:documentation "Condition signalled by code compiled with -single-stepping information when referencing a variable. -STEP-CONDITION-FORM hold the symbol, and STEP-CONDITION-RESULT holds -the value of the variable. No associated restarts.")) + (:documentation "Condition signaled when STEP returns.")) ;;;; restart definitions