-
Notifications
You must be signed in to change notification settings - Fork 1
/
xmainpe.sex
356 lines (308 loc) · 13.3 KB
/
xmainpe.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
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; ;;
;; File: xmainpe.sex ;;
;; Project: the specializer Unmix ;;
;; Author: S.A.Romanenko, the Institute for Applied ;;
;; Mathematics, the USSR Acedemy of Sciences, ;;
;; Moscow. ;;
;; Created: 5 May 1989 ;;
;; Revised: 8 April 1990 ;;
;; August 1990 ;;
;; December, 1992 ;;
;; ;;
;; Contents: The standard part of the Partial Evaluator ;;
;; as well as of the residual program generators ;;
;; produced by specializing the Partial Evaluator. ;;
;; ;;
;; This part is not to be specialized because the parameters of ;;
;; the functions are dynamic. ;;
;; ;;
;; ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Data structures used by the partial evaluator:
;; =============================================
;;
;; Configuration:
;;
;; <Configuration> ::= ( <Fname> > . <Svv> )
;; <Svv> ::= ( <Lisp S-expression>* )
;;
;; A configuration is a possible runtime function call,
;; which causes the partial evaluator to produce a specialized
;; version of the function <Fname> with respect to the values
;; <Svv> of the static parameters.
;;
;; PendingList:
;;
;; <PendingList> ::= ()
;; | ( <Configuration> . <PendingList> )
;;
;; A pending list is a list of configurations that are to
;; be used to generate residual function definitions.
;;
;; NameList:
;;
;; <NameList> ::= ()
;; | (( <Configuration> . <NewName> ) . <NameList> )
;;
;; In <NameList> each <Configuration> is associated with
;; a <NewFname> used to denote the residual function obtained by
;; specializing <Fname> with respect to <Svv>.
;;
;; CountList:
;;
;; <CountList> ::= ()
;; | (( <Fname> . <Int> ) . <CountList> )
;;
;; In <CountList> each <Fname> of associated with an integer,
;; which is equal to the number of residual functions produced
;; from the function <Fname>.
;; Naming conventions:
;; ==================
;;
;; ann-prog - the annotated Mixwell program
;; conf - a configuration
;; fundef - the annotated function definition
;; svn - a list of static variable names
;; dvn - a list of dynamic variable names
;; svv - a list of static variable values
;; dvv - a list of dynamic variable values
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; ;;
;; Residual program generation - Main Loop of ;;
;; the Partial Evaluator. ;;
;; ;;
;; ;;
;; The algorithm used: ;;
;; ------------------ ;;
;; ;;
;; Given: Ann-Prog = annotated program to partially evaluate, ;;
;; GoalSvv = static variable values for the goal ;;
;; function. ;;
;; ;;
;; (* Ask the name of the goal function *) ;;
;; Fname := SpecializeFunDef(Ann-Prog,'()); ;;
;; ;;
;; (* Initialize "Pending" and "Names". *) ;;
;; Conf := (Fname . Goalsvv): ;;
;; Pending := { Conf }; ;;
;; Out := {}; ;;
;; Names := { (Conf . Fname) }; ;;
;; ;;
;; (* Choose a configuration from Pending *) ;;
;; while Pending <> {} do ;;
;; begin ;;
;; choose Conf from Pending; ;;
;; Pending := Pending \ { Conf }; ;;
;; (Dvn . Body) := SpecializeFundef(Ann-Prog, Conf); ;;
;; NewFname := LookupNewFname!(Conf, Names); ;;
;; Body := Update!(Body, Pending, Names); ;;
;; ;;
;; (* Update Out *) ;;
;; Fun := list(NewFname, Dvn, '= ,Body); ;;
;; Out := Out + { Fun }; ;;
;; end; ;;
;; ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; This function is the entry point.
;; If "ann-prog" is empty, it means that the residual program
;; is to be generated by a residual program generator (which
;; is supposed to be created and loaded in advance).
;; Otherwise, the residual program will be generated by
;; ordinary partial evaluation.
;;
(define (umainpe:generate-residual-program o-file ann-prog goalsvv)
(define o-port #f) ;; An output port to which the residual program
;; is to be written.
(define pending #f) ;; A list of pending configuratins.
(define names #f) ;; A mapping from configurations to residual
;; function names.
(define counts #f) ;; A mapping from source function names
;; to counts of residual functions produced.
;;
;; This function inquires "specialize-fundef" about the name of
;; the goal function. This trick enables us to avoid specializing
;; the main program of the partial evaluator each time the partial
;; evaluator has to be specialized, because the result of
;; specializing the main program does not depend on "ann-prog".
;; Thus we can use the same specialized (by hand) main program for
;; all residual versions of "specialize-fundef".
;; Then the function initializes "pending" and "names" and
;; calls the main loop of the partial evaluator.
;;
(define (generate-residual-program-pe)
(with* (( (rf d-prog s-prog) ann-prog )
;--- Ask the name of the goal function !!!
( fname ($specialize-fundef ann-prog '()) )
( conf `(,fname . ,goalsvv) )
)
(set! counts '())
(set! pending '())
(set! names '())
(find-name! conf)
(choose-conf-pe)))
;;
;; This function chooses a configuration from "pending",
;; generates the list of the residual parameters and the
;; residual body, updates the body, "pending" and "names",
;; makes the residual function definition and outputs it.
;; Updating the residual body consists in replacing
;; configurations in function calls with the names of residual
;; functions.
;;
(define (choose-conf-pe)
(select
(pending)
(() => '())
((conf . rest) =>
(set! pending rest)
(with (( (dvn body) ($specialize-fundef ann-prog conf) )
)
(update! body)
(let* ((fname (cdr (assoc conf names)))
(fundef `(,fname ,dvn = ,body))
)
(print-fundef fundef)
(choose-conf-pe))))
))
;;
;; The functions "generate-residual-program-gn" and
;; "choose-conf-gn" have been obtained by specializing (by hand)
;; the function "generate-residual-program-pe" and the function
;; "choose-conf-pe" with respect to "ann-prog". The result does not
;; depend on "ann-prog", so these functions can be used with all
;; residual versions of "specialize-fundef".
;;
(define (generate-residual-program-gn)
(with* (;--- Ask the name of the goal function !!!
( fname ($specialize-fundef-$1 '()) )
( conf `(,fname . ,goalsvv) )
)
(set! counts '())
(set! pending '())
(set! names '())
(find-name! conf)
(choose-conf-gn)))
(define (choose-conf-gn)
(select
(pending)
(() => '())
((conf . rest) =>
(set! pending rest)
(with (( (dvn body) ($specialize-fundef-$1 conf) )
)
(update! body)
(let* ((fname (cdr (assoc conf names)))
(fundef `(,fname ,dvn = ,body))
)
(print-fundef fundef)
(choose-conf-gn)
)))
))
;;
;; Prints a residual function definition.
;;
(define (print-fundef fundef)
(display "*")
(pretty-print fundef o-port)
(newline o-port) (newline o-port))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; ;;
;; Updating Expression/PendingList/NameList ;;
;; ;;
;; The expression "exp" is traversed. Each time a residual ;;
;; call (call <Configuration> ...) is found, the <Configuration> ;;
;; is replaced with the atomic function name associated with ;;
;; the <Configuration>. ;;
;; Besides, all configurations that has not been recorded ;;
;; in "names" are recorded in "pending" and inserted in "names" ;;
;; together with new atomic function names. ;;
;; ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; Traverses an expression "exp" and replaces all
;; configurations in function calls with residual function
;; names (by means of destructive updating).
;;
(define (update! exp)
(select
(exp)
(_ & (symbol? exp) => #f)
(('quote const) => #f)
(('call conf . exp*) =>
(for-each update! exp*)
(set-car! (cdr exp) (find-name! conf)))
(('xcall fname . exp*) =>
(for-each update! exp*))
((op . exp*) =>
(for-each update! exp*))
))
;;
;; Returns the residual function name corresponding
;; to the configuration "conf". Updates "names", "pending",
;; and "counts", if necessary.
;;
(define (find-name! conf)
(with (( (fname . _) conf )
( conf-descr (assoc conf names))
)
(when (not conf-descr)
(set! conf-descr `(,conf . ,(make-fname! fname)))
(set! names `(,conf-descr . ,names))
(set! pending `(,conf . ,pending)))
(cdr conf-descr)))
;;
;; Returns a new residual function name.
;;
(define (make-fname! fname)
(string->symbol
(string-append
(symbol->string fname)
"-$"
(number->string (get-free-count! fname)))))
;;
;; Returns the number of residual functions produced
;; from the source function "fname" and increases
;; the counter.
;;
(define (get-free-count! fname)
(let ((fname-descr (assq fname counts)))
(if fname-descr
(let ((count (+ 1 (cdr fname-descr))))
(set-cdr! fname-descr count)
count)
(begin
(set! counts `((,fname . 1) . ,counts))
1))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; (umainpe:generate-residual-program o-file ann-prog goalsvv) ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(set! o-port (open-output-file o-file))
(if (null? ann-prog)
(generate-residual-program-gn)
(generate-residual-program-pe))
(close-output-port o-port))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; ;;
;; Applying functions with given symbolic name ;;
;; ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; "XAPPLY" is called from the file "xpe.s".
;;
;; The call
;; (XAPPLY 'fname (list exp1 exp2 ... expN))
;; is equivalent to
;; (fname exp1 exp2 ... expn).
;;
;;
(define xapply
(let ((proc-list '()))
(lambda (fname args)
(let ((fname/proc (assq fname proc-list)))
(if fname/proc
(apply (cdr fname/proc) args)
(let ((proc (eval-t fname)))
(set! proc-list `((,fname . ,proc) . ,proc-list))
(apply proc args)))))))