Rename $closure to $const-fun

* module/language/cps.scm ($const-fun): Rename from $closure, as we
  always use this now with nfree == 0.
* module/language/cps/closure-conversion.scm:
* module/language/cps/compile-bytecode.scm:
* module/language/cps/contification.scm:
* module/language/cps/cse.scm:
* module/language/cps/dce.scm:
* module/language/cps/devirtualize-integers.scm:
* module/language/cps/effects-analysis.scm:
* module/language/cps/licm.scm:
* module/language/cps/peel-loops.scm:
* module/language/cps/renumber.scm:
* module/language/cps/rotate-loops.scm:
* module/language/cps/simplify.scm:
* module/language/cps/slot-allocation.scm:
* module/language/cps/specialize-numbers.scm:
* module/language/cps/types.scm:
* module/language/cps/utils.scm:
* module/language/cps/verify.scm: Adapt users.

module/language/cps.scm

@@ -130,7 +130,7 @@
             $continue $branch $prompt $throw
 
             ;; Expressions.
-            $const $prim $fun $rec $closure $code
+            $const $prim $fun $rec $const-fun $code
             $call $callk $primcall $values
 
             ;; Building macros.
@@ -188,7 +188,7 @@
 (define-cps-type $prim name)
 (define-cps-type $fun body) ; Higher-order.
 (define-cps-type $rec names syms funs) ; Higher-order.
-(define-cps-type $closure label nfree) ; First-order.
+(define-cps-type $const-fun label) ; First-order.
 (define-cps-type $code label) ; First-order.
 (define-cps-type $call proc args)
 (define-cps-type $callk k proc args) ; First-order.
@@ -243,14 +243,14 @@
 
 (define-syntax build-exp
   (syntax-rules (unquote
-                 $const $prim $fun $rec $closure $code
+                 $const $prim $fun $rec $const-fun $code
                  $call $callk $primcall $values)
     ((_ (unquote exp)) exp)
     ((_ ($const val)) (make-$const val))
     ((_ ($prim name)) (make-$prim name))
     ((_ ($fun kentry)) (make-$fun kentry))
     ((_ ($rec names gensyms funs)) (make-$rec names gensyms funs))
-    ((_ ($closure k nfree)) (make-$closure k nfree))
+    ((_ ($const-fun k)) (make-$const-fun k))
     ((_ ($code k)) (make-$code k))
     ((_ ($call proc (unquote args))) (make-$call proc args))
     ((_ ($call proc (arg ...))) (make-$call proc (list arg ...)))
@@ -313,8 +313,8 @@
      (build-exp ($prim name)))
     (('fun kbody)
      (build-exp ($fun kbody)))
-    (('closure k nfree)
+    (('const-fun k)
-     (build-exp ($closure k nfree)))
+     (build-exp ($const-fun k)))
     (('code k)
      (build-exp ($code k)))
     (('rec (name sym fun) ...)
@@ -364,8 +364,8 @@
      `(prim ,name))
     (($ $fun kbody)
      `(fun ,kbody))
-    (($ $closure k nfree)
+    (($ $const-fun k)
-     `(closure ,k ,nfree))
+     `(const-fun ,k))
     (($ $code k)
      `(code ,k))
     (($ $rec names syms funs)

module/language/cps/closure-conversion.scm

@@ -478,7 +478,7 @@ Otherwise @var{var} is bound, so @var{k} is called with @var{var}."
                (letv var*)
                (let$ body (k var*))
                (letk k* ($kargs (#f) (var*) ,body))
-               (build-term ($continue k* #f ($closure kfun 0))))))
+               (build-term ($continue k* #f ($const-fun kfun))))))
        ((intset-ref free var)
         (if (and self-known? (eqv? 1 nfree))
             ;; A reference to the one free var of a well-known function.
@@ -523,7 +523,7 @@ term."
          ;; The call sites cannot be enumerated, but the closure has no
          ;; identity; statically allocate it.
          (with-cps cps
-           (build-term ($continue k src ($closure label 0)))))
+           (build-term ($continue k src ($const-fun label)))))
         (#(#f nfree)
          ;; The call sites cannot be enumerated; allocate a closure.
          (with-cps cps
@@ -618,7 +618,7 @@ bound to @var{var}, and continue to @var{k}."
         (match (vector (well-known? kfun) (intset-count free))
           (#(#f 0)
            (with-cps cps
-             (build-term ($continue k src ($closure kfun 0)))))
+             (build-term ($continue k src ($const-fun kfun)))))
           (#(#t 0)
            (with-cps cps
              (build-term ($continue k src ($const #f)))))

module/language/cps/compile-bytecode.scm

@@ -144,7 +144,7 @@
          (maybe-mov dst (slot arg)))
         (($ $const exp)
          (emit-load-constant asm (from-sp dst) exp))
-        (($ $closure k 0)
+        (($ $const-fun k)
          (emit-load-static-procedure asm (from-sp dst) k))
         (($ $code k)
          (emit-load-label asm (from-sp dst) k))

module/language/cps/contification.scm

@@ -169,7 +169,7 @@ $call, and are always called with a compatible arity."
       (match cont
         (($ $kargs _ _ ($ $continue _ _ exp))
          (match exp
-           ((or ($ $const) ($ $prim) ($ $closure) ($ $code) ($ $fun) ($ $rec))
+           ((or ($ $const) ($ $prim) ($ $const-fun) ($ $code) ($ $fun) ($ $rec))
             functions)
            (($ $values args)
             (exclude-vars functions args))

module/language/cps/cse.scm

@@ -214,7 +214,7 @@ false.  It could be that both true and false proofs are available."
              (($ $prim name) (cons 'prim name))
              (($ $fun body) #f)
              (($ $rec names syms funs) #f)
-             (($ $closure label nfree) #f)
+             (($ $const-fun label) #f)
              (($ $code label) (cons 'code label))
              (($ $call proc args) #f)
              (($ $callk k proc args) #f)
@@ -361,7 +361,7 @@ false.  It could be that both true and false proofs are available."
 
   (define (visit-exp exp)
     (rewrite-exp exp
-      ((or ($ $const) ($ $prim) ($ $fun) ($ $rec) ($ $closure) ($ $code)) ,exp)
+      ((or ($ $const) ($ $prim) ($ $fun) ($ $rec) ($ $const-fun) ($ $code)) ,exp)
       (($ $call proc args)
        ($call (subst-var proc) ,(map subst-var args)))
       (($ $callk k proc args)

module/language/cps/dce.scm

@@ -134,7 +134,7 @@ sites."
          (values live-labels live-vars))
         (($ $fun body)
          (values (intset-add live-labels body) live-vars))
-        (($ $closure body)
+        (($ $const-fun body)
          (values (intset-add live-labels body) live-vars))
         (($ $code body)
          (values (intset-add live-labels body) live-vars))
@@ -307,7 +307,7 @@ sites."
              (($ $fun body)
               (values cps
                       term))
-             (($ $closure body nfree)
+             (($ $const-fun body)
               (values cps
                       term))
              (($ $rec names vars funs)

module/language/cps/devirtualize-integers.scm

@@ -63,7 +63,7 @@
          (match term
            (($ $continue k src exp)
             (match exp
-              ((or ($ $const) ($ $prim) ($ $fun) ($ $closure) ($ $code) ($ $rec))
+              ((or ($ $const) ($ $prim) ($ $fun) ($ $const-fun) ($ $code) ($ $rec))
                use-counts)
               (($ $values args)
                (add-uses use-counts args))

module/language/cps/effects-analysis.scm

@@ -568,11 +568,9 @@ the LABELS that are clobbered by the effects of LABEL."
 
 (define (expression-effects exp)
   (match exp
-    ((or ($ $const) ($ $prim) ($ $values) ($ $code))
+    ((or ($ $const) ($ $prim) ($ $values) ($ $code) ($ $const-fun))
      &no-effects)
-    (($ $closure _ 0)
+    ((or ($ $fun) ($ $rec))
-     &no-effects)
-    ((or ($ $fun) ($ $rec) ($ $closure))
      (&allocate &unknown-memory-kinds))
     ((or ($ $call) ($ $callk))
      &all-effects)

module/language/cps/licm.scm

@@ -67,7 +67,7 @@
                              (not (effect-clobbers? fx* fx))))
                       loop-effects #t))
      (match exp
-       ((or ($ $const) ($ $prim) ($ $closure) ($ $code)) #t)
+       ((or ($ $const) ($ $prim) ($ $const-fun) ($ $code)) #t)
        (($ $primcall name param args)
         (and-map (lambda (arg) (not (intset-ref loop-vars arg)))
                  args))

module/language/cps/peel-loops.scm

@@ -142,7 +142,7 @@
     (intmap-ref fresh-vars var (lambda (var) var)))
   (define (rename-exp exp)
     (rewrite-exp exp
-      ((or ($ $const) ($ $prim) ($ $closure) ($ $code) ($ $rec ())) ,exp)
+      ((or ($ $const) ($ $prim) ($ $const-fun) ($ $code) ($ $rec ())) ,exp)
       (($ $values args)
        ($values ,(map rename-var args)))
       (($ $call proc args)

module/language/cps/renumber.scm

@@ -141,14 +141,14 @@
       (($ $kargs names syms ($ $continue k src ($ $rec names* syms*
                                                   (($ $fun kfun) ...))))
        (fold2 visit-fun kfun labels vars))
-      (($ $kargs names syms ($ $continue k src ($ $closure kfun nfree)))
+      (($ $kargs names syms ($ $continue k src ($ $const-fun kfun)))
        ;; Closures with zero free vars get copy-propagated so it's
        ;; possible to already have visited them.
        (maybe-visit-fun kfun labels vars))
       (($ $kargs names syms ($ $continue k src ($ $code kfun)))
        (maybe-visit-fun kfun labels vars))
       (($ $kargs names syms ($ $continue k src ($ $callk kfun)))
-       ;; Well-known functions never have a $closure created for them
+       ;; Well-known functions never have a $const-fun created for them
        ;; and are only referenced by their $callk call sites.
        (maybe-visit-fun kfun labels vars))
       (_ (values labels vars))))
@@ -169,8 +169,8 @@
     (define (rename-exp exp)
       (rewrite-exp exp
         ((or ($ $const) ($ $prim)) ,exp)
-        (($ $closure k nfree)
+        (($ $const-fun k)
-         ($closure (rename-label k) nfree))
+         ($const-fun (rename-label k)))
         (($ $code k)
          ($code (rename-label k)))
         (($ $fun body)

module/language/cps/rotate-loops.scm

@@ -110,7 +110,7 @@ corresponding var from REPLACEMENTS; otherwise return VAR."
            (($ $continue k src exp)
             ($continue k src
               ,(rewrite-exp exp
-                 ((or ($ $const) ($ $prim) ($ $closure) ($ $code)) ,exp)
+                 ((or ($ $const) ($ $prim) ($ $const-fun) ($ $code)) ,exp)
                  (($ $values args)
                   ($values ,(rename* args)))
                  (($ $call proc args)

module/language/cps/simplify.scm

@@ -68,7 +68,7 @@
     (match cont
       (($ $kargs _ _ ($ $continue _ _ exp))
        (match exp
-         ((or ($ $const) ($ $prim) ($ $fun) ($ $rec) ($ $closure) ($ $code))
+         ((or ($ $const) ($ $prim) ($ $fun) ($ $rec) ($ $const-fun) ($ $code))
           (values single multiple))
          (($ $call proc args)
           (ref* (cons proc args)))
@@ -250,7 +250,7 @@
             (($ $continue k src exp)
              ($continue k src
                ,(rewrite-exp exp
-                  ((or ($ $const) ($ $prim) ($ $fun) ($ $rec) ($ $closure)
+                  ((or ($ $const) ($ $prim) ($ $fun) ($ $rec) ($ $const-fun)
                        ($ $code))
                    ,exp)
                   (($ $call proc args)

module/language/cps/slot-allocation.scm

@@ -146,7 +146,7 @@ by a label, respectively."
          (return (intset self) empty-intset))
         (($ $kargs _ _ ($ $continue k src exp))
          (match exp
-           ((or ($ $const) ($ $closure) ($ $code))
+           ((or ($ $const) ($ $const-fun) ($ $code))
             (return (get-defs k) empty-intset))
            (($ $call proc args)
             (return (get-defs k) (intset-add (vars->intset args) proc)))

module/language/cps/specialize-numbers.scm

@@ -311,7 +311,7 @@ BITS indicating the significant bits needed for a variable.  BITS may be
                  (match term
                    (($ $continue k src exp)
                     (match exp
-                      ((or ($ $const) ($ $prim) ($ $fun) ($ $closure)
+                      ((or ($ $const) ($ $prim) ($ $fun) ($ $const-fun)
                            ($ $code) ($ $rec))
                        ;; No uses, so no info added to sigbits.
                        out)

module/language/cps/types.scm

@@ -1897,7 +1897,7 @@ maximum, where type is a bitset as a fixnum."
           (let ((entry (match exp
                          (($ $const val)
                           (constant-type val))
-                         ((or ($ $prim) ($ $fun) ($ $closure) ($ $code))
+                         ((or ($ $prim) ($ $fun) ($ $const-fun) ($ $code))
                           ;; Could be more precise here.
                           (make-type-entry &procedure -inf.0 +inf.0)))))
             (propagate1 k (adjoin-var types var entry))))))))

module/language/cps/utils.scm

@@ -225,7 +225,7 @@ intset."
           (match exp
             (($ $fun label) (return1 label))
             (($ $rec _ _ (($ $fun labels) ...)) (return labels))
-            (($ $closure label nfree) (return1 label))
+            (($ $const-fun label) (return1 label))
             (($ $code label) (return1 label))
             (($ $callk label) (return1 label))
             (_ (return0))))

module/language/cps/verify.scm

@@ -143,10 +143,9 @@ definitions that are available at LABEL."
             (visit-fun kfun empty-intset (intset-add first-order kfun))))
       (match exp
         ((or ($ $const) ($ $prim)) first-order)
-        ;; todo: $closure
         (($ $fun kfun)
          (visit-fun kfun bound first-order))
-        (($ $closure kfun)
+        (($ $const-fun kfun)
          (visit-first-order kfun))
         (($ $code kfun)
          (visit-first-order kfun))
@@ -181,10 +180,9 @@ definitions that are available at LABEL."
         (($ $continue k src exp)
          (match exp
            ((or ($ $const) ($ $prim)) first-order)
-           ;; todo: $closure
            (($ $fun kfun)
             (visit-fun kfun bound first-order))
-           (($ $closure kfun)
+           (($ $const-fun kfun)
             (visit-first-order kfun))
            (($ $code kfun)
             (visit-first-order kfun))
@@ -266,7 +264,7 @@ definitions that are available at LABEL."
         ((or ($ $kreceive) ($ $ktail)) #t)
         (_ (error "expected $kreceive or $ktail continuation" cont))))
     (match exp
-      ((or ($ $const) ($ $prim) ($ $closure) ($ $code) ($ $fun))
+      ((or ($ $const) ($ $prim) ($ $const-fun) ($ $code) ($ $fun))
        (assert-unary))
       (($ $rec names vars funs)
        (unless (= (length names) (length vars) (length funs))