[movitz-cvs] CVS movitz/losp/muerte
ffjeld
ffjeld at common-lisp.net
Mon Mar 12 21:53:40 UTC 2007
Update of /project/movitz/cvsroot/movitz/losp/muerte
In directory clnet:/tmp/cvs-serv5092
Modified Files:
conditions.lisp
Log Message:
Minor tweaks.
--- /project/movitz/cvsroot/movitz/losp/muerte/conditions.lisp 2007/03/11 22:43:32 1.23
+++ /project/movitz/cvsroot/movitz/losp/muerte/conditions.lisp 2007/03/12 21:53:40 1.24
@@ -10,7 +10,7 @@
;;;; Author: Frode Vatvedt Fjeld <frodef at acm.org>
;;;; Created at: Wed Nov 20 15:47:04 2002
;;;;
-;;;; $Id: conditions.lisp,v 1.23 2007/03/11 22:43:32 ffjeld Exp $
+;;;; $Id: conditions.lisp,v 1.24 2007/03/12 21:53:40 ffjeld Exp $
;;;;
;;;;------------------------------------------------------------------
@@ -230,7 +230,6 @@
"Signal the condition denoted by a condition designator.
Will only make-instance a condition when it is required.
Return the condition object, if there was one."
- (declare (dynamic-extent arguments))
(let* ((class (etypecase datum
(symbol
(or (find-class datum nil)
@@ -243,14 +242,14 @@
(condition nil)
(bos-type *break-on-signals*))
(with-simple-restart (continue "Ignore *break-on-signals*.")
- (let ((*break-on-signals* nil)) ; avoid recursive error if *b-o-s* is faulty.
+ (let ((*break-on-signals* nil)) ; avoid recursive error if *b-o-s* is faulty.
(when (typecase bos-type
(null nil)
(symbol
(let ((bos-class (find-class bos-type nil)))
(if (not bos-class)
(typep (class-prototype-value class) bos-type)
- (member bos-class cpl))))
+ (member bos-class cpl))))
(list
(typep (class-prototype-value class) bos-type))
(t (member bos-type cpl)))
@@ -259,7 +258,7 @@
`(funcall ,handler
(or condition
(setf condition
- (coerce-to-condition default-type datum args))))))
+ (coerce-to-condition default-type datum args))))))
(let ((*active-condition-handlers* *active-condition-handlers*))
(do () ((null *active-condition-handlers*))
(let ((handlers (pop *active-condition-handlers*)))
@@ -270,9 +269,9 @@
(let ((handler-class (find-class handler-type nil)))
(when (if (not handler-class)
(typep (class-prototype-value class) handler-type)
- (progn
- (setf (car handler) handler-class) ; XXX memoize this find-class..
- (member handler-class cpl)))
+ (progn
+ (setf (car handler) handler-class) ; XXX memoize this find-class..
+ (member handler-class cpl)))
(invoke-handler (cdr handler)))))
(cons
(when (typep (class-prototype-value class) handler-type)
More information about the Movitz-cvs
mailing list