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:
parent
686a6490f4
commit
d3dbf75ab3
6 changed files with 14 additions and 13 deletions
|
@ -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)))
|
||||
|
|
|
@ -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))
|
||||
|
|
|
@ -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)))))
|
||||
|
|
|
@ -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))))))
|
||||
|
|
|
@ -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)))))
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue