summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2020-05-13 08:59:04 +0200
committerAndy Wingo <wingo@pobox.com>2020-05-13 09:04:16 +0200
commitc5da9d65a7e7741535694ddebd8207a76294c922 (patch)
tree0b1e3f7ec7d4c8a2795293926a659d437b817e3f
parent132292fcb38b8cea11716bb208ed2ad35b1c3d45 (diff)
downloadguile-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.scm55
-rw-r--r--module/language/tree-il/optimize.scm25
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