Remove "free" field of $fun

* module/language/cps.scm ($fun): Remove unused "free" field.
* module/language/cps/arities.scm:
* module/language/cps/closure-conversion.scm:
* module/language/cps/constructors.scm:
* module/language/cps/contification.scm:
* module/language/cps/cse.scm:
* module/language/cps/dce.scm:
* module/language/cps/dfg.scm:
* module/language/cps/elide-values.scm:
* module/language/cps/prune-bailouts.scm:
* module/language/cps/prune-top-level-scopes.scm:
* module/language/cps/renumber.scm:
* module/language/cps/self-references.scm:
* module/language/cps/simplify.scm:
* module/language/cps/specialize-primcalls.scm:
* module/language/cps/type-fold.scm:
* module/language/cps/verify.scm:
* module/language/tree-il/compile-cps.scm: Adapt all callers.

diff --git a/module/language/cps.scm b/module/language/cps.scm
index 3e0748f..befa20f 100644 (file)
--- a/module/language/cps.scm
+++ b/module/language/cps.scm
@@ -71,7 +71,7 @@
 ;;;     That's to say that a $fun can be matched like this:
 ;;;
 ;;;     (match f
-;;;       (($ $fun free
+;;;       (($ $fun
 ;;;           ($ $cont kfun
 ;;;              ($ $kfun src meta self ($ $cont ktail ($ $ktail))
 ;;;                 ($ $kclause arity
@@ -189,7 +189,7 @@
 ;; Expressions.
 (define-cps-type $const val)
 (define-cps-type $prim name)
-(define-cps-type $fun free body) ; Higher-order.
+(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 $branch k exp)
@@ -268,7 +268,7 @@
     ((_ (unquote exp)) exp)
     ((_ ($const val)) (make-$const val))
     ((_ ($prim name)) (make-$prim name))
-    ((_ ($fun free body)) (make-$fun free (build-cps-cont body)))
+    ((_ ($fun body)) (make-$fun (build-cps-cont body)))
     ((_ ($rec names gensyms funs)) (make-$rec names gensyms funs))
     ((_ ($closure k nfree)) (make-$closure k nfree))
     ((_ ($call proc (unquote args))) (make-$call proc args))
@@ -381,8 +381,8 @@
      (build-cps-exp ($const exp)))
     (('prim name)
      (build-cps-exp ($prim name)))
-    (('fun free body)
-     (build-cps-exp ($fun free ,(parse-cps body))))
+    (('fun body)
+     (build-cps-exp ($fun ,(parse-cps body))))
     (('closure k nfree)
      (build-cps-exp ($closure k nfree)))
     (('rec (name sym fun) ...)
@@ -439,8 +439,8 @@
      `(const ,val))
     (($ $prim name)
      `(prim ,name))
-    (($ $fun free body)
-     `(fun ,free ,(unparse-cps body)))
+    (($ $fun body)
+     `(fun ,(unparse-cps body)))
     (($ $closure k nfree)
      `(closure ,k ,nfree))
     (($ $rec names syms funs)
@@ -490,7 +490,7 @@
 
     (define (fun-folder fun seed ...)
       (match fun
-        (($ $fun free body)
+        (($ $fun body)
          (cont-folder body seed ...))))
 
     (define (term-folder term seed ...)

diff --git a/module/language/cps/arities.scm b/module/language/cps/arities.scm
index 7448eb0..fa7cc14 100644 (file)
--- a/module/language/cps/arities.scm
+++ b/module/language/cps/arities.scm
@@ -133,16 +133,16 @@
              ($ $prim)
              ($ $values (_)))
          ,(adapt-exp 1 k src exp))
-        (($ $fun free body)
+        (($ $fun body)
          ,(adapt-exp 1 k src (build-cps-exp
-                               ($fun free ,(fix-arities* body dfg)))))
+                               ($fun ,(fix-arities* body dfg)))))
         (($ $rec names syms funs)
          ;; Assume $rec expressions have the correct arity.
          ($continue k src
            ($rec names syms (map (lambda (fun)
                                    (rewrite-cps-exp fun
-                                     (($ $fun free body)
-                                      ($fun free ,(fix-arities* body dfg)))))
+                                     (($ $fun body)
+                                      ($fun ,(fix-arities* body dfg)))))
                                  funs))))
         ((or ($ $call) ($ $callk))
          ;; In general, calls have unknown return arity.  For that

diff --git a/module/language/cps/closure-conversion.scm b/module/language/cps/closure-conversion.scm
index 8848e07..49ff30f 100644 (file)
--- a/module/language/cps/closure-conversion.scm
+++ b/module/language/cps/closure-conversion.scm
@@ -99,14 +99,14 @@
                  (union (visit-cont cont bound) free))
                (visit-term body bound)
                conts))
-        (($ $continue k src ($ $fun () body))
+        (($ $continue k src ($ $fun body))
          (match (lookup-predecessors k dfg)
            ((_) (match (lookup-cont k dfg)
                   (($ $kargs (name) (var))
                    (add-named-fun! var body))))
            (_ #f))
          (visit-cont body bound))
-        (($ $continue k src ($ $rec names vars (($ $fun () cont) ...)))
+        (($ $continue k src ($ $rec names vars (($ $fun cont) ...)))
          (hashq-set! letrec-conts k (lookup-cont k dfg))
          (let ((bound (append vars bound)))
            (for-each add-named-fun! vars cont)
@@ -443,7 +443,7 @@ bound to @var{var}, and continue with @var{body}."
         (($ $continue k src (or ($ $const) ($ $prim)))
          term)
 
-        (($ $continue k src ($ $fun () ($ $cont kfun)))
+        (($ $continue k src ($ $fun ($ $cont kfun)))
          (let ((fun-free (hashq-ref free-vars kfun)))
            (match (cons (well-known? kfun) fun-free)
              ((known?)
@@ -479,7 +479,7 @@ bound to @var{var}, and continue with @var{body}."
                            (visit-term body)))))
            (match in
              (() (bindings body))
-             (((name var ($ $fun ()
+             (((name var ($ $fun
                             (and fun-body
                                  ($ $cont kfun ($ $kfun src))))) . in)
               (let ((fun-free (hashq-ref free-vars kfun)))

diff --git a/module/language/cps/constructors.scm b/module/language/cps/constructors.scm
index 1416f17..bbe779d 100644 (file)
--- a/module/language/cps/constructors.scm
+++ b/module/language/cps/constructors.scm
@@ -94,8 +94,8 @@
        ,term)))
   (define (visit-fun fun)
     (rewrite-cps-exp fun
-      (($ $fun free body)
-       ($fun free ,(inline-constructors* body)))))
+      (($ $fun body)
+       ($fun ,(inline-constructors* body)))))
 
   (visit-cont fun))
 

diff --git a/module/language/cps/contification.scm b/module/language/cps/contification.scm
index 88bc097..1f70231 100644 (file)
--- a/module/language/cps/contification.scm
+++ b/module/language/cps/contification.scm
@@ -216,7 +216,7 @@
 
     (define (visit-fun term)
       (match term
-        (($ $fun free body)
+        (($ $fun body)
          (visit-cont body))))
     (define (visit-cont cont)
       (match cont
@@ -236,7 +236,7 @@
          (visit-term body term-k))
         (($ $continue k src exp)
          (match exp
-           (($ $fun free
+           (($ $fun
                ($ $cont fun-k
                   ($ $kfun src meta self ($ $cont tail-k ($ $ktail)) clause)))
             (if (and=> (bound-symbol k)
@@ -261,7 +261,7 @@
                    (if (null? rec)
                        '()
                        (list rec)))
-                  (((and elt (n s ($ $fun free ($ $cont kfun))))
+                  (((and elt (n s ($ $fun ($ $cont kfun))))
                     . nsf)
                    (if (recursive? kfun)
                        (lp nsf (cons elt rec))
@@ -273,7 +273,7 @@
               (match component
                 (((name sym fun) ...)
                  (match fun
-                   ((($ $fun free
+                   ((($ $fun
                         ($ $cont fun-k
                            ($ $kfun src meta self ($ $cont tail-k ($ $ktail))
                               clause)))
@@ -342,8 +342,8 @@
               ,body)))))))
   (define (visit-fun term)
     (rewrite-cps-exp term
-      (($ $fun free body)
-       ($fun free ,(visit-cont body)))))
+      (($ $fun body)
+       ($fun ,(visit-cont body)))))
   (define (visit-cont cont)
     (rewrite-cps-cont cont
       (($ $cont label ($ $kargs names syms body))
@@ -381,7 +381,7 @@
        (splice-continuations
         term-k
         (match exp
-          (($ $fun free 
+          (($ $fun 
               ($ $cont fun-k ($ $kfun src meta self ($ $cont tail-k))))
            ;; If the function's tail continuation has been substituted,
            ;; that means it has been contified.

diff --git a/module/language/cps/cse.scm b/module/language/cps/cse.scm
index 3534596..c8a57ca 100644 (file)
--- a/module/language/cps/cse.scm
+++ b/module/language/cps/cse.scm
@@ -287,7 +287,7 @@ could be that both true and false proofs are available."
         (match exp
           (($ $const val) (cons 'const val))
           (($ $prim name) (cons 'prim name))
-          (($ $fun free body) #f)
+          (($ $fun body) #f)
           (($ $rec names syms funs) #f)
           (($ $call proc args) #f)
           (($ $callk k proc args) #f)
@@ -469,8 +469,8 @@ could be that both true and false proofs are available."
 
     (define (visit-fun fun)
       (rewrite-cps-exp fun
-        (($ $fun free body)
-         ($fun (map subst-var free) ,(cse body dfg)))))
+        (($ $fun body)
+         ($fun ,(cse body dfg)))))
 
     (define (visit-exp* k src exp)
       (match exp

diff --git a/module/language/cps/dce.scm b/module/language/cps/dce.scm
index 0be9d61..34ffc3a 100644 (file)
--- a/module/language/cps/dce.scm
+++ b/module/language/cps/dce.scm
@@ -199,13 +199,13 @@
                          (match exp
                            ((or ($ $const) ($ $prim))
                             #f)
-                           (($ $fun free body)
+                           (($ $fun body)
                             (visit-fun body))
                            (($ $rec names syms funs)
                             (for-each (lambda (sym fun)
                                         (when (value-live? sym)
                                           (match fun
-                                            (($ $fun free body)
+                                            (($ $fun body)
                                              (visit-fun body)))))
                                       syms funs))
                            (($ $prompt escape? tag handler)
@@ -320,20 +320,20 @@
            (($ $continue k src exp)
             (if (bitvector-ref live-conts (label->idx term-k))
                 (match exp
-                  (($ $fun free body)
+                  (($ $fun body)
                    (build-cps-term
-                     ($continue k src ($fun free ,(visit-fun body)))))
+                     ($continue k src ($fun ,(visit-fun body)))))
                   (($ $rec names syms funs)
                    (rewrite-cps-term
                        (filter-map
                         (lambda (name sym fun)
                           (and (value-live? sym)
                                (match fun
-                                 (($ $fun free body)
+                                 (($ $fun body)
                                   (list name
                                         sym
                                         (build-cps-exp
-                                          ($fun free ,(visit-fun body))))))))
+                                          ($fun ,(visit-fun body))))))))
                         names syms funs)
                      (()
                       ($continue k src ($values ())))

diff --git a/module/language/cps/dfg.scm b/module/language/cps/dfg.scm
index 6cba764..22bc159 100644 (file)
--- a/module/language/cps/dfg.scm
+++ b/module/language/cps/dfg.scm
@@ -660,7 +660,7 @@ body continuation in the prompt."
             (($ $prompt escape? tag handler)
              (use! tag)
              (link-blocks! label handler))
-            (($ $fun free body)
+            (($ $fun body)
              (when global?
                (visit-fun body)))
             (($ $rec names syms funs)
@@ -668,7 +668,7 @@ body continuation in the prompt."
                (error "$rec should not be present when building a local DFG"))
              (for-each (lambda (fun)
                          (match fun
-                           (($ $fun free body)
+                           (($ $fun body)
                             (visit-fun body))))
                        funs))))
 
@@ -748,7 +748,7 @@ body continuation in the prompt."
                   (match exp
                     (($ $const val) (format port "const ~@y" val))
                     (($ $prim name) (format port "prim ~a" name))
-                    (($ $fun free ($ $cont kbody)) (format port "fun k~a" kbody))
+                    (($ $fun ($ $cont kbody)) (format port "fun k~a" kbody))
                     (($ $rec names syms funs) (format port "rec~{ v~a~}" syms))
                     (($ $closure label nfree) (format port "closure k~a (~a free)" label nfree))
                     (($ $call proc args) (format port "call~{ v~a~}" (cons proc args)))

diff --git a/module/language/cps/elide-values.scm b/module/language/cps/elide-values.scm
index 100ad1f..dadbd40 100644 (file)
--- a/module/language/cps/elide-values.scm
+++ b/module/language/cps/elide-values.scm
@@ -98,8 +98,8 @@
        ,term)))
   (define (visit-fun fun)
     (rewrite-cps-exp fun
-      (($ $fun free cont)
-       ($fun free ,(visit-cont cont)))))
+      (($ $fun cont)
+       ($fun ,(visit-cont cont)))))
 
   (visit-cont fun))
 

diff --git a/module/language/cps/prune-bailouts.scm b/module/language/cps/prune-bailouts.scm
index cc0c08b..c224f45 100644 (file)
--- a/module/language/cps/prune-bailouts.scm
+++ b/module/language/cps/prune-bailouts.scm
@@ -87,8 +87,8 @@
 
   (define (visit-fun fun)
     (rewrite-cps-exp fun
-      (($ $fun free body)
-       ($fun free ,(prune-bailouts* body)))))
+      (($ $fun body)
+       ($fun ,(prune-bailouts* body)))))
 
   (rewrite-cps-cont fun
     (($ $cont kfun

diff --git a/module/language/cps/prune-top-level-scopes.scm b/module/language/cps/prune-top-level-scopes.scm
index f300db4..4839b71 100644 (file)
--- a/module/language/cps/prune-top-level-scopes.scm
+++ b/module/language/cps/prune-top-level-scopes.scm
@@ -81,7 +81,7 @@
            (_ #t)))))
     (define (visit-fun fun)
       (match fun
-        (($ $fun free body)
+        (($ $fun body)
          (visit-cont body))))
 
     (visit-cont fun)

diff --git a/module/language/cps/renumber.scm b/module/language/cps/renumber.scm
index 58968a7..8a1c7a0 100644 (file)
--- a/module/language/cps/renumber.scm
+++ b/module/language/cps/renumber.scm
@@ -219,14 +219,14 @@
               (($ $letk conts body)
                (for-each visit-cont conts)
                (visit-term body reachable?))
-              (($ $continue k src ($ $fun free body))
+              (($ $continue k src ($ $fun body))
                (when reachable?
                  (set! queue (cons body queue))))
               (($ $continue k src ($ $rec names syms funs))
                (when reachable?
                  (set! queue (fold (lambda (fun queue)
                                      (match fun
-                                       (($ $fun free body)
+                                       (($ $fun body)
                                         (cons body queue))))
                                    queue
                                    funs))))
@@ -327,8 +327,8 @@
          ($prompt escape? (rename tag) (relabel handler))))))
   (define (visit-fun fun)
     (rewrite-cps-exp fun
-      (($ $fun free body)
-       ($fun (map rename free) ,(must-visit-cont body)))))
+      (($ $fun body)
+       ($fun ,(must-visit-cont body)))))
 
   (match term
     (($ $cont)

diff --git a/module/language/cps/self-references.scm b/module/language/cps/self-references.scm
index 6cf2545..45e2389 100644 (file)
--- a/module/language/cps/self-references.scm
+++ b/module/language/cps/self-references.scm
@@ -54,8 +54,8 @@
   (define (visit-exp exp)
     (rewrite-cps-exp exp
       ((or ($ $const) ($ $prim)) ,exp)
-      (($ $fun free body)
-       ($fun free ,(resolve-self-references body env)))
+      (($ $fun body)
+       ($fun ,(resolve-self-references body env)))
       (($ $rec names vars funs)
        ($rec names vars (map visit-recursive-fun funs vars)))
       (($ $call proc args)
@@ -73,7 +73,7 @@
 
   (define (visit-recursive-fun fun var)
     (rewrite-cps-exp fun
-      (($ $fun free (and cont ($ $cont _ ($ $kfun src meta self))))
-       ($fun free ,(resolve-self-references cont (acons var self env))))))
+      (($ $fun (and cont ($ $cont _ ($ $kfun src meta self))))
+       ($fun ,(resolve-self-references cont (acons var self env))))))
 
   (visit-cont fun))

diff --git a/module/language/cps/simplify.scm b/module/language/cps/simplify.scm
index 8f3b630..10e9d0a 100644 (file)
--- a/module/language/cps/simplify.scm
+++ b/module/language/cps/simplify.scm
@@ -61,7 +61,7 @@
          #f)))
     (define (visit-fun fun)
       (match fun
-        (($ $fun free body)
+        (($ $fun body)
          (visit-cont body))))
     (visit-cont fun)
     table))
@@ -139,8 +139,8 @@
          ($continue (reduce k scope) src ,exp))))
     (define (visit-fun fun)
       (rewrite-cps-exp fun
-        (($ $fun free body)
-         ($fun free ,(visit-cont body #f)))))
+        (($ $fun body)
+         ($fun ,(visit-cont body #f)))))
     (visit-cont fun #f)))
 
 (define (compute-beta-reductions fun)
@@ -189,7 +189,7 @@
          #f)))
     (define (visit-fun fun)
       (match fun
-        (($ $fun free body)
+        (($ $fun body)
          (visit-cont body))))
     (visit-cont fun)
     (values var-table k-table)))
@@ -253,8 +253,8 @@
          (build-cps-exp ($prompt escape? (subst tag) handler)))))
     (define (visit-fun fun)
       (rewrite-cps-exp fun
-        (($ $fun free body)
-         ($fun (map subst free) ,(must-visit-cont body)))))
+        (($ $fun body)
+         ($fun ,(must-visit-cont body)))))
     (must-visit-cont fun)))
 
 ;; Rewrite the scope tree to reflect the dominator tree.  Precondition:
@@ -281,12 +281,12 @@
 
     (define (visit-fun fun)
       (rewrite-cps-exp fun
-        (($ $fun free body)
-         ($fun free ,(visit-fun-cont body)))))
+        (($ $fun body)
+         ($fun ,(visit-fun-cont body)))))
 
     (define (visit-exp k src exp)
       (rewrite-cps-term exp
-        (($ $fun free body)
+        (($ $fun body)
          ($continue k src ,(visit-fun exp)))
         (($ $rec names syms funs)
          ($continue k src ($rec names syms (map visit-fun funs))))

diff --git a/module/language/cps/specialize-primcalls.scm b/module/language/cps/specialize-primcalls.scm
index 3a840dd..e5b76fb 100644 (file)
--- a/module/language/cps/specialize-primcalls.scm
+++ b/module/language/cps/specialize-primcalls.scm
@@ -101,7 +101,7 @@
 
       (define (visit-fun fun)
         (rewrite-cps-exp fun
-          (($ $fun free body)
-           ($fun free ,(visit-cont body)))))
+          (($ $fun body)
+           ($fun ,(visit-cont body)))))
 
       (visit-cont fun))))

diff --git a/module/language/cps/type-fold.scm b/module/language/cps/type-fold.scm
index c13f7fb..ba66ec3 100644 (file)
--- a/module/language/cps/type-fold.scm
+++ b/module/language/cps/type-fold.scm
@@ -430,8 +430,8 @@
              (_ ,term)))
          (define (visit-fun fun)
            (rewrite-cps-exp fun
-             (($ $fun free body)
-              ($fun free ,(fold-constants* body dfg)))))
+             (($ $fun body)
+              ($fun ,(fold-constants* body dfg)))))
          (rewrite-cps-cont fun
            (($ $cont kfun ($ $kfun src meta self tail clause))
             (kfun ($kfun src meta self ,tail ,(visit-cont clause))))))))))

diff --git a/module/language/cps/verify.scm b/module/language/cps/verify.scm
index e10cf83..6c23107 100644 (file)
--- a/module/language/cps/verify.scm
+++ b/module/language/cps/verify.scm
@@ -127,8 +127,7 @@
 
   (define (visit-fun fun k-env v-env)
     (match fun
-      (($ $fun (free ...) entry)
-       (for-each (cut check-var <> v-env) free)
+      (($ $fun entry)
        (visit-entry entry '() v-env))
       (_
        (error "unexpected $fun" fun))))

diff --git a/module/language/tree-il/compile-cps.scm b/module/language/tree-il/compile-cps.scm
index 65bec09..4e515f7 100644 (file)
--- a/module/language/tree-il/compile-cps.scm
+++ b/module/language/tree-il/compile-cps.scm
@@ -296,7 +296,7 @@
            (let-fresh (kfun ktail) (self)
              (build-cps-term
                ($continue k fun-src
-                 ($fun '()
+                 ($fun
                    (kfun ($kfun fun-src meta self (ktail ($ktail))
                              ,(convert-clauses body ktail)))))))
            (let ((scope-id (fresh-scope-id)))