with-fresh-name-state takes a cont, not a $fun

* module/language/cps.scm (with-fresh-name-state): Take a cont instead
  of a fun.

* module/language/cps/closure-conversion.scm:
* module/language/cps/constructors.scm:
* module/language/cps/elide-values.scm:
* module/language/cps/prune-bailouts.scm:
* module/language/cps/reify-primitives.scm: Adapt.

module/language/cps.scm

@@ -215,10 +215,7 @@
     body ...))
 
 (define-syntax-rule (with-fresh-name-state fun body ...)
-  (call-with-values (lambda ()
+  (call-with-values (lambda () (compute-max-label-and-var fun))
-                      (match fun
-                        (($ $fun free fun-k)
-                         (compute-max-label-and-var fun-k))))
     (lambda (max-label max-var)
       (parameterize ((label-counter (1+ max-label))
                      (var-counter (1+ max-var)))

module/language/cps/closure-conversion.scm

@@ -275,9 +275,9 @@ convert functions to flat closures."
 (define (convert-closures exp)
   "Convert free reference in @var{exp} to primcalls to @code{free-ref},
 and allocate and initialize flat closures."
-  (with-fresh-name-state exp
+  (match exp
-    (match exp
+    (($ $fun () body)
-      (($ $fun () body)
+     (with-fresh-name-state body
        (receive (body free) (cc body #f '())
          (unless (null? free)
            (error "Expected no free vars in toplevel thunk" exp body free))

module/language/cps/constructors.scm

@@ -99,5 +99,7 @@
      ($fun free ,(visit-cont body)))))
 
 (define (inline-constructors fun)
-  (with-fresh-name-state fun
+  (match fun
-    (inline-constructors* fun)))
+    (($ $fun free body)
+     (with-fresh-name-state body
+       (inline-constructors* fun)))))

module/language/cps/elide-values.scm

@@ -105,6 +105,6 @@
 (define (elide-values fun)
   (match fun
     (($ $fun free funk)
-     (with-fresh-name-state fun
+     (with-fresh-name-state funk
        (let ((conts (build-cont-table funk)))
          (elide-values* fun conts))))))

module/language/cps/prune-bailouts.scm

@@ -95,5 +95,7 @@
                      ,(and clause (visit-cont clause ktail))))))))
 
 (define (prune-bailouts fun)
-  (with-fresh-name-state fun
+  (match fun
-    (prune-bailouts* fun)))
+    (($ $fun free body)
+     (with-fresh-name-state body
+       (prune-bailouts* fun)))))

module/language/cps/reify-primitives.scm

@@ -109,7 +109,7 @@
 (define (reify-primitives fun)
   (match fun
     (($ $fun free body)
-     (with-fresh-name-state fun
+     (with-fresh-name-state body
        (let ((conts (build-cont-table body)))
          (define (visit-fun term)
            (rewrite-cps-exp term