Index: /trunk/ccl/level-1/l1-clos-boot.lisp
===================================================================
--- /trunk/ccl/level-1/l1-clos-boot.lisp	(revision 284)
+++ /trunk/ccl/level-1/l1-clos-boot.lisp	(revision 285)
@@ -176,5 +176,5 @@
            instance slot-id))
 (defun %slot-id-ref-missing (instance slot-id)
-  (slot-missing (class-of instance) instance (slot-id.name slot-id) 'slot-value))
+  (values (slot-missing (class-of instance) instance (slot-id.name slot-id) 'slot-value)))
 
 (defun %slot-id-set-obsolete (instance slot-id new-value)
@@ -184,5 +184,7 @@
 
 (defun %slot-id-set-missing (instance slot-id new-value)
-  (slot-missing (class-of instance) instance (slot-id.name slot-id) '(setf slot-value) new-value))
+  (slot-missing (class-of instance) instance (slot-id.name slot-id) 'setf new-value)
+  new-value
+  )
 
 
@@ -550,5 +552,5 @@
     (when (and def (not (typep def 'generic-function)))
       (cerror "Try to remove any global non-generic function or macro definition."
-	      "~s is defined as something other than a generic function." function-name)
+	      (make-condition 'simple-program-error :format-control "The functio ~s is defined as something other than a generic function." :format-arguments (list function-name)))
       (fmakunbound function-name)
       (setq def nil))
@@ -1063,7 +1065,7 @@
                  nil
                  nil
-                 #'(lambda (x y) (vanilla-union x y))
+                 #'(lambda (x y) (hierarchical-union2 x y))
                  nil
-                 #'(lambda (x y) (vanilla-intersection x y))
+                 #'(lambda (x y) (hierarchical-intersection2 x y))
                  nil
                  #'missing-type-method
@@ -1101,4 +1103,6 @@
 (new-type-class 'foreign)
 (new-type-class 'cons)
+(new-type-class 'intersection)
+(new-type-class 'negation)
 (defparameter *class-type-class* (new-type-class 'class))
 
@@ -1585,4 +1589,6 @@
 (make-built-in-class 'foreign-ctype *ctype-class*)
 (make-built-in-class 'class-ctype *ctype-class*)
+(make-built-in-class 'negation-ctype *ctype-class*)
+(make-built-in-class 'intersection-ctype *ctype-class*)
 
 
@@ -2294,5 +2300,5 @@
       (if slotd
 	(slot-value-using-class class instance slotd)
-	(slot-missing class instance slot-name 'slot-value))))
+	(values (slot-missing class instance slot-name 'slot-value)))))
     
 
@@ -2320,14 +2326,17 @@
 	(if slotd
 	  (setf (slot-value-using-class class instance slotd) value)
-	  (slot-missing class instance name '(setf slot-value) value))))
+	  (progn	    
+	    (slot-missing class instance name 'setf value)
+	    value))))
 
 (defsetf slot-value set-slot-value)
 
 (defun slot-makunbound (instance name)
-    (let* ((class (class-of instance))
-	   (slotd (find-slotd name (%class-slots class))))
-      (if slotd
-	(slot-makunbound-using-class class instance slotd)
-	(slot-missing class instance name 'slot-makunbound))))
+  (let* ((class (class-of instance))
+	 (slotd (find-slotd name (%class-slots class))))
+    (if slotd
+      (slot-makunbound-using-class class instance slotd)
+      (slot-missing class instance name 'slot-makunbound))
+    instance))
 
 (defun %std-slot-vector-boundp (slot-vector slotd)
@@ -2359,5 +2368,5 @@
     (if slotd
       (slot-boundp-using-class class instance slotd)
-      (slot-missing class instance name 'slot-boundp))))
+      (values (slot-missing class instance name 'slot-boundp)))))
 
 (defun slot-value-if-bound (instance name &optional default)
@@ -2648,11 +2657,10 @@
 	    (if bad-keys?
 	      (if errorp
-		(error #'(lambda (stream key name class vect)
-			   (let ((*print-array* t))
-			     (format stream 
-				     "~s is an invalid initarg to ~s for ~s.~%~
+		(signal-program-error
+		 "~s is an invalid initarg to ~s for ~s.~%~
                                     Valid initargs: ~s."
-				     key name class vect)))
-		       bad-key (function-name (car functions)) class initvect)
+		 bad-key
+		 (function-name (car functions))
+		 class (coerce initvect 'list))
 		(values bad-keys? bad-key))))
 	(if (eq initarg :allow-other-keys)
@@ -3075,5 +3083,5 @@
   (cond ((equal apo req) nil)
         ((not (eql (length apo) (length req)))
-         (error "Lengths of ~S and ~S differ." apo req))
+         (signal-program-error "Lengths of ~S and ~S differ." apo req))
         (t (let ((res nil))
              (dolist (arg apo (nreverse res))