mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-29 19:30:36 +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
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)