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 / sf / free.scm < prev    next >
Text File  |  1999-01-02  |  4KB  |  136 lines
  1. #| -*-Scheme-*-
  2.  
  3. $Id: free.scm,v 4.3 1999/01/02 06:19:10 cph Exp $
  4.  
  5. Copyright (c) 1988, 1993, 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. ;;;; SCode Optimizer: Free Variable Analysis
  23.  
  24. (declare (usual-integrations)
  25.      (integrate-external "object" "lsets"))
  26.  
  27. (declare (integrate-operator no-free-variables singleton-variable
  28.                  list->variable-set))
  29.  
  30. (define (no-free-variables) 
  31.   (empty-set variable? eq?))
  32.  
  33. (define (singleton-variable variable) 
  34.   (singleton-set variable? eq? variable))
  35.  
  36. (define (list->variable-set variable-list)
  37.   (list->set variable? eq? variable-list))
  38.  
  39. (define (free/expressions expressions)
  40.   (if (null? expressions)
  41.       (no-free-variables)
  42.       (set/union (free/expression (car expressions))
  43.          (free/expressions (cdr expressions)))))
  44.  
  45. (declare (integrate-operator free/expression))
  46.  
  47. (define (free/expression expression)
  48.   ((expression/method dispatch-vector expression) expression))
  49.  
  50. (define dispatch-vector
  51.   (expression/make-dispatch-vector))
  52.  
  53. (define define-method/free
  54.   (expression/make-method-definer dispatch-vector))
  55.  
  56. (define-method/free 'ACCESS
  57.   (lambda (expression)
  58.     (free/expression (access/environment expression))))
  59.  
  60. (define-method/free 'ASSIGNMENT
  61.   (lambda (expression)
  62.     (set/adjoin (free/expression (assignment/value expression))
  63.         (assignment/variable expression))))
  64.  
  65. (define-method/free 'COMBINATION
  66.   (lambda (expression)
  67.     (set/union (free/expression (combination/operator expression))
  68.            (free/expressions (combination/operands expression)))))
  69.  
  70. (define-method/free 'CONDITIONAL
  71.   (lambda (expression)
  72.     (set/union*
  73.      (free/expression (conditional/predicate expression))
  74.      (free/expression (conditional/consequent expression))
  75.      (free/expression (conditional/alternative expression)))))
  76.  
  77. (define-method/free 'CONSTANT
  78.   (lambda (expression) 
  79.     expression
  80.     (no-free-variables)))
  81.  
  82. (define-method/free 'DECLARATION
  83.   (lambda (expression)
  84.     (free/expression (declaration/expression expression))))
  85.  
  86. (define-method/free 'DELAY
  87.   (lambda (expression)
  88.     (free/expression (delay/expression expression))))
  89.  
  90. (define-method/free 'DISJUNCTION
  91.   (lambda (expression)
  92.     (set/union (free/expression (disjunction/predicate expression))
  93.            (free/expression (disjunction/alternative expression)))))
  94.  
  95. (define-method/free 'IN-PACKAGE
  96.   (lambda (expression)
  97.     (free/expression (in-package/environment expression))))
  98.  
  99. (define-method/free 'PROCEDURE
  100.   (lambda (expression)
  101.     (set/difference
  102.      (free/expression (procedure/body expression))
  103.      (list->variable-set
  104.       (block/bound-variables-list (procedure/block expression))))))
  105.  
  106. (define-method/free 'OPEN-BLOCK
  107.   (lambda (expression)
  108.     (set/difference
  109.      (set/union (free/expressions (open-block/values expression))
  110.         (let loop ((actions (open-block/actions expression)))
  111.           (cond ((null? actions) (no-free-variables))
  112.             ((eq? (car actions) open-block/value-marker)
  113.              (loop (cdr actions)))
  114.             (else
  115.              (set/union (free/expression (car actions))
  116.                     (loop (cdr actions)))))))
  117.      (list->variable-set 
  118.       (block/bound-variables-list (open-block/block expression))))))
  119.  
  120. (define-method/free 'QUOTATION
  121.   (lambda (expression) 
  122.     expression
  123.     (no-free-variables)))
  124.  
  125. (define-method/free 'REFERENCE
  126.   (lambda (expression) 
  127.     (singleton-variable (reference/variable expression))))
  128.  
  129. (define-method/free 'SEQUENCE
  130.   (lambda (expression)
  131.     (free/expressions (sequence/actions expression))))
  132.  
  133. (define-method/free 'THE-ENVIRONMENT
  134.   (lambda (expression) 
  135.     expression
  136.     (no-free-variables)))