mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-12 06:41:13 +02:00
Code Activity

CPS2 renumber works with first-order CPS

Browse source 
* module/language/cps2/renumber.scm (compute-renaming): Add support for
  $closure and $callk.
This commit is contained in:
Andy Wingo 2015-07-14 13:53:56 +02:00
parent dc27708f0b
commit a15a14203e
1 changed files with 12 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

12
module/language/cps2/renumber.scm
View file

@ -128,6 +128,10 @@
(($ $kfun src meta self tail clause) (($ $kfun src meta self tail clause)
(rename-var self vars)) (rename-var self vars))
(_ vars)))) (_ vars))))
(define (maybe-visit-fun kfun labels vars)
(if (intmap-ref labels kfun (lambda (_) #f))
(values labels vars)
(visit-fun kfun labels vars)))
(define (visit-nested-funs k labels vars) (define (visit-nested-funs k labels vars)
(match (intmap-ref conts k) (match (intmap-ref conts k)
(($ $kargs names syms ($ $continue k src ($ $fun kfun))) (($ $kargs names syms ($ $continue k src ($ $fun kfun)))
@ -135,6 +139,14 @@
(($ $kargs names syms ($ $continue k src ($ $rec names* syms* (($ $kargs names syms ($ $continue k src ($ $rec names* syms*
(($ $fun kfun) ...)))) (($ $fun kfun) ...))))
(fold2 visit-fun kfun labels vars)) (fold2 visit-fun kfun labels vars))
(($ $kargs names syms ($ $continue k src ($ $closure kfun nfree)))
;; Closures with zero free vars get copy-propagated so it's
;; possible to already have visited them.
(maybe-visit-fun kfun labels vars))
(($ $kargs names syms ($ $continue k src ($ $callk kfun)))
;; Well-known functions never have a $closure created for them
;; and are only referenced by their $callk call sites.
(maybe-visit-fun kfun labels vars))
(_ (values labels vars)))) (_ (values labels vars))))
(define (visit-fun kfun labels vars) (define (visit-fun kfun labels vars)
(let* ((preds (compute-predecessors conts kfun)) (let* ((preds (compute-predecessors conts kfun))