enable cse

* module/language/tree-il/optimize.scm: Enable CSE unless #:cse? #f is
  passed.

* test-suite/tests/tree-il.test: Disable CSE for one test.

diff --git a/module/language/tree-il/optimize.scm b/module/language/tree-il/optimize.scm
index baac915..c6e4fec 100644 (file)
--- a/module/language/tree-il/optimize.scm
+++ b/module/language/tree-il/optimize.scm
@@ -1,6 +1,6 @@
 ;;; Tree-il optimizer
 
-;; Copyright (C) 2009, 2011 Free Software Foundation, Inc.
+;; Copyright (C) 2009, 2011, 2012 Free Software Foundation, Inc.
 
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
@@ -22,6 +22,7 @@
   #:use-module (language tree-il)
   #:use-module (language tree-il primitives)
   #:use-module (language tree-il peval)
+  #:use-module (language tree-il cse)
   #:use-module (language tree-il fix-letrec)
   #:use-module (language tree-il debug)
   #:use-module (ice-9 match)
@@ -32,8 +33,15 @@
                  ((#:partial-eval? #f _ ...)
                   ;; Disable partial evaluation.
                   (lambda (x e) x))
-                 (_ peval))))
+                 (_ peval)))
+        (cse (match (memq #:cse? opts)
+               ((#:cse? #f _ ...)
+                ;; Disable CSE.
+                (lambda (x) x))
+               (_ cse))))
     (fix-letrec!
      (verify-tree-il
-      (peval (expand-primitives! (resolve-primitives! x env))
-             env)))))
+      (cse
+       (verify-tree-il
+        (peval (expand-primitives! (resolve-primitives! x env))
+               env)))))))

diff --git a/test-suite/tests/tree-il.test b/test-suite/tests/tree-il.test
index 2d0784e..2b07e62 100644 (file)
--- a/test-suite/tests/tree-il.test
+++ b/test-suite/tests/tree-il.test
@@ -148,7 +148,7 @@
             (lexical #t #f ref 0) (call return 1)
             (unbind)))
 
-  (assert-tree-il->glil without-partial-evaluation
+  (assert-tree-il->glil with-options (#:partial-eval? #f #:cse? #f)
    (let (x) (y) ((const 1)) (begin (lexical x y) (const #f)))
    (program () (std-prelude 0 1 #f) (label _)
             (const 1) (bind (x #f 0)) (lexical #t #f set 0)