From 8551305266cf5bcf7edf6f5ed5cc44c9e4479b7d Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Thu, 3 Dec 1992 03:20:52 +0000 Subject: [PATCH] Make explicitly-named structures have explicit type. --- v7/src/cref/object.scm | 12 ++++++++++-- v7/src/runtime/infstr.scm | 9 ++++++++- v7/src/runtime/lambda.scm | 3 ++- v7/src/runtime/pathnm.scm | 16 ++++++++-------- v7/src/runtime/uenvir.scm | 4 +++- v7/src/sf/object.scm | 7 +++++-- v8/src/runtime/infstr.scm | 9 ++++++++- v8/src/runtime/uenvir.scm | 4 +++- 8 files changed, 47 insertions(+), 17 deletions(-) diff --git a/v7/src/cref/object.scm b/v7/src/cref/object.scm index f4c91e623..d09c26c7b 100644 --- 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)) (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)) (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 87505f02f..59a95d802 100644 --- 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))) (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 4b407a263..606f672e8 100644 --- 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 896029747..37b1e5ad7 100644 --- 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: |# (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 441c76ff6..4267b60a3 100644 --- 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))) (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 0aa24d5c9..1250e4c46 100644 --- 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 87505f02f..59a95d802 100644 --- 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))) (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 441c76ff6..4267b60a3 100644 --- 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))) (define-structure (closure-ccenv + (type vector) (named ((ucode-primitive string->symbol) "#[(runtime environment)closure-ccenv]")) -- 2.25.1