mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-24 12:20:20 +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

15
module/language/cps/simplify.scm
View file

@ -64,14 +64,12 @@
(match fun
(($ $fun free body)
(visit-cont body))))
(visit-fun fun)
(visit-cont fun)
table))
(define (eta-reduce fun)
(let ((table (compute-eta-reductions fun))
(dfg (match fun
(($ $fun free body)
(compute-dfg body)))))
(dfg (compute-dfg fun)))
(define (reduce* k scope values?)
(match (hashq-ref table k)
(#f k)
@ -119,7 +117,7 @@
(rewrite-cps-exp fun
(($ $fun free body)
($fun free ,(visit-cont body #f)))))
(visit-fun fun)))
(visit-cont fun #f)))
(define (compute-beta-reductions fun)
;; A continuation's body can be inlined in place of a $values
@ -127,8 +125,7 @@
;; inlined if it is used only once, and not recursively.
(let ((var-table (make-hash-table))
(k-table (make-hash-table))
(dfg (match fun
(($ $fun free body) (compute-dfg body)))))
(dfg (compute-dfg fun)))
(define (visit-cont cont)
(match cont
(($ $cont sym ($ $kargs names syms body))
@ -171,7 +168,7 @@
(match fun
(($ $fun free body)
(visit-cont body))))
(visit-fun fun)
(visit-cont fun)
(values var-table k-table)))
(define (beta-reduce fun)
@ -235,7 +232,7 @@
(rewrite-cps-exp fun
(($ $fun free body)
($fun (map subst free) ,(must-visit-cont body)))))
(visit-fun fun)))
(must-visit-cont fun)))
(define (simplify fun)
;; Renumbering prunes continuations that are made unreachable by