From bc2ddb6539cf5edbbb3ac47002fe4997d3aa2b88 Mon Sep 17 00:00:00 2001
From: Juan Jose Garcia Ripoll <jjgarcia@users.sourceforge.net>
Date: Sat, 6 Oct 2012 10:15:13 +0200
Subject: [PATCH] Change the syntax of early-make-instance to make it a with-
 macro where the instance can be early referenced

---
 src/clos/kernel.lsp | 42 +++++++++++++++++++++---------------------
 1 file changed, 21 insertions(+), 21 deletions(-)

diff --git a/src/clos/kernel.lsp b/src/clos/kernel.lsp
index 037c87073..ad31f9106 100644
--- a/src/clos/kernel.lsp
+++ b/src/clos/kernel.lsp
@@ -252,12 +252,13 @@
 ;;;                                                         early versions
 
 (eval-when (:compile-toplevel :execute)
-  (defmacro early-make-instance (slots class &rest key-value-pairs)
+  (defmacro with-early-make-instance ((class slots) (object &rest key-value-pairs)
+				      &rest body)
     (setf slots (symbol-value slots))
-    `(let ((object (si::allocate-raw-instance nil (find-class ,class)
+    `(let ((,object (si::allocate-raw-instance nil (find-class ',class)
 					      ,(length slots))))
-       (declare (type standard-object object))
-       (si::instance-sig-set object)
+       (declare (type standard-object ,object))
+       (si::instance-sig-set ,object)
        ,@(loop for (name . slotd) in slots
 	    for initarg = (getf slotd :initarg)
 	    for initform = (getf slotd :initform)
@@ -265,29 +266,28 @@
 	    for index from 0
 	    do (when (and initarg (member initarg key-value-pairs))
 		 (setf initform (getf key-value-pairs initarg)))
-	    collect `(si::instance-set object ,index ,initform))
-       object)))
+	    collect `(si::instance-set ,object ,index ,initform))
+       ,@body)))
 
 ;;; early version used during bootstrap
 (defun ensure-generic-function (name &key (lambda-list (si::unbound) l-l-p))
   (if (and (fboundp name) (si::instancep (fdefinition name)))
       (fdefinition name)
       ;; create a fake standard-generic-function object:
-      (let ((gfun (early-make-instance
-		   +standard-generic-function-slots+
-		   'standard-generic-function
-		   :name name
-		   :spec-list nil
-		   :method-combination (find-method-combination nil 'standard nil)
-		   :lambda-list lambda-list
-		   :argument-precedence-order
-		   (and l-l-p (rest (si::process-lambda-list lambda-list t)))
-		   :method-class (find-class 'standard-method)
-		   :docstring nil
-		   :methods nil
-		   :a-p-o-function nil
-		   :declarations nil
-		   :dependents nil)))
+      (with-early-make-instance
+	  (standard-generic-function +standard-generic-function-slots+)
+	(gfun :name name
+	      :spec-list nil
+	      :method-combination (find-method-combination nil 'standard nil)
+	      :lambda-list lambda-list
+	      :argument-precedence-order
+	      (and l-l-p (rest (si::process-lambda-list lambda-list t)))
+	      :method-class (find-class 'standard-method)
+	      :docstring nil
+	      :methods nil
+	      :a-p-o-function nil
+	      :declarations nil
+	      :dependents nil)
 	;; create a new gfun
 	(set-funcallable-instance-function gfun 'standard-generic-function)
 	(setf (fdefinition name) gfun)