1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-02 13:00:26 +02:00

with-fresh-name-state takes a cont, not a $fun

* module/language/cps.scm (with-fresh-name-state): Take a cont instead
  of a fun.

* module/language/cps/closure-conversion.scm:
* module/language/cps/constructors.scm:
* module/language/cps/elide-values.scm:
* module/language/cps/prune-bailouts.scm:
* module/language/cps/reify-primitives.scm: Adapt.
This commit is contained in:
Andy Wingo 2014-04-11 10:21:04 +02:00
parent 686a6490f4
commit d3dbf75ab3
6 changed files with 14 additions and 13 deletions

View file

@ -215,10 +215,7 @@
body ...))
(define-syntax-rule (with-fresh-name-state fun body ...)
(call-with-values (lambda ()
(match fun
(($ $fun free fun-k)
(compute-max-label-and-var fun-k))))
(call-with-values (lambda () (compute-max-label-and-var fun))
(lambda (max-label max-var)
(parameterize ((label-counter (1+ max-label))
(var-counter (1+ max-var)))

View file

@ -275,9 +275,9 @@ convert functions to flat closures."
(define (convert-closures exp)
"Convert free reference in @var{exp} to primcalls to @code{free-ref},
and allocate and initialize flat closures."
(with-fresh-name-state exp
(match exp
(($ $fun () body)
(match exp
(($ $fun () body)
(with-fresh-name-state body
(receive (body free) (cc body #f '())
(unless (null? free)
(error "Expected no free vars in toplevel thunk" exp body free))

View file

@ -99,5 +99,7 @@
($fun free ,(visit-cont body)))))
(define (inline-constructors fun)
(with-fresh-name-state fun
(inline-constructors* fun)))
(match fun
(($ $fun free body)
(with-fresh-name-state body
(inline-constructors* fun)))))

View file

@ -105,6 +105,6 @@
(define (elide-values fun)
(match fun
(($ $fun free funk)
(with-fresh-name-state fun
(with-fresh-name-state funk
(let ((conts (build-cont-table funk)))
(elide-values* fun conts))))))

View file

@ -95,5 +95,7 @@
,(and clause (visit-cont clause ktail))))))))
(define (prune-bailouts fun)
(with-fresh-name-state fun
(prune-bailouts* fun)))
(match fun
(($ $fun free body)
(with-fresh-name-state body
(prune-bailouts* fun)))))

View file

@ -109,7 +109,7 @@
(define (reify-primitives fun)
(match fun
(($ $fun free body)
(with-fresh-name-state fun
(with-fresh-name-state body
(let ((conts (build-cont-table body)))
(define (visit-fun term)
(rewrite-cps-exp term