mirrors/ecl
1
Fork 0
mirror of https://gitlab.com/embeddable-common-lisp/ecl.git synced 2026-01-16 14:21:48 -08:00
Code Issues Projects Releases Packages Wiki Activity

Split the routines for generating accessor functions into a file that can be loaded at boot time

Browse source
This commit is contained in:
Juan Jose Garcia Ripoll 2012-10-07 15:02:15 +02:00
parent 18e7a43603
commit e8ac760e2c
1 changed files with 0 additions and 34 deletions
Download patch file Download diff file Expand all files Collapse all files

34
src/clos/boot.lsp
View file

@ -15,40 +15,6 @@
(defconstant +builtin-classes-pre-array+
(make-array (1+ #.(length +builtin-classes-list+))))
;;; ----------------------------------------------------------------------
;;; Early accessors and class construction
;;;
;;;
;;; The following macro is also used at bootstap for instantiating
;;; a class based only on the s-form description.
;;;
(eval-when (:compile-toplevel :execute)
(defmacro with-early-make-instance (slots (object class &rest key-value-pairs)
&rest body)
(when (symbolp slots)
(setf slots (symbol-value slots)))
`(let* ((%class ,class)
(,object (si::allocate-raw-instance nil %class
,(length slots))))
(declare (type standard-object ,object))
,@(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 (si::unbound))
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))))
when (si:sl-boundp initform)
collect `(si::instance-set ,object ,index ,initform)))
(when %class
(si::instance-sig-set ,object))
(with-early-accessors (,slots)
,@body))))
;;; ----------------------------------------------------------------------
;;; Building the classes T, CLASS, STANDARD-OBJECT and STANDARD-CLASS.
;;;