Source information goes on the $continue, not the $cont.

[bpt/guile.git] / module / language / cps / slot-allocation.scm

diff --git a/module/language/cps/slot-allocation.scm b/module/language/cps/slot-allocation.scm
index ddc3751..580d0f9 100644 (file)
--- a/module/language/cps/slot-allocation.scm
+++ b/module/language/cps/slot-allocation.scm
@@ -198,7 +198,7 @@ are comparable with eqv?.  A tmp slot may be used."
   (let ((l (dfa-k-idx dfa use-k)))
     (not (bitvector-ref (dfa-k-out dfa l) v-idx))))
 
-(define (allocate-slots fun)
+(define (allocate-slots fun dfg)
   (define (empty-live-slots)
     #b0)
 
@@ -231,11 +231,11 @@ are comparable with eqv?.  A tmp slot may be used."
                         live-slots)))
               live-slots)))))
 
-  (define (visit-clause clause dfg dfa allocation slots live-slots)
+  (define (visit-clause clause dfa allocation slots live-slots)
     (define nlocals (compute-slot live-slots #f))
     (define nargs
       (match clause
-        (($ $cont _ _ ($ $kclause _ ($ $cont _ _ ($ $kargs names syms))))
+        (($ $cont _ ($ $kclause _ ($ $cont _ ($ $kargs names syms))))
          (length syms))))
 
     (define (allocate! sym k hint live-slots)
@@ -310,7 +310,7 @@ are comparable with eqv?.  A tmp slot may be used."
             live-slots))
 
       (match cont
-        (($ $kclause arity ($ $cont k src body))
+        (($ $kclause arity ($ $cont k body))
          (visit-cont body k live-slots))
 
         (($ $kargs names syms body)
@@ -328,12 +328,12 @@ are comparable with eqv?.  A tmp slot may be used."
         (($ $letk conts body)
          (let ((live-slots (visit-term body label live-slots)))
            (for-each (match-lambda
-                      (($ $cont k src cont)
+                      (($ $cont k cont)
                        (visit-cont cont k live-slots)))
                      conts))
          live-slots)
 
-        (($ $continue k exp)
+        (($ $continue k src exp)
          (visit-exp exp label k live-slots))))
 
     (define (visit-exp exp label k live-slots)
@@ -420,19 +420,18 @@ are comparable with eqv?.  A tmp slot may be used."
         (_ live-slots)))
 
     (match clause
-      (($ $cont k _ body)
+      (($ $cont k body)
        (visit-cont body k live-slots)
        (hashq-set! allocation k nlocals))))
 
   (match fun
-    (($ $fun meta free ($ $cont k _ ($ $kentry self tail clauses)))
-     (let* ((dfg (compute-dfg fun #:global? #f))
-            (dfa (compute-live-variables fun dfg))
+    (($ $fun src meta free ($ $cont k ($ $kentry self tail clauses)))
+     (let* ((dfa (compute-live-variables fun dfg))
             (allocation (make-hash-table))
             (slots (make-vector (dfa-var-count dfa) #f))
             (live-slots (add-live-slot 0 (empty-live-slots))))
        (vector-set! slots (dfa-var-idx dfa self) 0)
        (hashq-set! allocation self (make-allocation 0 #f #f))
-       (for-each (cut visit-clause <> dfg dfa allocation slots live-slots)
+       (for-each (cut visit-clause <> dfa allocation slots live-slots)
                  clauses)
        allocation))))