Add with-fresh-name-state-from-dfg

* module/language/cps/dfg.scm (with-fresh-name-state-from-dfg): New
  helper.
  ($dfg, compute-dfg): Store max-var and max-label in the dfg.

* module/language/cps.scm (with-fresh-name-state): Don't raise an error
  on recursive invocation; that was mostly useful when finding a bug.

* module/language/cps/arities.scm (fix-arities):
* module/language/cps/specialize-primcalls.scm (specialize-primcalls):
  Use the new helper.

* .dir-locals.el: Update.

.dir-locals.el

@@ -14,6 +14,7 @@
      (eval . (put 'let-gensyms         'scheme-indent-function 1))
      (eval . (put 'let-fresh           'scheme-indent-function 2))
      (eval . (put 'with-fresh-name-state 'scheme-indent-function 1))
+     (eval . (put 'with-fresh-name-state-from-dfg 'scheme-indent-function 1))
      (eval . (put 'build-cps-term      'scheme-indent-function 0))
      (eval . (put 'build-cps-exp       'scheme-indent-function 0))
      (eval . (put 'build-cps-cont      'scheme-indent-function 0))

module/language/cps.scm

@@ -215,15 +215,12 @@
     body ...))
 
 (define-syntax-rule (with-fresh-name-state fun body ...)
-  (begin
+  (call-with-values (lambda ()
-    (when (or (label-counter) (var-counter))
+                      (compute-max-label-and-var fun))
-      (error "with-fresh-name-state should not be called recursively"))
+    (lambda (max-label max-var)
-    (call-with-values (lambda ()
+      (parameterize ((label-counter (1+ max-label))
-                        (compute-max-label-and-var fun))
+                     (var-counter (1+ max-var)))
-      (lambda (max-label max-var)
+        body ...))))
-        (parameterize ((label-counter (1+ max-label))
-                       (var-counter (1+ max-var)))
-          body ...)))))
 
 (define-syntax build-arity
   (syntax-rules (unquote)

module/language/cps/arities.scm

@@ -190,5 +190,6 @@
      ($fun src meta free ,(fix-clause-arities body dfg)))))
 
 (define (fix-arities fun)
-  (with-fresh-name-state fun
+  (let ((dfg (compute-dfg fun)))
-    (fix-arities* fun (compute-dfg fun))))
+    (with-fresh-name-state-from-dfg dfg
+      (fix-arities* fun dfg))))

module/language/cps/dfg.scm

@@ -49,6 +49,7 @@
             dfg-label-count
             dfg-min-var
             dfg-var-count
+            with-fresh-name-state-from-dfg
             lookup-def
             lookup-uses
             lookup-predecessors
@@ -102,7 +103,8 @@
 ;; Data-flow graph for CPS: both for values and continuations.
 (define-record-type $dfg
   (make-dfg conts preds defs uses scopes scope-levels
-            min-label label-count min-var var-count)
+            min-label max-label label-count
+            min-var max-var var-count)
   dfg?
   ;; vector of label -> $kif, $kargs, etc
   (conts dfg-cont-table)
@@ -118,8 +120,11 @@
   (scope-levels dfg-scope-levels)
 
   (min-label dfg-min-label)
+  (max-label dfg-max-label)
   (label-count dfg-label-count)
+
   (min-var dfg-min-var)
+  (max-var dfg-max-var)
   (var-count dfg-var-count))
 
 (define-inlinable (vector-push! vec idx val)
@@ -905,7 +910,13 @@ body continuation in the prompt."
         (visit-fun fun conts preds defs uses scopes scope-levels
                    min-label min-var global?)
         (make-dfg conts preds defs uses scopes scope-levels
-                  min-label label-count min-var var-count)))))
+                  min-label max-label label-count
+                  min-var max-var var-count)))))
+
+(define-syntax-rule (with-fresh-name-state-from-dfg dfg body ...)
+  (parameterize ((label-counter (1+ (dfg-max-label dfg)))
+                 (var-counter (1+ (dfg-max-var dfg))))
+    body ...))
 
 (define (lookup-cont label dfg)
   (let ((res (vector-ref (dfg-cont-table dfg) (- label (dfg-min-label dfg)))))

module/language/cps/specialize-primcalls.scm

@@ -31,8 +31,8 @@
   #:export (specialize-primcalls))
 
 (define (specialize-primcalls fun)
-  (with-fresh-name-state fun
+  (let ((dfg (compute-dfg fun #:global? #t)))
-    (let ((dfg (compute-dfg fun #:global? #t)))
+    (with-fresh-name-state-from-dfg dfg
       (define (immediate-u8? sym)
         (call-with-values (lambda () (find-constant-value sym dfg))
           (lambda (has-const? val)