From: Chris Hanson <org/chris-hanson/cph>
Date: Thu, 16 Aug 2001 20:02:58 +0000 (+0000)
Subject: Change "parent-name" field of package description to contain the names
X-Git-Tag: 20090517-FFI~2597
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=ff2699f9ec7422b4bbdf850b2285c3b8224eebf7;p=mit-scheme.git

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 ed61fac21..efa43cded 100644
--- 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 3eb893cdc..5285a75d8 100644
--- 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)