From: Chris Hanson Date: Thu, 13 Apr 1995 22:24:53 +0000 (+0000) Subject: Add code to check for illegal internal definitions and disallow them. X-Git-Tag: 20090517-FFI~6465 X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=f58237e7ecd9745ead9f640976f0fd69e4b94ec7;p=mit-scheme.git 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 fa85b2c9e..ddd905c90 100644 --- 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 fcf16cbd1..21b93cce7 100644 --- 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 1c38973d6..71021bb2e 100644 --- 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 aaccef9a0..4105b4e68 100644 --- 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?*) - + (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 fcf16cbd1..21b93cce7 100644 --- 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 1c38973d6..71021bb2e 100644 --- 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 ())