Skip to content
Snippets Groups Projects
Commit 49d1ac4a authored by ram's avatar ram
Browse files

More simple-condition fixes.

parent 7052da8d
No related branches found
No related tags found
No related merge requests found
......@@ -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) ())
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment