diff options
author | Andy Wingo <wingo@pobox.com> | 2020-05-13 08:59:04 +0200 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2020-05-13 09:04:16 +0200 |
commit | c5da9d65a7e7741535694ddebd8207a76294c922 (patch) | |
tree | 0b1e3f7ec7d4c8a2795293926a659d437b817e3f | |
parent | 132292fcb38b8cea11716bb208ed2ad35b1c3d45 (diff) | |
download | guile-c5da9d65a7e7741535694ddebd8207a76294c922.tar.gz |
Fix optimizers after language lowerer refactor
* module/language/cps/optimize.scm (define-optimizer):
(optimize-higher-order-cps, optimize-first-order-cps):
(make-cps-lowerer):
* module/language/tree-il/optimize.scm (optimize, make-lowerer): In an
embarrassing bug, after parsing optimization arguments, we were
aconsing them instead of the expected cons*. This meant the bootstrap
was running all Tree-IL optimizations! Change to have optimizers not
have defaults and use alists after parsing.
-rw-r--r-- | module/language/cps/optimize.scm | 55 | ||||
-rw-r--r-- | module/language/tree-il/optimize.scm | 25 |
2 files changed, 39 insertions, 41 deletions
diff --git a/module/language/cps/optimize.scm b/module/language/cps/optimize.scm index 590d2a40d..632b2cac1 100644 --- a/module/language/cps/optimize.scm +++ b/module/language/cps/optimize.scm @@ -48,11 +48,6 @@ cps-optimizations make-cps-lowerer)) -(define (kw-arg-ref args kw default) - (match (memq kw args) - ((_ val . _) val) - (_ default))) - (define *debug?* #f) (define (maybe-verify program) @@ -60,7 +55,7 @@ (verify program) program)) -(define-syntax-rule (define-optimizer optimize (pass kw default) ...) +(define-syntax-rule (define-optimizer optimize (pass kw) ...) (define* (optimize program #:optional (opts '())) ;; This series of assignments to `program' used to be a series of ;; let* bindings of `program', as you would imagine. In compiled @@ -76,7 +71,7 @@ ;; set!. (maybe-verify program) (set! program - (if (kw-arg-ref opts kw default) + (if (assq-ref opts kw) (maybe-verify (pass program)) program)) ... @@ -92,30 +87,30 @@ ;; unconditionally, because closure conversion requires it. Move the ;; pass back here when that's fixed. ;; - ;; (split-rec #:split-rec? #t) - (eliminate-dead-code #:eliminate-dead-code? #t) - (prune-top-level-scopes #:prune-top-level-scopes? #t) - (simplify #:simplify? #t) - (contify #:contify? #t) - (simplify #:simplify? #t) - (devirtualize-integers #:devirtualize-integers? #t) - (peel-loops #:peel-loops? #t) - (eliminate-common-subexpressions #:cse? #t) - (type-fold #:type-fold? #t) - (resolve-self-references #:resolve-self-references? #t) - (eliminate-dead-code #:eliminate-dead-code? #t) - (simplify #:simplify? #t)) + ;; (split-rec #:split-rec?) + (eliminate-dead-code #:eliminate-dead-code?) + (prune-top-level-scopes #:prune-top-level-scopes?) + (simplify #:simplify?) + (contify #:contify?) + (simplify #:simplify?) + (devirtualize-integers #:devirtualize-integers?) + (peel-loops #:peel-loops?) + (eliminate-common-subexpressions #:cse?) + (type-fold #:type-fold?) + (resolve-self-references #:resolve-self-references?) + (eliminate-dead-code #:eliminate-dead-code?) + (simplify #:simplify?)) (define-optimizer optimize-first-order-cps - (specialize-numbers #:specialize-numbers? #t) - (hoist-loop-invariant-code #:licm? #t) - (specialize-primcalls #:specialize-primcalls? #t) - (eliminate-common-subexpressions #:cse? #t) - (eliminate-dead-code #:eliminate-dead-code? #t) + (specialize-numbers #:specialize-numbers?) + (hoist-loop-invariant-code #:licm?) + (specialize-primcalls #:specialize-primcalls?) + (eliminate-common-subexpressions #:cse?) + (eliminate-dead-code #:eliminate-dead-code?) ;; Running simplify here enables rotate-loops to do a better job. - (simplify #:simplify? #t) - (rotate-loops #:rotate-loops? #t) - (simplify #:simplify? #t)) + (simplify #:simplify?) + (rotate-loops #:rotate-loops?) + (simplify #:simplify?)) (define (cps-optimizations) (available-optimizations 'cps)) @@ -134,6 +129,10 @@ (renumber exp)) (define (make-cps-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)) (let ((opts (let lp ((all-opts (cps-optimizations))) (match all-opts diff --git a/module/language/tree-il/optimize.scm b/module/language/tree-il/optimize.scm index 6c64e17c1..4fc75b6a7 100644 --- a/module/language/tree-il/optimize.scm +++ b/module/language/tree-il/optimize.scm @@ -32,11 +32,6 @@ make-lowerer tree-il-optimizations)) -(define (kw-arg-ref args kw default) - (match (memq kw args) - ((_ val . _) val) - (_ default))) - (define *debug?* #f) (define (maybe-verify x) @@ -45,27 +40,31 @@ x)) (define (optimize x env opts) - (define-syntax-rule (run-pass pass kw default) - (when (kw-arg-ref opts kw default) + (define-syntax-rule (run-pass pass kw) + (when (assq-ref opts kw) (set! x (maybe-verify (pass x))))) (define (resolve* x) (resolve-primitives x env)) (define (peval* x) (peval x env)) (define (letrectify* x) - (let ((seal? (kw-arg-ref opts #:seal-private-bindings? #f))) + (let ((seal? (assq-ref opts #:seal-private-bindings?))) (letrectify x #:seal-private-bindings? seal?))) (maybe-verify x) - (run-pass resolve* #:resolve-primitives? #t) - (run-pass expand-primitives #:expand-primitives? #t) - (run-pass letrectify* #:letrectify? #t) + (run-pass resolve* #:resolve-primitives?) + (run-pass expand-primitives #:expand-primitives?) + (run-pass letrectify* #:letrectify?) (set! x (fix-letrec x)) - (run-pass peval* #:partial-eval? #t) - (run-pass eta-expand #:eta-expand? #t) + (run-pass peval* #:partial-eval?) + (run-pass eta-expand #:eta-expand?) x) (define (tree-il-optimizations) (available-optimizations 'tree-il)) (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)) (let ((opts (let lp ((all-opts (tree-il-optimizations))) (match all-opts |