summaryrefslogtreecommitdiff
path: root/module
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2024-04-23 12:45:46 +0200
committerAndy Wingo <wingo@pobox.com>2024-04-23 13:06:34 +0200
commit3b76a30e3ca1f0b7ee7944836c2fc5660596b3bd (patch)
tree6f737059b1c6c702b42faf9e308f54969a0c6d43 /module
parente2fad20257e0c5adf59c30fedc736206a9253042 (diff)
downloadguile-3b76a30e3ca1f0b7ee7944836c2fc5660596b3bd.tar.gz
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?.
Diffstat (limited to 'module')
-rw-r--r--module/language/tree-il/optimize.scm23
1 files 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)