From: Chris Hanson Date: Fri, 28 Oct 1988 07:03:24 +0000 (+0000) Subject: Several changes to make package model objects fasdumpable. X-Git-Tag: 20090517-FFI~12477 X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=d8c2147d78b23ecb6bd55e78ce43d3960f49393b;p=mit-scheme.git Several changes to make package model objects fasdumpable. --- diff --git a/v7/src/cref/cref.pkg b/v7/src/cref/cref.pkg index 148e16fd7..7b0813bc1 100644 --- 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 4ddaa17a8..906236f2d 100644 --- 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 1d0de6068..19b5879b6 100644 --- 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)) -(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 symbolsymbol "#[(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 4f01f13f7..79e62c576 100644 --- 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]"))) ;;;; 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