Initial revision

diff --git a/v7/src/runtime/illdef.scm b/v7/src/runtime/illdef.scm
new file mode 100644 (file)
index 0000000..da76e93
--- /dev/null
+++ b/v7/src/runtime/illdef.scm
@@ -0,0 +1,139 @@
+#| -*-Scheme-*-
+
+$Id: illdef.scm,v 1.1 1995/04/13 22:24:31 cph Exp $
+
+Copyright (c) 1991-95 Massachusetts Institute of Technology
+
+This material was developed by the Scheme project at the Massachusetts
+Institute of Technology, Department of Electrical Engineering and
+Computer Science.  Permission to copy this software, to redistribute
+it, and to use it for any purpose is granted, subject to the following
+restrictions and understandings.
+
+1. Any copy made of this software must include this copyright notice
+in full.
+
+2. Users of this software agree to make their best efforts (a) to
+return to the MIT Scheme project any improvements or extensions that
+they make, so that these may be included in future releases; and (b)
+to inform MIT of noteworthy uses of this software.
+
+3. All materials developed as a consequence of the use of this
+software shall duly acknowledge such use, in accordance with the usual
+standards of acknowledging credit in academic research.
+
+4. MIT has made no warrantee or representation that the operation of
+this software will be error-free, and MIT is under no obligation to
+provide any services, by way of maintenance, update, or otherwise.
+
+5. In conjunction with products arising from the use of this material,
+there shall be no use of the name of the Massachusetts Institute of
+Technology nor of any adaptation thereof in any advertising,
+promotional, or sales literature without prior written consent from
+MIT in each case. |#
+
+;;;; Check for Illegal Definitions
+;;; package: (runtime illegal-definitions)
+
+(declare (usual-integrations))
+\f
+(define walker)
+
+(define (initialize-package!)
+  (set! walker
+       (make-scode-walker walk/constant
+                          `((ACCESS ,walk/access)
+                            (ASSIGNMENT ,walk/assignment)
+                            (COMBINATION ,walk/combination)
+                            (COMMENT ,walk/comment)
+                            (CONDITIONAL ,walk/conditional)
+                            (DEFINITION ,walk/definition)
+                            (DELAY ,walk/delay)
+                            (DISJUNCTION ,walk/disjunction)
+                            (IN-PACKAGE ,walk/in-package)
+                            (LAMBDA ,walk/lambda)
+                            (SEQUENCE ,walk/sequence))))
+  unspecific)
+
+(define (check-for-illegal-definitions expression)
+  (walk/expression (if (open-block? expression)
+                      (open-block-components expression unscan-defines)
+                      expression)
+                  'LEGAL))
+
+(define (walk/expression expression context)
+  ((scode-walk walker expression) expression context))
+
+(define-integrable (walk/no-definitions expression)
+  (walk/expression expression 'ILLEGAL))
+
+(define (walk/lambda expression context)
+  context
+  (let loop
+      ((expressions
+       (sequence-actions
+        (lambda-components expression
+          (lambda (name required optional rest auxiliary declarations body)
+            name required optional rest
+            (unscan-defines auxiliary declarations body))))))
+    (if (definition? (car expressions))
+       (begin
+         (walk/no-definitions (definition-value (car expressions)))
+         (if (not (null? (cdr expressions)))
+             (loop (cdr expressions))))
+       (for-each walk/no-definitions expressions))))
+
+(define (walk/definition expression context)
+  (case context
+    ((ILLEGAL)
+     (error "Definition appears in illegal context:"
+           (unsyntax expression)))
+    ((UNUSUAL)
+     (warn "Definition appears in unusual context:"
+          (unsyntax expression))))
+  (walk/no-definitions (definition-value expression)))
+\f
+(define (walk/sequence expression context)
+  (for-each (lambda (expression)
+             (walk/expression expression context))
+           (sequence-actions expression)))
+
+(define (walk/constant expression context)
+  expression context
+  unspecific)
+
+(define (walk/access expression context)
+  context
+  (walk/no-definitions (access-environment expression)))
+
+(define (walk/assignment expression context)
+  context
+  (walk/no-definitions (assignment-value expression)))
+
+(define (walk/combination expression context)
+  context
+  (walk/no-definitions (combination-operator expression))
+  (for-each walk/no-definitions (combination-operands expression)))
+
+(define (walk/comment expression context)
+  (walk/expression (comment-expression expression) context))
+
+(define (walk/conditional expression context)
+  (walk/no-definitions (conditional-predicate expression))
+  (let ((context (if (eq? 'LEGAL context) 'UNUSUAL context)))
+    (walk/expression (conditional-consequent expression) context)
+    (walk/expression (conditional-alternative expression) context)))
+
+(define (walk/delay expression context)
+  context
+  (walk/no-definitions (delay-expression expression)))
+
+(define (walk/disjunction expression context)
+  (walk/no-definitions (disjunction-predicate expression))
+  (walk/expression (disjunction-alternative expression)
+                  (if (eq? 'LEGAL context) 'UNUSUAL context)))
+
+(define (walk/in-package expression context)
+  context
+  (walk/no-definitions (in-package-environment expression))
+  (check-for-illegal-definitions (in-package-expression expression)))
\ No newline at end of file