From d2784ea1af341608361f61db9c06ccfd2722b921 Mon Sep 17 00:00:00 2001
From: Andy Wingo <wingo@pobox.com>
Date: Thu, 22 Jun 2023 20:07:17 +0200
Subject: [PATCH] Include optimizations when targetting hoot runtime

* module/language/cps/optimize.scm (optimize-hoot-backend-cps): There
are a couple optimizations we need to clean up after tailification, so
include those here.
---
 module/language/cps/optimize.scm | 25 +++++++++++++++++++------
 1 file changed, 19 insertions(+), 6 deletions(-)

diff --git a/module/language/cps/optimize.scm b/module/language/cps/optimize.scm
index dee9b30de..0e544c24e 100644
--- a/module/language/cps/optimize.scm
+++ b/module/language/cps/optimize.scm
@@ -122,9 +122,18 @@
   (rotate-loops #:rotate-loops?)
   (simplify #:simplify?))
 
+(define-optimizer optimize-hoot-backend-cps
+  (eliminate-dead-code #:eliminate-dead-code?)
+  (simplify #:simplify?))
+
 (define (cps-optimizations)
   (available-optimizations 'cps))
 
+;; For the moment, this is just here.
+(define (hoot-backend-cps-optimizations)
+  '((#:simplify? 1)
+    (#:eliminate-dead-code? 1)))
+
 (define (target-runtime)
   "Determine what kind of virtual machine we are targetting.  Usually this
 is @code{guile-vm} when generating bytecode for Guile's virtual machine,
@@ -144,7 +153,7 @@ but it can be @code{hoot} when targetting WebAssembly."
   (set! exp (convert-closures exp))
   (optimize-first-order-cps exp opts))
 
-(define (select-opts-for-optimization-level optimization-level opts all-opts)
+(define (select-optimizations optimization-level opts all-opts)
   (define (kw-arg-ref args kw default)
     (match (memq kw args)
       ((_ val . _) val)
@@ -165,14 +174,18 @@ but it can be @code{hoot} when targetting WebAssembly."
         (reify-primitives
          (lower-primcalls exp)))))
     ('hoot
-     (lambda (exp env)
-       (unify-returns
-        (tailify exp))))))
+     (let ((opts (select-optimizations optimization-level opts
+                                       (hoot-backend-cps-optimizations))))
+       (lambda (exp env)
+         (optimize-hoot-backend-cps
+          (unify-returns
+           (tailify exp))
+          opts))))))
 
 (define (make-cps-lowerer optimization-level opts)
   (define generic-opts
-    (select-opts-for-optimization-level optimization-level opts
-                                        (cps-optimizations)))
+    (select-optimizations optimization-level opts
+                          (cps-optimizations)))
   (define lower-cps/backend
     (make-backend-cps-lowerer optimization-level opts))
   (lambda (exp env)