Change "parent-name" field of package description to contain the names

of every ancestor of the package.  This is necessary so that we can
replace the use of ".glo" files with ".pkd" files.

diff --git a/v7/src/cref/conpkg.scm b/v7/src/cref/conpkg.scm
index ed61fac21be83fc949eb05059f17ef2dd292b951..efa43cded06a04b4a3f34f62a8af3b98af5784a5 100644 (file)
--- a/v7/src/cref/conpkg.scm
+++ b/v7/src/cref/conpkg.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: conpkg.scm,v 1.9 2001/08/15 02:59:35 cph Exp $
+$Id: conpkg.scm,v 1.10 2001/08/16 20:02:58 cph Exp $
 
 Copyright (c) 1988-2001 Massachusetts Institute of Technology
 
@@ -45,10 +45,11 @@ USA.
        (split-bindings-list (package/sorted-bindings package)))
     (lambda (internal external)
       (vector (package/name package)
-             (let ((parent (package/parent package)))
-               (if parent
-                   (package/name parent)
-                   'NONE))
+             (let loop ((package package))
+               (let ((parent (package/parent package)))
+                 (if parent
+                     (cons (package/name parent) (loop parent))
+                     '())))
              (map (let ((map-files
                          (lambda (clause)
                            (map ->namestring

diff --git a/v7/src/runtime/packag.scm b/v7/src/runtime/packag.scm
index 3eb893cdcc4889840fb4e53af4e7c4f7c63f829b..5285a75d840cda86d3501959ec18b58feb77ef5a 100644 (file)
--- a/v7/src/runtime/packag.scm
+++ b/v7/src/runtime/packag.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: packag.scm,v 14.29 2001/08/15 02:56:08 cph Exp $
+$Id: packag.scm,v 14.30 2001/08/16 20:02:35 cph Exp $
 
 Copyright (c) 1988-1999, 2001 Massachusetts Institute of Technology
 
@@ -239,7 +239,7 @@ USA.
 (define-structure (package-description (type vector)
                                       (conc-name package-description/))
   (name #f read-only #t)
-  (parent-name #f read-only #t)
+  (ancestors #f read-only #t)
   (file-cases #f read-only #t)
   (initialization #f read-only #t)
   (finalization #f read-only #t)
@@ -268,8 +268,7 @@ USA.
   (and (vector? object)
        (fix:= (vector-length object) 8)
        (package-name? (package-description/name object))
-       (or (package-name? (package-description/parent-name object))
-          (eq? (package-description/parent-name object) 'NONE))
+       (list-of-type? (package-description/ancestors object) package-name?)
        (list-of-type? (package-description/file-cases object)
         (lambda (case)
           (and (pair? case)
@@ -332,10 +331,10 @@ USA.
   (let ((name (package-description/name description))
        (environment
         (extend-package-environment
-         (let ((parent (package-description/parent-name description)))
-           (if (eq? parent 'NONE)
-               null-environment
-               (package/environment (find-package parent))))
+         (let ((ancestors (package-description/ancestors description)))
+           (if (pair? ancestors)
+               (package/environment (find-package (car ancestors)))
+               null-environment))
          (cons (package-description/internal-names description)
                (lambda (name) name))
          (cons (package-description/internal-bindings description)