From e0ef087cebe0f59c334cb94b0da3051684ccc9e6 Mon Sep 17 00:00:00 2001
From: Andy Wingo <wingo@pobox.com>
Date: Tue, 14 Jul 2015 14:12:00 +0200
Subject: [PATCH] Beginnings of first-order CPS optimization

* module/language/cps2/optimize.scm (optimize-higher-order-cps): Renamed
  from "optimize".
  (optimize-first-order-cps): New function.

* module/language/cps2/compile-cps.scm: Adapt.
---
 module/language/cps2/compile-cps.scm |  2 +-
 module/language/cps2/optimize.scm    | 76 +++++++++++++++-------------
 2 files changed, 42 insertions(+), 36 deletions(-)

diff --git a/module/language/cps2/compile-cps.scm b/module/language/cps2/compile-cps.scm
index e505233ca..4294f9463 100644
--- a/module/language/cps2/compile-cps.scm
+++ b/module/language/cps2/compile-cps.scm
@@ -100,5 +100,5 @@
   (convert-fun 0))
 
 (define (compile-cps exp env opts)
-  (let ((exp (renumber (optimize exp opts))))
+  (let ((exp (renumber (optimize-higher-order-cps exp opts))))
     (values (conts->fun exp) env env)))
diff --git a/module/language/cps2/optimize.scm b/module/language/cps2/optimize.scm
index 3d4bb2753..4a19a57b7 100644
--- a/module/language/cps2/optimize.scm
+++ b/module/language/cps2/optimize.scm
@@ -37,7 +37,8 @@
   #:use-module (language cps2 split-rec)
   #:use-module (language cps2 type-fold)
   #:use-module (language cps2 verify)
-  #:export (optimize))
+  #:export (optimize-higher-order-cps
+            optimize-first-order-cps))
 
 (define (kw-arg-ref args kw default)
   (match (memq kw args)
@@ -51,40 +52,45 @@
       (verify program)
       program))
 
-(define* (optimize program #:optional (opts '()))
-  (define (run-pass! pass kw default)
+(define-syntax-rule (define-optimizer optimize (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
+    ;; code this is fine because the compiler is able to allocate all
+    ;; let*-bound variable to the same slot, which also means that the
+    ;; garbage collector doesn't have to retain so many copies of the
+    ;; term being optimized.  However during bootstrap, the interpreter
+    ;; doesn't do this optimization, leading to excessive data retention
+    ;; as the terms are rewritten.  To marginally improve bootstrap
+    ;; memory usage, here we use set! instead.  The compiler should
+    ;; produce the same code in any case, though currently it does not
+    ;; because it doesn't do escape analysis on the box created for the
+    ;; set!.
+    (maybe-verify program)
     (set! program
-          (if (kw-arg-ref opts kw default)
-              (maybe-verify (pass program))
-              program)))
+      (if (kw-arg-ref opts kw default)
+          (maybe-verify (pass program))
+          program))
+    ...
+    (verify program)
+    program))
 
-  (maybe-verify program)
+(define-optimizer optimize-higher-order-cps
+  (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)
+  (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))
 
-  ;; This series of assignments to `program' used to be a series of let*
-  ;; bindings of `program', as you would imagine.  In compiled code this
-  ;; is fine because the compiler is able to allocate all let*-bound
-  ;; variable to the same slot, which also means that the garbage
-  ;; collector doesn't have to retain so many copies of the term being
-  ;; optimized.  However during bootstrap, the interpreter doesn't do
-  ;; this optimization, leading to excessive data retention as the terms
-  ;; are rewritten.  To marginally improve bootstrap memory usage, here
-  ;; we use set! instead.  The compiler should produce the same code in
-  ;; any case, though currently it does not because it doesn't do escape
-  ;; analysis on the box created for the set!.
-
-  (run-pass! split-rec #:split-rec? #t)
-  (run-pass! eliminate-dead-code #:eliminate-dead-code? #t)
-  (run-pass! prune-top-level-scopes #:prune-top-level-scopes? #t)
-  (run-pass! simplify #:simplify? #t)
-  (run-pass! contify #:contify? #t)
-  (run-pass! inline-constructors #:inline-constructors? #t)
-  (run-pass! specialize-primcalls #:specialize-primcalls? #t)
-  (run-pass! elide-values #:elide-values? #t)
-  (run-pass! prune-bailouts #:prune-bailouts? #t)
-  (run-pass! eliminate-common-subexpressions #:cse? #t)
-  (run-pass! type-fold #:type-fold? #t)
-  (run-pass! resolve-self-references #:resolve-self-references? #t)
-  (run-pass! eliminate-dead-code #:eliminate-dead-code? #t)
-  (run-pass! simplify #:simplify? #t)
-
-  (verify program))
+(define-optimizer optimize-first-order-cps
+  (eliminate-dead-code #:eliminate-dead-code? #t)
+  (simplify #:simplify? #t))