Adapt visit-prompt-control-flow to use intsets.

* module/language/cps/dfg.scm (compute-reachable): Use intsets.
  (compute-interval): Adapt.
  (visit-prompt-control-flow): Adapt.

module/language/cps/dfg.scm

@@ -41,6 +41,7 @@
   #:use-module (srfi srfi-9)
   #:use-module (srfi srfi-26)
   #:use-module (language cps)
+  #:use-module (language cps intset)
   #:export (build-cont-table
             lookup-cont
 
@@ -139,24 +140,13 @@
   "Compute and return the continuations that may be reached if flow
 reaches a continuation N.  Returns a vector of bitvectors, whose first
 index corresponds to MIN-LABEL, and so on."
-  (let (;; Vector of bitvectors, indicating that continuation N can
+  (let (;; Vector of intsets, indicating that continuation N can
         ;; reach a set M...
         (reachable (make-vector label-count #f)))
 
     (define (label->idx label) (- label min-label))
 
-    ;; All continuations are reachable from themselves.
-    (let lp ((n 0))
-      (when (< n label-count)
-        (let ((bv (make-bitvector label-count #f)))
-          (bitvector-set! bv n #t)
-          (vector-set! reachable n bv)
-          (lp (1+ n)))))
-
     ;; Iterate labels backwards, to converge quickly.
-    (let ((tmp (make-bitvector label-count #f)))
-      (define (add-reachable! succ)
-        (bit-set*! tmp (vector-ref reachable (label->idx succ)) #t))
     (let lp ((label (+ min-label label-count)) (changed? #f))
       (cond
        ((= label min-label)
@@ -165,22 +155,24 @@ index corresponds to MIN-LABEL, and so on."
             reachable))
        (else
         (let* ((label (1- label))
-                 (idx (label->idx label)))
+               (idx (label->idx label))
-            (bitvector-fill! tmp #f)
+               (old (vector-ref reachable idx))
-            (visit-cont-successors
+               (new (fold (lambda (succ set)
-             (case-lambda
-               (() #t)
-               ((succ0) (add-reachable! succ0))
-               ((succ0 succ1) (add-reachable! succ0) (add-reachable! succ1)))
-             (lookup-cont label dfg))
-            (bitvector-set! tmp idx #t)
-            (bit-set*! tmp (vector-ref reachable idx) #f)
                             (cond
-             ((bit-position #t tmp 0)
+                             ((vector-ref reachable (label->idx succ))
-              (bit-set*! (vector-ref reachable idx) tmp #t)
+                              => (lambda (succ-set)
-              (lp label #t))
+                                   (intset-union set succ-set)))
+                             (else set)))
+                          (or (vector-ref reachable idx)
+                              (intset-add empty-intset label))
+                          (visit-cont-successors list
+                                                 (lookup-cont label dfg)))))
+          (cond
+           ((eq? old new)
+            (lp label changed?))
            (else
-              (lp label changed?))))))))))
+            (vector-set! reachable idx new)
+            (lp label #t)))))))))
 
 (define (find-prompts dfg min-label label-count)
   "Find the prompts in DFG between MIN-LABEL and MIN-LABEL +
@@ -201,19 +193,17 @@ pairs."
 
 (define (compute-interval reachable min-label label-count start end)
   "Compute and return the set of continuations that may be reached from
-START, inclusive, but not reached by END, exclusive.  Returns a
+START, inclusive, but not reached by END, exclusive.  Returns an
-bitvector."
+intset."
-  (let ((body (make-bitvector label-count #f)))
+  (intset-subtract (vector-ref reachable (- start min-label))
-    (bit-set*! body (vector-ref reachable (- start min-label)) #t)
+                   (vector-ref reachable (- end min-label))))
-    (bit-set*! body (vector-ref reachable (- end min-label)) #f)
-    body))
 
 (define (find-prompt-bodies dfg min-label label-count)
   "Find all the prompts in DFG from the LABEL-COUNT continuations
 starting at MIN-LABEL, and compute the set of continuations that is
 reachable from the prompt bodies but not from the corresponding handler.
-Returns a list of PROMPT, HANDLER, BODY lists, where the BODY is a
+Returns a list of PROMPT, HANDLER, BODY lists, where the BODY is an
-bitvector."
+intset."
   (match (find-prompts dfg min-label label-count)
     (() '())
     (((prompt . handler) ...)
@@ -246,7 +236,7 @@ body continuation in the prompt."
   (for-each
    (match-lambda
     ((prompt handler body)
-     (define (out-or-back-edge? n)
+     (define (out-or-back-edge? label)
        ;; Most uses of visit-prompt-control-flow don't need every body
        ;; continuation, and would be happy getting called only for
        ;; continuations that postdominate the rest of the body.  Unless
@@ -259,16 +249,15 @@ body continuation in the prompt."
        ;; not continue to the pop if it never terminates.  The pop could
        ;; even be removed by DCE, in that case.
        (or-map (lambda (succ)
-                 (let ((succ (label->idx succ)))
+                 (or (not (intset-ref body succ))
-                   (or (not (bitvector-ref body succ))
+                     (<= succ label)))
-                       (<= succ n))))
+               (lookup-successors label dfg)))
-               (lookup-successors (idx->label n) dfg)))
+     (let lp ((label min-label))
-     (let lp ((n 0))
+       (let ((label (intset-next body label)))
-       (let ((n (bit-position #t body n)))
+         (when label
-         (when n
+           (when (or complete? (out-or-back-edge? label))
-           (when (or complete? (out-or-back-edge? n))
+             (f prompt handler label))
-             (f prompt handler (idx->label n)))
+           (lp (1+ label)))))))
-           (lp (1+ n)))))))
    (find-prompt-bodies dfg min-label label-count)))
 
 (define (analyze-reverse-control-flow fun dfg min-label label-count)