-
Notifications
You must be signed in to change notification settings - Fork 1
/
xfcd.sex
267 lines (218 loc) · 9.47 KB
/
xfcd.sex
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; ;;
;; File: xfcd.sex ;;
;; Project: the specializer Unmix ;;
;; Author: S.A.Romanenko, the Institute for Applied ;;
;; Mathematics, the USSR Acedemy of Sciences, ;;
;; Moscow. ;;
;; Credits: Some parts of the program have been taken ;;
;; from the specializer Mix made by Peter Sestoft ;;
;; and N.C.Kehler Holst (The Mix Group), ;;
;; mix@diku.UUCP, at the University of Copenhagen. ;;
;; Created: 5 May 1989 ;;
;; Revised: 6 April 1990 ;;
;; July 1990 ;;
;; ;;
;; Contents: The phase of the Annotator ;;
;; that finds a congruent division of data ;;
;; into static and dynamic parts. ;;
;; ;;
;; Synopsis: ;;
;; (find-congruent-division prog descr) ;;
;; ;;
;; prog - a Mixwell program ;;
;; descr - a list of atoms "s" and "d" ;;
;; ;;
;; Description: ;;
;; The program finds a congruent division of data ;;
;; into static and dinamic parts for ;;
;; the Mixwell program "prog". ;;
;; ;;
;; The sequence of indicators in "descr" tells ;;
;; for the variable in the corresponding place ;;
;; in the parameter list of the goal function ;;
;; whether its value is supposed to be static ;;
;; ("known") or dynamic ("unknown") at partial ;;
;; evaluation time. ;;
;; ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Some comments see in the file xsepsd.s ...
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; ;;
;; Finding a Congruent Division of Data ;;
;; into Static and Dynamic Parts ;;
;; ;;
;; Global effect: evaluate a program over an abstract domain ;;
;; (s,d), where s = static and d = dynamic, to produce ;;
;; a description of the program with all function parameters ;;
;; classified as: ;;
;; s (static) - if it depends only on available data, or ;;
;; d (dynamic) - if it might depend on unavailable data. ;;
;; ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; Given a description of the goal function's parameters,
;; returns a description of all functions in "prog"
;; (i.e. a set of meta-configurations).
;;
(define (ufcd:find-congruent-division prog descr)
(define meta-confs #f) ;; A list of meta-configurations.
(define meta-confs-modified? #f) ;; A flag to stop iterations.
;;
;; Collects all meta-configurations that result from
;; the program "prog" and the description "mc" and
;; updates "mc".
;;
(define (collect-mc-prog!)
(for-each
(lambda (fundef)
(with* (( (fname pars _ body) fundef )
( (_ args . res) (assq fname meta-confs) )
)
(update-mc! fname args (abstract-eval body pars args))
(collect-mc! body pars args)))
prog
))
;;
;; Collects all meta-configurations that result from
;; the expression "exp" and the description "mc" in the
;; abstract environment (vn,vv) and updates "mc".
;;
(define (collect-mc! exp vn vv)
(select
(exp)
(_
& (symbol? exp) => #f)
(('quote exp) => #f)
((call? . fname_exp*)
& (memq call? '(call rcall)) =>
(with* (( (fname . exp*) fname_exp* )
( _ (collect-mc*! exp* vn vv))
(args (abstract-eval* exp* vn vv))
(res (lub-list args))
)
(update-mc! fname args res)))
(('xcall fname . exp*) =>
(collect-mc*! exp* vn vv))
((op . exp*) =>
(collect-mc*! exp* vn vv))
))
;;
;; Iterates the function "collect-mc" on "exp*".
;;
(define (collect-mc*! exp* vn vv)
(for-each (lambda (exp) (collect-mc! exp vn vv)) exp*))
;;
;; Abstract evaluation of an expression.
;; Returns an indicator, computed as the result of doing
;; abstract interpretation of "exp" in the environment where
;; the names of "vn" are bound to the corresponding values
;; of "vv". "mc" is used to get abstract values of the function
;; calls appearing in "exp".
;;
(define (abstract-eval exp vn vv)
(select
(exp)
(_
& (symbol? exp) =>
(lookup-variable exp vn vv))
(('quote exp) => 's)
(('generalize exp) => 'd)
((call? . fname_exp*)
& (memq call? '(call rcall)) =>
(with* (( (fname . exp*) fname_exp* )
( (_ fargs . fres) (assq fname meta-confs) ))
fres))
(('xcall fname . exp*) =>
(lub-list (abstract-eval* exp* vn vv)))
((op . exp*) =>
(lub-list (abstract-eval* exp* vn vv)))
))
;;
;; Iterates the function "abstract-eval" on "exp*".
;;
(define (abstract-eval* exp* vn vv)
(map (lambda (exp) (abstract-eval exp vn vv)) exp*))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; ;;
;; Least Upper Bound Computation ;;
;; ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; Returns lub of two indicators.
;;
(define (lub ind1 ind2)
(if (eq? ind1 'd) 'd ind2))
;;
;; Returns the lub of a list of indicators.
;;
(define (lub-list ind*)
(if (memq 'd ind*) 'd 's))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; ;;
;; Description Handling ;;
;; ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; Returns a new description where all parameters and
;; results are classified as s (static).
;;
(define (initial-meta-confs prog)
(map
(lambda (fundef)
(with (( (fname fpars _ _) fundef ))
`(,fname ,(map (lambda (par) 's) fpars) . s)))
prog))
;;
;; Updates the description of the function "fname" in "meta-confs".
;; The new parameter description is obtained by computing
;; the least upper bound of the old parameter description and
;; "fargs". The new result description is obtained by computing
;; the least upper bound of all the indicators in the new
;; parameter description.
;;
(define (update-mc! fname args res)
(with* (( fdescr (assq fname meta-confs) )
( (_ args1 . res1) fdescr )
( lub-args (map lub args args1) )
( lub-res (lub res res1) )
)
(when (or (not (equal? lub-args args1))
(not (equal? lub-res res1)))
(set-cdr! fdescr
`(,lub-args . ,lub-res))
(set! meta-confs-modified? #t))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; ;;
;; Environment Handling ;;
;; ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; Returns the value of the variable "vname" in the environment
;; (vn,vv).
;;
(define (lookup-variable vname vn vv)
(select
(vn vv)
(() () =>
(error "Undefined variable: " vname))
((vn . nrest) (vv . vrest) =>
(if (eq? vname vn)
vv
(lookup-variable vname nrest vrest)))
))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; (ufcd:find-congruent-division prog descr) ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(with* (( ((fname . _) . prog-rest) prog ))
(set! meta-confs
`((,fname ,descr . ,(lub-list descr))
. ,(initial-meta-confs prog-rest))
))
(let recalc-mc! ()
(display "*")
(set! meta-confs-modified? #f)
(collect-mc-prog!)
(if meta-confs-modified?
(recalc-mc!)
meta-confs)))