home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / mitsch75.zip / scheme-7_5_17-src.zip / scheme-7.5.17 / src / runtime / illdef.scm < prev    next >
Text File  |  1999-01-02  |  4KB  |  125 lines
  1. #| -*-Scheme-*-
  2.  
  3. $Id: illdef.scm,v 1.4 1999/01/02 06:11:34 cph Exp $
  4.  
  5. Copyright (c) 1991-1999 Massachusetts Institute of Technology
  6.  
  7. This program is free software; you can redistribute it and/or modify
  8. it under the terms of the GNU General Public License as published by
  9. the Free Software Foundation; either version 2 of the License, or (at
  10. your option) any later version.
  11.  
  12. This program is distributed in the hope that it will be useful, but
  13. WITHOUT ANY WARRANTY; without even the implied warranty of
  14. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  15. General Public License for more details.
  16.  
  17. You should have received a copy of the GNU General Public License
  18. along with this program; if not, write to the Free Software
  19. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  20. |#
  21.  
  22. ;;;; Check for Illegal Definitions
  23. ;;; package: (runtime illegal-definitions)
  24.  
  25. (declare (usual-integrations))
  26.  
  27. (define walker)
  28.  
  29. (define (initialize-package!)
  30.   (set! walker
  31.     (make-scode-walker walk/constant
  32.                `((ACCESS ,walk/access)
  33.                  (ASSIGNMENT ,walk/assignment)
  34.                  (COMBINATION ,walk/combination)
  35.                  (COMMENT ,walk/comment)
  36.                  (CONDITIONAL ,walk/conditional)
  37.                  (DEFINITION ,walk/definition)
  38.                  (DELAY ,walk/delay)
  39.                  (DISJUNCTION ,walk/disjunction)
  40.                  (IN-PACKAGE ,walk/in-package)
  41.                  (LAMBDA ,walk/lambda)
  42.                  (SEQUENCE ,walk/sequence))))
  43.   unspecific)
  44.  
  45. (define (check-for-illegal-definitions expression)
  46.   (walk/expression (if (open-block? expression)
  47.                (open-block-components expression unscan-defines)
  48.                expression)
  49.            'LEGAL))
  50.  
  51. (define (walk/expression expression context)
  52.   ((scode-walk walker expression) expression context))
  53.  
  54. (define-integrable (walk/no-definitions expression)
  55.   (walk/expression expression 'ILLEGAL))
  56.  
  57. (define (walk/lambda expression context)
  58.   context
  59.   (let loop
  60.       ((expressions
  61.     (sequence-actions
  62.      (lambda-components expression
  63.        (lambda (name required optional rest auxiliary declarations body)
  64.          name required optional rest
  65.          (unscan-defines auxiliary declarations body))))))
  66.     (if (null? (cdr expressions))
  67.     (walk/no-definitions (car expressions))
  68.     (begin
  69.       (walk/expression (car expressions) 'LEGAL)
  70.       (loop (cdr expressions))))))
  71.  
  72. (define (walk/definition expression context)
  73.   (case context
  74.     ((ILLEGAL)
  75.      (error "Definition appears in illegal context:"
  76.         (unsyntax expression)))
  77.     ((UNUSUAL)
  78.      (warn "Definition appears in unusual context:"
  79.        (unsyntax expression))))
  80.   (walk/no-definitions (definition-value expression)))
  81.  
  82. (define (walk/sequence expression context)
  83.   (for-each (lambda (expression)
  84.           (walk/expression expression context))
  85.         (sequence-actions expression)))
  86.  
  87. (define (walk/constant expression context)
  88.   expression context
  89.   unspecific)
  90.  
  91. (define (walk/access expression context)
  92.   context
  93.   (walk/no-definitions (access-environment expression)))
  94.  
  95. (define (walk/assignment expression context)
  96.   context
  97.   (walk/no-definitions (assignment-value expression)))
  98.  
  99. (define (walk/combination expression context)
  100.   context
  101.   (walk/no-definitions (combination-operator expression))
  102.   (for-each walk/no-definitions (combination-operands expression)))
  103.  
  104. (define (walk/comment expression context)
  105.   (walk/expression (comment-expression expression) context))
  106.  
  107. (define (walk/conditional expression context)
  108.   (walk/no-definitions (conditional-predicate expression))
  109.   (let ((context (if (eq? 'LEGAL context) 'UNUSUAL context)))
  110.     (walk/expression (conditional-consequent expression) context)
  111.     (walk/expression (conditional-alternative expression) context)))
  112.  
  113. (define (walk/delay expression context)
  114.   context
  115.   (walk/no-definitions (delay-expression expression)))
  116.  
  117. (define (walk/disjunction expression context)
  118.   (walk/no-definitions (disjunction-predicate expression))
  119.   (walk/expression (disjunction-alternative expression)
  120.            (if (eq? 'LEGAL context) 'UNUSUAL context)))
  121.  
  122. (define (walk/in-package expression context)
  123.   context
  124.   (walk/no-definitions (in-package-environment expression))
  125.   (check-for-illegal-definitions (in-package-expression expression)))