src/cold/set-up-cold-packages.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-COLD")
  11
  12 ;;;; $Header$
  13
  14 ;;; an entry in the table which describes the non-standard part (i.e. not
  15 ;;; CL/CL-USER/KEYWORD) of the package structure of the SBCL system
  16 ;;;
  17 ;;; We make no attempt to be fully general; our table doesn't need to be
  18 ;;; able to express features which we don't happen to use.
  19 (export '(package-data
  20           package-data-name
  21           package-data-nicknames
  22           package-data-export
  23           package-data-reexport
  24           package-data-import-from
  25           package-data-use))
  26 (defstruct package-data
  27   ;; a string designator for the package name
  28   (name (error "missing PACKAGE-DATA-NAME datum"))
  29   ;; a doc string
  30   (doc (error "missing PACKAGE-DOC datum"))
  31   ;; a list of string designators for package nicknames
  32   nicknames
  33   ;; a tree containing names for exported symbols which'll be set up at package
  34   ;; creation time, and NILs, which are ignored. (This is a tree in order to
  35   ;; allow constructs like '("ENOSPC" #!+LINUX ("EDQUOT" "EISNAM" "ENAVAIL"
  36   ;; "EREMOTEIO")) to be used in initialization. NIL entries in the tree are
  37   ;; ignored for the same reason of notational convenience.)
  38   export
  39   ;; a list of string designators for exported symbols which don't necessarily
  40   ;; originate in this package (so their EXPORT operations should be handled
  41   ;; after USE operations have been done, so that duplicates aren't created)
  42   reexport
  43   ;; a list of sublists describing imports. Each sublist has the format as an
  44   ;; IMPORT-FROM list in DEFPACKAGE: the first element is the name of the
  45   ;; package to import from, and the remaining elements are the names of
  46   ;; symbols to import.
  47   import-from
  48   ;; a tree of string designators for package names of other packages
  49   ;; which this package uses
  50   use)
  51
  52 (let ((package-data-list (read-from-file "package-data-list.lisp-expr")))
  53
  54     ;; Build all packages that we need, and initialize them as far as we
  55     ;; can without referring to any other packages.
  56     (dolist (package-data package-data-list)
  57       (let* ((package (make-package
  58                        (package-data-name package-data)
  59                        :nicknames (package-data-nicknames package-data)
  60                        :use nil)))
  61         #!+sb-doc (setf (documentation package t)
  62                         (package-data-doc package-data))
  63         ;; Walk the tree of exported names, exporting each name.
  64         (labels ((recurse (tree)
  65                    (etypecase tree
  66                      ;; FIXME: The comments above say the structure is a tree,
  67                      ;; but here we're sleazily treating it as though
  68                      ;; dotted lists never occur. Replace this LIST case
  69                      ;; with separate NULL and CONS cases to fix this.
  70                      (list (mapc #'recurse tree))
  71                      (string (export (intern tree package) package)))))
  72           (recurse (package-data-export package-data)))))
  73
  74     ;; Now that all packages exist, we can set up package-package
  75     ;; references.
  76     (dolist (package-data package-data-list)
  77       (use-package (package-data-use package-data)
  78                    (package-data-name package-data))
  79       (dolist (sublist (package-data-import-from package-data))
  80         (let* ((from-package (first sublist))
  81                (symbol-names (rest sublist))
  82                (symbols (mapcar (lambda (name)
  83                                   ;; old way, broke for importing symbols
  84                                   ;; like SB!C::DEBUG-SOURCE-FORM into
  85                                   ;; SB!DI -- WHN 19990714
  86                                   #+nil
  87                                   (let ((s (find-symbol name from-package)))
  88                                     (unless s
  89                                       (error "can't find ~S in ~S"
  90                                              name
  91                                              from-package))
  92                                     s)
  93                                   ;; new way, works for SB!DI stuff
  94                                   ;; -- WHN 19990714
  95                                   (intern name from-package))
  96                                 symbol-names)))
  97           (import symbols (package-data-name package-data)))))
  98
  99     ;; Now that all package-package references exist, we can handle
 100     ;; REEXPORT operations. (We have to wait until now because they
 101     ;; interact with USE operations.) KLUDGE: This code doesn't detect
 102     ;; dependencies and do exports in proper order to work around them, so
 103     ;; it could break randomly (with build-time errors, not with silent
 104     ;; errors or runtime errors) if multiple levels of re-exportation are
 105     ;; used, e.g. package A exports X, package B uses A and reexports X,
 106     ;; and package C uses B and reexports X. That doesn't seem to be an
 107     ;; issue in the current code, and it's hard to see why anyone would
 108     ;; want to do it, and it should be straightforward (though tedious) to
 109     ;; extend the code here to deal with that if it ever becomes necessary.
 110     (dolist (package-data package-data-list)
 111       (let ((package (find-package (package-data-name package-data))))
 112         (dolist (symbol-name (package-data-reexport package-data))
 113           (multiple-value-bind (symbol status)
 114               (find-symbol symbol-name package)
 115             (unless status
 116               (error "No symbol named ~S is accessible in ~S."
 117                      symbol-name
 118                      package))
 119             (when (eq (symbol-package symbol) package)
 120               (error "~S is not inherited/imported, but native to ~S."
 121                      symbol-name
 122                      package))
 123             (export symbol package))))))