3
$Id: chtype.scm,v 4.4 2001/12/20 16:28:23 cph Exp $
5
Copyright (c) 1988, 1993, 1999, 2001 Massachusetts Institute of Technology
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.
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.
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., 59 Temple Place - Suite 330, Boston, MA
23
;;;; SCode Optimizer: Intern object types
25
(declare (usual-integrations)
26
(integrate-external "object"))
28
(define (change-type/block block)
29
(change-type/object enumeration/random block)
30
(block/for-each-bound-variable block
32
(change-type/object enumeration/random variable)))
33
(for-each change-type/block (block/children block)))
35
(define (change-type/expressions expressions)
36
(for-each change-type/expression expressions))
38
(declare (integrate-operator change-type/expression))
40
(define (change-type/expression expression)
41
(change-type/object enumeration/expression expression)
42
((expression/method dispatch-vector expression) expression))
44
(define dispatch-vector
45
(expression/make-dispatch-vector))
47
(define define-method/change-type
48
(expression/make-method-definer dispatch-vector))
50
(declare (integrate-operator change-type/object))
52
(define (change-type/object enumeration object)
53
(set-object/enumerand!
55
(enumeration/name->enumerand enumeration
56
(enumerand/name (object/enumerand object)))))
58
(define-method/change-type 'ACCESS
60
(change-type/expression (access/environment expression))))
62
(define-method/change-type 'ASSIGNMENT
64
(change-type/expression (assignment/value expression))))
66
(define-method/change-type 'COMBINATION
68
(change-type/expression (combination/operator expression))
69
(change-type/expressions (combination/operands expression))))
71
(define-method/change-type 'CONDITIONAL
73
(change-type/expression (conditional/predicate expression))
74
(change-type/expression (conditional/consequent expression))
75
(change-type/expression (conditional/alternative expression))))
77
(define-method/change-type 'CONSTANT
82
(define-method/change-type 'DECLARATION
84
(change-type/expression (declaration/expression expression))))
86
(define-method/change-type 'DELAY
88
(change-type/expression (delay/expression expression))))
90
(define-method/change-type 'DISJUNCTION
92
(change-type/expression (disjunction/predicate expression))
93
(change-type/expression (disjunction/alternative expression))))
95
(define-method/change-type 'PROCEDURE
97
(change-type/expression (procedure/body expression))))
99
(define-method/change-type 'OPEN-BLOCK
101
(change-type/expressions (open-block/values expression))
102
(change-type/open-block-actions (open-block/actions expression))))
104
(define (change-type/open-block-actions actions)
105
(cond ((null? actions) 'DONE)
106
((eq? (car actions) open-block/value-marker)
107
(change-type/open-block-actions (cdr actions)))
108
(else (change-type/expression (car actions))
109
(change-type/open-block-actions (cdr actions)))))
111
(define-method/change-type 'QUOTATION
113
(change-type/quotation expression)))
115
(define (change-type/quotation quotation)
116
(change-type/expression (quotation/expression quotation)))
118
(define-method/change-type 'REFERENCE
123
(define-method/change-type 'SEQUENCE
125
(change-type/expressions (sequence/actions expression))))
127
(define-method/change-type 'THE-ENVIRONMENT
b'\\ No newline at end of file'