From ff2699f9ec7422b4bbdf850b2285c3b8224eebf7 Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Thu, 16 Aug 2001 20:02:58 +0000 Subject: [PATCH] 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. --- v7/src/cref/conpkg.scm | 11 ++++++----- v7/src/runtime/packag.scm | 15 +++++++-------- 2 files changed, 13 insertions(+), 13 deletions(-) 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) -- 2.25.1