| blob | c2ceed6f7a2fe4d21aff55ce122cb86e817b4a0f |
1 ;;;; This file contains structures and functions for the maintenance of
2 ;;;; basic information about defined types. Different object systems
3 ;;;; can be supported simultaneously.
5 ;;;; This software is part of the SBCL system. See the README file for
6 ;;;; more information.
7 ;;;;
8 ;;;; This software is derived from the CMU CL system, which was
9 ;;;; written at Carnegie Mellon University and released into the
10 ;;;; public domain. The software is in the public domain and is
11 ;;;; provided with absolutely no warranty. See the COPYING and CREDITS
12 ;;;; files for more information.
17 \f
18 ;;;; the CLASSOID structure
20 ;;; The CLASSOID structure is a supertype of all classoid types.
21 ;;; Its definition occurs in 'early-classoid.lisp'
28 self))))
30 \f
31 ;;;; basic LAYOUT stuff
33 ;;; a list of conses, initialized by genesis
34 ;;;
35 ;;; In each cons, the car is the symbol naming the layout, and the
36 ;;; cdr is the layout itself.
39 ;;; a table mapping class names to layouts for classes we have
40 ;;; referenced but not yet loaded. This is initialized from an alist
41 ;;; created by genesis describing the layouts that genesis created at
42 ;;; cold-load time.
44 (!cold-init-forms
45 ;; Protected by *WORLD-LOCK*
55 ;;; The LAYOUT structure itself is defined in 'early-classoid.lisp'
63 "for ~S~@[, INVALID=~S~]"
70 \f
71 ;;;; support for the hash values used by CLOS when working with LAYOUTs
73 ;;; a generator for random values suitable for the CLOS-HASH slots of
74 ;;; LAYOUTs. We use our own RANDOM-STATE here because we'd like
75 ;;; pseudo-random values to come the same way in the target even when
76 ;;; we make minor changes to the system, in order to reduce the
77 ;;; mysteriousness of possible CLOS bugs.
80 ;; FIXME: I'm not sure why this expression is (1+ (RANDOM FOO)),
81 ;; returning a strictly positive value. I copied it verbatim from
82 ;; CMU CL INITIALIZE-LAYOUT-HASH, so presumably it works, but I
83 ;; dunno whether the hash values are really supposed to be 1-based.
84 ;; They're declared as INDEX.. Or is this a hack to try to avoid
85 ;; having to use bignum arithmetic? Or what? An explanation would be
86 ;; nice.
87 ;;
88 ;; an explanation is provided in Kiczales and Rodriguez, "Efficient
89 ;; Method Dispatch in PCL", 1990. -- CSR, 2005-11-30
95 \f
96 ;;; If we can't find any existing layout, then we create a new one
97 ;;; storing it in *FORWARD-REFERENCED-LAYOUTS*. In classic CMU CL, we
98 ;;; used to immediately check for compatibility, but for
99 ;;; cross-compilability reasons (i.e. convenience of using this
100 ;;; function in a MAKE-LOAD-FORM expression) that functionality has
101 ;;; been split off into INIT-OR-CHECK-LAYOUT.
103 ;; The comment "This seems ..." is misleading but I don't have a better one.
104 ;; FIND-LAYOUT is used by FIND-AND-INIT-OR-CHECK-LAYOUT which is used
105 ;; by FOP-LAYOUT, so clearly it's used when reading fasl files.
107 ;; This seems to be currently used only from the compiler, but make
108 ;; it thread-safe all the same. We need to lock *F-R-L* before doing
109 ;; FIND-CLASSOID in case (SETF FIND-CLASSOID) happens in parallel.
118 ;;; If LAYOUT is uninitialized, initialize it with CLASSOID, LENGTH,
119 ;;; INHERITS, DEPTHOID, and RAW-SLOT-METADATA. Otherwise require
120 ;;; that it be consistent with the existing values.
121 ;;;
122 ;;; UNDEFINED-CLASS values are interpreted specially as "we don't know
123 ;;; anything about the class", so if LAYOUT is initialized, any
124 ;;; preexisting class slot value is OK, and if it's not initialized,
125 ;;; its class slot value is set to an UNDEFINED-CLASS. -- FIXME: This
126 ;;; is no longer true, :UNINITIALIZED used instead.
128 layout-raw-slot-metadata-type)
129 layout)
130 %init-or-check-layout))
134 ;; There was no layout before, we just created one which
135 ;; we'll now initialize with our information.
142 ;; FIXME: Now that LAYOUTs are born :UNINITIALIZED, maybe this
143 ;; clause is not needed?
147 ;; There was an old layout already initialized with old
148 ;; information, and we'll now check that old information
149 ;; which was known with certainty is consistent with current
150 ;; information which is known with certainty.
152 raw-slot-metadata)))
153 layout)
155 ;;; In code for the target Lisp, we don't dump LAYOUTs using the
156 ;;; standard load form mechanism, we use special fops instead, in
157 ;;; order to make cold load come out right. But when we're building
158 ;;; the cross-compiler, we can't do that because we don't have access
159 ;;; to special non-ANSI low-level things like special fops, and we
160 ;;; don't need to do that anyway because our code isn't going to be
161 ;;; cold loaded, so we use the ordinary load form system.
162 ;;;
163 ;;; KLUDGE: A special hack causes this not to be called when we are
164 ;;; building code for the target Lisp. It would be tidier to just not
165 ;;; have it in place when we're building the target Lisp, but it
166 ;;; wasn't clear how to do that without rethinking DEF!STRUCT quite a
167 ;;; bit, so I punted. -- WHN 19990914
168 #+sb-xc-host
178 ;; Since LAYOUT refers to a class which refers back to the LAYOUT,
179 ;; we have to do this in two stages, like the TREE-WITH-PARENT
180 ;; example in the MAKE-LOAD-FORM entry in the ANSI spec.
182 ;; "creation" form (which actually doesn't create a new LAYOUT if
183 ;; there's a preexisting one with this name)
185 ;; "initialization" form (which actually doesn't initialize
186 ;; preexisting LAYOUTs, just checks that they're consistent).
194 ;;; If LAYOUT's slot values differ from the specified slot values in
195 ;;; any interesting way, then give a warning and return T.
197 layout
198 simple-string
199 index
200 simple-vector
201 layout-depthoid
202 layout-raw-slot-metadata-type))
203 redefine-layout-warning))
205 context length inherits depthoid
206 raw-slot-metadata)
212 ~A superclasses: ~S~% ~
213 ~A superclasses: ~S"
214 name
215 old-context
217 context
219 t)
223 ~@(~A~) definition of superclass ~S is incompatible with~% ~
224 ~A definition."
225 name
226 old-context
228 context)
229 t))
233 ~A length: ~W~% ~
234 ~A length: ~W"
235 name
236 old-context old-length
237 context length)
238 t))
241 #!-interleaved-raw-slots
243 ~A untagged slots: ~W~% ~
244 ~A untagged slots: ~W"
245 name
246 old-context old-metadata
247 context raw-slot-metadata)
248 #!+interleaved-raw-slots
250 between the ~A definition and the ~A definition"
251 name old-context context)
252 t))
255 between the ~A definition and the ~A definition"
256 name old-context context)
257 t))))
259 ;;; Require that LAYOUT data be consistent with CLASSOID, LENGTH,
260 ;;; INHERITS, DEPTHOID, and RAW-SLOT-METADATA.
263 layout-raw-slot-metadata-type))
264 check-layout))
268 "compile time" length inherits depthoid
269 raw-slot-metadata)
270 ;; Classic CMU CL had more options here. There are several reasons
271 ;; why they might want more options which are less appropriate for
272 ;; us: (1) It's hard to fit the classic CMU CL flexible approach
273 ;; into the ANSI-style MAKE-LOAD-FORM system, and having a
274 ;; non-MAKE-LOAD-FORM-style system is painful when we're trying to
275 ;; make the cross-compiler run under vanilla ANSI Common Lisp. (2)
276 ;; We have CLOS now, and if you want to be able to flexibly
277 ;; redefine classes without restarting the system, it'd make sense
278 ;; to use that, so supporting complexity in order to allow
279 ;; modifying DEFSTRUCTs without restarting the system is a low
280 ;; priority. (3) We now have the ability to rebuild the SBCL
281 ;; system from scratch, so we no longer need this functionality in
282 ;; order to maintain the SBCL system by modifying running images.
287 ;;; a common idiom (the same as CMU CL FIND-LAYOUT) rolled up into a
288 ;;; single function call
289 ;;;
290 ;;; Used by the loader to forward-reference layouts for classes whose
291 ;;; definitions may not have been loaded yet. This allows type tests
292 ;;; to be loaded when the type definition hasn't been loaded yet.
294 layout-raw-slot-metadata-type)
295 layout)
296 find-and-init-or-check-layout))
302 (%init-or-check-layout layout
305 length
306 inherits
307 depthoid
308 metadata)))))
310 ;;; Record LAYOUT as the layout for its class, adding it as a subtype
311 ;;; of all superclasses. This is the operation that "installs" a
312 ;;; layout for a class in the type system, clobbering any old layout.
313 ;;; However, this does not modify the class namespace; that is a
314 ;;; separate operation (think anonymous classes.)
315 ;;; -- If INVALIDATE, then all the layouts for any old definition
316 ;;; and subclasses are invalidated, and the SUBCLASSES slot is cleared.
317 ;;; -- If DESTRUCT-LAYOUT, then this is some old layout, and is to be
318 ;;; destructively modified to hold the same type information.
327 ;; Attempting to register ourselves with a temporary undefined
328 ;; class placeholder is almost certainly a programmer error. (I
329 ;; should know, I did it.) -- WHN 19990927
332 ;; This assertion dates from classic CMU CL. The rationale is
333 ;; probably that calling REGISTER-LAYOUT more than once for the
334 ;; same LAYOUT is almost certainly a programmer error.
337 ;; Figure out what classes are affected by the change, and issue
338 ;; appropriate warnings and invalidations.
380 ;;; Arrange the inherited layouts to appear at their expected depth,
381 ;;; ensuring that hierarchical type tests succeed. Layouts with
382 ;;; DEPTHOID >= 0 (i.e. hierarchical classes) are placed first,
383 ;;; at exactly that index in the INHERITS vector. Then, non-hierarchical
384 ;;; layouts are placed in remaining elements. Then, any still-empty
385 ;;; elements are filled with their successors, ensuring that each
386 ;;; element contains a valid layout.
387 ;;;
388 ;;; This reordering may destroy CPL ordering, so the inherits should
389 ;;; not be read as being in CPL order.
399 ;; KLUDGE: 0 here is the "uninitialized" element. We need
400 ;; to specify it explicitly for portability purposes, as
401 ;; elements can be read before being set [ see below, "(EQL
402 ;; OLD-LAYOUT 0)" ]. -- CSR, 2002-04-20
428 inherits)))
429 \f
430 ;;;; class precedence lists
432 ;;; Topologically sort the list of objects to meet a set of ordering
433 ;;; constraints given by pairs (A . B) constraining A to precede B.
434 ;;; When there are multiple objects to choose, the tie-breaker
435 ;;; function is called with both the list of object to choose from and
436 ;;; the reverse ordering built so far.
471 obj)))
481 ;;; standard class precedence list computation
501 superclasses)))
506 \f
507 ;;;; object types to represent classes
509 ;;; BUILT-IN-CLASS is used to represent the standard classes that
510 ;;; aren't defined with DEFSTRUCT and other specially implemented
511 ;;; primitive types whose only attribute is their name.
512 ;;; It is defined in 'early-classoid.lisp'
514 ;;; STRUCTURE-CLASS represents what we need to know about structure
515 ;;; classes. Non-structure "typed" defstructs are a special case, and
516 ;;; don't have a corresponding class.
521 \f
522 ;;;; classoid namespace
533 (:forthcoming-defclass-type
534 ;; FIXME: Currently, nothing needs to be done in this case.
535 ;; Later, when PCL is integrated tighter into SBCL, this
536 ;; might need more work.
537 nil)
538 (:instance
542 ;; KLUDGE: The reason these clauses aren't directly
543 ;; parallel is that we need to use the internal
544 ;; CLASSOID structure ourselves, because we don't
545 ;; have CLASSes to work with until PCL is built. In
546 ;; the host, CLASSes have an approximately
547 ;; one-to-one correspondence with the target
548 ;; CLASSOIDs (as well as with the target CLASSes,
549 ;; modulo potential differences with respect to
550 ;; conditions).
551 #+sb-xc-host
556 cross-compiler."
558 #-sb-xc-host
564 (:primitive
566 (:defined
574 ;; FIXME: I'm unconvinced of the need to handle either of these.
575 ;; Package locks preclude the latter, and in the former case,
576 ;; once you've made some random thing into a :PRIMITIVE kind of type,
577 ;; you've painted yourself into a corner - those types
578 ;; elicit vociferous complaints if you try to redefine them.
579 ;;
580 ;; we need to handle things like
581 ;; (setf (find-class 'foo) (find-class 'integer))
582 ;; and
583 ;; (setf (find-class 'integer) (find-class 'integer))
585 ;; But I can't figure out how to get assertions to pass
586 ;; without violation what would otherwise be invariants
587 ;; of the internal representation of types. This sucks.
597 new-value)
603 (:primitive
607 ;; Note: We cannot remove the classoid cell from the table,
608 ;; since compiled code may refer directly to the cell, and
609 ;; getting a different cell for a classoid with the same name
610 ;; just would not do.
612 ;; Remove the proper name of the classoid, if this was it.
618 ;; Clear the cell.
625 ;;; Called when we are about to define NAME as a class meeting some
626 ;;; predicate (such as a meta-class type test.) The first result is
627 ;;; always of the desired class. The second result is any existing
628 ;;; LAYOUT for this name.
629 ;;;
630 ;;; Again, this should be compiler-only, but easier to make this
631 ;;; thread-safe.
638 old
646 ;;; If the classoid has a proper name, return the name, otherwise return
647 ;;; the classoid.
652 name
653 classoid)))
654 \f
655 ;;;; CLASS type operations
657 ;; CLASSOID-ENUMERABLE-P is referenced during compile by !DEFINE-TYPE-CLASS.
658 ;; But don't redefine it when building the target since we've already
659 ;; got a perfectly good definition loaded for the host.
661 ;; Actually this definition makes very little sense because
662 ;; (TYPE-ENUMERABLE (FIND-CLASSOID 'CHARACTER)) => T
663 ;; but (TYPE-ENUMERABLE (SPECIFIER-TYPE 'CHARACTER)) => NIL.
664 ;; You should never see the CLASSOID used as a type though,
665 ;; at least not from parsing and set operations.
666 ;; On a related note, (TYPE-ENUMERABLE (FIND-CLASSOID 'NULL))
667 ;; should probably be T, but you'll never see that type either.
668 ;; Perhaps a better definition of this function would be
669 ;; (if (classoid-translation x) (bug "enumerable-p classoid?") nil)
674 ;;; We might be passed classoids with invalid layouts; in any pairwise
675 ;;; class comparison, we must ensure that both are valid before
676 ;;; proceeding.
681 ;; Avoid accidentally reaching code that can't work.
683 #-sb-xc-host
689 t)
693 ~S in ~A.~%~:@>"
694 class
696 error-context))
697 nil)
700 t)))
702 for ~A.~%~:@>"
710 t)
718 ;; FIXME: explain why this isn't (LAYOUT-FOR-STD-CLASS-P LAYOUT).
723 ;;; Simple methods for TYPE= and SUBTYPEP should never be called when
724 ;;; the two classes are equal, since there are EQ checks in those
725 ;;; operations.
743 ;; If there's a forward-referenced class involved we don't know for sure.
744 ;; (There are cases which we /could/ figure out, but that doesn't seem
745 ;; to be required or important, really.)
750 ;;; When finding the intersection of a sealed class and some other
751 ;;; class (not hierarchically related) the intersection is the union
752 ;;; of the currently shared subclasses.
771 class1)
772 ;; If one is a subclass of the other, then that is the
773 ;; intersection.
776 class1)
779 class2)
780 ;; Otherwise, we can't in general be sure that the
781 ;; intersection is empty, since a subclass of both might be
782 ;; defined. But we can eliminate it for some special cases.
785 ;; No subclass of both can be defined.
788 ;; checking whether a subclass of both can be defined:
791 ;; checking whether a subclass of both can be defined:
794 ;; uncertain, since a subclass of both might be defined
795 nil))))
797 ;;; KLUDGE: we need this to deal with the special-case INSTANCE and
798 ;;; FUNCALLABLE-INSTANCE types (which used to be CLASSOIDs until CSR
799 ;;; discovered that this was incompatible with the MOP class
800 ;;; hierarchy). See NAMED :COMPLEX-SUBTYPEP-ARG2
803 lra fdefn random-class))
805 ;;; KLUDGE: we need this because of the need to represent
806 ;;; intersections of two classes, even when empty at a given time, as
807 ;;; uncanonicalized intersections because of the possibility of later
808 ;;; defining a subclass of both classes. The necessity for changing
809 ;;; the default return value from SUBTYPEP to NIL, T if no alternate
810 ;;; method is present comes about because, unlike the other places we
811 ;;; use INVOKE-COMPLEX-SUBTYPEP-ARG1-METHOD, in HAIRY methods and the
812 ;;; like, classes are in their own hierarchy with no possibility of
813 ;;; mixtures with other type classes.
824 \f
825 ;;;; built-in classes
827 ;;; The BUILT-IN-CLASSES list is a data structure which configures the
828 ;;; creation of all the built-in classes. It contains all the info
829 ;;; that we need to maintain the mapping between classes, compile-time
830 ;;; types and run-time type codes. These options are defined:
831 ;;;
832 ;;; :TRANSLATION (default none)
833 ;;; When this class is "parsed" as a type specifier, it is
834 ;;; translated into the specified internal type representation,
835 ;;; rather than being left as a class. This is used for types
836 ;;; which we want to canonicalize to some other kind of type
837 ;;; object because in general we want to be able to include more
838 ;;; information than just the class (e.g. for numeric types.)
839 ;;;
840 ;;; :STATE (default :SEALED)
841 ;;; The value of CLASS-STATE which we want on completion,
842 ;;; indicating whether subclasses can be created at run-time.
843 ;;;
844 ;;; :HIERARCHICAL-P (default T unless any of the inherits are non-hierarchical)
845 ;;; True if we can assign this class a unique inheritance depth.
846 ;;;
847 ;;; :CODES (default none)
848 ;;; Run-time type codes which should be translated back to this
849 ;;; class by CLASS-OF. Unspecified for abstract classes.
850 ;;;
851 ;;; :INHERITS (default this class and T)
852 ;;; The class-precedence list for this class, with this class and
853 ;;; T implicit.
854 ;;;
855 ;;; :DIRECT-SUPERCLASSES (default to head of CPL)
856 ;;; List of the direct superclasses of this class.
857 ;;;
858 ;;; NB: not to be confused with SB-PCL::*BUILT-IN-CLASSES*
860 ;; To me these data would look nicer with commas instead of "#."
873 ;; should this be #!-(or x86 x86-64) ?
887 :translation complex
901 #!+long-float
907 #!+sb-simd-pack
909 :translation simd-pack
914 :translation float
917 :translation single-float
922 :translation double-float
926 #!+long-float
928 :translation long-float
933 :translation rational
941 :translation integer
956 :hierarchical-p nil
983 array sequence)
1071 (*))
1076 :element-type
1104 #!+long-float
1123 #!+long-float
1131 :translation string
1135 :translation simple-string
1149 array sequence)
1152 :translation base-string
1158 :translation simple-base-string
1162 array sequence)
1164 #!+sb-unicode
1171 #!+sb-unicode
1177 array sequence)
1184 :translation cons
1204 ;;; See also src/code/class-init.lisp where we finish setting up the
1205 ;;; translations for built-in types.
1206 (!cold-init-forms
1212 inherits
1213 codes
1214 state
1215 depth
1216 prototype-form
1221 x
1224 ()
1229 ;; Unseal it so that REGISTER-LAYOUT doesn't warn
1231 it)
1237 :name name
1239 :direct-superclasses
1241 nil
1243 direct-superclasses)))))))))
1254 super-layout))
1255 inherits-list))
1261 0
1262 inherits-vector
1263 depthoid
1268 ;;; Define temporary PCL STANDARD-CLASSes. These will be set up
1269 ;;; correctly and the Lisp layout replaced by a PCL wrapper after PCL
1270 ;;; is loaded and the class defined.
1271 (!cold-init-forms
1273 ;; You'd think with all the pedantic explanation in here it would at least
1274 ;; be right, but it isn't: layout-inherits for FUNDAMENTAL-STREAM
1275 ;; ends up as (T SLOT-OBJECT STREAM STANDARD-OBJECT)
1277 ;; the inherits-vector of FUNDAMENTAL-STREAM is set up,
1278 ;; a vector containing the elements of the list below,
1279 ;; i.e. '(T STREAM STREAM), is created, and
1280 ;; this is what the function ORDER-LAYOUT-INHERITS
1281 ;; would do, too.
1282 ;;
1283 ;; So, the purpose is to guarantee a valid layout for
1284 ;; the FUNDAMENTAL-STREAM class, matching what
1285 ;; ORDER-LAYOUT-INHERITS would do.
1286 ;; ORDER-LAYOUT-INHERITS would place STREAM at index 2
1287 ;; in the INHERITS(-VECTOR). Index 1 would not be
1288 ;; filled, so STREAM is duplicated there (as
1289 ;; ORDER-LAYOUTS-INHERITS would do). Maybe the
1290 ;; duplicate definition could be removed (removing a
1291 ;; STREAM element), because FUNDAMENTAL-STREAM is
1292 ;; redefined after PCL is set up, anyway. But to play
1293 ;; it safely, we define the class with a valid INHERITS
1294 ;; vector.
1301 ;; Needed to open-code the MAP, below
1308 inherits-list)))
1314 ;;; Now that we have set up the class heterarchy, seal the sealed
1315 ;;; classes. This must be done after the subclasses have been set up.
1316 (!cold-init-forms
1320 \f
1321 ;;;; class definition/redefinition
1323 ;;; This is to be called whenever we are altering a class.
1324 #+sb-xc-host
1326 #-sb-xc-host
1330 ;; FIXME: This should probably be CERROR.
1334 ;;; Mark LAYOUT as invalid. Setting DEPTHOID -1 helps cause unsafe
1335 ;;; structure type tests to fail. Remove class from all superclasses
1336 ;;; too (might not be registered, so might not be in subclasses of the
1337 ;;; nominal superclasses.) We set the layout-clos-hash slots to 0 to
1338 ;;; invalidate the wrappers for specialized dispatch functions, which
1339 ;;; use those slots as indexes into tables.
1353 \f
1354 ;;;; cold loading initializations
1356 ;;; FIXME: It would be good to arrange for this to be called when the
1357 ;;; cross-compiler is being built, not just when the target Lisp is
1358 ;;; being cold loaded. Perhaps this could be moved to its own file
1359 ;;; late in the build-order.lisp-expr sequence, and be put in
1360 ;;; !COLD-INIT-FORMS there?
1370 name layout))))))
1372 (!cold-init-forms
1379 x
1384 \f