Modify CREF to show references to inherited bindings.

This will help track down which parts of the string abstraction need to be
replaced.

diff --git a/src/cref/forpkg.scm b/src/cref/forpkg.scm
index 7f1b6c19c687bcf863cd505d08ae04521ac56120..865ff52282da2f68bc62ba563a279a3c2559f325 100644 (file)
--- a/src/cref/forpkg.scm
+++ b/src/cref/forpkg.scm
@@ -106,6 +106,7 @@ USA.
     (let ((class (assq package classes)))
       (if class
          (format-package/bindings port indentation width package (cdr class)))
+      (format-package/inherited port indentation width package)
       (for-each (lambda (class)
                  (if (not (eq? package (car class)))
                      (format-package/imports port indentation width package
@@ -197,6 +198,20 @@ USA.
                          ")")
           name)))))
 
+(define (format-package/inherited port indentation width package)
+  (let ((inherited
+         (filter (lambda (reference)
+                   (let ((binding (reference/binding reference)))
+                     (and binding
+                          (ancestor-package? (binding/package binding)
+                                             package))))
+                 (package/references package))))
+    (if (pair? inherited)
+        (begin
+          (newline port)
+          (format-references port indentation width "Inherited" package
+                             (sort inherited reference<?))))))
+
 (define (format-package/imports port indentation width local-package
                                remote-package bindings)
   (format-exports port indentation width local-package remote-package bindings

diff --git a/src/cref/object.scm b/src/cref/object.scm
index d37996f49bcab8f3e5ca23092c3a26aabaeb4602..c2fed00d5ad7561feae89d61f196b2163f2883ca 100644 (file)
--- a/src/cref/object.scm
+++ b/src/cref/object.scm
@@ -87,6 +87,12 @@ USA.
   (set-package/bindings! package
                         (cons binding (package/bindings package))))
 
+(define (ancestor-package? p1 p2)
+  (let ((parent (package/parent p2)))
+    (and parent
+         (or (eq? p1 parent)
+             (ancestor-package? p1 parent)))))
+
 (define-integrable (file-case/type file-case)
   (car file-case))