Add code to check for illegal internal definitions and disallow them.

diff --git a/v7/src/runtime/ed-ffi.scm b/v7/src/runtime/ed-ffi.scm
index fa85b2c9ebf957e1d5bbd794dfbf18238f1cd43a..ddd905c9004b5b716b7aab17469991eac85acfe5 100644 (file)
--- a/v7/src/runtime/ed-ffi.scm
+++ b/v7/src/runtime/ed-ffi.scm
@@ -1,6 +1,6 @@
 #| -*- Scheme -*-
 
-$Id: ed-ffi.scm,v 1.11 1995/02/21 23:01:09 cph Exp $
+$Id: ed-ffi.scm,v 1.12 1995/04/13 22:24:43 cph Exp $
 
 Copyright (c) 1988-95 Massachusetts Institute of Technology
 
@@ -120,6 +120,8 @@ MIT in each case. |#
                syntax-table/system-internal)
     ("histry"  (runtime history)
                syntax-table/system-internal)
+    ("illdef"  (runtime illegal-definitions)
+               syntax-table/system-internal)
     ("infstr"  (runtime compiler-info)
                syntax-table/system-internal)
     ("infutl"  (runtime compiler-info)

diff --git a/v7/src/runtime/make.scm b/v7/src/runtime/make.scm
index fcf16cbd16a8b2df48e0182cfc0b698a413e4d04..21b93cce7843f3ae1d9c52a5ed852e5d284bab6a 100644 (file)
--- a/v7/src/runtime/make.scm
+++ b/v7/src/runtime/make.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: make.scm,v 14.56 1995/01/06 18:44:17 cph Exp $
+$Id: make.scm,v 14.57 1995/04/13 22:24:53 cph Exp $
 
 Copyright (c) 1988-95 Massachusetts Institute of Technology
 
@@ -447,6 +447,7 @@ MIT in each case. |#
    (RUNTIME PARSER)
    (RUNTIME UNPARSER)
    (RUNTIME SYNTAXER)
+   (RUNTIME ILLEGAL-DEFINITIONS)
    (RUNTIME MACROS)
    (RUNTIME SYSTEM-MACROS)
    (RUNTIME DEFSTRUCT)

diff --git a/v7/src/runtime/runtime.pkg b/v7/src/runtime/runtime.pkg
index 1c38973d6310fb4614c5ce53d164851139b2728c..71021bb2eda8ade3aa4ce43f2f3884588ca0140e 100644 (file)
--- a/v7/src/runtime/runtime.pkg
+++ b/v7/src/runtime/runtime.pkg
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: runtime.pkg,v 14.250 1995/04/12 21:15:35 cph Exp $
+$Id: runtime.pkg,v 14.251 1995/04/13 22:24:17 cph Exp $
 
 Copyright (c) 1988-95 Massachusetts Institute of Technology
 
@@ -2766,6 +2766,13 @@ MIT in each case. |#
          parse-lambda-list)
   (initialization (initialize-package!)))
 
+(define-package (runtime illegal-definitions)
+  (files "illdef")
+  (parent ())
+  (export (runtime syntaxer)
+         check-for-illegal-definitions)
+  (initialization (initialize-package!)))
+
 (define-package (runtime system)
   (files "system")
   (parent ())

diff --git a/v7/src/runtime/syntax.scm b/v7/src/runtime/syntax.scm
index aaccef9a0715ee6bd42aae992ff550e9170c2ece..4105b4e688ae25d62e64928b2a8ad93708196b43 100644 (file)
--- a/v7/src/runtime/syntax.scm
+++ b/v7/src/runtime/syntax.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Id: syntax.scm,v 14.25 1994/02/25 20:35:03 cph Exp $
+$Id: syntax.scm,v 14.26 1995/04/13 22:24:05 cph Exp $
 
-Copyright (c) 1988-1994 Massachusetts Institute of Technology
+Copyright (c) 1988-95 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -43,6 +43,7 @@ MIT in each case. |#
   (set! system-global-syntax-table (make-system-global-syntax-table))
   (set! user-initial-syntax-table
        (make-syntax-table system-global-syntax-table))
+  (set! *disallow-illegal-definitions?* #t)
   (set! hook/syntax-expression default/syntax-expression)
   unspecific)
 
@@ -51,6 +52,7 @@ MIT in each case. |#
 (define *syntax-table*)
 (define *current-keyword* #f)
 (define *syntax-top-level?*)
+(define *disallow-illegal-definitions?*)
 
 (define (make-system-global-syntax-table)
   (let ((table (make-syntax-table)))
@@ -104,21 +106,27 @@ MIT in each case. |#
                    (if (default-object? table) #f table)))
 
 (define (syntax-top-level name syntaxer expression table)
-  (fluid-let ((*syntax-table*
-              (if table
-                  (begin
-                    (if (not (syntax-table? table))
-                        (error:wrong-type-argument table "syntax table" name))
-                    table)
-                  (if (unassigned? *syntax-table*)
-                      (nearest-repl/syntax-table)
-                      *syntax-table*)))
-             (*current-keyword* #f))
-    (syntaxer #t expression)))
+  (let ((scode
+        (fluid-let ((*syntax-table*
+                     (if table
+                         (begin
+                           (if (not (syntax-table? table))
+                               (error:wrong-type-argument table
+                                                          "syntax table"
+                                                          name))
+                           table)
+                         (if (unassigned? *syntax-table*)
+                             (nearest-repl/syntax-table)
+                             *syntax-table*)))
+                    (*current-keyword* #f))
+          (syntaxer #t expression))))
+    (if *disallow-illegal-definitions?*
+       (check-for-illegal-definitions scode))
+    scode))
 
 (define (syntax/top-level?)
   *syntax-top-level?*)
-
+\f
 (define-integrable (syntax-subsequence expressions)
   (syntax-sequence #f expressions))
 
@@ -496,7 +504,8 @@ MIT in each case. |#
          ((SHALLOW) syntax/fluid-let/shallow)
          ((DEEP) syntax/fluid-let/deep)
          ((COMMON-LISP) syntax/fluid-let/common-lisp)
-         (else (error "SET-FLUID-LET-TYPE!: unknown type" type)))))
+         (else (error "SET-FLUID-LET-TYPE!: unknown type" type))))
+  unspecific)
 
 (define (syntax/fluid-let/shallow top-level? bindings body)
   (if (null? bindings)
@@ -745,8 +754,10 @@ MIT in each case. |#
 
 (define (enable-scan-defines!)
   (set! make-scode-sequence make-sequence/scan)
-  (set! internal-make-lambda make-lambda/scan))
+  (set! internal-make-lambda make-lambda/scan)
+  unspecific)
 
 (define (disable-scan-defines!)
   (set! make-scode-sequence make-sequence)
-  (set! internal-make-lambda make-lambda/no-scan))
\ No newline at end of file
+  (set! internal-make-lambda make-lambda/no-scan)
+  unspecific)
\ No newline at end of file

diff --git a/v8/src/runtime/make.scm b/v8/src/runtime/make.scm
index fcf16cbd16a8b2df48e0182cfc0b698a413e4d04..21b93cce7843f3ae1d9c52a5ed852e5d284bab6a 100644 (file)
--- a/v8/src/runtime/make.scm
+++ b/v8/src/runtime/make.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: make.scm,v 14.56 1995/01/06 18:44:17 cph Exp $
+$Id: make.scm,v 14.57 1995/04/13 22:24:53 cph Exp $
 
 Copyright (c) 1988-95 Massachusetts Institute of Technology
 
@@ -447,6 +447,7 @@ MIT in each case. |#
    (RUNTIME PARSER)
    (RUNTIME UNPARSER)
    (RUNTIME SYNTAXER)
+   (RUNTIME ILLEGAL-DEFINITIONS)
    (RUNTIME MACROS)
    (RUNTIME SYSTEM-MACROS)
    (RUNTIME DEFSTRUCT)

diff --git a/v8/src/runtime/runtime.pkg b/v8/src/runtime/runtime.pkg
index 1c38973d6310fb4614c5ce53d164851139b2728c..71021bb2eda8ade3aa4ce43f2f3884588ca0140e 100644 (file)
--- a/v8/src/runtime/runtime.pkg
+++ b/v8/src/runtime/runtime.pkg
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: runtime.pkg,v 14.250 1995/04/12 21:15:35 cph Exp $
+$Id: runtime.pkg,v 14.251 1995/04/13 22:24:17 cph Exp $
 
 Copyright (c) 1988-95 Massachusetts Institute of Technology
 
@@ -2766,6 +2766,13 @@ MIT in each case. |#
          parse-lambda-list)
   (initialization (initialize-package!)))
 
+(define-package (runtime illegal-definitions)
+  (files "illdef")
+  (parent ())
+  (export (runtime syntaxer)
+         check-for-illegal-definitions)
+  (initialization (initialize-package!)))
+
 (define-package (runtime system)
   (files "system")
   (parent ())