From d799c7a4e7d8314e6f268ea61a6540655905bbd3 Mon Sep 17 00:00:00 2001
From: Juan Jose Garcia Ripoll <jjgarcia@users.sourceforge.net>
Date: Fri, 5 Oct 2012 23:04:12 +0200
Subject: [PATCH] All accessors are redefined as generic functions after
 bootstrapping ECL

---
 src/clos/fixup.lsp    |  4 +++-
 src/clos/standard.lsp | 32 +++++++++++++++++++++++---------
 2 files changed, 26 insertions(+), 10 deletions(-)

diff --git a/src/clos/fixup.lsp b/src/clos/fixup.lsp
index 97fda9d7d..7615102df 100644
--- a/src/clos/fixup.lsp
+++ b/src/clos/fixup.lsp
@@ -45,7 +45,9 @@
     (map-into direct-slots #'identity new-direct-slots)
     (map-into effective-slots #'identity new-effective-slots)
     (when (typep class 'std-class)
-      (std-create-slots-table class)))
+      (std-create-slots-table class)
+      )
+    (std-class-generate-accessors class))
   (mapc #'convert-one-class (class-direct-subclasses class)))
 
 ;;;
diff --git a/src/clos/standard.lsp b/src/clos/standard.lsp
index 2d1f544f2..96fba5afc 100644
--- a/src/clos/standard.lsp
+++ b/src/clos/standard.lsp
@@ -655,8 +655,21 @@ because it contains a reference to the undefined class~%  ~A"
 	  #'(lambda (value self)
 	      (setf (slot-value self slot-name) value))))
 
+(defun safe-add-method (name method)
+  ;; Adds a method to a function which might have been previously defined
+  ;; as non-generic, without breaking the function
+  (if (or *clos-booted*
+	  (not (fboundp name))
+	  (si::instancep (fdefinition name)))
+      (add-method (ensure-generic-function name) method)
+      (let* ((alt-name #:foo)
+	     (gf (ensure-generic-function alt-name)))
+	(add-method gf method)
+	(setf (fdefinition name) gf
+	      (generic-function-name gf) name)
+	(fmakunbound alt-name))))
+
 (defun std-class-generate-accessors (standard-class &aux optimizable)
-  (declare (si::c-local))
   ;;
   ;; The accessors are closures, which are generated every time the
   ;; slots of the class change. The accessors are safe: they check that
@@ -700,15 +713,16 @@ because it contains a reference to the undefined class~%  ~A"
 			     (apply #'writer-method-class standard-class slotd
 				    writer-args))))
 	(dolist (fname (slot-definition-readers slotd))
-	  (add-method (ensure-generic-function fname)
-		      (make-method reader-class nil `(,standard-class) '(self)
-				   (wrapped-method-function reader)
-				   (list :slot-definition slotd))))
+	  (safe-add-method fname
+			   (make-method reader-class nil `(,standard-class) '(self)
+					(wrapped-method-function reader)
+					(list :slot-definition slotd))))
 	(dolist (fname (slot-definition-writers slotd))
-	  (add-method (ensure-generic-function fname)
-		      (make-method writer-class nil `(,(find-class t) ,standard-class) '(value self)
-				   (wrapped-method-function writer)
-				   (list :slot-definition slotd))))))))
+	  (safe-add-method fname
+			   (make-method writer-class nil
+					`(,(find-class t) ,standard-class) '(value self)
+					(wrapped-method-function writer)
+					(list :slot-definition slotd))))))))
 
 ;;; ======================================================================
 ;;; STANDARD-OBJECT