[Guile-commits] branch wip-tailify updated: Remove pk verbosity in tailify.scm

[Andy Wingo]

This is an automated email from the git hooks/post-receive script.

wingo pushed a commit to branch wip-tailify
in repository guile.

The following commit(s) were added to refs/heads/wip-tailify by this push:
     new 814742241 Remove pk verbosity in tailify.scm
814742241 is described below

commit 8147422415611358cc18f4f2ee9794fb8c01fab1
Author: Andy Wingo <wingo@pobox.com>
AuthorDate: Thu Apr 6 13:36:04 2023 +0200

    Remove pk verbosity in tailify.scm
---
 module/language/cps/tailify.scm | 61 ++++++++++++++++++++---------------------
 1 file changed, 29 insertions(+), 32 deletions(-)

diff --git a/module/language/cps/tailify.scm b/module/language/cps/tailify.scm
index f9ebb63d2..d03692943 100644
--- a/module/language/cps/tailify.scm
+++ b/module/language/cps/tailify.scm
@@ -1,6 +1,6 @@
 ;;; Continuation-passing style (CPS) intermediate language (IL)
 
-;; Copyright (C) 2021 Free Software Foundation, Inc.
+;; Copyright (C) 2021, 2023 Free Software Foundation, Inc.
 
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
@@ -134,22 +134,21 @@ be rewritten to continue to the tail's ktail."
       (($ $kfun src meta self ktail kentry)
        ktail)))
 
-  (pk 'tailify-tail head body fresh-names original-ktail local-ktail)
+  ;; (pk 'tailify-tail head body fresh-names original-ktail local-ktail)
 
   (define (rename-var var)   (rename-var* fresh-names var))
   (define (rename-vars vars) (rename-vars* fresh-names vars))
   (define (rename-exp exp)
-    (pk 'rename exp
-     (rewrite-exp exp
-       ((or ($ $const) ($ $prim) ($ $const-fun) ($ $code)) ,exp)
-       (($ $call proc args)
-        ($call (rename-var proc) ,(rename-vars args)))
-       (($ $callk k proc args)
-        ($callk k (and proc (rename-var proc)) ,(rename-vars args)))
-       (($ $primcall name param args)
-        ($primcall name param ,(rename-vars args)))
-       (($ $values args)
-        ($values ,(rename-vars args))))))
+    (rewrite-exp exp
+      ((or ($ $const) ($ $prim) ($ $const-fun) ($ $code)) ,exp)
+      (($ $call proc args)
+       ($call (rename-var proc) ,(rename-vars args)))
+      (($ $callk k proc args)
+       ($callk k (and proc (rename-var proc)) ,(rename-vars args)))
+      (($ $primcall name param args)
+       ($primcall name param ,(rename-vars args)))
+      (($ $values args)
+       ($values ,(rename-vars args)))))
 
   (define (compute-saved-vars fresh-names k)
     (compute-saved-vars* fresh-names live-in constants reprs k))
@@ -201,7 +200,7 @@ be rewritten to continue to the tail's ktail."
        (let ((exp (rename-exp exp)))
          (cond
           ((eqv? k original-ktail)
-           (pk 'original-tail-call k exp)
+           ;; (pk 'original-tail-call k exp)
            (match exp
              (($ $values args)
               ;; The original term is a $values in tail position.
@@ -227,13 +226,13 @@ be rewritten to continue to the tail's ktail."
              (($ $kreceive)
               ;; A non-tail-call: push the pending continuation and tail
               ;; call instead.
-              (pk 'non-tail-call head k exp)
+              ;; (pk 'non-tail-call head k exp)
               (match exp
                 ((or ($ $call) ($ $callk) ($ $calli))
                  (call-with-values (lambda ()
                                      (compute-saved-vars fresh-names k))
                    (lambda (reprs vars)
-                     (pk 'saved-vars reprs vars)
+                     ;; (pk 'saved-vars reprs vars)
                      (with-cps cps
                        (letk kexp ($kargs () ()
                                     ($continue local-ktail src ,exp)))
@@ -314,13 +313,14 @@ be rewritten to continue to the tail's ktail."
   ;; we just rewrite all the body conts.
   (intset-fold
    (lambda (label cps)
-     (match (pk 'tailify-tail1 head label (intmap-ref cps label))
+     (match (intmap-ref cps label)
        ((or ($ $kfun) ($ $kclause) ($ $ktail)) cps) ;; Unchanged.
        (($ $kargs names vals term)
+        ;; (pk 'tailify-tail1 head label names vals term)
         (with-cps cps
           (let$ term (rewrite-term term))
           (let$ term (maybe-unwind-prompt label term))
-          (setk label ($kargs names vals ,(pk 'setting label term)))))))
+          (setk label ($kargs names vals ,term))))))
    body cps))
 
 (define (tailify-tails cps winds live-in constants reprs tails)
@@ -354,8 +354,7 @@ REPRS holds the representation of each var."
   (define fresh-names-per-tail
     (intmap-map (lambda (head body)
                   (intset-fold (lambda (var fresh)
-                                 (intmap-add fresh var (pk 'live-in head var
-                                                           (fresh-var))))
+                                 (intmap-add fresh var (fresh-var)))
                                (intmap-ref live-in head)
                                empty-intmap))
                 tails))
@@ -387,7 +386,7 @@ REPRS holds the representation of each var."
     (define (restore-saved cps body term)
       (call-with-values (lambda () (compute-saved-vars head))
         (lambda (reprs vars)
-          (pk 'restoring head reprs vars)
+          ;; (pk 'restoring head reprs vars)
           (define names (map (lambda (_) 'restored) vars))
           (if (null? names)
               (with-cps cps ($ (values body term)))
@@ -509,11 +508,12 @@ body, as an intset."
          (intmap-add splits label split (lambda (old new) new)))
         ((_ _ . _)
          ;; Otherwise this is a new split.
-         (pk 'join-split label)
+         ;; (pk 'join-split label)
          (intmap-add splits label label (lambda (old new) new)))))))
   ;; label -> split head
   (define initial-splits
-    (pk (intset-fold initial-split body empty-intmap)))
+    (intset-fold initial-split body empty-intmap))
+  ;; (pk initial-splits)
   (cond
    ((trivial-intmap initial-splits)
     ;; There's only one split head, so only one tail.
@@ -523,7 +523,7 @@ body, as an intset."
     ;; head, then collect the tails by split head.
     (let ((splits (fixpoint
                    (lambda (splits)
-                     (pk 'fixpoint splits)
+                     ;; (pk 'fixpoint splits)
                      (intset-fold compute-split body splits))
                    initial-splits)))
       (intmap-fold
@@ -647,7 +647,8 @@ tails in such a way that they enter via a $kfun and leave 
only via tail
 calls."
   (define succs (compute-successors cps kfun))
   (define preds (invert-graph succs))
-  (define tails (pk 'tails (compute-tails kfun body preds cps)))
+  (define tails (compute-tails kfun body preds cps))
+  ;; (pk 'tails tails)
   (cond
    ((trivial-intmap tails)
     (tailify-trivial-tail body cps))
@@ -659,14 +660,10 @@ calls."
           (reprs (compute-var-representations cps)))
       (tailify-tails cps winds live-in constants reprs tails)))))
 
-(define (dump* map)
-  (intmap-fold (lambda (label cont) (pk label cont) (values)) map)
-  map)
-
 (define (tailify cps)
   ;; Renumber so that label order is topological order.
   (let ((cps (renumber cps)))
     (with-fresh-name-state cps
-      (dump* (intmap-fold tailify-function
-                          (compute-reachable-functions cps)
-                          cps)))))
+      (intmap-fold tailify-function
+                   (compute-reachable-functions cps)
+                   cps))))