Make explicitly-named structures have explicit type.

diff --git a/v7/src/cref/object.scm b/v7/src/cref/object.scm
index f4c91e6234e7943282483d5ca5df41798da247ec..d09c26c7ba933ee6554ac8169d65d3e6bb427e55 100644 (file)
--- a/v7/src/cref/object.scm
+++ b/v7/src/cref/object.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/cref/object.scm,v 1.4 1991/10/30 20:58:35 cph Exp $
+$Id: object.scm,v 1.5 1992/12/03 03:13:59 cph Exp $
 
-Copyright (c) 1988-91 Massachusetts Institute of Technology
+Copyright (c) 1988-92 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -37,6 +37,7 @@ MIT in each case. |#
 (declare (usual-integrations))
 \f
 (define-structure (package-description
+                  (type vector)
                   (named
                    (string->symbol "#[(cross-reference)package-description]"))
                   (constructor make-package-description)
@@ -49,6 +50,7 @@ MIT in each case. |#
   (imports false read-only true))
 
 (define-structure (pmodel
+                  (type vector)
                   (named (string->symbol "#[(cross-reference)pmodel]"))
                   (conc-name pmodel/))
   (root-package false read-only true)
@@ -58,6 +60,7 @@ MIT in each case. |#
   (pathname false read-only true))
 
 (define-structure (package
+                  (type vector)
                   (named (string->symbol "#[(cross-reference)package]"))
                   (constructor %make-package
                                (name file-cases files initialization parent))
@@ -106,6 +109,7 @@ MIT in each case. |#
   (cdr clause))
 \f
 (define-structure (binding
+                  (type vector)
                   (named (string->symbol "#[(cross-reference)binding]"))
                   (constructor %make-binding (package name value-cell))
                   (conc-name binding/))
@@ -132,6 +136,7 @@ MIT in each case. |#
   (eq? binding (binding/source-binding binding)))
 
 (define-structure (value-cell
+                  (type vector)
                   (named (string->symbol "#[(cross-reference)value-cell]"))
                   (constructor make-value-cell ())
                   (conc-name value-cell/))
@@ -140,6 +145,7 @@ MIT in each case. |#
   (source-binding false))
 
 (define-structure (link
+                  (type vector)
                   (named (string->symbol "#[(cross-reference)link]"))
                   (constructor %make-link)
                   (conc-name link/))
@@ -153,6 +159,7 @@ MIT in each case. |#
     link))
 
 (define-structure (expression
+                  (type vector)
                   (named (string->symbol "#[(cross-reference)expression]"))
                   (constructor make-expression (package file type))
                   (conc-name expression/))
@@ -163,6 +170,7 @@ MIT in each case. |#
   (value-cell false))
 
 (define-structure (reference
+                  (type vector)
                   (named (string->symbol "#[(cross-reference)reference]"))
                   (constructor %make-reference (package name))
                   (conc-name reference/))

diff --git a/v7/src/runtime/infstr.scm b/v7/src/runtime/infstr.scm
index 87505f02fc81fa8fe3a29c340f29f7abe72fe2e9..59a95d802870323d73f60152a2e57e284cf8814a 100644 (file)
--- a/v7/src/runtime/infstr.scm
+++ b/v7/src/runtime/infstr.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: infstr.scm,v 1.7 1992/11/29 14:16:51 gjr Exp $
+$Id: infstr.scm,v 1.8 1992/12/03 03:18:37 cph Exp $
 
 Copyright (c) 1988-1992 Massachusetts Institute of Technology
 
@@ -51,6 +51,7 @@ MIT in each case. |#
    "#[(runtime compiler-info)dbg-info-vector-tag]"))
 
 (define-structure (dbg-info
+                  (type vector)
                   (named
                    ((ucode-primitive string->symbol)
                     "#[(runtime compiler-info)dbg-info]"))
@@ -72,6 +73,7 @@ MIT in each case. |#
                 labels))))))
 
 (define-structure (dbg-expression
+                  (type vector)
                   (named
                    ((ucode-primitive string->symbol)
                     "#[(runtime compiler-info)dbg-expression]"))
@@ -84,6 +86,7 @@ MIT in each case. |#
   (dbg-label/offset (dbg-expression/label expression)))
 
 (define-structure (dbg-procedure
+                  (type vector)
                   (named
                    ((ucode-primitive string->symbol)
                     "#[(runtime compiler-info)dbg-procedure]"))
@@ -113,6 +116,7 @@ MIT in each case. |#
   (< (dbg-procedure/label-offset x) (dbg-procedure/label-offset y)))
 \f
 (define-structure (dbg-continuation
+                  (type vector)
                   (named
                    ((ucode-primitive string->symbol)
                     "#[(runtime compiler-info)dbg-continuation]"))
@@ -131,6 +135,7 @@ MIT in each case. |#
   (< (dbg-continuation/label-offset x) (dbg-continuation/label-offset y)))
 
 (define-structure (dbg-block
+                  (type vector)
                   (named
                    ((ucode-primitive string->symbol)
                     "#[(runtime compiler-info)dbg-block]"))
@@ -147,6 +152,7 @@ MIT in each case. |#
   )
 
 (define-structure (dbg-variable
+                  (type vector)
                   (named
                    ((ucode-primitive string->symbol)
                     "#[(runtime compiler-info)dbg-variable]"))
@@ -220,6 +226,7 @@ MIT in each case. |#
                                    'SET-DBG-LABEL/NAMES!))))
 
 (define-structure (dbg-label-1
+                  (type vector)
                   (named
                    ((ucode-primitive string->symbol)
                     "#[(runtime compiler-info)dbg-label]"))

diff --git a/v7/src/runtime/lambda.scm b/v7/src/runtime/lambda.scm
index 4b407a2630521256857a60697f065b8078db41ac..606f672e893fff6b0e7d0708e94d08daf6b1697b 100644 (file)
--- a/v7/src/runtime/lambda.scm
+++ b/v7/src/runtime/lambda.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: lambda.scm,v 14.9 1992/11/29 14:17:42 gjr Exp $
+$Id: lambda.scm,v 14.10 1992/12/03 03:20:52 cph Exp $
 
 Copyright (c) 1988-1992 Massachusetts Institute of Technology
 
@@ -442,6 +442,7 @@ MIT in each case. |#
 (define lambda-bound)
 
 (define-structure (block-declaration
+                  (type vector)
                   (named ((ucode-primitive string->symbol)
                           "#[Block Declaration]")))
   (text false read-only true))

diff --git a/v7/src/runtime/pathnm.scm b/v7/src/runtime/pathnm.scm
index 896029747012e5729c51456bb06ace110f771bbc..37b1e5ad7f24023f44b502bd893c739e59a6082f 100644 (file)
--- a/v7/src/runtime/pathnm.scm
+++ b/v7/src/runtime/pathnm.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: pathnm.scm,v 14.23 1992/11/29 14:19:50 gjr Exp $
+$Id: pathnm.scm,v 14.24 1992/12/03 03:20:15 cph Exp $
 
 Copyright (c) 1988-1992 Massachusetts Institute of Technology
 
@@ -106,6 +106,7 @@ these rules:
 |#
 \f
 (define-structure (pathname
+                  (type vector)
                   (named ((ucode-primitive string->symbol)
                           "#[(runtime pathname)pathname]"))
                   (constructor %make-pathname)
@@ -450,11 +451,11 @@ these rules:
   (operation/end-of-line-string false read-only true)
   (operation/pathname-canonicalize false read-only true))
 
-(define-structure (host
-                  (named ((ucode-primitive string->symbol)
-                          "#[(runtime pathname)host]"))
-                  (constructor %make-host)
-                  (conc-name host/))
+(define-structure (host (type vector)
+                       (named ((ucode-primitive string->symbol)
+                               "#[(runtime pathname)host]"))
+                       (constructor %make-host)
+                       (conc-name host/))
   (type-index false read-only true)
   (name false read-only true))
 
@@ -469,8 +470,7 @@ these rules:
        (equal? (host/name x) (host/name y))))
 
 (define (guarantee-host host operation)
-  (if (not (host? host))
-      (error:wrong-type-argument host "host" operation))
+  (if (not (host? host)) (error:wrong-type-argument host "host" operation))
   host)
 
 (define (host-operation/parse-namestring host)

diff --git a/v7/src/runtime/uenvir.scm b/v7/src/runtime/uenvir.scm
index 441c76ff610180a45c7bddcb1dc0e9394efc05a1..4267b60a3094c0d2822c17863005451562dde5f5 100644 (file)
--- a/v7/src/runtime/uenvir.scm
+++ b/v7/src/runtime/uenvir.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: uenvir.scm,v 14.29 1992/11/29 14:23:01 gjr Exp $
+$Id: uenvir.scm,v 14.30 1992/12/03 03:20:32 cph Exp $
 
 Copyright (c) 1988-1992 Massachusetts Institute of Technology
 
@@ -272,6 +272,7 @@ MIT in each case. |#
 ;;;; Compiled Code Environments
 
 (define-structure (stack-ccenv
+                  (type vector)
                   (named
                    ((ucode-primitive string->symbol)
                     "#[(runtime environment)stack-ccenv]"))
@@ -517,6 +518,7 @@ MIT in each case. |#
   (vector-length (dbg-block/layout-vector block)))
 \f
 (define-structure (closure-ccenv
+                  (type vector)
                   (named
                    ((ucode-primitive string->symbol)
                     "#[(runtime environment)closure-ccenv]"))

diff --git a/v7/src/sf/object.scm b/v7/src/sf/object.scm
index 0aa24d5c94aa03984752ed2053107d59706f402d..1250e4c46795283144f5040522a93854ede9cc21 100644 (file)
--- a/v7/src/sf/object.scm
+++ b/v7/src/sf/object.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: object.scm,v 4.3 1992/11/04 10:17:32 jinx Exp $
+$Id: object.scm,v 4.4 1992/12/03 03:18:21 cph Exp $
 
 Copyright (c) 1987-1992 Massachusetts Institute of Technology
 
@@ -51,6 +51,7 @@ MIT in each case. |#
         `(BEGIN
            (DEFINE-ENUMERAND ,name ,enumeration)
            (DEFINE-STRUCTURE (,name
+                              (TYPE VECTOR)
                               (NAMED ,(symbol-append name '/ENUMERAND))
                               (CONC-NAME ,(symbol-append name '/))
                               (CONSTRUCTOR ,(symbol-append name '/MAKE)))
@@ -110,7 +111,8 @@ MIT in each case. |#
      )))
 
 (define-enumerand block random)
-(define-structure (block (named block/enumerand)
+(define-structure (block (type vector)
+                        (named block/enumerand)
                         (conc-name block/)
                         (constructor %block/make))
   parent
@@ -129,6 +131,7 @@ MIT in each case. |#
 
 (define-enumerand delayed-integration random)
 (define-structure (delayed-integration
+                  (type vector)
                   (named delayed-integration/enumerand)
                   (conc-name delayed-integration/)
                   (constructor delayed-integration/make (operations value)))

diff --git a/v8/src/runtime/infstr.scm b/v8/src/runtime/infstr.scm
index 87505f02fc81fa8fe3a29c340f29f7abe72fe2e9..59a95d802870323d73f60152a2e57e284cf8814a 100644 (file)
--- a/v8/src/runtime/infstr.scm
+++ b/v8/src/runtime/infstr.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: infstr.scm,v 1.7 1992/11/29 14:16:51 gjr Exp $
+$Id: infstr.scm,v 1.8 1992/12/03 03:18:37 cph Exp $
 
 Copyright (c) 1988-1992 Massachusetts Institute of Technology
 
@@ -51,6 +51,7 @@ MIT in each case. |#
    "#[(runtime compiler-info)dbg-info-vector-tag]"))
 
 (define-structure (dbg-info
+                  (type vector)
                   (named
                    ((ucode-primitive string->symbol)
                     "#[(runtime compiler-info)dbg-info]"))
@@ -72,6 +73,7 @@ MIT in each case. |#
                 labels))))))
 
 (define-structure (dbg-expression
+                  (type vector)
                   (named
                    ((ucode-primitive string->symbol)
                     "#[(runtime compiler-info)dbg-expression]"))
@@ -84,6 +86,7 @@ MIT in each case. |#
   (dbg-label/offset (dbg-expression/label expression)))
 
 (define-structure (dbg-procedure
+                  (type vector)
                   (named
                    ((ucode-primitive string->symbol)
                     "#[(runtime compiler-info)dbg-procedure]"))
@@ -113,6 +116,7 @@ MIT in each case. |#
   (< (dbg-procedure/label-offset x) (dbg-procedure/label-offset y)))
 \f
 (define-structure (dbg-continuation
+                  (type vector)
                   (named
                    ((ucode-primitive string->symbol)
                     "#[(runtime compiler-info)dbg-continuation]"))
@@ -131,6 +135,7 @@ MIT in each case. |#
   (< (dbg-continuation/label-offset x) (dbg-continuation/label-offset y)))
 
 (define-structure (dbg-block
+                  (type vector)
                   (named
                    ((ucode-primitive string->symbol)
                     "#[(runtime compiler-info)dbg-block]"))
@@ -147,6 +152,7 @@ MIT in each case. |#
   )
 
 (define-structure (dbg-variable
+                  (type vector)
                   (named
                    ((ucode-primitive string->symbol)
                     "#[(runtime compiler-info)dbg-variable]"))
@@ -220,6 +226,7 @@ MIT in each case. |#
                                    'SET-DBG-LABEL/NAMES!))))
 
 (define-structure (dbg-label-1
+                  (type vector)
                   (named
                    ((ucode-primitive string->symbol)
                     "#[(runtime compiler-info)dbg-label]"))

diff --git a/v8/src/runtime/uenvir.scm b/v8/src/runtime/uenvir.scm
index 441c76ff610180a45c7bddcb1dc0e9394efc05a1..4267b60a3094c0d2822c17863005451562dde5f5 100644 (file)
--- a/v8/src/runtime/uenvir.scm
+++ b/v8/src/runtime/uenvir.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: uenvir.scm,v 14.29 1992/11/29 14:23:01 gjr Exp $
+$Id: uenvir.scm,v 14.30 1992/12/03 03:20:32 cph Exp $
 
 Copyright (c) 1988-1992 Massachusetts Institute of Technology
 
@@ -272,6 +272,7 @@ MIT in each case. |#
 ;;;; Compiled Code Environments
 
 (define-structure (stack-ccenv
+                  (type vector)
                   (named
                    ((ucode-primitive string->symbol)
                     "#[(runtime environment)stack-ccenv]"))
@@ -517,6 +518,7 @@ MIT in each case. |#
   (vector-length (dbg-block/layout-vector block)))
 \f
 (define-structure (closure-ccenv
+                  (type vector)
                   (named
                    ((ucode-primitive string->symbol)
                     "#[(runtime environment)closure-ccenv]"))