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

Public make-cont-folder

Browse source 
* module/language/cps.scm (make-cont-folder): Add global? parameter, and
  make public.
  (fold-conts): Adapt.
  (fold-local-conts): Use make-cont-folder, and take a function instead
  of a continuation.

* module/language/cps/arities.scm (fix-clause-arities, fix-arities*):
* module/language/cps/compile-bytecode.scm (collect-conts):
* module/language/cps/elide-values.scm (elide-values*): Adapt to
  fold-local-conts change.
This commit is contained in:
Andy Wingo 2014-03-29 07:56:08 +01:00
parent 1eda52c8ad
commit a6f823bd02
4 changed files with 21 additions and 44 deletions
Download patch file Download diff file Expand all files Collapse all files

12
module/language/cps/arities.scm
View file

@ -32,9 +32,8 @@
#:use-module (language cps primitives)
#:export (fix-arities))
(define (fix-clause-arities clause)
(let ((conts (build-local-cont-table clause))
(ktail (match clause
(define (fix-clause-arities clause conts)
(let ((ktail (match clause
(($ $cont _ ($ $kentry _ ($ $cont ktail) _)) ktail))))
(define (visit-term term)
(rewrite-cps-term term
@ -184,9 +183,10 @@
(sym ($kentry self ,tail ,(map visit-cont clauses)))))))
(define (fix-arities* fun)
(rewrite-cps-exp fun
(($ $fun src meta free body)
($fun src meta free ,(fix-clause-arities body)))))
(let ((conts (build-local-cont-table fun)))
(rewrite-cps-exp fun
(($ $fun src meta free body)
($fun src meta free ,(fix-clause-arities body conts))))))
(define (fix-arities fun)
(with-fresh-name-state fun