81
93
(define define-method/integrate
82
94
(expression/make-method-definer dispatch-vector))
97
(define-method/integrate 'ACCESS
98
(lambda (operations environment expression)
99
(let ((environment* (integrate/expression operations environment
100
(access/environment expression)))
101
(name (access/name expression)))
103
(define (dont-integrate)
104
(access/make (access/scode expression)
105
(access/block expression)
108
(if (not (constant/system-global-environment? environment*))
110
(operations/lookup-global
112
(lambda (operation info)
114
((#F EXPAND) (dont-integrate))
117
(ignored-variable-warning name)
121
(reassign name (copy/expression/intern
122
(access/block expression)
123
(integration-info/expression info))))
125
((INTEGRATE-OPERATOR)
126
(warn "Not integrating operator in access: " name)
130
(error "Unknown operation" operation))))
86
134
(define-method/integrate 'ASSIGNMENT
87
135
(lambda (operations environment assignment)
88
136
(let ((variable (assignment/variable assignment)))
89
137
(operations/lookup operations variable
90
(lambda (operation info)
93
((INTEGRATE INTEGRATE-OPERATOR EXPAND)
94
(warn "Attempt to assign integrated name"
95
(variable/name variable)))
96
(else (error "Unknown operation" operation))))
98
;; The value of an assignment is the old value
99
;; of the variable, hence, it is refernced.
138
(lambda (operation info)
142
(ignored-variable-warning (variable/name variable)))
143
((EXPAND INTEGRATE INTEGRATE-OPERATOR)
144
(warn "Attempt to assign integrated name"
145
(variable/name variable)))
146
(else (error "Unknown operation" operation))))
100
149
(variable/reference! variable)
101
150
(assignment/make (assignment/scode assignment)
102
(assignment/block assignment)
104
(integrate/expression operations
106
(assignment/value assignment))))))
108
(define *eager-integration-switch #f)
151
(assignment/block assignment)
153
(integrate/expression operations
155
(assignment/value assignment))))))
158
(define-method/integrate 'COMBINATION
159
(lambda (operations environment combination)
160
(integrate/combination
161
combination operations environment
162
(combination/block combination)
163
(combination/operator combination)
164
(integrate/expressions operations
166
(combination/operands combination)))))
169
(define-method/integrate 'CONDITIONAL
170
(lambda (operations environment expression)
171
(integrate/conditional operations environment expression
172
(integrate/expression
173
operations environment
174
(conditional/predicate expression))
175
(conditional/consequent expression)
176
(conditional/alternative expression))))
178
(define sf:enable-conditional-folding? #t)
180
(define (integrate/conditional operations environment expression
184
(cond ((expression/call-to-not? integrated-predicate)
185
;; (if (not <e1>) <e2> <e3>) => (if <e1> <e3> <e2>)
186
(integrate/conditional
187
operations environment expression
188
(first (combination/operands integrated-predicate))
189
alternative consequent))
191
((sequence? integrated-predicate)
193
(and expression (object/scode expression))
194
(append (except-last-pair (sequence/actions integrated-predicate))
195
(list (integrate/conditional
196
operations environment #f
197
(last (sequence/actions integrated-predicate))
201
((and (expression/never-false? integrated-predicate)
202
(noisy-test sf:enable-conditional-folding?
203
"Fold constant true conditional"))
205
(and expression (conditional/scode expression))
206
(list integrated-predicate
207
(integrate/expression operations environment consequent))))
209
((and (expression/always-false? integrated-predicate)
210
(noisy-test sf:enable-conditional-folding?
211
"Fold constant false conditional"))
213
(and expression (conditional/scode expression))
214
(list integrated-predicate
215
(integrate/expression operations environment alternative))))
218
(conditional/make (and expression (conditional/scode expression))
220
(integrate/expression operations environment consequent)
221
(integrate/expression operations environment alternative)))))
224
(define-method/integrate 'CONSTANT
225
(lambda (operations environment expression)
226
(declare (ignore operations environment))
230
(define-method/integrate 'DECLARATION
231
(lambda (operations environment declaration)
233
(integrate/expression
234
(declarations/bind operations
235
(declaration/declarations declaration))
236
environment (declaration/expression declaration))))
237
(if (constant? answer)
240
(declaration/scode declaration)
241
(declaration/declarations declaration)
245
(define-method/integrate 'DELAY
246
(lambda (operations environment expression)
248
(delay/scode expression)
249
(integrate/expression operations environment
250
(delay/expression expression)))))
254
(define-method/integrate 'DISJUNCTION
255
(lambda (operations environment expression)
256
(integrate/disjunction
257
operations environment expression
258
(integrate/expression
259
operations environment (disjunction/predicate expression))
260
(disjunction/alternative expression))))
262
(define sf:enable-disjunction-folding? #t)
264
(define (integrate/disjunction operations environment expression
265
integrated-predicate alternative)
266
(cond ((expression/call-to-not? integrated-predicate)
267
;; (or (not e1) e2) => (if e1 e2 #t)
268
(integrate/conditional
269
operations environment expression
270
(first (combination/operands integrated-predicate))
272
(constant/make #f #t)))
274
((and (expression/never-false? integrated-predicate)
275
(noisy-test sf:enable-disjunction-folding?
276
"Fold constant true disjunction"))
277
;; (or <exp1> <exp2>) => <exp1> if <exp1> is never false
278
integrated-predicate)
280
((and (expression/always-false? integrated-predicate)
281
(noisy-test sf:enable-disjunction-folding?
282
"Fold constant false disjunction"))
283
;; (or <exp1> <exp2>)
284
;; => (begin <exp1> <exp2>) if <exp1> is always false
285
(sequence/make (and expression (object/scode expression))
286
(list integrated-predicate
287
(integrate/expression
288
operations environment alternative))))
290
((sequence? integrated-predicate)
292
(and expression (object/scode expression))
293
(append (except-last-pair (sequence/actions integrated-predicate))
294
(list (integrate/disjunction
295
operations environment #f
296
(last (sequence/actions integrated-predicate))
300
(disjunction/make (and expression (object/scode expression))
302
(integrate/expression
304
environment alternative)))))
307
(define-method/integrate 'OPEN-BLOCK
308
(lambda (operations environment expression)
310
(lambda () (integrate/open-block operations environment expression))
311
(lambda (operations environment expression)
312
(declare (ignore operations environment))
316
(define-method/integrate 'PROCEDURE
317
(lambda (operations environment procedure)
318
(integrate/procedure operations
319
(simulate-unknown-application environment procedure)
323
(define-method/integrate 'QUOTATION
324
(lambda (operations environment expression)
325
(declare (ignore operations environment))
326
(integrate/quotation expression)))
328
(define (integrate/quotation quotation)
331
(integrate/top-level* (quotation/scode quotation)
332
(quotation/block quotation)
333
(quotation/expression quotation)))
334
(lambda (operations environment expression)
335
operations environment ;ignore
339
(define sf:warn-on-unintegrated-argument #f)
110
341
(define-method/integrate 'REFERENCE
111
342
(lambda (operations environment expression)
112
343
(let ((variable (reference/variable expression)))
113
(letrec ((integration-success
114
(lambda (new-expression)
115
(variable/integrated! variable)
119
(variable/reference! variable)
121
(try-safe-integration
123
(integrate/name-if-safe expression expression
124
environment operations
125
'(INTEGRATE INTEGRATE-SAFELY)
127
integration-failure))))
128
(operations/lookup operations variable
129
(lambda (operation info)
131
((INTEGRATE-OPERATOR EXPAND)
132
(variable/reference! variable)
135
(integrate/name expression expression info environment
136
integration-success integration-failure))
138
(try-safe-integration))
140
(error "Unknown operation" operation))))
142
(if *eager-integration-switch
143
(try-safe-integration)
144
(integration-failure))))))))
146
(define (integrate/name-if-safe expr reference environment
147
operations safe-operations if-win if-fail)
148
(let ((variable (reference/variable reference)))
149
(if (or (variable/side-effected variable)
150
(not (block/safe? (variable/block variable))))
154
(if (safely-integrable-value? value environment operations
159
(copy/expression/intern (reference/block reference)
162
(environment/lookup environment variable
164
(if (delayed-integration? value)
165
(if (delayed-integration/in-progress? value)
167
(finish (delayed-integration/force value)))
169
(lambda () (if-fail))
170
(lambda () (if-fail)))))))
344
(define (dont-integrate)
345
(variable/reference! variable)
350
(lambda (operation info)
353
(ignored-variable-warning (variable/name variable))
360
(let ((new-expression
361
(integrate/name expression expression info environment)))
363
(begin (variable/integrated! variable)
367
((INTEGRATE-OPERATOR)
368
(if sf:warn-on-unintegrated-argument
369
(warn "Not integrating operator in argument position: " variable))
373
(error "Unknown operation" operation))))
172
377
(define (reassign expr object)
173
378
(if (and expr (object/scode expr))
174
;; Abstraction violation
175
379
(with-new-scode (object/scode expr) object)
178
(define (safely-integrable-value? value environment operations safe-operations)
179
(let check ((value value) (top? #t))
180
(or (constant? value)
181
(and (reference? value)
183
(let ((variable (reference/variable value)))
184
(or (operations/lookup operations variable
185
(lambda (operation info)
187
(memq operation safe-operations))
189
(and (not (variable/side-effected variable))
190
(block/safe? (variable/block variable))
191
(environment/lookup environment variable
196
(operations/lookup operations variable
197
(lambda (operation info)
204
;; not found variable
207
(define (integrate/reference-operator expression operations environment
208
block operator operands)
209
(let ((variable (reference/variable operator)))
210
(letrec ((mark-integrated!
212
(variable/integrated! variable)))
215
(variable/reference! variable)
216
(combination/optimizing-make expression block
221
(integrate/combination expression operations environment
222
block operator operands)))
223
(try-safe-integration
225
(integrate/name-if-safe expression operator
226
environment operations
227
'(EXPAND INTEGRATE INTEGRATE-OPERATOR
230
integration-failure))))
231
(operations/lookup operations variable
232
(lambda (operation info)
234
((#F) (integration-failure))
235
((INTEGRATE INTEGRATE-OPERATOR)
236
(integrate/name expression
237
operator info environment
239
integration-failure))
241
(try-safe-integration))
245
(lambda (new-expression)
247
(integrate/expression operations environment
250
(reference/block operator)))
252
(error "Unknown operation" operation))))
254
(if *eager-integration-switch
255
(try-safe-integration)
256
(integration-failure)))))))
383
(define-method/integrate 'SEQUENCE
384
(lambda (operations environment expression)
386
(and expression (object/scode expression))
387
(integrate/actions operations environment
388
(sequence/actions expression)))))
391
(define-method/integrate 'THE-ENVIRONMENT
392
(lambda (operations environment expression)
400
;;; If not #f, display the top-level procedure names as they are
401
;;; processed. Useful for debugging.
402
(define sf:display-top-level-procedure-names? #f)
404
(define (maybe-displaying-name name thunk)
405
(if (and sf:display-top-level-procedure-names?
406
(null? *current-block-names*))
409
(write-string "Integrating procedure " port)
260
414
(define (integrate/open-block operations environment expression)
261
415
(let ((variables (open-block/variables expression))
262
(block (open-block/block expression)))
416
(block (open-block/block expression)))
263
417
(let ((operations
264
(declarations/bind (operations/shadow operations variables)
265
(block/declarations block))))
266
(process-block-flags (block/flags block)
270
(environment/recursive-bind operations
273
(open-block/values expression)))
274
(lambda (environment vals)
276
(integrate/actions operations
278
(open-block/actions expression))))
279
;; Complain about unreferenced variables.
280
;; If the block is unsafe, then it is likely that
281
;; there will be a lot of them on purpose (top level or
282
;; the-environment) so no complaining.
283
(if (block/safe? (open-block/block expression))
284
(for-each (lambda (variable)
285
(if (variable/unreferenced? variable)
286
(warn "Unreferenced defined variable:"
287
(variable/name variable))))
291
(if (open-block/optimized expression)
293
(and expression (object/scode expression))
296
(open-block/optimizing-make
297
expression block variables vals
298
actions operations environment)))))))))))
300
(define-method/integrate 'OPEN-BLOCK
301
(lambda (operations environment expression)
303
(lambda () (integrate/open-block operations environment expression))
304
(lambda (operations environment expression)
305
operations environment
308
(define (process-block-flags flags continuation)
311
(let ((this-flag (car flags)))
313
((AUTOMAGIC-INTEGRATIONS)
314
(fluid-let ((*eager-integration-switch #T))
315
(process-block-flags (cdr flags) continuation)))
316
((NO-AUTOMAGIC-INTEGRATIONS)
317
(fluid-let ((*eager-integration-switch #F))
318
(process-block-flags (cdr flags) continuation)))
320
(fluid-let ((*eta-substitution-switch #T))
321
(process-block-flags (cdr flags) continuation)))
322
((NO-ETA-SUBSTITUTION)
323
(fluid-let ((*eta-substitution-switch #F))
324
(process-block-flags (cdr flags) continuation)))
325
((OPEN-BLOCK-OPTIMIZATIONS)
326
(fluid-let ((*block-optimizing-switch #T))
327
(process-block-flags (cdr flags) continuation)))
328
((NO-OPEN-BLOCK-OPTIMIZATIONS)
329
(fluid-let ((*block-optimizing-switch #F))
330
(process-block-flags (cdr flags) continuation)))
331
(else (error "Bad flag"))))))
418
(declarations/bind (operations/shadow operations variables)
419
(block/declarations block))))
422
(environment/recursive-bind operations
425
(open-block/values expression)))
426
(lambda (environment vals)
428
(integrate/actions operations
430
(open-block/actions expression))))
431
;; Complain about unreferenced variables.
432
;; If the block is unsafe, then it is likely that
433
;; there will be a lot of them on purpose (top level or
434
;; the-environment) so no complaining.
435
(if (block/safe? (open-block/block expression))
436
(for-each (lambda (variable)
437
(if (variable/unreferenced? variable)
438
(warn "Unreferenced defined variable:"
439
(variable/name variable))))
444
(and expression (object/scode expression))
333
448
(define (variable/unreferenced? variable)
334
449
(and (not (variable/integrated variable))
335
450
(not (variable/referenced variable))
336
(not (variable/can-ignore? variable))))
338
(define-method/integrate 'PROCEDURE
339
(lambda (operations environment procedure)
340
(integrate/procedure operations
341
(simulate-unknown-application environment procedure)
344
;; Cannot optimize (lambda () (bar)) => bar (eta substitution) because
345
;; BAR may be a procedure with different arity than the lambda
347
#| You can get some weird stuff with this
350
(define (loop1) (loop2))
351
(define (loop2) (loop3))
352
(define (loop3) (loop1))
363
and if you have automagic integrations on, this won't finish
364
optimizing. Well, you told the machine to loop forever, and it
365
determines that it can do this at compile time, so you get what
370
(define *eta-substitution-switch #F)
451
(not (variable/may-ignore? variable))
452
(not (variable/must-ignore? variable))))
372
454
(define (integrate/procedure operations environment procedure)
373
455
(let ((block (procedure/block procedure))
374
(required (procedure/required procedure))
375
(optional (procedure/optional procedure))
376
(rest (procedure/rest procedure)))
377
(fluid-let ((*current-block-names*
378
(cons (procedure/name procedure)
379
*current-block-names*)))
380
(process-block-flags (block/flags block)
383
(integrate/expression
387
(append required optional (if rest (list rest) '())))
388
(block/declarations block))
390
(procedure/body procedure))))
391
;; Possibly complain about variables bound and not
393
(if (block/safe? block)
394
(for-each (lambda (variable)
395
(if (variable/unreferenced? variable)
396
(warn "Unreferenced bound variable:"
397
(variable/name variable)
398
*current-block-names*)))
400
(append required optional (list rest))
401
(append required optional))))
402
(if (and *eta-substitution-switch
406
(let ((operands (combination/operands body)))
407
(match-up? operands required))
410
(list->set variable? eq? required)
411
(free/expression (combination/operator body)))))
412
(combination/operator body)
413
(procedure/make (procedure/scode procedure)
415
(procedure/name procedure)
421
(define (match-up? operands required)
424
(and (not (null? required))
425
(let ((this-operand (car operands))
426
(this-required (car required)))
427
(and (reference? this-operand)
428
(eq? (reference/variable this-operand) this-required)
429
(match-up? (cdr operands) (cdr required)))))))
456
(name (procedure/name procedure))
457
(required (procedure/required procedure))
458
(optional (procedure/optional procedure))
459
(rest (procedure/rest procedure)))
460
(maybe-displaying-name
463
(fluid-let ((*current-block-names* (cons name *current-block-names*)))
464
(let ((body (integrate/expression
468
(append required optional (if rest (list rest) '())))
469
(block/declarations block))
471
(procedure/body procedure))))
472
;; Possibly complain about variables bound and not
474
(if (block/safe? block)
475
(for-each (lambda (variable)
476
(if (variable/unreferenced? variable)
477
(warn "Unreferenced bound variable:"
478
(variable/name variable)
479
*current-block-names*)))
481
(append required optional (list rest))
482
(append required optional))))
483
(procedure/make (procedure/scode procedure)
431
(define-method/integrate 'COMBINATION
432
(lambda (operations environment combination)
433
(integrate/combination
434
combination operations environment
435
(combination/block combination)
436
(combination/operator combination)
437
(integrate/expressions operations
439
(combination/operands combination)))))
492
;;; INTEGRATE-COMBINATION
493
(define integrate-combination-dispatch-vector
494
(expression/make-dispatch-vector))
496
(define define-method/integrate-combination
497
(expression/make-method-definer integrate-combination-dispatch-vector))
441
499
(define (integrate/combination expression operations environment
442
block operator operands)
443
(cond ((reference? operator)
444
(integrate/reference-operator expression operations environment
445
block operator operands))
446
((and (access? operator)
447
(constant/system-global-environment?
448
(integrate/expression operations environment (access/environment operator))))
449
(integrate/access-operator expression operations environment
450
block operator operands))
451
((and (constant? operator)
452
(primitive-procedure? (constant/value operator)))
454
(and (eq? (constant/value operator) (ucode-primitive apply))
455
(integrate/hack-apply? operands))))
457
(integrate/combination expression operations environment
458
block (car operands*) (cdr operands*))
459
(integrate/primitive-operator expression operations environment
460
block operator operands))))
462
(combination/optimizing-make
465
(let* ((integrate-procedure
467
(integrate/procedure-operator operations environment
468
block operator operands)))
470
(if (procedure? operator)
471
(integrate-procedure operator)
473
(integrate/expression operations
476
(if (procedure? operator)
477
(integrate-procedure operator)
479
(cond ((integrate/compound-operator operator operands)
480
=> integrate-procedure)
500
block operator operands)
501
((expression/method integrate-combination-dispatch-vector operator)
502
expression operations environment block operator operands))
505
(define-method/integrate-combination 'ACCESS
506
(lambda (expression operations environment block operator operands)
507
(integrate/access-operator expression operations environment
508
block operator operands)))
510
(define (integrate/access-operator expression operations environment block operator operands)
511
(let ((name (access/name operator))
513
(integrate/expression operations environment (access/environment operator))))
515
(define (dont-integrate)
518
(access/make (access/scode operator)
519
(access/block operator)
520
environment* name) operands))
522
(if (not (constant/system-global-environment? environment*))
524
(operations/lookup-global
526
(lambda (operation info)
528
((#F) (dont-integrate))
531
(cond ((info expression operands (reference/block operator))
532
=> (lambda (new-expression)
533
(integrate/expression operations environment new-expression)))
534
(else (dont-integrate))))
537
(ignored-variable-warning (variable/name name))
540
((INTEGRATE INTEGRATE-OPERATOR)
543
(copy/expression/intern block (integration-info/expression info)))))
544
(integrate/combination expression operations environment block new-operator operands)))
547
(error "unknown operation" operation))))
550
;;; assignment-operator
551
(define-method/integrate-combination 'ASSIGNMENT
552
(lambda (expression operations environment block operator operands)
553
(warn "Value of assignment used as an operator.")
554
;; We don't try to make sense of this, we just
555
;; build the code and let the runtime raise an error.
556
(combination/make expression
558
(integrate/expression operations environment operator)
561
;;; combination-operator
562
(define-method/integrate-combination 'COMBINATION
563
(lambda (expression operations environment block operator operands)
564
(integrate-combination/default expression operations environment block operator operands)))
566
;;; conditional-operator
567
(define-method/integrate-combination 'CONDITIONAL
568
(lambda (expression operations environment block operator operands)
569
(integrate-combination/default expression operations environment block operator operands)))
571
;;; constant-operator
572
(define sf:enable-elide-double-negatives? #t)
574
(define-method/integrate-combination 'CONSTANT
575
(lambda (expression operations environment block operator operands)
576
;; Elide a double negative only if it doesn't change the type of the answer.
577
(cond ((and (expression/constant-eq? operator (ucode-primitive not))
578
(length=? operands 1)
579
(expression/call-to-not? (first operands))
581
(first (combination/operands (first operands))))
582
(noisy-test sf:enable-elide-double-negatives?
583
"Elide double negative"))
584
(first (combination/operands (first operands))))
586
((primitive-procedure? (constant/value operator))
588
(and (eq? (constant/value operator) (ucode-primitive apply))
589
(integrate/hack-apply? operands))))
591
(integrate/combination expression operations environment
592
block (car operands*) (cdr operands*))
593
(integrate/primitive-operator expression operations environment
594
block operator operands))))
597
(warn "Application of constant value" (constant/value operator))
598
(integrate-combination/default expression operations environment
599
block operator operands)))))
601
(define (integrate/primitive-operator expression operations environment
602
block operator operands)
603
(declare (ignore operations environment))
604
(combination/make expression block operator operands))
606
;;; declaration-operator
607
(define-method/integrate-combination 'DECLARATION
608
(lambda (expression operations environment block operator operands)
609
(integrate-combination/default expression operations environment block operator operands)))
612
(define-method/integrate-combination 'DELAY
613
(lambda (expression operations environment block operator operands)
614
;; Nonsense - generate a warning.
615
(warn "Delayed object in operator position. This will cause a runtime error.")
616
(combination/make expression
618
(integrate/expression operations environment operator)
621
;;; disjunction-operator
622
(define-method/integrate-combination 'DISJUNCTION
623
(lambda (expression operations environment block operator operands)
624
(integrate-combination/default expression operations environment
625
block operator operands)))
627
;;; open-block-operator
628
(define-method/integrate-combination 'OPEN-BLOCK
629
(lambda (expression operations environment block operator operands)
630
(declare (ignore expression operations environment block operator operands))
631
;; This shouldn't be possible.
632
(error "INTERNAL-ERROR: integrate-combination 'open-block")))
634
;;; procedure-operator (let)
635
(define-method/integrate-combination 'PROCEDURE
636
(lambda (expression operations environment block operator operands)
637
(integrate-combination/default expression operations environment
638
block operator operands)))
484
640
(define (integrate/procedure-operator operations environment
485
block procedure operands)
641
block procedure operands)
486
642
(integrate/procedure operations
487
(simulate-application environment block
491
(define (integrate/primitive-operator expression operations environment
492
block operator operands)
493
(let ((integration-failure
495
(combination/optimizing-make expression block operator operands))))
496
(operations/lookup operations (constant/value operator)
497
(lambda (operation info)
499
((#F) (integration-failure))
504
(integrate/expression operations environment expression))
507
(else (error "Unknown operation" operation))))
508
integration-failure)))
643
(simulate-application environment block
647
;;; quotation-operator
648
(define-method/integrate-combination 'QUOTATION
649
(lambda (expression operations environment block operator operands)
650
(integrate-combination/default expression operations environment
651
block operator operands)))
653
;;; reference-operator
654
(define-method/integrate-combination 'REFERENCE
655
(lambda (expression operations environment block operator operands)
656
(integrate/reference-operator expression operations environment
657
block operator operands)))
659
(define (integrate/reference-operator expression operations environment
660
block operator operands)
661
(let ((variable (reference/variable operator)))
662
(let ((integration-failure
664
(variable/reference! variable)
665
(combination/make expression block operator operands))))
666
(operations/lookup operations variable
667
(lambda (operation info)
669
((#F) (integration-failure))
672
(let ((new-expression (info expression operands (reference/block operator))))
675
(variable/integrated! variable)
676
(integrate/expression operations environment new-expression))
677
(integration-failure))))
680
(ignored-variable-warning (variable/name variable))
681
(integration-failure))
683
((INTEGRATE INTEGRATE-OPERATOR)
684
(let ((new-expression (integrate/name expression
685
operator info environment)))
688
(variable/integrated! variable)
689
(integrate/combination expression operations environment
690
block new-expression operands))
691
(integration-failure))))
694
(error "Unknown operation" operation))))
695
integration-failure))))
697
;;; sequence-operator
698
(define-method/integrate-combination 'SEQUENCE
699
(lambda (expression operations environment block operator operands)
700
(integrate-combination/default expression operations environment
701
block operator operands)))
703
;;; the-environment-operator
704
(define-method/integrate-combination 'THE-ENVIRONMENT
705
(lambda (expression operations environment block operator operands)
706
(warn "(THE-ENVIRONMENT) used as an operator. Will cause a runtime error.")
707
(combination/make expression block
708
(integrate/expression operations environment operator)
711
(define (integrate-combination/default expression operations environment
712
block operator operands)
716
(let* ((integrate-procedure
718
(integrate/procedure-operator operations environment
719
block operator operands)))
721
(if (procedure? operator)
722
(integrate-procedure operator)
724
(integrate/expression operations
727
(if (procedure? operator)
728
(integrate-procedure operator)
730
(cond ((integrate/compound-operator operator operands)
731
=> integrate-procedure)
735
(define (integrate/hack-apply? operands)
736
(define (check operand)
737
(cond ((constant? operand)
738
(if (null? (constant/value operand))
741
((not (combination? operand))
744
(let ((rator (combination/operator operand)))
745
(if (or (and (constant? rator)
746
(eq? (ucode-primitive cons)
747
(constant/value rator)))
748
(eq? 'cons (global-ref? rator)))
749
(let* ((rands (combination/operands operand))
750
(next (check (cadr rands))))
753
(cons (car rands) next)))
756
(and (not (null? operands))
757
(let ((tail (check (car (last-pair operands)))))
758
(and (not (eq? tail 'FAIL))
759
(append (except-last-pair operands)
510
763
;;; ((let ((a (foo)) (b (bar)))
511
764
;;; (lambda (receiver)
630
883
(define (sequence-with-actions sequence actions)
631
884
(sequence/make (sequence/scode sequence) actions))
633
(define (non-side-effecting? expression)
634
(or (reference? expression)
635
(non-side-effecting-in-sequence? expression)))
637
(define-method/integrate 'DECLARATION
638
(lambda (operations environment declaration)
639
(let ((declarations (declaration/declarations declaration))
640
(expression (declaration/expression declaration)))
642
(declaration/scode declaration)
644
(integrate/expression (declarations/bind operations declarations)
650
(define-method/integrate 'CONSTANT
651
(lambda (operations environment expression)
656
(define-method/integrate 'THE-ENVIRONMENT
657
(lambda (operations environment expression)
662
(define-method/integrate 'QUOTATION
663
(lambda (operations environment expression)
666
(integrate/quotation expression)))
668
;; Optimize (if #f a b) => b; (if #t a b) => a
669
;; (if (let (...) t) a b) => (let (...) (if t a b))
670
;; (if (begin ... t) a b) => (begin ... (if t a b))
672
(define-method/integrate 'CONDITIONAL
673
(lambda (operations environment expression)
674
(let ((predicate (integrate/expression
675
operations environment
676
(conditional/predicate expression)))
677
(consequent (integrate/expression
678
operations environment
679
(conditional/consequent expression)))
680
(alternative (integrate/expression
681
operations environment
682
(conditional/alternative expression))))
683
(let loop ((predicate predicate))
684
(cond ((constant? predicate)
685
(if (constant/value predicate)
688
((sequence? predicate)
689
(sequence-with-actions
691
(let ((actions (reverse (sequence/actions predicate))))
693
(cons (loop (car actions))
695
((and (combination? predicate)
696
(procedure? (combination/operator predicate))
699
(procedure/body (combination/operator predicate)))))
700
(combination-with-operator
703
(combination/operator predicate)
704
(loop (procedure/body (combination/operator predicate))))))
706
(conditional/make (conditional/scode expression)
707
predicate consequent alternative)))))))
709
;; Optimize (or #f a) => a; (or #t a) => #t
711
(define-method/integrate 'DISJUNCTION
712
(lambda (operations environment expression)
713
(let ((predicate (integrate/expression operations environment
714
(disjunction/predicate expression)))
715
(alternative (integrate/expression
716
operations environment
717
(disjunction/alternative expression))))
718
(if (constant? predicate)
719
(if (constant/value predicate)
722
(disjunction/make (disjunction/scode expression)
723
predicate alternative)))))
725
(define-method/integrate 'SEQUENCE
726
(lambda (operations environment expression)
727
;; Optimize (begin (foo)) => (foo)
728
;; Optimize (begin a b (foo) 22 (bar)) => (begin (foo) (bar))
729
(sequence/optimizing-make
731
(integrate/actions operations environment
732
(sequence/actions expression)))))
734
(define (integrate/actions operations environment actions)
735
(let ((action (car actions)))
736
(if (null? (cdr actions))
737
(list (if (eq? action open-block/value-marker)
739
(integrate/expression operations environment action)))
740
(cons (cond ((reference? action)
741
;; This clause lets you ignore a variable by
742
;; mentioning it in a sequence.
743
(variable/can-ignore! (reference/variable action))
745
((eq? action open-block/value-marker)
748
(integrate/expression operations environment action)))
749
(integrate/actions operations environment (cdr actions))))))
751
(define (sequence/optimizing-make expression actions)
752
(let ((actions (remove-non-side-effecting actions)))
753
(if (null? (cdr actions))
755
(sequence/make (and expression (object/scode expression))
758
(define (remove-non-side-effecting actions)
759
;; Do not remove references from sequences, because they have
760
;; meaning as declarations. The output code generator will take
761
;; care of removing them when they are no longer needed.
762
(if (null? (cdr actions))
764
(let ((rest (remove-non-side-effecting (cdr actions))))
765
(if (non-side-effecting-in-sequence? (car actions))
767
(cons (car actions) rest)))))
769
(define (non-side-effecting-in-sequence? expression)
770
;; Compiler does a better job of this because it is smarter about
771
;; what kinds of expressions can cause side effects. But this
772
;; should be adequate to catch most of the simple cases.
773
(or (constant? expression)
774
(quotation? expression)
776
(procedure? expression)
777
(and (access? expression)
778
(non-side-effecting-in-sequence? (access/environment expression)))))
780
(define-method/integrate 'ACCESS
781
(lambda (operations environment expression)
782
(let ((environment* (integrate/expression operations environment
783
(access/environment expression)))
784
(name (access/name expression)))
785
(cond ((and (constant/system-global-environment? environment*)
786
(assq name usual-integrations/constant-alist))
788
(constant/make (access/scode expression)
789
(constant/value (cdr entry)))))
790
(else (access/make (access/scode expression)
791
environment* name))))))
793
886
(define (constant/system-global-environment? expression)
794
887
(and (constant? expression)
795
888
(system-global-environment? (constant/value expression))))
797
(define-method/integrate 'DELAY
798
(lambda (operations environment expression)
800
(delay/scode expression)
801
(integrate/expression operations environment
802
(delay/expression expression)))))
804
(define (integrate/quotation quotation)
807
(integrate/top-level* (quotation/scode quotation)
808
(quotation/block quotation)
809
(quotation/expression quotation)))
810
(lambda (operations environment expression)
811
operations environment ;ignore
814
(define (integrate/access-operator expression operations environment
815
block operator operands)
816
(let ((name (access/name operator))
820
(and expression (object/scode expression))
822
(integrate/expression operations environment operator)
823
(integrate/expressions operations environment operands)))))
824
(cond ((and (eq? name 'APPLY)
825
(integrate/hack-apply? operands))
826
=> (lambda (operands*)
827
(integrate/combination expression operations environment
828
block (car operands*) (cdr operands*))))
829
((assq name usual-integrations/constant-alist)
831
(integrate/combination expression operations environment
832
block (cdr entry) operands)))
833
((assq name usual-integrations/expansion-alist)
835
((cdr entry) expression operands
836
identity-procedure dont-integrate #f)))
1035
944
(case (delayed-integration/state delayed-integration)
1036
945
((NOT-INTEGRATED)
1039
(delayed-integration/environment delayed-integration))
1041
(delayed-integration/operations delayed-integration))
1042
(expression (delayed-integration/value delayed-integration)))
1043
(set-delayed-integration/state! delayed-integration
1045
(set-delayed-integration/environment! delayed-integration #f)
1046
(set-delayed-integration/operations! delayed-integration #f)
1047
(set-delayed-integration/value! delayed-integration #f)
1048
(integrate/expression operations environment expression))))
948
(delayed-integration/environment delayed-integration))
950
(delayed-integration/operations delayed-integration))
951
(expression (delayed-integration/value delayed-integration)))
952
(set-delayed-integration/state! delayed-integration
954
(set-delayed-integration/environment! delayed-integration #f)
955
(set-delayed-integration/operations! delayed-integration #f)
956
(set-delayed-integration/value! delayed-integration #f)
957
(integrate/expression operations environment expression))))
1049
958
(set-delayed-integration/state! delayed-integration 'INTEGRATED)
1050
959
(set-delayed-integration/value! delayed-integration value)))
1051
960
((INTEGRATED) 'DONE)
1052
961
((BEING-INTEGRATED)
1053
962
(error "Attempt to re-force delayed integration"
1054
delayed-integration))
963
delayed-integration))
1056
965
(error "Delayed integration has unknown state"
1057
delayed-integration)))
1058
(delayed-integration/value delayed-integration))
1063
Simple LET-like combination. Delete any unreferenced
1064
parameters. If no parameters remain, delete the
1065
combination and lambda. Values bound to the unreferenced
1066
parameters are pulled out of the combination. But integrated
1067
forms are simply removed.
1073
(declare (integrate c))
1086
(define (foldable-constant? thing)
1089
(define (foldable-constants? list)
1091
(and (foldable-constant? (car list))
1092
(foldable-constants? (cdr list)))))
1094
(define (foldable-constant-value thing)
1095
(cond ((constant? thing)
1096
(constant/value thing))
1098
(error "foldable-constant-value: can't happen" thing))))
1100
(define *foldable-primitive-procedures
1101
(map make-primitive-procedure
1102
'(OBJECT-TYPE OBJECT-TYPE?
1103
NOT EQ? NULL? PAIR? ZERO? POSITIVE? NEGATIVE?
1104
&= &< &> &+ &- &* &/ 1+ -1+)))
1106
(define (foldable-operator? operator)
1107
(and (constant? operator)
1108
(primitive-procedure? (constant/value operator))
1109
(memq (constant/value operator) *foldable-primitive-procedures)))
1111
;;; deal with (let () (define ...))
1112
;;; deal with (let ((x 7)) (let ((y 4)) ...)) => (let ((x 7) (y 4)) ...)
1113
;;; Actually, we really don't want to hack with these for various
1116
(define (combination/optimizing-make expression block operator operands)
1119
(and (foldable-operator? operator)
1120
(foldable-constants? operands))
1121
(constant/make (and expression (object/scode expression))
1122
(apply (constant/value operator)
1123
(map foldable-constant-value operands))))
1126
;; (force (delay x)) ==> x
1127
(and (constant? operator)
1128
(eq? (constant/value operator) force)
1129
(= (length operands) 1)
1130
(delay? (car operands)))
1131
(delay/expression (car operands)))
1133
((and (procedure? operator)
1134
(block/safe? (procedure/block operator))
1135
(for-all? (declarations/original
1136
(block/declarations (procedure/block operator)))
1137
declarations/known?)
1138
(for-all? (procedure/optional operator)
1139
variable/integrated)
1140
(or (not (procedure/rest operator))
1141
(variable/integrated (procedure/rest operator))))
1142
(delete-unreferenced-parameters
1143
(append (procedure/required operator)
1144
(procedure/optional operator))
1145
(procedure/rest operator)
1146
(procedure/body operator)
1148
(lambda (required referenced-operands unreferenced-operands)
1150
(if (and (null? required)
1151
;; need to avoid things like this
1152
;; (foo bar (let () (define (baz) ..) ..))
1154
;; (foo bar (define (baz) ..) ..)
1155
(not (open-block? (procedure/body operator))))
1156
(reassign expression (procedure/body operator))
1158
(and expression (object/scode expression))
1161
(procedure/scode operator)
1162
(procedure/block operator)
1163
(procedure/name operator)
1167
(procedure/body operator))
1168
referenced-operands))))
1169
(if (null? unreferenced-operands)
1171
(sequence/optimizing-make
1173
(append unreferenced-operands (list form))))))))
1175
(combination/make (and expression (object/scode expression))
1176
block operator operands))))
1178
(define (delete-unreferenced-parameters parameters rest body operands receiver)
1179
(let ((free-in-body (free/expression body)))
1180
(let loop ((parameters parameters)
1182
(required-parameters '())
1183
(referenced-operands '())
1184
(unreferenced-operands '()))
1185
(cond ((null? parameters)
1186
(if (or rest (null? operands))
1187
(receiver (reverse required-parameters) ; preserve order
1188
(reverse referenced-operands)
1189
(if (or (null? operands)
1190
(variable/integrated rest))
1191
unreferenced-operands
1192
(append operands unreferenced-operands)))
1193
(error "Argument mismatch" operands)))
1195
(error "Argument mismatch" parameters))
1197
(let ((this-parameter (car parameters))
1198
(this-operand (car operands)))
1199
(cond ((set/member? free-in-body this-parameter)
1200
(loop (cdr parameters)
1202
(cons this-parameter required-parameters)
1203
(cons this-operand referenced-operands)
1204
unreferenced-operands))
1205
((variable/integrated this-parameter)
1206
(loop (cdr parameters)
1210
unreferenced-operands))
1212
(loop (cdr parameters)
1217
unreferenced-operands))))))))))
1219
(define *block-optimizing-switch #f)
1221
;; This is overly hairy, but if it works, no one need know.
1222
;; What we do is this:
1223
;; 1 Make a directed graph of the dependencies in an open
1225
;; 2 Identify the circular dependencies and place them in
1227
;; 3 Identify the bindings that can be made in parallel and
1228
;; make LET type statements.
1229
;; 4 This deletes unused bindings in an open block and
1230
;; compartmentalizes the environment.
1231
;; 5 Re-optimize the code in the body. This can help if the
1232
;; eta-substitution-switch is on.
1234
(define (open-block/optimizing-make expression block vars values
1235
actions operations environment)
1236
(if (and *block-optimizing-switch
1237
(block/safe? block))
1238
(let ((table:var->vals (associate-vars-and-vals vars values))
1239
(bound-variables (varlist->varset vars)))
1240
(let ((table:vals->free
1241
(get-free-vars-in-bindings bound-variables values))
1242
(body-free (get-body-free-vars bound-variables actions)))
1243
;; (write-string "Free vars in body")
1244
;; (display (map variable/name body-free))
1245
(let ((graph (build-graph vars
1249
(collapse-circularities! graph)
1250
;; (print-graph graph)
1251
(label-node-depth! graph)
1252
(let ((template (linearize graph)))
1253
;; (print-template template)
1254
(integrate/expression
1255
operations environment
1256
(build-new-code expression
1258
(block/parent block)
1259
table:var->vals actions))))))
1261
(and expression (object/scode expression))
1262
block vars values actions #t)))
1265
(define (print-template template)
1266
(if (null? template)
1268
(let ((this (car template)))
1270
(display (car this))
1271
(display (map variable/name (cdr this)))
1272
(print-template (cdr template)))))
1275
(define (associate-vars-and-vals vars vals)
1276
(let ((table (make-generic-eq?-table)))
1277
(define (fill-table vars vals)
1278
(cond ((null? vars) (if (null? vals) '() (error "Mismatch")))
1279
((null? vals) (error "Mismatch"))
1280
(else (table-put! table (car vars) (car vals))
1281
(fill-table (cdr vars) (cdr vals)))))
1282
(fill-table vars vals)
1285
(declare (integrate varlist->varset nodelist->nodeset
1286
empty-nodeset singleton-nodeset
1287
empty-varset singleton-varset))
1289
(define (varlist->varset list)
1290
(declare (integrate list))
1291
(list->set variable? eq? list))
1293
(define (nodelist->nodeset list)
1294
(declare (integrate list))
1295
(list->set node? eq? list))
1297
(define (empty-nodeset)
1298
(empty-set node? eq?))
1300
(define (singleton-nodeset node)
1301
(declare (integrate node))
1302
(singleton-set node? eq? node))
1304
(define (empty-varset)
1305
(declare (integrate node))
1306
(empty-set variable? eq?))
1308
(define (singleton-varset variable)
1309
(declare (integrate variable))
1310
(singleton-set variable? eq? variable))
1312
(define (get-free-vars-in-bindings bound-variables vals)
1313
;; find variables in bindings that are scoped to these
1315
(let ((table (make-generic-eq?-table)))
1316
(define (kernel val)
1317
(let ((free-variables (free/expression val)))
1318
(table-put! table val
1319
(set/intersection bound-variables free-variables))))
1320
(for-each kernel vals)
1323
(define (get-body-free-vars bound-variables actions)
1324
(let ((body-forms (get-body actions)))
1325
(let loop ((body-forms body-forms)
1326
(free (empty-varset)))
1327
(if (null? body-forms)
1329
(loop (cdr body-forms)
1331
(set/intersection bound-variables
1333
(car body-forms)))))))))
1335
(define (get-body actions)
1336
(cond ((null? actions) '())
1337
((eq? (car actions) open-block/value-marker) (get-body (cdr actions)))
1338
(else (cons (car actions) (get-body (cdr actions))))))
1340
;;; Graph structure for figuring out dependencies in a LETREC
1342
(define-structure (node
1343
(constructor %make-node (type vars))
1346
(vars #f read-only #t)
1347
(needs (empty-nodeset))
1348
(needed-by (empty-nodeset))
1351
(define-integrable (make-base-node)
1352
(%make-node 'BASE (empty-varset)))
1354
(define-integrable (variable->node variable)
1355
(%make-node 'SETUP (singleton-varset variable)))
1357
(define-integrable (make-letrec-node variable-set)
1358
(%make-node 'LETREC variable-set))
1360
(define-integrable (add-node-need! needer what-i-need)
1361
(set-%node-needs! needer (set/adjoin (%node-needs needer) what-i-need)))
1363
(define-integrable (remove-node-need! needer what-i-no-longer-need)
1364
(set-%node-needs! needer
1365
(set/remove (%node-needs needer) what-i-no-longer-need)))
1367
(define-integrable (add-node-needed-by! needee what-needs-me)
1368
(set-%node-needed-by! needee
1369
(set/adjoin (%node-needed-by needee) what-needs-me)))
1371
(define-integrable (remove-node-needed-by! needee what-needs-me)
1372
(set-%node-needed-by! needee
1373
(set/remove (%node-needed-by needee) what-needs-me)))
1375
(define (build-graph vars table:var->vals table:vals->free body-free)
1376
(let ((table:variable->node (make-generic-eq?-table)))
1378
(define (kernel variable)
1379
(let ((node (variable->node variable)))
1380
(table-put! table:variable->node variable node)))
1382
(for-each kernel vars)
1384
(link-nodes! body-free table:var->vals table:vals->free vars
1385
table:variable->node)))
1387
(define-integrable (link-2-nodes! from-node to-node)
1388
(add-node-need! from-node to-node)
1389
(add-node-needed-by! to-node from-node))
1391
(define (unlink-node! node)
1392
(set/for-each (lambda (needer)
1393
(remove-node-needed-by! needer node))
1395
(set/for-each (lambda (needee)
1396
(remove-node-need! needee node))
1397
(%node-needed-by node))
1398
(set-%node-type! node 'UNLINKED))
1400
(define-integrable (unlink-nodes! nodelist)
1401
(for-each unlink-node! nodelist))
1403
(define (link-nodes! body-free
1404
table:var->vals table:vals->free variables table:var->node)
1406
(define (kernel variable)
1407
(table-get table:var->node variable
1409
(table-get-chain variable
1412
(lambda (needed-var)
1413
(table-get table:var->node needed-var
1414
(lambda (needed-node)
1415
(link-2-nodes! node needed-node))
1417
(error "Broken analysis: can't get node"))))
1419
(lambda () (error "Broken analysis: can't get free variable info"))
1420
table:var->vals table:vals->free))
1421
(lambda () (error "Broken analysis: no node for variable"))))
1423
(for-each kernel variables)
1425
(let ((base-node (make-base-node)))
1427
(lambda (needed-var)
1428
(table-get table:var->node needed-var
1429
(lambda (needed-node)
1430
(link-2-nodes! base-node needed-node))
1431
(lambda () (error "Broken analysis: free var"))))
1435
(define (collapse-circularities! graph)
1436
;; Search for a circularity: if found, collapse it, and repeat
1437
;; until none are found.
1439
(find-circularity graph
1441
(collapse-nodelist! nodelist)
1446
(define (find-circularity graph if-found if-not)
1447
;; Walk the tree keeping track of nodes visited
1448
;; If a node is encountered more than once, there is
1449
;; a circularitiy. NODES-VISITED is a list kept in
1450
;; base node first order. If a node is found on the
1451
;; list, the tail of the list is the nodes in the
1454
(define (fc this-node nodes-visited if-found if-not)
1455
(if (null? this-node)
1457
(let ((circularity (memq this-node nodes-visited)))
1459
(if-found circularity)
1460
;; Add this node to the visited list, and loop
1461
;; over the needs of this node.
1462
(let ((new-visited (append nodes-visited (list this-node))))
1463
(let loop ((needs (set->list (%node-needs this-node))))
1466
(fc (car needs) new-visited if-found
1467
(lambda () (loop (cdr needs)))))))))))
1469
(fc graph '() if-found if-not))
1471
(define (collapse-nodelist! nodelist)
1472
;; Replace the nodes in the nodelist with a single node that
1473
;; has all the variables in it. This node will become a LETREC
1476
;; Error check: make sure graph is consistant.
1477
(for-each (lambda (node) (if (eq? (%node-type node) 'UNLINKED)
1478
(error "node not linked")))
1481
(let ((nodeset (nodelist->nodeset nodelist)))
1482
(let ((varset (apply set/union* (map %node-vars nodelist)))
1483
(needs-set (set/difference
1484
(apply set/union* (map %node-needs nodelist))
1486
(needed-by (set/difference
1487
(apply set/union* (map %node-needed-by nodelist))
1490
(let ((letrec-node (make-letrec-node varset)))
1491
(set/for-each (lambda (need) (link-2-nodes! letrec-node need))
1494
(lambda (needer) (link-2-nodes! needer letrec-node)) needed-by)
1495
;; now delete nodes in nodelist
1496
(unlink-nodes! nodelist)))))
1498
(define (label-node-depth! graph)
1499
(define (label-nodes! nodeset depth)
1500
(if (set/empty? nodeset)
1503
(set/for-each (lambda (node) (set-%node-depth! node depth)) nodeset)
1505
(apply set/union* (map %node-needs (set->list nodeset)))
1507
(label-nodes! (singleton-nodeset graph) 0))
1510
(define (print-graph node)
1515
(display (%node-depth node))
1516
(display (%node-type node))
1517
(set/for-each (lambda (variable)
1519
(display (variable/name variable)))
1521
(set/for-each print-graph (%node-needs node)))))
1524
(define (collapse-parallel-nodelist depth nodeset)
1525
(if (set/empty? nodeset)
1527
(let loop ((nodestream (set->list nodeset))
1528
(let-children (empty-varset))
1529
(letrec-children (empty-varset))
1530
(children (empty-nodeset)))
1531
(if (null? nodestream)
1532
(let ((outer-contour
1533
(collapse-parallel-nodelist (1+ depth) children)))
1534
(append (if (set/empty? let-children)
1536
(list (cons 'LET (set->list let-children))))
1537
(if (set/empty? letrec-children)
1539
(list (cons 'LETREC (set->list letrec-children))))
1541
(let ((this-node (car nodestream)))
1542
(if (= (%node-depth this-node) (1+ depth))
1543
(if (eq? (%node-type this-node) 'LETREC)
1544
(loop (cdr nodestream)
1546
(set/union (%node-vars this-node) letrec-children)
1547
(set/union (%node-needs this-node) children))
1548
(loop (cdr nodestream)
1549
(set/union (%node-vars this-node) let-children)
1551
(set/union (%node-needs this-node) children)))
1552
;; deeper nodes will be picked up later
1553
(loop (cdr nodestream)
1558
(define (linearize graph)
1559
(collapse-parallel-nodelist 0 (%node-needs graph)))
1561
(define (build-new-code expression template parent vars->vals actions)
1562
(let ((body (sequence/optimizing-make expression (get-body actions))))
1563
(let loop ((template template)
1566
(if (null? template)
1568
(let ((this (car template)))
1569
(let ((this-type (car this))
1570
(this-vars (cdr this)))
1573
(table-get vars->vals var
1575
(lambda () (error "broken"))))
1578
(if (eq? this-type 'LET)
1579
(let ((block (block/make block #t this-vars)))
1580
(loop (cdr template)
1582
(combination/optimizing-make
1594
(let ((block (block/make block #t this-vars)))
1595
(loop (cdr template)
1598
(and expression (object/scode expression))
1599
block this-vars this-vals
1602
open-block/value-marker)
b'\\ No newline at end of file'
966
delayed-integration)))
967
(delayed-integration/value delayed-integration))
b'\\ No newline at end of file'
added
removed
src/sf/subst.scm
