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 / tables.scm < prev    next >
Text File  |  1999-01-02  |  2KB  |  67 lines
  1. #| -*-Scheme-*-
  2.  
  3. $Id: tables.scm,v 4.3 1999/01/02 06:19:10 cph Exp $
  4.  
  5. Copyright (c) 1987, 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: Tables
  23.  
  24. (declare (usual-integrations)
  25.      (integrate-external "object"))
  26.  
  27. ;;;; Operations
  28.  
  29. (define (operations/make)
  30.   (cons '() '()))
  31.  
  32. (define (operations/lookup operations variable if-found if-not)
  33.   (let ((entry (assq variable (car operations))))
  34.     (if entry
  35.     (if (cdr entry)
  36.         (if-found (cadr entry) (cddr entry))
  37.         (if-not))
  38.     (let ((entry (assq variable (cdr operations))))
  39.       (if entry
  40.           (if-found (cadr entry) (cddr entry))
  41.           (if-not))))))
  42.  
  43. (define (operations/shadow operations variables)
  44.   (cons (map* (car operations)
  45.           (lambda (variable) (cons variable false))
  46.           variables)
  47.     (cdr operations)))
  48.  
  49. (define (operations/bind operations operation variable value)
  50.   (cons (cons (cons* variable operation value)
  51.           (car operations))
  52.     (cdr operations)))
  53.  
  54. (define (operations/bind-global operations operation variable value)
  55.   (cons (car operations)
  56.     (cons (cons* variable operation value)
  57.           (cdr operations))))
  58.  
  59. (define (operations/map-external operations procedure)
  60.   (let loop ((elements (car operations)))
  61.     (cond ((null? elements)
  62.        '())
  63.       ((cdar elements)
  64.        (cons (procedure (cadar elements) (caar elements) (cddar elements))
  65.          (loop (cdr elements))))
  66.       (else
  67.        (loop (cdr elements))))))