(setf (layout-invalid layout) nil
(classoid-layout classoid) layout))
- (let ((inherits (layout-inherits layout)))
- (dotimes (i (length inherits)) ; FIXME: should be DOVECTOR
- (let* ((super (layout-classoid (svref inherits i)))
- (subclasses (or (classoid-subclasses super)
- (setf (classoid-subclasses super)
- (make-hash-table :test 'eq)))))
- (when (and (eq (classoid-state super) :sealed)
- (not (gethash classoid subclasses)))
- (warn "unsealing sealed class ~S in order to subclass it"
- (classoid-name super))
- (setf (classoid-state super) :read-only))
- (setf (gethash classoid subclasses)
- (or destruct-layout layout))))))
+ (dovector (super-layout (layout-inherits layout))
+ (let* ((super (layout-classoid super-layout))
+ (subclasses (or (classoid-subclasses super)
+ (setf (classoid-subclasses super)
+ (make-hash-table :test 'eq)))))
+ (when (and (eq (classoid-state super) :sealed)
+ (not (gethash classoid subclasses)))
+ (warn "unsealing sealed class ~S in order to subclass it"
+ (classoid-name super))
+ (setf (classoid-state super) :read-only))
+ (setf (gethash classoid subclasses)
+ (or destruct-layout layout)))))
(values))
); EVAL-WHEN
(setf (info :type :classoid name)
(make-classoid-cell name))))
-;;; FIXME: When the system is stable, this DECLAIM FTYPE should
-;;; probably go away in favor of the DEFKNOWN for FIND-CLASS.
-(declaim (ftype (function (symbol &optional t (or null sb!c::lexenv)))
- find-classoid))
(eval-when (#-sb-xc :compile-toplevel :load-toplevel :execute)
(defun find-classoid (name &optional (errorp t) environment)
#!+sb-doc
(setq
*built-in-classes*
'((t :state :read-only :translation t)
- (character :enumerable t :translation base-char)
+ (character :enumerable t :translation base-char
+ :prototype-form (code-char 42))
(base-char :enumerable t
:inherits (character)
- :codes (#.sb!vm:base-char-widetag))
- (symbol :codes (#.sb!vm:symbol-header-widetag))
+ :codes (#.sb!vm:base-char-widetag)
+ :prototype-form (code-char 42))
+ (symbol :codes (#.sb!vm:symbol-header-widetag)
+ :prototype-form '#:mu)
(instance :state :read-only)
- (system-area-pointer :codes (#.sb!vm:sap-widetag))
- (weak-pointer :codes (#.sb!vm:weak-pointer-widetag))
+ (system-area-pointer :codes (#.sb!vm:sap-widetag)
+ :prototype-form (sb!sys:int-sap 42))
+ (weak-pointer :codes (#.sb!vm:weak-pointer-widetag)
+ :prototype-form (sb!ext:make-weak-pointer (find-package "CL")))
(code-component :codes (#.sb!vm:code-header-widetag))
(lra :codes (#.sb!vm:return-pc-header-widetag))
- (fdefn :codes (#.sb!vm:fdefn-widetag))
+ (fdefn :codes (#.sb!vm:fdefn-widetag)
+ :prototype-form (sb!kernel:make-fdefn "42"))
(random-class) ; used for unknown type codes
(function
:codes (#.sb!vm:closure-header-widetag
#.sb!vm:simple-fun-header-widetag)
- :state :read-only)
+ :state :read-only
+ :prototype-form (function (lambda () 42)))
(funcallable-instance
:inherits (function)
:state :read-only)
+ (number :translation number)
+ (complex
+ :translation complex
+ :inherits (number)
+ :codes (#.sb!vm:complex-widetag)
+ :prototype-form (complex 42 42))
+ (complex-single-float
+ :translation (complex single-float)
+ :inherits (complex number)
+ :codes (#.sb!vm:complex-single-float-widetag)
+ :prototype-form (complex 42f0 42f0))
+ (complex-double-float
+ :translation (complex double-float)
+ :inherits (complex number)
+ :codes (#.sb!vm:complex-double-float-widetag)
+ :prototype-form (complex 42d0 42d0))
+ #!+long-float
+ (complex-long-float
+ :translation (complex long-float)
+ :inherits (complex number)
+ :codes (#.sb!vm:complex-long-float-widetag)
+ :prototype-form (complex 42l0 42l0))
+ (real :translation real :inherits (number))
+ (float
+ :translation float
+ :inherits (real number))
+ (single-float
+ :translation single-float
+ :inherits (float real number)
+ :codes (#.sb!vm:single-float-widetag)
+ :prototype-form 42f0)
+ (double-float
+ :translation double-float
+ :inherits (float real number)
+ :codes (#.sb!vm:double-float-widetag)
+ :prototype-form 42d0)
+ #!+long-float
+ (long-float
+ :translation long-float
+ :inherits (float real number)
+ :codes (#.sb!vm:long-float-widetag)
+ :prototype-form 42l0)
+ (rational
+ :translation rational
+ :inherits (real number))
+ (ratio
+ :translation (and rational (not integer))
+ :inherits (rational real number)
+ :codes (#.sb!vm:ratio-widetag)
+ :prototype-form 1/42)
+ (integer
+ :translation integer
+ :inherits (rational real number))
+ (fixnum
+ :translation (integer #.sb!xc:most-negative-fixnum
+ #.sb!xc:most-positive-fixnum)
+ :inherits (integer rational real number)
+ :codes (#.sb!vm:even-fixnum-lowtag #.sb!vm:odd-fixnum-lowtag)
+ :prototype-form 42)
+ (bignum
+ :translation (and integer (not fixnum))
+ :inherits (integer rational real number)
+ :codes (#.sb!vm:bignum-widetag)
+ ;; FIXME: wrong for 64-bit!
+ :prototype-form (expt 2 42))
+
(array :translation array :codes (#.sb!vm:complex-array-widetag)
- :hierarchical-p nil)
+ :hierarchical-p nil
+ :prototype-form (make-array nil :adjustable t))
(simple-array
:translation simple-array :codes (#.sb!vm:simple-array-widetag)
- :inherits (array))
+ :inherits (array)
+ :prototype-form (make-array nil))
(sequence
:translation (or cons (member nil) vector))
(vector
(simple-vector
:translation simple-vector :codes (#.sb!vm:simple-vector-widetag)
:direct-superclasses (vector simple-array)
- :inherits (vector simple-array array sequence))
+ :inherits (vector simple-array array sequence)
+ :prototype-form (make-array 0))
(bit-vector
:translation bit-vector :codes (#.sb!vm:complex-bit-vector-widetag)
- :inherits (vector array sequence))
+ :inherits (vector array sequence)
+ :prototype-form (make-array 0 :element-type 'bit :fill-pointer t))
(simple-bit-vector
:translation simple-bit-vector :codes (#.sb!vm:simple-bit-vector-widetag)
:direct-superclasses (bit-vector simple-array)
:inherits (bit-vector vector simple-array
- array sequence))
+ array sequence)
+ :prototype-form (make-array 0 :element-type 'bit))
(simple-array-unsigned-byte-2
:translation (simple-array (unsigned-byte 2) (*))
:codes (#.sb!vm:simple-array-unsigned-byte-2-widetag)
:direct-superclasses (vector simple-array)
- :inherits (vector simple-array array sequence))
+ :inherits (vector simple-array array sequence)
+ :prototype-form (make-array 0 :element-type '(unsigned-byte 2)))
(simple-array-unsigned-byte-4
:translation (simple-array (unsigned-byte 4) (*))
:codes (#.sb!vm:simple-array-unsigned-byte-4-widetag)
:direct-superclasses (vector simple-array)
- :inherits (vector simple-array array sequence))
+ :inherits (vector simple-array array sequence)
+ :prototype-form (make-array 0 :element-type '(unsigned-byte 4)))
+ (simple-array-unsigned-byte-7
+ :translation (simple-array (unsigned-byte 7) (*))
+ :codes (#.sb!vm:simple-array-unsigned-byte-7-widetag)
+ :direct-superclasses (vector simple-array)
+ :inherits (vector simple-array array sequence)
+ :prototype-form (make-array 0 :element-type '(unsigned-byte 7)))
(simple-array-unsigned-byte-8
:translation (simple-array (unsigned-byte 8) (*))
:codes (#.sb!vm:simple-array-unsigned-byte-8-widetag)
:direct-superclasses (vector simple-array)
- :inherits (vector simple-array array sequence))
+ :inherits (vector simple-array array sequence)
+ :prototype-form (make-array 0 :element-type '(unsigned-byte 8)))
+ (simple-array-unsigned-byte-15
+ :translation (simple-array (unsigned-byte 7) (*))
+ :codes (#.sb!vm:simple-array-unsigned-byte-15-widetag)
+ :direct-superclasses (vector simple-array)
+ :inherits (vector simple-array array sequence)
+ :prototype-form (make-array 0 :element-type '(unsigned-byte 15)))
(simple-array-unsigned-byte-16
- :translation (simple-array (unsigned-byte 16) (*))
- :codes (#.sb!vm:simple-array-unsigned-byte-16-widetag)
- :direct-superclasses (vector simple-array)
- :inherits (vector simple-array array sequence))
+ :translation (simple-array (unsigned-byte 16) (*))
+ :codes (#.sb!vm:simple-array-unsigned-byte-16-widetag)
+ :direct-superclasses (vector simple-array)
+ :inherits (vector simple-array array sequence)
+ :prototype-form (make-array 0 :element-type '(unsigned-byte 16)))
+ (simple-array-unsigned-byte-29
+ :translation (simple-array (unsigned-byte 29) (*))
+ :codes (#.sb!vm:simple-array-unsigned-byte-29-widetag)
+ :direct-superclasses (vector simple-array)
+ :inherits (vector simple-array array sequence)
+ :prototype-form (make-array 0 :element-type '(unsigned-byte 29)))
+ (simple-array-unsigned-byte-31
+ :translation (simple-array (unsigned-byte 31) (*))
+ :codes (#.sb!vm:simple-array-unsigned-byte-31-widetag)
+ :direct-superclasses (vector simple-array)
+ :inherits (vector simple-array array sequence)
+ :prototype-form (make-array 0 :element-type '(unsigned-byte 31)))
(simple-array-unsigned-byte-32
- :translation (simple-array (unsigned-byte 32) (*))
- :codes (#.sb!vm:simple-array-unsigned-byte-32-widetag)
- :direct-superclasses (vector simple-array)
- :inherits (vector simple-array array sequence))
+ :translation (simple-array (unsigned-byte 32) (*))
+ :codes (#.sb!vm:simple-array-unsigned-byte-32-widetag)
+ :direct-superclasses (vector simple-array)
+ :inherits (vector simple-array array sequence)
+ :prototype-form (make-array 0 :element-type '(unsigned-byte 32)))
(simple-array-signed-byte-8
- :translation (simple-array (signed-byte 8) (*))
- :codes (#.sb!vm:simple-array-signed-byte-8-widetag)
- :direct-superclasses (vector simple-array)
- :inherits (vector simple-array array sequence))
+ :translation (simple-array (signed-byte 8) (*))
+ :codes (#.sb!vm:simple-array-signed-byte-8-widetag)
+ :direct-superclasses (vector simple-array)
+ :inherits (vector simple-array array sequence)
+ :prototype-form (make-array 0 :element-type '(signed-byte 8)))
(simple-array-signed-byte-16
- :translation (simple-array (signed-byte 16) (*))
- :codes (#.sb!vm:simple-array-signed-byte-16-widetag)
- :direct-superclasses (vector simple-array)
- :inherits (vector simple-array array sequence))
+ :translation (simple-array (signed-byte 16) (*))
+ :codes (#.sb!vm:simple-array-signed-byte-16-widetag)
+ :direct-superclasses (vector simple-array)
+ :inherits (vector simple-array array sequence)
+ :prototype-form (make-array 0 :element-type '(signed-byte 16)))
(simple-array-signed-byte-30
- :translation (simple-array (signed-byte 30) (*))
- :codes (#.sb!vm:simple-array-signed-byte-30-widetag)
- :direct-superclasses (vector simple-array)
- :inherits (vector simple-array array sequence))
+ :translation (simple-array (signed-byte 30) (*))
+ :codes (#.sb!vm:simple-array-signed-byte-30-widetag)
+ :direct-superclasses (vector simple-array)
+ :inherits (vector simple-array array sequence)
+ :prototype-form (make-array 0 :element-type '(signed-byte 30)))
(simple-array-signed-byte-32
- :translation (simple-array (signed-byte 32) (*))
- :codes (#.sb!vm:simple-array-signed-byte-32-widetag)
- :direct-superclasses (vector simple-array)
- :inherits (vector simple-array array sequence))
+ :translation (simple-array (signed-byte 32) (*))
+ :codes (#.sb!vm:simple-array-signed-byte-32-widetag)
+ :direct-superclasses (vector simple-array)
+ :inherits (vector simple-array array sequence)
+ :prototype-form (make-array 0 :element-type '(signed-byte 32)))
(simple-array-single-float
- :translation (simple-array single-float (*))
- :codes (#.sb!vm:simple-array-single-float-widetag)
- :direct-superclasses (vector simple-array)
- :inherits (vector simple-array array sequence))
+ :translation (simple-array single-float (*))
+ :codes (#.sb!vm:simple-array-single-float-widetag)
+ :direct-superclasses (vector simple-array)
+ :inherits (vector simple-array array sequence)
+ :prototype-form (make-array 0 :element-type 'single-float))
(simple-array-double-float
- :translation (simple-array double-float (*))
- :codes (#.sb!vm:simple-array-double-float-widetag)
- :direct-superclasses (vector simple-array)
- :inherits (vector simple-array array sequence))
- #!+long-float
- (simple-array-long-float
- :translation (simple-array long-float (*))
- :codes (#.sb!vm:simple-array-long-float-widetag)
- :direct-superclasses (vector simple-array)
- :inherits (vector simple-array array sequence))
- (simple-array-complex-single-float
- :translation (simple-array (complex single-float) (*))
- :codes (#.sb!vm:simple-array-complex-single-float-widetag)
- :direct-superclasses (vector simple-array)
- :inherits (vector simple-array array sequence))
- (simple-array-complex-double-float
- :translation (simple-array (complex double-float) (*))
- :codes (#.sb!vm:simple-array-complex-double-float-widetag)
- :direct-superclasses (vector simple-array)
- :inherits (vector simple-array array sequence))
- #!+long-float
- (simple-array-complex-long-float
- :translation (simple-array (complex long-float) (*))
- :codes (#.sb!vm:simple-array-complex-long-float-widetag)
- :direct-superclasses (vector simple-array)
- :inherits (vector simple-array array sequence))
- (string
- :translation string
- :codes (#.sb!vm:complex-string-widetag)
- :direct-superclasses (vector)
- :inherits (vector array sequence))
- (simple-string
- :translation simple-string
- :codes (#.sb!vm:simple-string-widetag)
- :direct-superclasses (string simple-array)
- :inherits (string vector simple-array
- array sequence))
- (list
- :translation (or cons (member nil))
- :inherits (sequence))
- (cons
- :codes (#.sb!vm:list-pointer-lowtag)
- :translation cons
- :inherits (list sequence))
- (null
- :translation (member nil)
- :inherits (symbol list sequence)
- :direct-superclasses (symbol list))
- (number :translation number)
- (complex
- :translation complex
- :inherits (number)
- :codes (#.sb!vm:complex-widetag))
- (complex-single-float
- :translation (complex single-float)
- :inherits (complex number)
- :codes (#.sb!vm:complex-single-float-widetag))
- (complex-double-float
- :translation (complex double-float)
- :inherits (complex number)
- :codes (#.sb!vm:complex-double-float-widetag))
- #!+long-float
- (complex-long-float
- :translation (complex long-float)
- :inherits (complex number)
- :codes (#.sb!vm:complex-long-float-widetag))
- (real :translation real :inherits (number))
- (float
- :translation float
- :inherits (real number))
- (single-float
- :translation single-float
- :inherits (float real number)
- :codes (#.sb!vm:single-float-widetag))
- (double-float
- :translation double-float
- :inherits (float real number)
- :codes (#.sb!vm:double-float-widetag))
- #!+long-float
- (long-float
- :translation long-float
- :inherits (float real number)
- :codes (#.sb!vm:long-float-widetag))
- (rational
- :translation rational
- :inherits (real number))
- (ratio
- :translation (and rational (not integer))
- :inherits (rational real number)
- :codes (#.sb!vm:ratio-widetag))
- (integer
- :translation integer
- :inherits (rational real number))
- (fixnum
- :translation (integer #.sb!xc:most-negative-fixnum
- #.sb!xc:most-positive-fixnum)
- :inherits (integer rational real number)
- :codes (#.sb!vm:even-fixnum-lowtag #.sb!vm:odd-fixnum-lowtag))
- (bignum
- :translation (and integer (not fixnum))
- :inherits (integer rational real number)
- :codes (#.sb!vm:bignum-widetag))
- (stream
- :state :read-only
- :depth 3
- :inherits (instance)))))
+ :translation (simple-array double-float (*))
+ :codes (#.sb!vm:simple-array-double-float-widetag)
+ :direct-superclasses (vector simple-array)
+ :inherits (vector simple-array array sequence)
+ :prototype-form (make-array 0 :element-type 'double-float))
+ #!+long-float
+ (simple-array-long-float
+ :translation (simple-array long-float (*))
+ :codes (#.sb!vm:simple-array-long-float-widetag)
+ :direct-superclasses (vector simple-array)
+ :inherits (vector simple-array array sequence)
+ :prototype-form (make-array 0 :element-type 'long-float))
+ (simple-array-complex-single-float
+ :translation (simple-array (complex single-float) (*))
+ :codes (#.sb!vm:simple-array-complex-single-float-widetag)
+ :direct-superclasses (vector simple-array)
+ :inherits (vector simple-array array sequence)
+ :prototype-form (make-array 0 :element-type '(complex single-float)))
+ (simple-array-complex-double-float
+ :translation (simple-array (complex double-float) (*))
+ :codes (#.sb!vm:simple-array-complex-double-float-widetag)
+ :direct-superclasses (vector simple-array)
+ :inherits (vector simple-array array sequence)
+ :prototype-form (make-array 0 :element-type '(complex double-float)))
+ #!+long-float
+ (simple-array-complex-long-float
+ :translation (simple-array (complex long-float) (*))
+ :codes (#.sb!vm:simple-array-complex-long-float-widetag)
+ :direct-superclasses (vector simple-array)
+ :inherits (vector simple-array array sequence)
+ :prototype-form (make-array 0 :element-type '(complex long-float)))
+ (string
+ :translation string
+ :direct-superclasses (vector)
+ :inherits (vector array sequence))
+ (simple-string
+ :translation simple-string
+ :direct-superclasses (string simple-array)
+ :inherits (string vector simple-array array sequence))
+ (vector-nil
+ :translation (vector nil)
+ :codes (#.sb!vm:complex-vector-nil-widetag)
+ :direct-superclasses (string)
+ :inherits (string vector array sequence)
+ :prototype-form (make-array 0 :element-type 'nil :fill-pointer t))
+ (simple-array-nil
+ :translation (simple-array nil (*))
+ :codes (#.sb!vm:simple-array-nil-widetag)
+ :direct-superclasses (vector-nil simple-string)
+ :inherits (vector-nil simple-string string vector simple-array
+ array sequence)
+ :prototype-form (make-array 0 :element-type 'nil))
+ (base-string
+ :translation base-string
+ :codes (#.sb!vm:complex-base-string-widetag)
+ :direct-superclasses (string)
+ :inherits (string vector array sequence)
+ :prototype-form (make-array 0 :element-type 'base-char :fill-pointer t))
+ (simple-base-string
+ :translation simple-base-string
+ :codes (#.sb!vm:simple-base-string-widetag)
+ :direct-superclasses (base-string simple-string)
+ :inherits (base-string simple-string string vector simple-array
+ array sequence)
+ :prototype-form (make-array 0 :element-type 'base-char))
+ (list
+ :translation (or cons (member nil))
+ :inherits (sequence))
+ (cons
+ :codes (#.sb!vm:list-pointer-lowtag)
+ :translation cons
+ :inherits (list sequence)
+ :prototype-form (cons nil nil))
+ (null
+ :translation (member nil)
+ :inherits (symbol list sequence)
+ :direct-superclasses (symbol list)
+ :prototype-form 'nil)
+
+ (stream
+ :state :read-only
+ :depth 3
+ :inherits (instance)
+ :prototype-form (make-broadcast-stream)))))
-;;; comment from CMU CL:
-;;; See also type-init.lisp where we finish setting up the
-;;; translations for built-in types.
+;;; See also src/code/class-init.lisp where we finish setting up the
+;;; translations for built-in types.
(!cold-init-forms
(dolist (x *built-in-classes*)
#-sb-xc-host (/show0 "at head of loop over *BUILT-IN-CLASSES*")
enumerable
state
depth
+ prototype-form
(hierarchical-p t) ; might be modified below
(direct-superclasses (if inherits
(list (car inherits))
'(t))))
x
- (declare (ignore codes state translation))
+ (declare (ignore codes state translation prototype-form))
(let ((inherits-list (if (eq name t)
()
(cons t (reverse inherits))))
(let ((inherits (layout-inherits layout))
(classoid (layout-classoid layout)))
(modify-classoid classoid)
- (dotimes (i (length inherits)) ; FIXME: DOVECTOR
- (let* ((super (svref inherits i))
- (subs (classoid-subclasses (layout-classoid super))))
+ (dovector (super inherits)
+ (let ((subs (classoid-subclasses (layout-classoid super))))
(when subs
(remhash classoid subs)))))
(values))
projects / sbcl.git / blobdiff