When initializing packages, ignore missing packages.
authorChris Hanson <org/chris-hanson/cph>
Sat, 2 Feb 2008 18:20:59 +0000 (18:20 +0000)
committerChris Hanson <org/chris-hanson/cph>
Sat, 2 Feb 2008 18:20:59 +0000 (18:20 +0000)
v7/src/runtime/make.scm

index 3981a694673d5087024c61a6662a892d93da9392..35bcd8ac57389afbbb8ba9638f3fb241fe4d32a6 100644 (file)
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: make.scm,v 14.113 2008/02/02 05:35:30 cph Exp $
+$Id: make.scm,v 14.114 2008/02/02 18:20:59 cph Exp $
 
 Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
     1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
@@ -189,23 +189,27 @@ USA.
            (loop (cdr name)))))
     (tty-write-string ")"))
 
-  (let ((env (package-reference package-name)))
-    (cond ((not (lexical-unreferenceable? env procedure-name))
-          (print-name "initialize:")
-          (if (not (eq? procedure-name 'INITIALIZE-PACKAGE!))
-              (begin
-                (tty-write-string " [")
-                (tty-write-string (system-pair-car procedure-name))
-                (tty-write-string "]")))
-          ((lexical-reference env procedure-name)))
-         ((not mandatory?)
-          (print-name "* skipping:"))
-         (else
-          ;; Missing mandatory package! Report it and die.
-          (print-name "Package")
-          (tty-write-string " is missing initialization procedure ")
-          (tty-write-string (system-pair-car procedure-name))
-          (fatal-error "Could not initialize a required package.")))))
+  (cond ((let ((package (find-package package-name #f)))
+          (and package
+               (let ((env (package/environment package)))
+                 (and (not (lexical-unreferenceable? env procedure-name))
+                      (lexical-reference env procedure-name)))))
+        => (lambda (procedure)
+             (print-name "initialize:")
+             (if (not (eq? procedure-name 'INITIALIZE-PACKAGE!))
+                 (begin
+                   (tty-write-string " [")
+                   (tty-write-string (system-pair-car procedure-name))
+                   (tty-write-string "]")))
+             (procedure)))
+       ((not mandatory?)
+        (print-name "* skipping:"))
+       (else
+        ;; Missing mandatory package! Report it and die.
+        (print-name "Package")
+        (tty-write-string " is missing initialization procedure ")
+        (tty-write-string (system-pair-car procedure-name))
+        (fatal-error "Could not initialize a required package."))))
 
 (define (package-reference name)
   (package/environment (find-package name)))
@@ -526,10 +530,8 @@ USA.
    ;; More debugging
    ((RUNTIME CONTINUATION-PARSER) INITIALIZE-SPECIAL-FRAMES! #f)
    (RUNTIME URI)
-   (RUNTIME HTTP-CLIENT)))
-
-(if (eq? os-name 'NT)
-    (package-initialize '(RUNTIME WIN32-REGISTRY) 'INITIALIZE-PACKAGE! #f))
+   (RUNTIME HTTP-CLIENT)
+   (RUNTIME WIN32-REGISTRY)))
 \f
 (let ((obj (file->object "site" #t #f)))
   (if obj