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