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

Create SPECIALIER and EQL-SPECIALIZER as classes without slots

Browse source
This commit is contained in:
Juan Jose Garcia Ripoll 2012-04-22 21:26:00 +02:00
parent b9dd1309ee
commit 1ecb59b7f4
1 changed files with 13 additions and 2 deletions
Download patch file Download diff file Expand all files Collapse all files

15
src/clos/boot.lsp
View file

@ -47,6 +47,8 @@
(make-empty-standard-class 'FUNCALLABLE-STANDARD-CLASS
standard-class))
(metaobject (make-empty-standard-class 'METAOBJECT standard-class))
(specializer (make-empty-standard-class 'SPECIALIZER standard-class))
(eql-specializer (make-empty-standard-class 'EQL-SPECIALIZER standard-class))
(the-class (make-empty-standard-class 'CLASS standard-class))
(the-t (make-empty-standard-class 'T the-class))
;; It does not matter that we pass NIL instead of a class object,
@ -124,8 +126,11 @@
(class-direct-superclasses standard-object) (list the-t)
(class-direct-subclasses standard-object) (list metaobject)
(class-direct-superclasses metaobject) (list standard-object)
(class-direct-subclasses metaobject) (list the-class)
(class-direct-superclasses the-class) (list metaobject)
(class-direct-subclasses metaobject) (list specializer)
(class-direct-superclasses specializer) (list metaobject)
(class-direct-subclasses specializer) (list the-class)
(class-direct-superclasses eql-specializer) (list specializer)
(class-direct-superclasses the-class) (list specializer)
(class-direct-subclasses the-class) (list std-class)
(class-direct-superclasses std-class) (list the-class)
(class-direct-superclasses standard-class) (list std-class)
@ -134,6 +139,8 @@
(si::instance-sig-set the-t)
(si::instance-sig-set standard-object)
(si::instance-sig-set metaobject)
(si::instance-sig-set specializer)
(si::instance-sig-set eql-specializer)
(si::instance-sig-set the-class)
(si::instance-sig-set std-class)
(si::instance-sig-set standard-class)
@ -147,6 +154,10 @@
(setf cpl (list* standard-object cpl))
(class-precedence-list metaobject)
(setf cpl (list* metaobject cpl))
(class-precedence-list specializer)
(setf cpl (list* specializer cpl))
(class-precedence-list eql-specializer)
(list* eql-specializer cpl)
(class-precedence-list the-class)
(setf cpl (list* the-class cpl))
(class-precedence-list std-class)