Change the syntax of early-make-instance to make it a with- macro where the instance can be early referenced

This commit is contained in:
Juan Jose Garcia Ripoll 2012-10-06 10:15:13 +02:00
parent d799c7a4e7
commit bc2ddb6539

View file

@ -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)