mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-20 11:40:18 +02:00
Code Activity

Better CPS conversion for tests in tests

Browse source 
* module/language/tree-il/compile-cps.scm (convert): Tests in tests have
  their consequents and alternates also converted in test context.
This commit is contained in:
Andy Wingo 2016-01-03 18:18:51 +01:00
parent 166703c5ce
commit fb2f7b4e5f
1 changed files with 9 additions and 2 deletions
Download patch file Download diff file Expand all files Collapse all files

11
module/language/tree-il/compile-cps.scm
View file

@ -773,7 +773,7 @@
(build-term ($continue k src ($primcall 'apply args*))))))) (build-term ($continue k src ($primcall 'apply args*)))))))
(($ <conditional> src test consequent alternate) (($ <conditional> src test consequent alternate)
(define (convert-test cps kt kf) (define (convert-test cps test kt kf)
(match test (match test
(($ <primcall> src (? branching-primitive? name) args) (($ <primcall> src (? branching-primitive? name) args)
(convert-args cps args (convert-args cps args
@ -781,6 +781,13 @@
(with-cps cps (with-cps cps
(build-term ($continue kf src (build-term ($continue kf src
($branch kt ($primcall name args)))))))) ($branch kt ($primcall name args))))))))
(($ <conditional> src test consequent alternate)
(with-cps cps
(let$ t (convert-test consequent kt kf))
(let$ f (convert-test alternate kt kf))
(letk kt* ($kargs () () ,t))
(letk kf* ($kargs () () ,f))
($ (convert-test test kt* kf*))))
(_ (convert-arg cps test (_ (convert-arg cps test
(lambda (cps test) (lambda (cps test)
(with-cps cps (with-cps cps
@ -791,7 +798,7 @@
(let$ f (convert alternate k subst)) (let$ f (convert alternate k subst))
(letk kt ($kargs () () ,t)) (letk kt ($kargs () () ,t))
(letk kf ($kargs () () ,f)) (letk kf ($kargs () () ,f))
($ (convert-test kt kf)))) ($ (convert-test test kt kf))))
(($ <lexical-set> src name gensym exp) (($ <lexical-set> src name gensym exp)
(convert-arg cps exp (convert-arg cps exp