Rename $kentry to $kfun

[bpt/guile.git] / module / language / cps / reify-primitives.scm

diff --git a/module/language/cps/reify-primitives.scm b/module/language/cps/reify-primitives.scm
index 410a66b..3c5e5bc 100644 (file)
--- a/module/language/cps/reify-primitives.scm
+++ b/module/language/cps/reify-primitives.scm
@@ -102,7 +102,8 @@
                                  ($continue ktail #f
                                    ($call throw
                                           (wna false str eol false))))))
-                        ,(primitive-ref 'throw kthrow #f))))))))))
+                        ,(primitive-ref 'throw kthrow #f)))))
+                 ,#f)))))
 
 ;; FIXME: Operate on one function at a time, for efficiency.
 (define (reify-primitives fun)
@@ -110,19 +111,20 @@
     (let ((conts (build-cont-table fun)))
       (define (visit-fun term)
         (rewrite-cps-exp term
-          (($ $fun src meta free body)
-           ($fun src meta free ,(visit-cont body)))))
+          (($ $fun free body)
+           ($fun free ,(visit-cont body)))))
       (define (visit-cont cont)
         (rewrite-cps-cont cont
           (($ $cont sym ($ $kargs names syms body))
            (sym ($kargs names syms ,(visit-term body))))
-          (($ $cont sym ($ $kentry self (and tail ($ $cont ktail)) ()))
+          (($ $cont sym ($ $kfun src meta self (and tail ($ $cont ktail)) #f))
            ;; A case-lambda with no clauses.  Reify a clause.
-           (sym ($kentry self ,tail (,(reify-clause ktail)))))
-          (($ $cont sym ($ $kentry self tail clauses))
-           (sym ($kentry self ,tail ,(map visit-cont clauses))))
-          (($ $cont sym ($ $kclause arity body))
-           (sym ($kclause ,arity ,(visit-cont body))))
+           (sym ($kfun src meta self ,tail ,(reify-clause ktail))))
+          (($ $cont sym ($ $kfun src meta self tail clause))
+           (sym ($kfun src meta self ,tail ,(visit-cont clause))))
+          (($ $cont sym ($ $kclause arity body alternate))
+           (sym ($kclause ,arity ,(visit-cont body)
+                          ,(and alternate (visit-cont alternate)))))
           (($ $cont)
            ,cont)))
       (define (visit-term term)
@@ -132,7 +134,7 @@
           (($ $continue k src exp)
            ,(match exp
               (($ $prim name)
-               (match (lookup-cont k conts)
+               (match (vector-ref conts k)
                  (($ $kargs (_))
                   (cond
                    ((builtin-name->index name)