Fix bug: package parent can sometimes be the symbol UNKNOWN.

diff --git a/v7/src/cref/conpkg.scm b/v7/src/cref/conpkg.scm
index d83090690c718ece074ea4f8b43651b57820548a..42cbd10c4890c7474f73f61f8f016bb76509bc22 100644 (file)
--- a/v7/src/cref/conpkg.scm
+++ b/v7/src/cref/conpkg.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: conpkg.scm,v 1.13 2001/08/20 21:02:35 cph Exp $
+$Id: conpkg.scm,v 1.14 2001/09/28 00:38:32 cph Exp $
 
 Copyright (c) 1988-2001 Massachusetts Institute of Technology
 
@@ -63,17 +63,16 @@ USA.
                  (eq? (link/owner link) package)))))))
 
 (define (package-structure<? x y)
-  (cond ((package/topological<? x y) true)
-       ((package/topological<? y x) false)
+  (cond ((package/topological<? x y) #t)
+       ((package/topological<? y x) #f)
        (else (package<? x y))))
 
 (define (package/topological<? x y)
   (and (not (eq? x y))
        (let loop ((y (package/parent y)))
-        (and y
-             (not (eq? y 'UNKNOWN))
+        (and (package? y)
              (if (eq? x y)
-                 true
+                 #t
                  (loop (package/parent y)))))))
 \f
 (define (package->external package extension?)
@@ -82,7 +81,7 @@ USA.
       (vector (package/name package)
              (let loop ((package package))
                (let ((parent (package/parent package)))
-                 (if (and parent (not (eq? parent 'UNKNOWN)))
+                 (if (package? parent)
                      (cons (package/name parent) (loop parent))
                      '())))
              (list->vector

diff --git a/v7/src/cref/forpkg.scm b/v7/src/cref/forpkg.scm
index 991bc743d5ddeddea9d05a4a00cfdf73cbd9bb85..0b90a6c787f03ccc7fbebeedbbe2a5cf52d9604e 100644 (file)
--- a/v7/src/cref/forpkg.scm
+++ b/v7/src/cref/forpkg.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Id: forpkg.scm,v 1.9 1999/01/02 06:11:34 cph Exp $
+$Id: forpkg.scm,v 1.10 2001/09/28 00:38:21 cph Exp $
 
-Copyright (c) 1988-1999 Massachusetts Institute of Technology
+Copyright (c) 1988-1999, 2001 Massachusetts Institute of Technology
 
 This program is free software; you can redistribute it and/or modify
 it under the terms of the GNU General Public License as published by
@@ -16,7 +16,8 @@ General Public License for more details.
 
 You should have received a copy of the GNU General Public License
 along with this program; if not, write to the Free Software
-Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
+USA.
 |#
 
 ;;;; Package Model Formatter
@@ -45,7 +46,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
        (indentation "  ")
        (width 79)
        (packages (pmodel/packages pmodel))
-       (output? false))
+       (output? #f))
     (let ((free-references
           (append-map! (lambda (package)
                          (list-transform-negative
@@ -54,9 +55,9 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
                        packages)))
       (if (not (null? free-references))
          (begin
-           (format-references port indentation width "Free References" false
+           (format-references port indentation width "Free References" #f
              (sort free-references reference<?))
-           (set! output? true))))
+           (set! output? #t))))
     (with-values (lambda () (get-value-cells/unusual packages))
       (lambda (undefined multiple)
        (if (not (null? undefined))
@@ -65,7 +66,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
                  (output-port/write-string port "\f\n"))
              (format-value-cells port indentation width "Undefined Bindings"
                                  undefined)
-           (set! output? true)))
+           (set! output? #t)))
        (if (not (null? multiple))
            (begin
              (if output?
@@ -73,12 +74,12 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
              (format-value-cells port indentation width
                                  "Bindings with Multiple Definitions"
                                  multiple)
-             (set! output? true)))))
+             (set! output? #t)))))
     output?))
 \f
 (define (format-package port indentation width package)
   (write-package-name "Package" package port)
-  (if (package/parent package)
+  (if (package? (package/parent package))
       (write-package-name "Parent" (package/parent package) port))
   (format-package/files port indentation width package)
   (let ((classes
@@ -111,7 +112,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
   (write-label label port)
   (for-each (lambda (binding)
              (format-expressions
-              port indentation width false
+              port indentation width #f
               (string-append
                (binding/name-string binding)
                " "

diff --git a/v7/src/cref/redpkg.scm b/v7/src/cref/redpkg.scm
index 6e787bac428ab6e12bb18d86017c8fa34fa7e8da..3225176ea4413851c6d57925d19160c5fb1dbe2b 100644 (file)
--- a/v7/src/cref/redpkg.scm
+++ b/v7/src/cref/redpkg.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: redpkg.scm,v 1.18 2001/08/20 21:02:41 cph Exp $
+$Id: redpkg.scm,v 1.19 2001/09/28 00:38:05 cph Exp $
 
 Copyright (c) 1988-2001 Massachusetts Institute of Technology
 
@@ -126,9 +126,9 @@ USA.
                   (type vector)
                   (constructor make-analysis-cache (pathname time data))
                   (conc-name analysis-cache/))
-  (pathname false read-only true)
-  (time false)
-  (data false))
+  (pathname #f read-only #t)
+  (time #f)
+  (data #f))
 
 (define (cache-file-analyses! pmodel)
   (let ((pathname (pathname-new-type (pmodel/pathname pmodel) "fre"))
@@ -541,7 +541,7 @@ USA.
 (define (package-lookup package name)
   (let package-loop ((package package))
     (or (package/find-binding package name)
-       (and (package/parent package)
+       (and (package? (package/parent package))
             (package-loop (package/parent package))))))
 
 (define (name->package packages name)