mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 03:40:34 +02:00
Code Activity

Tree-IL lowerer has #:dump-optimized-tree-il? option

Browse source 
* 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?.
This commit is contained in:
Andy Wingo 2024-04-23 12:45:46 +02:00
parent e2fad20257
commit 3b76a30e3c
1 changed files with 19 additions and 4 deletions
Download patch file Download diff file Expand all files Collapse all files

23
module/language/tree-il/optimize.scm
View file

@ -28,6 +28,15 @@
make-lowerer make-lowerer
tree-il-optimizations)) 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 (make-optimizer opts)
(define-syntax lookup (define-syntax lookup
(syntax-rules () (syntax-rules ()
@ -35,8 +44,7 @@
(lookup kw id id)) (lookup kw id id))
((lookup kw submodule proc) ((lookup kw submodule proc)
(and (assq-ref opts kw) (and (assq-ref opts kw)
(module-ref (resolve-interface '(language tree-il submodule)) (lazy-ref (language tree-il submodule) proc)))))
'proc)))))
(let ((verify (or (lookup #:verify-tree-il? debug verify-tree-il) (let ((verify (or (lookup #:verify-tree-il? debug verify-tree-il)
(lambda (exp) exp))) (lambda (exp) exp)))
(modulify (lookup #:resolve-free-vars? resolve-free-vars)) (modulify (lookup #:resolve-free-vars? resolve-free-vars))
@ -62,6 +70,8 @@
(run-pass! (peval exp env #:cross-module-inlining? xinline?)) (run-pass! (peval exp env #:cross-module-inlining? xinline?))
(run-pass! (eta-expand exp)) (run-pass! (eta-expand exp))
(run-pass! (inlinables exp)) (run-pass! (inlinables exp))
(when (assq-ref opts #:dump-optimized-tree-il?)
(dump-optimized-tree-il exp env))
exp))) exp)))
(define (optimize x env opts) (define (optimize x env opts)
@ -70,14 +80,19 @@
(define (tree-il-optimizations) (define (tree-il-optimizations)
(available-optimizations 'tree-il)) (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 (make-lowerer optimization-level opts)
(define (kw-arg-ref args kw default) (define (kw-arg-ref args kw default)
(match (memq kw args) (match (memq kw args)
((_ val . _) val) ((_ val . _) val)
(_ default))) (_ default)))
(define (enabled-for-level? level) (<= level optimization-level)) (define (enabled-for-level? level) (and level (<= level optimization-level)))
(make-optimizer (make-optimizer
(let lp ((all-opts (tree-il-optimizations))) (let lp ((all-opts (tree-il-options)))
(match all-opts (match all-opts
(() '()) (() '())
(((kw level) . all-opts) (((kw level) . all-opts)