1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-13 15:10:34 +02:00

Disable resolve-primitives pass below -O2

* module/language/tree-il/optimize.scm (optimize): Disable
  resolve-primitives below -O2.  This is because compile-cps is going to
  start expanding all primcalls it sees.
This commit is contained in:
Andy Wingo 2018-01-05 10:40:03 +01:00
parent 16db934bbc
commit 51fd5952cb

View file

@ -28,16 +28,30 @@
#:export (optimize #:export (optimize
tree-il-optimizations)) tree-il-optimizations))
(define (kw-arg-ref args kw default)
(match (memq kw args)
((_ val . _) val)
(_ default)))
(define *debug?* #f)
(define (maybe-verify x)
(if *debug?*
(verify-tree-il x)
x))
(define (optimize x env opts) (define (optimize x env opts)
(let ((peval (match (memq #:partial-eval? opts) (define-syntax-rule (run-pass pass kw default)
((#:partial-eval? #f _ ...) (when (kw-arg-ref opts kw default)
;; Disable partial evaluation. (set! x (maybe-verify (pass x)))))
(lambda (x e) x)) (define (resolve* x) (resolve-primitives x env))
(_ peval)))) (define (peval* x) (peval x env))
(fix-letrec (maybe-verify x)
(verify-tree-il (run-pass resolve* #:resolve-primitives? #t)
(peval (expand-primitives (resolve-primitives x env)) (run-pass expand-primitives #:expand-primitives? #t)
env))))) (run-pass peval* #:partial-eval? #t)
(run-pass fix-letrec #:fix-letrec? #t)
x)
(define (tree-il-optimizations) (define (tree-il-optimizations)
;; Avoid resolve-primitives until -O2, when CPS optimizations kick in. ;; Avoid resolve-primitives until -O2, when CPS optimizations kick in.