[Guile-commits] branch main updated: Tree-IL lowerer has #:dump-optimized-tree-il? option

[Andy Wingo]

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

wingo pushed a commit to branch main
in repository guile.

The following commit(s) were added to refs/heads/main by this push:
     new 3b76a30e3 Tree-IL lowerer has #:dump-optimized-tree-il? option
3b76a30e3 is described below

commit 3b76a30e3ca1f0b7ee7944836c2fc5660596b3bd
Author: Andy Wingo <wingo@pobox.com>
AuthorDate: Tue Apr 23 12:45:46 2024 +0200

    Tree-IL lowerer has #:dump-optimized-tree-il? option
    
    * module/language/tree-il/optimize.scm (make-optimizer): If the keyword
    argument #:dump-optimized-tree-il? is present, print the Tree-IL that
    will be handed to the next compiler.  Also re-enable #:verify-tree-il?.
---
 module/language/tree-il/optimize.scm | 23 +++++++++++++++++++----
 1 file changed, 19 insertions(+), 4 deletions(-)

diff --git a/module/language/tree-il/optimize.scm 
b/module/language/tree-il/optimize.scm
index 11e0470be..466429a85 100644
--- a/module/language/tree-il/optimize.scm
+++ b/module/language/tree-il/optimize.scm
@@ -28,6 +28,15 @@
             make-lowerer
             tree-il-optimizations))
 
+(define-syntax-rule (lazy-ref mod proc)
+  (module-ref (resolve-interface 'mod) 'proc))
+
+(define (dump-optimized-tree-il exp env)
+  ((lazy-ref (ice-9 pretty-print) pretty-print)
+   ((lazy-ref (language scheme decompile-tree-il) decompile-tree-il)
+    exp env '()))
+  exp)
+
 (define (make-optimizer opts)
   (define-syntax lookup
     (syntax-rules ()
@@ -35,8 +44,7 @@
        (lookup kw id id))
       ((lookup kw submodule proc)
        (and (assq-ref opts kw)
-            (module-ref (resolve-interface '(language tree-il submodule))
-                        'proc)))))
+            (lazy-ref (language tree-il submodule) proc)))))
   (let ((verify     (or (lookup #:verify-tree-il? debug verify-tree-il)
                         (lambda (exp) exp)))
         (modulify   (lookup #:resolve-free-vars? resolve-free-vars))
@@ -62,6 +70,8 @@
       (run-pass! (peval exp env #:cross-module-inlining? xinline?))
       (run-pass! (eta-expand exp))
       (run-pass! (inlinables exp))
+      (when (assq-ref opts #:dump-optimized-tree-il?)
+        (dump-optimized-tree-il exp env))
       exp)))
 
 (define (optimize x env opts)
@@ -70,14 +80,19 @@
 (define (tree-il-optimizations)
   (available-optimizations 'tree-il))
 
+(define (tree-il-options)
+  (cons* '(#:dump-optimized-tree-il? #f)
+         '(#:verify-tree-il? #f)
+         (tree-il-optimizations)))
+
 (define (make-lowerer optimization-level opts)
   (define (kw-arg-ref args kw default)
     (match (memq kw args)
       ((_ val . _) val)
       (_ default)))
-  (define (enabled-for-level? level) (<= level optimization-level))
+  (define (enabled-for-level? level) (and level (<= level optimization-level)))
   (make-optimizer
-   (let lp ((all-opts (tree-il-optimizations)))
+   (let lp ((all-opts (tree-il-options)))
      (match all-opts
        (() '())
        (((kw level) . all-opts)