From 05fa67ad172794e205f667063745ef4ff5377893 Mon Sep 17 00:00:00 2001
From: jjgarcia <jjgarcia>
Date: Thu, 10 Apr 2003 19:47:56 +0000
Subject: [PATCH] Define and use UNBOUND-SLOT condition.

---
 src/CHANGELOG           |  2 ++
 src/c/symbols_list.h    |  2 ++
 src/clos/boot.lsp       |  2 +-
 src/clos/conditions.lsp | 13 +++++++++++++
 4 files changed, 18 insertions(+), 1 deletion(-)

diff --git a/src/CHANGELOG b/src/CHANGELOG
index fc6d8ecc3..f9f46818e 100644
--- a/src/CHANGELOG
+++ b/src/CHANGELOG
@@ -1348,6 +1348,8 @@ ECLS 0.9
     destructuring (Thanks to the CMUCL team for maintaining a reasonably
     portable LOOP!).
 
+  - SLOT-UNBOUND now effectively signals an UNBOUND-SLOT condition.
+
 TODO:
 =====
 
diff --git a/src/c/symbols_list.h b/src/c/symbols_list.h
index c796ed131..50b957f14 100644
--- a/src/c/symbols_list.h
+++ b/src/c/symbols_list.h
@@ -196,6 +196,7 @@ cl_symbols[] = {
 {"CDR", CL_ORDINARY, cl_cdr, 1},
 {"CEILING", CL_ORDINARY, cl_ceiling, -1},
 {"CELL-ERROR", CL_ORDINARY, NULL, -1},
+{"CELL-ERROR-NAME", CL_ORDINARY, NULL, -1},
 {"CERROR", CL_ORDINARY, cl_cerror, -1},
 {"CHAR", CL_ORDINARY, cl_char, 2},
 {"CHAR-CODE", CL_ORDINARY, cl_char_code, 1},
@@ -832,6 +833,7 @@ cl_symbols[] = {
 {"TYPECASE", CL_ORDINARY, NULL, -1},
 {"TYPEP", CL_ORDINARY, NULL, -1},
 {"UNBOUND-SLOT", CL_ORDINARY, NULL, -1},
+{"UNBOUND-SLOT-INSTANCE", CL_ORDINARY, NULL, -1},
 {"UNBOUND-VARIABLE", CL_ORDINARY, NULL, -1},
 {"UNDEFINED-FUNCTION", CL_ORDINARY, NULL, -1},
 {"UNEXPORT", CL_ORDINARY, cl_unexport, -1},
diff --git a/src/clos/boot.lsp b/src/clos/boot.lsp
index 8e9b4828a..17ac6cc53 100644
--- a/src/clos/boot.lsp
+++ b/src/clos/boot.lsp
@@ -134,7 +134,7 @@
       (error "~A is not a slot of ~A" slot-name object))
 
     (defmethod slot-unbound ((class t) object slot-name)
-      (error "the slot ~A of ~A is unbound" slot-name object))
+      (error 'slot-unbound :instance object :name slot-name))
     ))
 
 (boot)
diff --git a/src/clos/conditions.lsp b/src/clos/conditions.lsp
index 53f8d3c03..f68bf1073 100644
--- a/src/clos/conditions.lsp
+++ b/src/clos/conditions.lsp
@@ -461,6 +461,8 @@ returns with NIL."
 (define-condition simple-warning (simple-condition warning)
   () (:REPORT simple-condition-printer))
 
+(define-condition style-warning (warning) ())
+
 (define-condition simple-error (simple-condition error) ())
 
 (define-condition storage-condition (serious-condition) ())
@@ -520,6 +522,13 @@ returns with NIL."
 	     (format stream "The variable ~S is unbound."
 		     (cell-error-name condition)))))
   
+(define-condition unbound-slot (cell-error)
+  ((instance :INITARG :INSTANCE :READER unbound-slot-instance))
+  (:REPORT (lambda (condition stream)
+	     (format stream "The slot ~S in the object ~S is unbound."
+		     (cell-error-name condition)
+		     (unbound-slot-instance condition)))))
+
 (define-condition undefined-function (cell-error)
   ()
   (:REPORT (lambda (condition stream)
@@ -535,6 +544,10 @@ returns with NIL."
 
 (define-condition floating-point-underflow (arithmetic-error) ())
 
+(define-condition floating-point-inexact (arithmetic-error) ())
+
+(define-condition floating-point-invalid-operation (arithmetic-error) ())
+
 (define-condition abort-failure (control-error) ()
   (:REPORT (lambda (c s) (declare (ignore c))
 		   (write-string "Abort failed." s))))