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

Save some space in boot.lsp by removing explicit metaclasses in the list

Browse source
This commit is contained in:
Juanjo Garcia-Ripoll 2012-10-05 16:02:52 +02:00
parent 632e208a5c
commit 3409980ba5
1 changed files with 6 additions and 19 deletions
Download patch file Download diff file Expand all files Collapse all files

25
src/clos/boot.lsp
View file

@ -106,51 +106,40 @@
collect (canonical-slot-to-direct-slot nil s))))
(eval-when (eval)
(defconstant +class-hierarchy+
`((standard-class) ; Special-cased below
`((standard-class
:metaclass nil) ; Special-cased below
(t
:index 0
:metaclass standard-class)
:index 0)
(standard-object
:metaclass standard-class
:direct-superclasses (t))
(metaobject
:metaclass standard-class
:direct-superclasses (standard-object))
(method-combination
:metaclass standard-class
:direct-superclasses (metaobject)
:direct-slots #.(canonical-slots +method-combination-slots+))
(specializer
:metaclass standard-class
:direct-superclasses (metaobject)
:direct-slots #.(canonical-slots +specializer-slots+))
(eql-specializer
:metaclass standard-class
:direct-superclasses (specializer)
:direct-slots #.(canonical-slots +eql-specializer-slots+))
(class
:metaclass standard-class
:direct-superclasses (specializer)
:direct-slots #.(canonical-slots +class-slots+))
(forward-referenced-class
:metaclass standard-class
:direct-superclasses (class)
:direct-slots #.(canonical-slots +class-slots+))
(built-in-class
:metaclass standard-class
:direct-superclasses (class)
:direct-slots #1=#.(canonical-slots +standard-class-slots+))
(std-class
:metaclass standard-class
:direct-superclasses (class)
:direct-slots #1#)
(standard-class
:metaclass standard-class
:direct-superclasses (std-class)
:direct-slots #1#
:metaclass standard-class)
(funcallable-standard-class
:metaclass standard-class
:direct-superclasses (std-class)
:direct-slots #1#)
,@(loop for (name . rest) in +builtin-classes-list+
@ -166,12 +155,10 @@
;;; We cannot use the functions CREATE-STANDARD-CLASS and others because SLOTS,
;;; DIRECT-SLOTS, etc are empty and therefore SLOT-VALUE does not work.
(defun make-empty-standard-class (name &key metaclass direct-superclasses direct-slots index)
(defun make-empty-standard-class (name &key (metaclass 'standard-class)
direct-superclasses direct-slots index)
(declare (si::c-local))
(let* ((the-metaclass (cond (metaclass
(gethash metaclass si::*class-name-hash-table*))
(t
nil)))
(let* ((the-metaclass (and metaclass (gethash metaclass si::*class-name-hash-table*)))
(class (or (gethash name si::*class-name-hash-table*)
(si:allocate-raw-instance nil the-metaclass
#.(length +standard-class-slots+)))))