mirror of
https://gitlab.com/embeddable-common-lisp/ecl.git
synced 2026-01-17 06:42:18 -08:00
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:
parent
d799c7a4e7
commit
bc2ddb6539
1 changed files with 21 additions and 21 deletions
|
|
@ -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)
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue