Several changes to make package model objects fasdumpable.

diff --git a/v7/src/cref/cref.pkg b/v7/src/cref/cref.pkg
index 148e16fd7bd2f5940ac595ec033b116cc66a45d4..7b0813bc1a4f8c4db63f46e7aaa6e40bb3b3f436 100644 (file)
--- a/v7/src/cref/cref.pkg
+++ b/v7/src/cref/cref.pkg
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/cref/cref.pkg,v 1.1 1988/06/13 12:38:35 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/cref/cref.pkg,v 1.2 1988/10/28 07:03:12 cph Rel $
 
 Copyright (c) 1988 Massachusetts Institute of Technology
 
@@ -38,7 +38,6 @@ MIT in each case. |#
 
 (define-package (cross-reference)
   (files "mset"
-        "btree"
         "object"
         "toplev")
   (parent ())
@@ -48,6 +47,16 @@ MIT in each case. |#
          cref/generate-cref
          cref/generate-trivial-constructor))
 
+(define-package (cross-reference balanced-binary-tree)
+  (files "btree")
+  (parent ())
+  (export (cross-reference)
+         btree-delete!
+         btree-fringe
+         btree-insert!
+         btree-lookup
+         make-btree))
+
 (define-package (cross-reference analyze-file)
   (files "anfile")
   (parent (cross-reference))

diff --git a/v7/src/cref/make.scm b/v7/src/cref/make.scm
index 4ddaa17a8cb652944ffd7286168ac26599b0dbe1..906236f2d47b4187b2dc994f350946a2754b25fb 100644 (file)
--- a/v7/src/cref/make.scm
+++ b/v7/src/cref/make.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/cref/make.scm,v 1.2 1988/06/14 10:32:05 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/cref/make.scm,v 1.3 1988/10/28 07:03:16 cph Exp $
 
 Copyright (c) 1988 Massachusetts Institute of Technology
 
@@ -37,4 +37,4 @@ MIT in each case. |#
 (declare (usual-integrations))
 
 (package/system-loader "cref" '() false)
-(add-system! (make-system "CREF" 1 2 '()))
\ No newline at end of file
+(add-system! (make-system "CREF" 1 3 '()))
\ No newline at end of file

diff --git a/v7/src/cref/object.scm b/v7/src/cref/object.scm
index 1d0de6068539a694e1184f886d41c5da35c92b7e..19b5879b67f039415306c144d2c46b21fbc1f57e 100644 (file)
--- a/v7/src/cref/object.scm
+++ b/v7/src/cref/object.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/cref/object.scm,v 1.1 1988/06/13 12:38:28 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/cref/object.scm,v 1.2 1988/10/28 07:03:20 cph Rel $
 
 Copyright (c) 1988 Massachusetts Institute of Technology
 
@@ -36,8 +36,11 @@ MIT in each case. |#
 
 (declare (usual-integrations))
 \f
-(define-structure (package-description (constructor make-package-description)
-                                      (conc-name package-description/))
+(define-structure (package-description
+                  (named
+                   (string->symbol "#[(cross-reference)package-description]"))
+                  (constructor make-package-description)
+                  (conc-name package-description/))
   (name false read-only true)
   (file-cases false read-only true)
   (parent false read-only true)
@@ -45,7 +48,9 @@ MIT in each case. |#
   (exports false read-only true)
   (imports false read-only true))
 
-(define-structure (pmodel (conc-name pmodel/))
+(define-structure (pmodel
+                  (named (string->symbol "#[(cross-reference)pmodel]"))
+                  (conc-name pmodel/))
   (root-package false read-only true)
   (primitive-package false read-only true)
   (packages false read-only true)
@@ -53,6 +58,7 @@ MIT in each case. |#
   (default-pathname false read-only true))
 
 (define-structure (package
+                  (named (string->symbol "#[(cross-reference)package]"))
                   (constructor %make-package
                                (name file-cases files initialization parent))
                   (conc-name package/))
@@ -62,8 +68,8 @@ MIT in each case. |#
   (initialization false read-only true)
   parent
   (children '())
-  (bindings (make-btree symbol<? binding/name) read-only true)
-  (references (make-btree symbol<? reference/name) read-only true))
+  (bindings (make-btree) read-only true)
+  (references (make-btree) read-only true))
 
 (define (make-package name file-cases initialization parent)
   (let ((files
@@ -84,7 +90,7 @@ MIT in each case. |#
   (null? (package/name package)))
 
 (define (package/find-binding package name)
-  (btree-lookup (package/bindings package) name
+  (btree-lookup (package/bindings package) symbol<? binding/name name
     identity-procedure
     (lambda (name) name false)))
 
@@ -100,9 +106,10 @@ MIT in each case. |#
 (define-integrable (file-case-clause/files clause)
   (cdr clause))
 \f
-(define-structure (binding (constructor %make-binding
-                                       (package name value-cell))
-                          (conc-name binding/))
+(define-structure (binding
+                  (named (string->symbol "#[(cross-reference)binding]"))
+                  (constructor %make-binding (package name value-cell))
+                  (conc-name binding/))
   (package false read-only true)
   (name false read-only true)
   (value-cell false read-only true)
@@ -125,14 +132,18 @@ MIT in each case. |#
 (define (binding/internal? binding)
   (eq? binding (binding/source-binding binding)))
 
-(define-structure (value-cell (constructor make-value-cell ())
-                             (conc-name value-cell/))
+(define-structure (value-cell
+                  (named (string->symbol "#[(cross-reference)value-cell]"))
+                  (constructor make-value-cell ())
+                  (conc-name value-cell/))
   (bindings '())
   (expressions '())
   (source-binding false))
 
-(define-structure (link (constructor %make-link)
-                       (conc-name link/))
+(define-structure (link
+                  (named (string->symbol "#[(cross-reference)link]"))
+                  (constructor %make-link)
+                  (conc-name link/))
   (source false read-only true)
   (destination false read-only true))
 
@@ -142,16 +153,20 @@ MIT in each case. |#
                        (cons link (binding/links source-binding)))
     link))
 
-(define-structure (expression (constructor make-expression (package file type))
-                             (conc-name expression/))
+(define-structure (expression
+                  (named (string->symbol "#[(cross-reference)expression]"))
+                  (constructor make-expression (package file type))
+                  (conc-name expression/))
   (package false read-only true)
   (file false read-only true)
   (type false read-only true)
   (references '())
   (value-cell false))
 
-(define-structure (reference (constructor %make-reference (package name))
-                            (conc-name reference/))
+(define-structure (reference
+                  (named (string->symbol "#[(cross-reference)reference]"))
+                  (constructor %make-reference (package name))
+                  (conc-name reference/))
   (package false read-only true)
   (name false read-only true)
   (expressions '())

diff --git a/v7/src/cref/redpkg.scm b/v7/src/cref/redpkg.scm
index 4f01f13f72e1b857c468cb8ac0159316c4aca556..79e62c576f454f03af81637d7404b2f3fce9aac9 100644 (file)
--- a/v7/src/cref/redpkg.scm
+++ b/v7/src/cref/redpkg.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/cref/redpkg.scm,v 1.1 1988/06/13 12:38:30 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/cref/redpkg.scm,v 1.2 1988/10/28 07:03:24 cph Rel $
 
 Copyright (c) 1988 Massachusetts Institute of Technology
 
@@ -325,7 +325,7 @@ MIT in each case. |#
                   default-pathname))))
 
 (define primitive-package-name
-  (list (string->uninterned-symbol "primitives")))
+  (list (string->symbol "#[(cross-reference reader)primitives]")))
 \f
 ;;;; Binding and Reference
 
@@ -340,6 +340,8 @@ MIT in each case. |#
   (let ((source-binding (intern-binding! source-package source-name)))
     (make-link source-binding
               (btree-insert! (package/bindings destination-package)
+                             symbol<?
+                             binding/name
                              destination-name
                 (lambda (destination-name)
                   (make-binding destination-package
@@ -351,7 +353,7 @@ MIT in each case. |#
                 identity-procedure))))
 
 (define (intern-binding! package name)
-  (btree-insert! (package/bindings package) name
+  (btree-insert! (package/bindings package) symbol<? binding/name name
     (lambda (name)
       (let ((value-cell (make-value-cell)))
        (let ((binding (make-binding package name value-cell)))
@@ -369,7 +371,7 @@ MIT in each case. |#
           (set-expression/references!
            expression
            (cons reference (expression/references expression))))))
-    (btree-insert! (package/references package) name
+    (btree-insert! (package/references package) symbol<? reference/name name
       (lambda (name)
        (%make-reference package name))
       (lambda (reference)