mirrors/ecl
1
Fork 0
mirror of https://gitlab.com/embeddable-common-lisp/ecl.git synced 2026-01-18 07:12:26 -08:00
Code Issues Projects Releases Packages Wiki Activity

Fixes in with-early-make-instance

Browse source
This commit is contained in:
Juan Jose Garcia Ripoll 2012-10-07 13:10:18 +02:00
parent 4f983c9770
commit 9949e17b22
1 changed files with 12 additions and 10 deletions
Download patch file Download diff file Expand all files Collapse all files

22
src/clos/boot.lsp
View file

@ -31,16 +31,18 @@
(,object (si::allocate-raw-instance nil %class
,(length slots))))
(declare (type standard-object ,object))
,@(loop for (name . slotd) in slots
for initarg = (getf slotd :initarg)
for initform = (getf slotd :initform)
for initvalue = (getf key-value-pairs initarg)
for index from 0
do (cond ((and initarg (member initarg key-value-pairs))
(setf initform (getf key-value-pairs initarg)))
((getf key-value-pairs name)
(setf initform (getf key-value-pairs name))))
collect `(si::instance-set ,object ,index ,initform))
,@(flet ((initializerp (name list)
(not (eq (getf list name 'wrong) 'wrong))))
(loop for (name . slotd) in slots
for initarg = (getf slotd :initarg)
for initform = (getf slotd :initform)
for initvalue = (getf key-value-pairs initarg)
for index from 0
do (cond ((and initarg (initializerp initarg key-value-pairs))
(setf initform (getf key-value-pairs initarg)))
((initializerp name key-value-pairs)
(setf initform (getf key-value-pairs name))))
collect `(si::instance-set ,object ,index ,initform)))
(when %class
(si::instance-sig-set ,object))
(with-early-accessors (,slots)