common-lisp/sbcl.sbcl
1
0
Fork 0
mirror of git://git.code.sf.net/p/sbcl/sbcl synced 2026-09-10 07:26:40 -04:00
Code Issues Actions 8 Packages Projects Releases Wiki Activity

Comments and rearrangements in {defboot,target-error}.lisp

Browse source 
Add and/or extend explanatory comments for the special
variables *HANDLER-CLUSTERS*, *RESTART-CLUSTERS*
and *CONDITION-RESTARTS*.

Slightly rearranged RESTART-NAME and RESTART-REPORT.
This commit is contained in:
Jan Moringen 2013-09-20 22:15:53 +02:00 committed by Christophe Rhodes
parent 15cd7569cd
commit 2fcf367a1f
2 changed files with 34 additions and 21 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

6
src/code/defboot.lisp
View file

@ -405,8 +405,10 @@ evaluated as a PROGN."
;;; KLUDGE: we PROCLAIM these special here so that we can use restart
;;; macros in the compiler before the DEFVARs are compiled.
(sb!xc:proclaim
'(special *handler-clusters* *restart-clusters* *condition-restarts*))
;;;
;;; For an explanation of these data structures, see DEFVARs in
;;; target-error.lisp.
(sb!xc:proclaim '(special *handler-clusters* *restart-clusters* *condition-restarts*))
(defmacro-mundanely with-condition-restarts
(condition-form restarts-form &body body)

49
src/code/target-error.lisp
View file

@ -11,13 +11,6 @@
;;;; files for more information.
(in-package "SB!KERNEL")
;;; a list of lists of restarts
(defvar *restart-clusters* '())
;;; an ALIST (condition . restarts) which records the restarts currently
;;; associated with Condition
(defvar *condition-restarts* ())
(defun muffle-warning-p (warning)
(declare (special *muffled-warnings*))
@ -28,8 +21,27 @@
(when (muffle-warning-p warning)
(muffle-warning warning)))))))
;;; an alist with elements of the form
;;;
;;; (CONDITION . (HANDLER1 HANDLER2 ...))
;;;
;;; Recently established handlers are added at the beginning of the
;;; list. Elements to the left of the alist take precedence over
;;; elements to the right.
(defvar *handler-clusters* (initial-handler-clusters))
;;; a list of lists of currently active RESTART instances. maintained
;;; by RESTART-BIND.
(defvar *restart-clusters* '())
;;; an ALIST with elements of the form
;;;
;;; (CONDITION . (RESTART1 RESTART2 ...))
;;;
;;; which records the restarts currently associated with
;;; conditions. maintained by WITH-CONDITION-RESTARTS.
(defvar *condition-restarts* ())
(defstruct (restart (:copier nil) (:predicate nil))
(name (missing-arg) :type symbol :read-only t)
(function (missing-arg) :type function)
@ -42,6 +54,17 @@
(prin1 (restart-name restart) stream))
(restart-report restart stream)))
#!+sb-doc
(setf (fdocumentation 'restart-name 'function)
"Return the name of the given restart object.")
(defun restart-report (restart stream)
(funcall (or (restart-report-function restart)
(lambda (stream)
(format stream "~S" (or (restart-name restart)
restart))))
stream))
(defvar *restart-test-stack* nil)
(defun compute-restarts (&optional condition)
@ -74,18 +97,6 @@ restarts associated with CONDITION (or with no condition) will be returned."
(res restart)))))
(res))))
#!+sb-doc
(setf (fdocumentation 'restart-name 'function)
"Return the name of the given restart object.")
(defun restart-report (restart stream)
(funcall (or (restart-report-function restart)
(let ((name (restart-name restart)))
(lambda (stream)
(if name (format stream "~S" name)
(format stream "~S" restart)))))
stream))
(defun find-restart (identifier &optional condition)
#!+sb-doc
"Return the first restart identified by IDENTIFIER. If IDENTIFIER is a symbol,