mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-19 03:00:25 +02:00
Code Activity

Include optimizations when targetting hoot runtime

Browse source 
* module/language/cps/optimize.scm (optimize-hoot-backend-cps): There
are a couple optimizations we need to clean up after tailification, so
include those here.
This commit is contained in:
Andy Wingo 2023-06-22 20:07:17 +02:00
parent 23d4263c1a
commit d2784ea1af
1 changed files with 19 additions and 6 deletions
Download patch file Download diff file Expand all files Collapse all files

19
module/language/cps/optimize.scm
View file

@ -122,9 +122,18 @@
(rotate-loops #:rotate-loops?) (rotate-loops #:rotate-loops?)
(simplify #:simplify?)) (simplify #:simplify?))
(define-optimizer optimize-hoot-backend-cps
(eliminate-dead-code #:eliminate-dead-code?)
(simplify #:simplify?))
(define (cps-optimizations) (define (cps-optimizations)
(available-optimizations 'cps)) (available-optimizations 'cps))
;; For the moment, this is just here.
(define (hoot-backend-cps-optimizations)
'((#:simplify? 1)
(#:eliminate-dead-code? 1)))
(define (target-runtime) (define (target-runtime)
"Determine what kind of virtual machine we are targetting. Usually this "Determine what kind of virtual machine we are targetting. Usually this
is @code{guile-vm} when generating bytecode for Guile's virtual machine, is @code{guile-vm} when generating bytecode for Guile's virtual machine,
@ -144,7 +153,7 @@ but it can be @code{hoot} when targetting WebAssembly."
(set! exp (convert-closures exp)) (set! exp (convert-closures exp))
(optimize-first-order-cps exp opts)) (optimize-first-order-cps exp opts))
(define (select-opts-for-optimization-level optimization-level opts all-opts) (define (select-optimizations optimization-level opts all-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)
@ -165,13 +174,17 @@ but it can be @code{hoot} when targetting WebAssembly."
(reify-primitives (reify-primitives
(lower-primcalls exp))))) (lower-primcalls exp)))))
('hoot ('hoot
(let ((opts (select-optimizations optimization-level opts
(hoot-backend-cps-optimizations))))
(lambda (exp env) (lambda (exp env)
(optimize-hoot-backend-cps
(unify-returns (unify-returns
(tailify exp)))))) (tailify exp))
opts))))))
(define (make-cps-lowerer optimization-level opts) (define (make-cps-lowerer optimization-level opts)
(define generic-opts (define generic-opts
(select-opts-for-optimization-level optimization-level opts (select-optimizations optimization-level opts
(cps-optimizations))) (cps-optimizations)))
(define lower-cps/backend (define lower-cps/backend
(make-backend-cps-lowerer optimization-level opts)) (make-backend-cps-lowerer optimization-level opts))