compute-live-variables uses CFA analysis

* module/language/cps/dfg.scm ($dfa): Store a CFA instead of a separate
  k-map and order.
  (dfa-k-idx, dfa-k-sym, dfa-k-count): Adapt.
  (compute-live-variables): Use analyze-control-flow instead of rolling
  out own RPO numbering.  Will allow us to fix some prompt-related
  things in a central place.

diff --git a/module/language/cps/dfg.scm b/module/language/cps/dfg.scm
index 99eadab..55b589b 100644 (file)
--- a/module/language/cps/dfg.scm
+++ b/module/language/cps/dfg.scm
@@ -495,12 +495,10 @@
 
 ;; Data-flow analysis.
 (define-record-type $dfa
-  (make-dfa k-map order var-map names syms in out)
+  (make-dfa cfa var-map names syms in out)
   dfa?
-  ;; Hash table mapping k-sym -> k-idx
-  (k-map dfa-k-map)
-  ;; Vector of k-idx -> k-sym
-  (order dfa-order)
+  ;; CFA, for its reverse-post-order numbering
+  (cfa dfa-cfa)
   ;; Hash table mapping var-sym -> var-idx
   (var-map dfa-var-map)
   ;; Vector of var-idx -> name
@@ -513,14 +511,13 @@
   (out dfa-out))
 
 (define (dfa-k-idx dfa k)
-  (or (hashq-ref (dfa-k-map dfa) k)
-      (error "unknown k" k)))
+  (cfa-k-idx (dfa-cfa dfa) k))
 
 (define (dfa-k-sym dfa idx)
-  (vector-ref (dfa-order dfa) idx))
+  (cfa-k-sym (dfa-cfa dfa) idx))
 
 (define (dfa-k-count dfa)
-  (vector-length (dfa-order dfa)))
+  (cfa-k-count (dfa-cfa dfa)))
 
 (define (dfa-var-idx dfa var)
   (or (hashq-ref (dfa-var-map dfa) var)
@@ -550,74 +547,52 @@
                        (set! n (1+ n)))
                      use-maps)
       (values mapping n)))
-  (define (block-accessor blocks accessor)
-    (lambda (k)
-      (accessor (lookup-block k blocks))))
-  (define (renumbering-accessor mapping blocks accessor)
-    (lambda (k)
-      (map (cut hashq-ref mapping <>)
-           ((block-accessor blocks accessor) k))))
-  (match fun
-    (($ $fun src meta free
-        (and entry
-             ($ $cont kentry ($ $kentry self ($ $cont ktail tail)))))
-     (call-with-values (lambda () (make-variable-mapping (dfg-use-maps dfg)))
-       (lambda (var-map nvars)
-         (define (fold-all-conts f seed)
-           (fold-local-conts (lambda (k cont seed) (f k seed))
-                             seed entry))
-         (let* ((blocks (dfg-blocks dfg))
-                (order (reverse-post-order ktail
-                                           (block-accessor blocks block-preds)
-                                           fold-all-conts))
-                (k-map (make-block-mapping order))
-                (succs (convert-predecessors
-                        order
-                        (renumbering-accessor k-map blocks block-succs)))
-                (syms (make-vector nvars #f))
-                (names (make-vector nvars #f))
-                (usev (make-vector (vector-length order) '()))
-                (defv (make-vector (vector-length order) '()))
-                (live-in (make-vector (vector-length order) #f))
-                (live-out (make-vector (vector-length order) #f)))
-           (define (k->idx k)
-             (or (hashq-ref k-map k) (error "unknown k" k)))
-           ;; Initialize syms, names, defv, and usev.
-           (hash-for-each
-            (lambda (sym use-map)
-              (match use-map
-                (($ $use-map name sym def uses)
-                 (let ((v (or (hashq-ref var-map sym)
-                              (error "unknown var" sym))))
-                   (vector-set! syms v sym)
-                   (vector-set! names v name)
-                   (for-each (lambda (def)
-                               (vector-push! defv (k->idx def) v))
-                             ((block-accessor blocks block-preds) def))
-                   (for-each (lambda (use)
-                               (vector-push! usev (k->idx use) v))
-                             uses)))))
-            (dfg-use-maps dfg))
-
-           ;; Initialize live-in and live-out sets.
-           (let lp ((n 0))
-             (when (< n (vector-length live-out))
-               (vector-set! live-in n (make-bitvector nvars #f))
-               (vector-set! live-out n (make-bitvector nvars #f))
-               (lp (1+ n))))
-
-           ;; Liveness is a reverse data-flow problem, so we give
-           ;; compute-maximum-fixed-point a reversed graph, swapping in
-           ;; and out, usev and defv, using successors instead of
-           ;; predecessors, and starting with ktail instead of the
-           ;; entry.
-           (compute-maximum-fixed-point succs live-out live-in defv usev #t)
-
-           (make-dfa k-map order var-map names syms live-in live-out)))))))
+  (call-with-values (lambda () (make-variable-mapping (dfg-use-maps dfg)))
+    (lambda (var-map nvars)
+      (let* ((cfa (analyze-control-flow fun dfg #:reverse? #t))
+             (syms (make-vector nvars #f))
+             (names (make-vector nvars #f))
+             (usev (make-vector (cfa-k-count cfa) '()))
+             (defv (make-vector (cfa-k-count cfa) '()))
+             (live-in (make-vector (cfa-k-count cfa) #f))
+             (live-out (make-vector (cfa-k-count cfa) #f)))
+        ;; Initialize syms, names, defv, and usev.
+        (hash-for-each
+         (lambda (sym use-map)
+           (match use-map
+             (($ $use-map name sym def uses)
+              (let ((v (or (hashq-ref var-map sym)
+                           (error "unknown var" sym))))
+                (vector-set! syms v sym)
+                (vector-set! names v name)
+                (for-each (lambda (def)
+                            (vector-push! defv (cfa-k-idx cfa def) v))
+                          (block-preds (lookup-block def (dfg-blocks dfg))))
+                (for-each (lambda (use)
+                            (vector-push! usev (cfa-k-idx cfa use) v))
+                          uses)))))
+         (dfg-use-maps dfg))
+
+        ;; Initialize live-in and live-out sets.
+        (let lp ((n 0))
+          (when (< n (vector-length live-out))
+            (vector-set! live-in n (make-bitvector nvars #f))
+            (vector-set! live-out n (make-bitvector nvars #f))
+            (lp (1+ n))))
+
+        ;; Liveness is a reverse data-flow problem, so we give
+        ;; compute-maximum-fixed-point a reversed graph, swapping in
+        ;; for out, and usev for defv.  Note that since we are using
+        ;; a reverse CFA, cfa-preds are actually successors, and
+        ;; continuation 0 is ktail.
+        (compute-maximum-fixed-point (cfa-preds cfa)
+                                     live-out live-in defv usev #t)
+
+        (make-dfa cfa var-map names syms live-in live-out)))))
 
 (define (print-dfa dfa)
   (match dfa
-    (($ $dfa k-map order var-map names syms in out)
+    (($ $dfa cfa var-map names syms in out)
      (define (print-var-set bv)
        (let lp ((n 0))
          (let ((n (bit-position #t bv n)))
@@ -625,8 +600,8 @@
              (format #t " ~A" (vector-ref syms n))
              (lp (1+ n))))))
      (let lp ((n 0))
-       (when (< n (vector-length order))
-         (format #t "~A:\n" (vector-ref order n))
+       (when (< n (cfa-k-count cfa))
+         (format #t "~A:\n" (cfa-k-sym cfa n))
          (format #t "  in:")
          (print-var-set (vector-ref in n))
          (newline)