src/code/type-init.lisp

   1 ;;;; When this file's top level forms are run, it precomputes the
   2 ;;;; translations for commonly used type specifiers. This stuff is
   3 ;;;; split off from the other type stuff to get around problems with
   4 ;;;; everything needing to be loaded before everything else. This file
   5 ;;;; is the first to exercise the type machinery. This stuff is also
   6 ;;;; somewhat implementation-dependent in that implementations may
   7 ;;;; want to precompute other types which are important to them.
   8
   9 ;;;; This software is part of the SBCL system. See the README file for
  10 ;;;; more information.
  11 ;;;;
  12 ;;;; This software is derived from the CMU CL system, which was
  13 ;;;; written at Carnegie Mellon University and released into the
  14 ;;;; public domain. The software is in the public domain and is
  15 ;;;; provided with absolutely no warranty. See the COPYING and CREDITS
  16 ;;;; files for more information.
  17
  18 (in-package "SB-KERNEL")
  19
  20 ;;; built-in classes
  21 (/show0 "beginning type-init.lisp")
  22
  23 ;; We want to assign SAETP-CTYPE for each SAETP instance, but we can't do it
  24 ;; just yet because CHARACTER and FIXNUM are not acceptable to SPECIFIER-TYPE.
  25 ;; The reason they're not is that each is a builtin classoid with a translation
  26 ;; that can be given to SPECIFIER-TYPE as it has a translator:
  27 ;;  CHARACTER =  (CHARACTER-SET)
  28 ;;  FIXNUM = `(INTEGER ,MOST-NEGATIVE-FIXNUM ,MOST-POSITIVE-FIXNUM)
  29 ;; but the classoid's TRANSLATION slot isn't set yet.
  30 ;; So ideally we could commence with the loop over *builtin-classoids*
  31 ;; assigning each their translation, and then come back to filling in SAETP-CTYPE.
  32 ;; That's where we hit a circularity: You can't parse BIT-VECTOR because while we
  33 ;; know that it's (ARRAY BIT (*)), in order to parse (ARRAY <x>) you have to call
  34 ;; %UPGRADED-ARRAY-ELEMENT-TYPE with the parse of <x>, looking for the first SAETP
  35 ;; whosed -CTYPE is a supertype of <x>. But the SAETP-CTYPEs aren't filled in!
  36 ;; The solution I favor is to process CHARACTER and FIXNUM in *builtin-classoids*,
  37 ;; then assign all SAETP-CTYPES, then do the rest of *builtin-classoids*.
  38 (dolist (spec '(character fixnum))
  39   (let* ((bic-entry (assoc spec *builtin-classoids*))
  40          (translation (getf (cdr bic-entry) :translation))
  41          (classoid (find-classoid spec)))
  42     (aver classoid)
  43     ;; In cold-init, the TRANSLATION is already in its internal representation
  44     ;; as though SPECIFIER-TYPE were called. This is extremely convenient
  45     ;; because parsing doesn't work. See the call to !MAKE-BUILT-IN-CLASSOID
  46     ;; in class.lisp - it sets :TRANSLATION to :INITIALIZING only in the host.
  47     (let ((ctype #+sb-xc-host (specifier-type translation)
  48                  #-sb-xc-host translation))
  49       (aver (ctype-p ctype))
  50       (aver (not (unknown-type-p ctype)))
  51       (setf (built-in-classoid-translation classoid) ctype)
  52       (setf (info :type :builtin spec) ctype))))
  53
  54 (dovector (saetp sb-vm:*specialized-array-element-type-properties*)
  55   (let* ((spec (sb-vm:saetp-specifier saetp))
  56          (ctype (specifier-type spec)))
  57     (aver (not (unknown-type-p ctype)))
  58     (setf (sb-vm:saetp-ctype saetp) ctype)))
  59
  60 #+sb-xc-host
  61 (dolist (x *builtin-classoids*)
  62   (destructuring-bind (name &key (translation nil trans-p) &allow-other-keys)
  63       x
  64     (/show "doing class with" name)
  65     (when trans-p
  66       (let ((classoid (classoid-cell-classoid (find-classoid-cell name :create t)))
  67             (type (specifier-type translation)))
  68         (when (typep (built-in-classoid-translation classoid) 'ctype)
  69           (aver (eq (built-in-classoid-translation classoid) type)))
  70         (setf (built-in-classoid-translation classoid) type)
  71         (setf (info :type :builtin name) type)))))
  72
  73 ;;; the Common Lisp defined type spec symbols
  74 (defconstant-eqx +!standard-type-names+
  75   '(array atom bignum bit bit-vector character compiled-function
  76     complex cons double-float extended-char fixnum float function
  77     hash-table integer keyword list long-float nil null number package
  78     pathname random-state ratio rational real readtable sequence
  79     short-float simple-array simple-bit-vector simple-string simple-vector
  80     single-float standard-char stream string base-char symbol t vector)
  81   #'equal)
  82
  83 ;;; built-in symbol type specifiers
  84
  85 ;;; Predefined types that are of kind :INSTANCE can't have their
  86 ;;; :BUILTIN property set, so we cull them out. This used to operate
  87 ;;; on all +!STANDARD-TYPE-NAMES+ because !PRECOMPUTE-TYPES was ok to
  88 ;;; call on unknown types. This relied upon the knowledge that
  89 ;;; VALUES-SPECIFIER-TYPE avoided signaling a PARSE-UNKNOWN-TYPE
  90 ;;; condition while in cold-init. This is terrible! It means that
  91 ;;; (a) we have to know that something wouldn't signal
  92 ;;;     when it otherwise should, and
  93 ;;; (b) we can call that thing when the very data that it depends on
  94 ;;;     are actually wrong.
  95 ;;; Well, in as much as we have to do this suspicious action,
  96 ;;; at least let's not get into a state where we *know*
  97 ;;; that it ought to signal.
  98
  99 (/show0 "precomputing built-in symbol type specifiers")
 100 (!precompute-types
 101  (remove-if (lambda (x)
 102               (memq x '(compiled-function hash-table package pathname
 103                         random-state readtable)))
 104             +!standard-type-names+))
 105
 106 #+sb-xc-host (setf *type-system-initialized* t)
 107
 108 (/show0 "done with type-init.lisp")