Fix nested contification bugs
authorAndy Wingo <wingo@pobox.com>
Fri, 4 Oct 2013 16:03:29 +0000 (18:03 +0200)
committerAndy Wingo <wingo@pobox.com>
Fri, 4 Oct 2013 16:03:29 +0000 (18:03 +0200)
* module/language/cps/contification.scm (contify): Exhaustively replace
  contified tail continuations, to fix a bug in nested tail-recursive
  contifications.  Likewise, call lookup-return-cont when searching for
  common return continuations.

module/language/cps/contification.scm

index 469cd28..dda6ee3 100644 (file)
@@ -49,7 +49,9 @@
     (define (subst-return! old-tail new-tail)
       (set! cont-substs (acons old-tail new-tail cont-substs)))
     (define (lookup-return-cont k)
-      (or (assq-ref cont-substs k) k))
+      (match (assq-ref cont-substs k)
+        (#f k)
+        (k (lookup-return-cont k))))
 
     (define (add-pending-contifications! scope conts)
       (for-each (match-lambda
@@ -78,7 +80,8 @@
                    (((($ $arity req () #f () #f) . k) . clauses)
                     (if (= (length req) (length args))
                         (build-cps-term
-                          ($continue k ($values args)))
+                          ($continue (lookup-return-cont k)
+                            ($values args)))
                         (lp clauses)))
                    ((_ . clauses) (lp clauses)))))))
 
         (match (find-call (lookup-cont use cont-table))
           (($ $continue k ($ $call proc* args))
            (and (eq? proc proc*) (not (memq proc args)) (applicable? proc args)
-                k))
+                (lookup-return-cont k)))
           (_ #f)))
 
       (and