mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-17 09:10:22 +02:00
Code Activity

Root higher-order CPS term is always $kfun $cont

Browse source 
* module/language/cps/arities.scm:
* module/language/cps/closure-conversion.scm:
* module/language/cps/compile-bytecode.scm:
* module/language/cps/constructors.scm:
* module/language/cps/contification.scm:
* module/language/cps/cse.scm:
* module/language/cps/dce.scm:
* module/language/cps/elide-values.scm:
* module/language/cps/prune-bailouts.scm:
* module/language/cps/prune-top-level-scopes.scm:
* module/language/cps/renumber.scm:
* module/language/cps/self-references.scm:
* module/language/cps/simplify.scm:
* module/language/cps/specialize-primcalls.scm:
* module/language/tree-il/compile-cps.scm: Adapt to produce and consume
  raw $kfun $cont instances.

* .dir-locals.el: Update $letrec indentation.
This commit is contained in:
Andy Wingo 2014-04-11 14:01:27 +02:00
parent b85f5f851f
commit a0329d0109
16 changed files with 212 additions and 223 deletions
Download patch file Download diff file Expand all files Collapse all files

22
module/language/cps/elide-values.scm
View file

@ -53,8 +53,8 @@
($letk ,(map visit-cont conts)
,(visit-term body)))
(($ $letrec names syms funs body)
($letrec names syms (map (cut elide-values* <> conts) funs)
,(visit-term body)))
($letrec names syms (map visit-fun funs)
,(visit-term body)))
(($ $continue k src ($ $primcall 'values vals))
,(rewrite-cps-term (vector-ref conts k)
(($ $ktail)
@ -94,17 +94,17 @@
(build-cps-term
($continue k src ($values vals))))))))
(($ $continue k src (and fun ($ $fun)))
($continue k src ,(elide-values* fun conts)))
($continue k src ,(visit-fun fun)))
(($ $continue)
,term)))
(define (visit-fun fun)
(rewrite-cps-exp fun
(($ $fun free cont)
($fun free ,(visit-cont cont)))))
(rewrite-cps-exp fun
(($ $fun free body)
($fun free ,(visit-cont body)))))
(visit-cont fun))
(define (elide-values fun)
(match fun
(($ $fun free funk)
(with-fresh-name-state funk
(let ((conts (build-cont-table funk)))
(elide-values* fun conts))))))
(with-fresh-name-state fun
(let ((conts (build-cont-table fun)))
(elide-values* fun conts))))