src/code/defbangtype.lisp

   1 ;;;; This software is part of the SBCL system. See the README file for
   2 ;;;; more information.
   3 ;;;;
   4 ;;;; This software is derived from the CMU CL system, which was
   5 ;;;; written at Carnegie Mellon University and released into the
   6 ;;;; public domain. The software is in the public domain and is
   7 ;;;; provided with absolutely no warranty. See the COPYING and CREDITS
   8 ;;;; files for more information.
   9
  10 (in-package "SB!KERNEL")
  11
  12 (file-comment
  13   "$Header$")
  14 \f
  15 ;;;; the DEF!TYPE macro
  16
  17 ;;; DEF!MACRO = cold DEFTYPE, a version of DEFTYPE which at
  18 ;;; build-the-cross-compiler time defines its macro both in the
  19 ;;; cross-compilation host Lisp and in the target Lisp. Basically,
  20 ;;; DEF!TYPE does something like
  21 ;;;   (DEFTYPE SB!XC:FOO ..)
  22 ;;;   #+SB-XC-HOST (SB!XC:DEFTYPE FOO ..)
  23 ;;; except that it also automatically delays the SB!XC:DEFTYPE call,
  24 ;;; if necessary, until the cross-compiler's DEFTYPE machinery has been
  25 ;;; set up.
  26
  27 ;;; FIXME: This code was created by cut-and-paste from the
  28 ;;; corresponding code for DEF!MACRO. DEF!TYPE and DEF!MACRO are
  29 ;;; currently very parallel, and if we ever manage to rationalize the
  30 ;;; use of UNCROSS in the cross-compiler, they should become
  31 ;;; completely parallel, at which time they should be merged to
  32 ;;; eliminate the duplicate code.
  33
  34 (defmacro def!type (&rest rest)
  35   `(progn
  36      (deftype ,@rest)
  37      #+sb-xc-host
  38      ,(let ((form `(sb!xc:deftype ,@(uncross rest))))
  39         (if (boundp '*delayed-def!types*)
  40             `(push ',form *delayed-def!types*)
  41             form))))
  42
  43 ;;; machinery to implement DEF!TYPE delays
  44 #+sb-xc-host
  45 (progn
  46   (/show "binding *DELAYED-DEF!TYPES*")
  47   (defvar *delayed-def!types* nil)
  48   (/show "done binding *DELAYED-DEF!TYPES*")
  49   (defun force-delayed-def!types ()
  50     (if (boundp '*delayed-def!types*)
  51         (progn
  52           (mapc #'eval *delayed-def!types*)
  53           (makunbound '*delayed-def!types*))
  54         ;; This condition is probably harmless if it comes up when
  55         ;; interactively experimenting with the system by loading a
  56         ;; source file into it more than once. But it's worth warning
  57         ;; about it because it definitely shouldn't come up in an
  58         ;; ordinary build process.
  59         (warn "*DELAYED-DEF!TYPES* is already unbound."))))