From ce36fb16fff30ba1915dbd9d52d2325acedd54c7 Mon Sep 17 00:00:00 2001
From: Andy Wingo <wingo@pobox.com>
Date: Wed, 28 Oct 2015 08:38:46 +0000
Subject: [PATCH] Bootstrap build doesn't have to expand CPS optimizations

* module/language/cps/optimize.scm (define-optimizer)
  (optimize-higher-order-cps, optimize-first-order-cps): Obfuscate a bit
  so that the bootstrap build won't have to expand optimization passes.
  Might marginally speed up the bootstrap process.
---
 module/language/cps/optimize.scm | 72 +++++++++++++++++---------------
 1 file changed, 38 insertions(+), 34 deletions(-)

diff --git a/module/language/cps/optimize.scm b/module/language/cps/optimize.scm
index 8777222c9..515fc7963 100644
--- a/module/language/cps/optimize.scm
+++ b/module/language/cps/optimize.scm
@@ -24,20 +24,6 @@
 
 (define-module (language cps optimize)
   #:use-module (ice-9 match)
-  #:use-module (language cps constructors)
-  #:use-module (language cps contification)
-  #:use-module (language cps cse)
-  #:use-module (language cps dce)
-  #:use-module (language cps elide-values)
-  #:use-module (language cps licm)
-  #:use-module (language cps peel-loops)
-  #:use-module (language cps prune-top-level-scopes)
-  #:use-module (language cps prune-bailouts)
-  #:use-module (language cps rotate-loops)
-  #:use-module (language cps self-references)
-  #:use-module (language cps simplify)
-  #:use-module (language cps specialize-primcalls)
-  #:use-module (language cps type-fold)
   #:use-module (language cps verify)
   #:export (optimize-higher-order-cps
             optimize-first-order-cps
@@ -55,7 +41,7 @@
       (verify program)
       program))
 
-(define-syntax-rule (define-optimizer optimize (pass kw default) ...)
+(define-syntax-rule (define-optimizer optimize ((@ mod pass) kw default) ...)
   (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
@@ -72,7 +58,7 @@
     (maybe-verify program)
     (set! program
       (if (kw-arg-ref opts kw default)
-          (maybe-verify (pass program))
+          (maybe-verify ((module-ref (resolve-interface 'mod) 'pass) program))
           program))
     ...
     (maybe-verify program)))
@@ -88,27 +74,45 @@
   ;; 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)
-  (inline-constructors #:inline-constructors? #t)
-  (specialize-primcalls #:specialize-primcalls? #t)
-  (elide-values #:elide-values? #t)
-  (prune-bailouts #:prune-bailouts? #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))
+  ((@ (language cps dce) eliminate-dead-code)
+   #:eliminate-dead-code? #t)
+  ((@ (language cps prune-top-level-scopes) prune-top-level-scopes)
+   #:prune-top-level-scopes? #t)
+  ((@ (language cps simplify) simplify)
+   #:simplify? #t)
+  ((@ (language cps contification) contify)
+   #:contify? #t)
+  ((@ (language cps constructors) inline-constructors)
+   #:inline-constructors? #t)
+  ((@ (language cps specialize-primcalls) specialize-primcalls)
+   #:specialize-primcalls? #t)
+  ((@ (language cps elide-values) elide-values)
+   #:elide-values? #t)
+  ((@ (language cps prune-bailouts) prune-bailouts)
+   #:prune-bailouts? #t)
+  ((@ (language cps peel-loops) peel-loops)
+   #:peel-loops? #t)
+  ((@ (language cps cse) eliminate-common-subexpressions)
+   #:cse? #t)
+  ((@ (language cps type-fold) type-fold)
+   #:type-fold? #t)
+  ((@ (language cps self-references) resolve-self-references)
+   #:resolve-self-references? #t)
+  ((@ (language cps dce) eliminate-dead-code)
+   #:eliminate-dead-code? #t)
+  ((@ (language cps simplify) simplify)
+   #:simplify? #t))
 
 (define-optimizer optimize-first-order-cps
-  (hoist-loop-invariant-code #:licm? #t)
+  ((@ (language cps licm) hoist-loop-invariant-code)
+   #:licm? #t)
   ;; FIXME: CSE here to eliminate duplicate free-ref terms.
-  (eliminate-dead-code #:eliminate-dead-code? #t)
-  (rotate-loops #:rotate-loops? #t)
-  (simplify #:simplify? #t))
+  ((@ (language cps dce) eliminate-dead-code)
+   #:eliminate-dead-code? #t)
+  ((@ (language cps rotate-loops) rotate-loops)
+   #:rotate-loops? #t)
+  ((@ (language cps simplify) simplify)
+   #:simplify? #t))
 
 (define (cps-default-optimization-options)
   (list ;; #:split-rec? #t