From 49d1ac4a6c8f7a5df04e5bdda6bae77a73be34d5 Mon Sep 17 00:00:00 2001 From: ram <ram> Date: Thu, 22 Jul 1993 01:08:02 +0000 Subject: [PATCH] More simple-condition fixes. --- code/error.lisp | 40 ++++++++++++++++++++++++---------------- 1 file changed, 24 insertions(+), 16 deletions(-) diff --git a/code/error.lisp b/code/error.lisp index 7712a25c6..e1a2ec59a 100644 --- a/code/error.lisp +++ b/code/error.lisp @@ -7,7 +7,7 @@ ;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/error.lisp,v 1.29 1993/07/22 00:23:32 ram Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/error.lisp,v 1.30 1993/07/22 01:08:02 ram Exp $") ;;; ;;; ********************************************************************** ;;; @@ -627,7 +627,6 @@ (define-condition warning (condition) ()) (define-condition style-warning (warning) ()) -(define-condition simple-style-warning (style-warning) ()) (defun warn (datum &rest arguments) "Warns about a situation by signalling a condition formed by datum and @@ -656,6 +655,10 @@ (apply #'format stream (simple-condition-format-control condition) (simple-condition-format-arguments condition))) +(deftype simple-condition () + '(or internal-simple-condition simple-warning simple-type-error + simple-error simple-style-warning)) + ;;; The simple-condition is really called internal-simple-condition, so ;;; SIMPLE-CONDITION-FORMAT-CONTROL and SIMPLE-CONDITION-FORMAT-ARGUMENTS could ;;; be written to handle the simple-condition, simple-warning, @@ -673,15 +676,12 @@ (setf (symbol-plist 'simple-condition) (symbol-plist 'internal-simple-condition)) -(deftype simple-condition () - '(or internal-simple-condition simple-warning simple-type-error - simple-error simple-style-warning)) ;;; The simple-warning type has a conc-name, so SIMPLE-CONDITION-FORMAT-CONTROL ;;; and SIMPLE-CONDITION-FORMAT-ARGUMENTS could be written to handle the -;;; simple-condition, simple-warning, simple-type-error, and simple-error types. -;;; This seems to create some kind of bogus multiple inheritance that the user -;;; sees. +;;; simple-condition, simple-warning, simple-type-error, and simple-error +;;; types. This seems to create some kind of bogus multiple inheritance that +;;; the user sees. ;;; (define-condition simple-warning (warning) (format-control @@ -767,21 +767,29 @@ ;;; (defun simple-condition-format-control (condition) (etypecase condition - (simple-condition (internal-simple-condition-format-control condition)) - (simple-warning (internal-simple-warning-format-control condition)) + (internal-simple-condition + (internal-simple-condition-format-control condition)) + (simple-warning + (internal-simple-warning-format-control condition)) (simple-style-warning (internal-simple-style-warning-format-control condition)) - (simple-type-error (internal-simple-type-error-format-control condition)) - (simple-error (internal-simple-error-format-control condition)))) + (simple-type-error + (internal-simple-type-error-format-control condition)) + (simple-error + (internal-simple-error-format-control condition)))) ;;; (defun simple-condition-format-arguments (condition) (etypecase condition - (simple-condition (internal-simple-condition-format-arguments condition)) - (simple-warning (internal-simple-warning-format-arguments condition)) + (internal-simple-condition + (internal-simple-condition-format-arguments condition)) + (simple-warning + (internal-simple-warning-format-arguments condition)) (simple-style-warning (internal-simple-style-warning-format-arguments condition)) - (simple-type-error (internal-simple-type-error-format-arguments condition)) - (simple-error (internal-simple-error-format-arguments condition)))) + (simple-type-error + (internal-simple-type-error-format-arguments condition)) + (simple-error + (internal-simple-error-format-arguments condition)))) (define-condition program-error (error) ()) -- GitLab