reorder $cont's k and src fields

* module/language/cps.scm ($cont): Reorder the "k" and "src" fields.
  (build-cps-cont): Adapt.  Happily this is the one make-$cont use site.

* module/language/cps.scm:
* module/language/cps/arities.scm:
* module/language/cps/closure-conversion.scm:
* module/language/cps/compile-rtl.scm:
* module/language/cps/dfg.scm:
* module/language/cps/reify-primitives.scm:
* module/language/cps/slot-allocation.scm:
* module/language/cps/verify.scm: Adapt pattern matchers.

8 files changed, 31 insertions, 31 deletions

diff --git a/module/language/cps.scm b/module/language/cps.scm
index 49cdea2c9..562d07068 100644
--- a/module/language/cps.scm
+++ b/module/language/cps.scm
@@ -113,7 +113,7 @@
 
 ;; Continuations.
 (define-cps-type $letk conts body)
-(define-cps-type $cont src k cont)
+(define-cps-type $cont k src cont)
 (define-cps-type $kif kt kf)
 (define-cps-type $ktrunc arity k)
 (define-cps-type $kargs names syms body)
@@ -175,7 +175,7 @@
 (define-syntax build-cps-cont
   (syntax-rules (unquote)
     ((_ (unquote exp)) exp)
-    ((_ (k src cont)) (make-$cont src k (build-cont-body cont)))))
+    ((_ (k src cont)) (make-$cont k src (build-cont-body cont)))))
 
 (define-syntax build-cps-call
   (syntax-rules (unquote
@@ -294,12 +294,12 @@
 (define (unparse-cps exp)
   (match exp
     ;; Continuations.
-    (($ $letk (($ $cont src k ($ $kargs (name) (sym) body))) val)
+    (($ $letk (($ $cont k src ($ $kargs (name) (sym) body))) val)
      `(let ,k (,name ,sym ,(unparse-cps val))
            ,(unparse-cps body)))
     (($ $letk conts body)
      `(letk ,(map unparse-cps conts) ,(unparse-cps body)))
-    (($ $cont src sym body)
+    (($ $cont sym src body)
      `(k ,sym ,(unparse-cps body)))
     (($ $kif kt kf)
      `(kif ,kt ,kf))
diff --git a/module/language/cps/arities.scm b/module/language/cps/arities.scm
index f284da55f..bfae9b573 100644
--- a/module/language/cps/arities.scm
+++ b/module/language/cps/arities.scm
@@ -53,10 +53,10 @@
                        conts)
                  body))
 
-    (($ $cont src sym ($ $kargs names syms body))
+    (($ $cont sym src ($ $kargs names syms body))
      (fold-conts proc (proc term seed) body))
 
-    (($ $cont src sym ($ $kentry arity body))
+    (($ $cont sym src ($ $kentry arity body))
      (fold-conts proc (proc term seed) body))
 
     (($ $cont)
@@ -73,7 +73,7 @@
          (match conts
            ((cont . conts)
             (match cont
-              (($ $cont _ (? (cut eq? <> k))) cont)
+              (($ $cont (? (cut eq? <> k))) cont)
               (else (lp conts))))))))
 
 (define (fix-arities fun)
@@ -105,7 +105,7 @@
               ($continue kseq ,exp))
              (($ $cont _ _ ($ $kargs () () _))
               ($continue k ,exp))
-             (($ $cont src k)
+             (($ $cont k src)
               ,(let-gensyms (k*)
                  (build-cps-term
                    ($letk ((k* src ($kargs () () ($continue k ($void)))))
@@ -130,9 +130,9 @@
                                           ($continue k
                                             ($primcall 'return (v))))))
                            ($continue k* ,exp)))))))
-               (($ $cont src _ ($ $ktrunc ($ $arity () () #f () #f) kseq))
+               (($ $cont _ src ($ $ktrunc ($ $arity () () #f () #f) kseq))
                 ,(drop-result src kseq))
-               (($ $cont src kseq ($ $kargs () () _))
+               (($ $cont kseq src ($ $kargs () () _))
                 ,(drop-result src kseq))
                (($ $cont)
                 ($continue k ,exp))))))))
@@ -183,9 +183,9 @@
 
     (define (visit-cont cont)
       (rewrite-cps-cont cont
-        (($ $cont src sym ($ $kargs names syms body))
+        (($ $cont sym src ($ $kargs names syms body))
          (sym src ($kargs names syms ,(visit-term body))))
-        (($ $cont src sym ($ $kentry arity body))
+        (($ $cont sym src ($ $kentry arity body))
          (sym src ($kentry ,arity ,(visit-cont body))))
         (($ $cont)
          ,cont)))
diff --git a/module/language/cps/closure-conversion.scm b/module/language/cps/closure-conversion.scm
index 39858b451..5a49b084c 100644
--- a/module/language/cps/closure-conversion.scm
+++ b/module/language/cps/closure-conversion.scm
@@ -118,12 +118,12 @@ convert functions to flat closures."
          (values (build-cps-term ($letk ,conts ,body))
                  (union free free*)))))
 
-    (($ $cont src sym ($ $kargs names syms body))
+    (($ $cont sym src ($ $kargs names syms body))
      (receive (body free) (cc body self (append syms bound))
        (values (build-cps-cont (sym src ($kargs names syms ,body)))
                free)))
 
-    (($ $cont src sym ($ $kentry arity body))
+    (($ $cont sym src ($ $kentry arity body))
      (receive (body free) (cc body self bound)
        (values (build-cps-cont (sym src ($kentry ,arity ,body)))
                free)))
@@ -242,9 +242,9 @@ convert functions to flat closures."
          ,term)))
     (define (visit-cont cont)
       (rewrite-cps-cont cont
-        (($ $cont src sym ($ $kargs names syms body))
+        (($ $cont sym src ($ $kargs names syms body))
          (sym src ($kargs names syms ,(visit-term body))))
-        (($ $cont src sym ($ $kentry arity body))
+        (($ $cont sym src ($ $kentry arity body))
          (sym src ($kentry ,arity ,(visit-cont body))))
         ;; Other kinds of continuations don't bind values and don't have
         ;; bodies.
diff --git a/module/language/cps/compile-rtl.scm b/module/language/cps/compile-rtl.scm
index 5a4dfef54..c0fc9b8e5 100644
--- a/module/language/cps/compile-rtl.scm
+++ b/module/language/cps/compile-rtl.scm
@@ -79,10 +79,10 @@
      (visit-funs proc body)
      (for-each (lambda (cont) (visit-funs proc cont)) conts))
 
-    (($ $cont src sym ($ $kargs names syms body))
+    (($ $cont sym src ($ $kargs names syms body))
      (visit-funs proc body))
 
-    (($ $cont src sym ($ $kentry arity body))
+    (($ $cont sym src ($ $kentry arity body))
      (visit-funs proc body))
 
     (_ (values))))
@@ -95,7 +95,7 @@
            (fold-conts proc seed body)
            conts))
 
-    (($ $cont src k cont)
+    (($ $cont k src cont)
      (fold-conts proc (proc k src cont seed) cont))
 
     (($ $kargs names syms body)
@@ -342,7 +342,7 @@
       (call-with-values (lambda () (allocate-slots self body))
         (lambda (moves slots nlocals)
           (match body
-            (($ $cont src k
+            (($ $cont k src
                 ($ $kentry ($ $arity req opt rest kw allow-other-keys?) body))
              (let ((kw-indices (map (match-lambda
                                      ((key name sym)
diff --git a/module/language/cps/dfg.scm b/module/language/cps/dfg.scm
index 4c51aba66..84f6f0975 100644
--- a/module/language/cps/dfg.scm
+++ b/module/language/cps/dfg.scm
@@ -97,7 +97,7 @@
 
         ;; Treat the entry continuation as its own parent, and as a hack
         ;; declare "ktail" as being a child of the entry.
-        (($ $cont src k ($ $kentry arity body))
+        (($ $cont k src ($ $kentry arity body))
          (when exp-k
            (error "$kentry not at top level?"))
          (add-def! k k)
@@ -107,7 +107,7 @@
          (link-parent! 'ktail k)
          (visit body k))
 
-        (($ $cont src k cont)
+        (($ $cont k src cont)
          (def! k)
          (hashq-set! conts k cont)
          (link-parent! k exp-k)
diff --git a/module/language/cps/reify-primitives.scm b/module/language/cps/reify-primitives.scm
index 11ee1303e..a9233916e 100644
--- a/module/language/cps/reify-primitives.scm
+++ b/module/language/cps/reify-primitives.scm
@@ -60,10 +60,10 @@
                        conts)
                  body))
 
-    (($ $cont src sym ($ $kargs names syms body))
+    (($ $cont sym src ($ $kargs names syms body))
      (fold-conts proc (proc term seed) body))
 
-    (($ $cont src sym ($ $kentry arity body))
+    (($ $cont sym src ($ $kentry arity body))
      (fold-conts proc (proc term seed) body))
 
     (($ $cont)
@@ -82,7 +82,7 @@
 (define (build-cont-table term)
   (fold-conts (lambda (cont table)
                 (match cont
-                  (($ $cont src k cont)
+                  (($ $cont k src cont)
                    (vhash-consq k cont table))))
               vlist-null
               term))
@@ -113,9 +113,9 @@
          ($fun meta self free ,(map visit-cont entries)))))
     (define (visit-cont cont)
       (rewrite-cps-cont cont
-        (($ $cont src sym ($ $kargs names syms body))
+        (($ $cont sym src ($ $kargs names syms body))
          (sym src ($kargs names syms ,(visit-term body))))
-        (($ $cont src sym ($ $kentry arity body))
+        (($ $cont sym src ($ $kentry arity body))
          (sym src ($kentry ,arity ,(visit-cont body))))
         (($ $cont)
          ,cont)))
diff --git a/module/language/cps/slot-allocation.scm b/module/language/cps/slot-allocation.scm
index 00180d49a..0aaa2c137 100644
--- a/module/language/cps/slot-allocation.scm
+++ b/module/language/cps/slot-allocation.scm
@@ -294,7 +294,7 @@ are comparable with eqv?.  A tmp slot may be used."
            (for-each (cut visit <> exp-k live-set) conts))
          live-set)
 
-        (($ $cont src k cont)
+        (($ $cont k src cont)
          (hashq-set! visited k #t)
          (visit cont k live-set))
 
diff --git a/module/language/cps/verify.scm b/module/language/cps/verify.scm
index eed74ddcc..8b649172a 100644
--- a/module/language/cps/verify.scm
+++ b/module/language/cps/verify.scm
@@ -55,7 +55,7 @@
               (v-env '()))
     (match exp
       ;; Continuations.
-      (($ $letk (($ $cont src k cont) ...) body)
+      (($ $letk (($ $cont k src cont) ...) body)
        (let ((k-env (add-env k k-env)))
          (for-each check-src src)
          (for-each (match-lambda
@@ -103,8 +103,8 @@
             (error "entry should be symbol" k))
           (for-each
            (match-lambda
-            (($ $cont src* k*
-                ($ $kentry arity ($ $cont src k ($ $kargs names syms body))))
+            (($ $cont k* src*
+                ($ $kentry arity ($ $cont k src ($ $kargs names syms body))))
              (check-src src*)
              (check-src src)
              (match arity