[Guile-commits] GNU Guile branch, master, updated. v2.1.0-896-g1e91d95

[Andy Wingo]

This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU Guile".

http://git.savannah.gnu.org/cgit/guile.git/commit/?id=1e91d95704b9e59fc948c07e70082dd18806b2b4

The branch, master has been updated
       via  1e91d95704b9e59fc948c07e70082dd18806b2b4 (commit)
      from  c0c93581c4a2cb65e1afa52c48b18a39e69cb4fb (commit)

Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.

- Log -----------------------------------------------------------------
commit 1e91d95704b9e59fc948c07e70082dd18806b2b4
Author: Andy Wingo <address@hidden>
Date:   Thu Apr 10 09:25:38 2014 +0200

    Remove tests for old Tree-IL CSE module
    
    * test-suite/tests/cse.test: Remove.
    * test-suite/Makefile.am:

-----------------------------------------------------------------------

Summary of changes:
 test-suite/Makefile.am    |    3 +-
 test-suite/tests/cse.test |  305 ---------------------------------------------
 2 files changed, 1 insertions(+), 307 deletions(-)
 delete mode 100644 test-suite/tests/cse.test

diff --git a/test-suite/Makefile.am b/test-suite/Makefile.am
index 4d08d06..05e7134 100644
--- a/test-suite/Makefile.am
+++ b/test-suite/Makefile.am
@@ -1,7 +1,7 @@
 ## Process this file with automake to produce Makefile.in.
 ##
 ## Copyright 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009,
-##   2010, 2011, 2012, 2013 Software Foundation, Inc.
+##   2010, 2011, 2012, 2013, 2014 Software Foundation, Inc.
 ##
 ## This file is part of GUILE.
 ##
@@ -40,7 +40,6 @@ SCM_TESTS = tests/00-initial-env.test         \
            tests/continuations.test            \
            tests/coverage.test                 \
            tests/cross-compilation.test        \
-           tests/cse.test                      \
            tests/curried-definitions.test      \
            tests/dwarf.test                    \
            tests/ecmascript.test               \
diff --git a/test-suite/tests/cse.test b/test-suite/tests/cse.test
deleted file mode 100644
index 25e6626..0000000
--- a/test-suite/tests/cse.test
+++ /dev/null
@@ -1,305 +0,0 @@
-;;;; tree-il.test --- test suite for compiling tree-il   -*- scheme -*-
-;;;; Andy Wingo <address@hidden> --- May 2009
-;;;;
-;;;;   Copyright (C) 2009, 2010, 2011, 2012, 2013 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
-;;;; License as published by the Free Software Foundation; either
-;;;; version 3 of the License, or (at your option) any later version.
-;;;;
-;;;; This library is distributed in the hope that it will be useful,
-;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-;;;; Lesser General Public License for more details.
-;;;;
-;;;; You should have received a copy of the GNU Lesser General Public
-;;;; License along with this library; if not, write to the Free Software
-;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 
USA
-
-(define-module (test-suite tree-il)
-  #:use-module (test-suite lib)
-  #:use-module (system base compile)
-  #:use-module (system base pmatch)
-  #:use-module (system base message)
-  #:use-module (language tree-il)
-  #:use-module (language tree-il canonicalize)
-  #:use-module (language tree-il primitives)
-  #:use-module (language tree-il fix-letrec)
-  #:use-module (language tree-il cse)
-  #:use-module (language tree-il peval)
-  #:use-module (srfi srfi-13))
-
-(define-syntax pass-if-cse
-  (syntax-rules ()
-    ((_ in pat)
-     (pass-if 'in
-       (let ((evaled (unparse-tree-il
-                      (canonicalize
-                       (fix-letrec
-                        (cse
-                         (peval
-                          (expand-primitives
-                           (resolve-primitives
-                            (compile 'in #:from 'scheme #:to 'tree-il)
-                            (current-module))))))))))
-         (pmatch evaled
-           (pat #t)
-           (_   (pk 'cse-mismatch)
-                ((@ (ice-9 pretty-print) pretty-print)
-                 'in)
-                (newline)
-                ((@ (ice-9 pretty-print) pretty-print)
-                 evaled)
-                (newline)
-                ((@ (ice-9 pretty-print) pretty-print)
-                 'pat)
-                (newline)
-                #f)))))))
-
-
-(with-test-prefix "cse"
-
-  ;; The eq? propagates, and (if TEST #t #f) folds to TEST if TEST is
-  ;; boolean-valued.
-  (pass-if-cse
-   (lambda (x y)
-      (and (eq? x y)
-           (eq? x y)))
-    (lambda _
-     (lambda-case
-      (((x y) #f #f #f () (_ _))
-       (primcall eq? (lexical x _) (lexical y _))))))
-
-  ;; The eq? propagates, and (if TEST #f #t) folds to (not TEST).
-  (pass-if-cse
-   (lambda (x y)
-      (if (eq? x y) #f #t))
-    (lambda _
-     (lambda-case
-      (((x y) #f #f #f () (_ _))
-       (primcall not
-                 (primcall eq? (lexical x _) (lexical y _)))))))
-
-  ;; (if TEST (not TEST) #f)
-  ;; => (if TEST #f #f)
-  ;; => (begin TEST #f)
-  ;; => #f
-  (pass-if-cse
-    (lambda (x y)
-      (and (eq? x y) (not (eq? x y))))
-    (lambda _
-     (lambda-case
-      (((x y) #f #f #f () (_ _))
-       (const #f)))))
-
-  ;; (if TEST #f TEST) => (if TEST #f #f) => ...
-  (pass-if-cse
-   (lambda (x y)
-      (if (eq? x y) #f (eq? x y)))
-    (lambda _
-     (lambda-case
-      (((x y) #f #f #f () (_ _))
-       (const #f)))))
-
-  ;; The same, but side-effecting primitives do not propagate.
-  (pass-if-cse
-   (lambda (x y)
-      (and (set-car! x y) (not (set-car! x y))))
-    (lambda _
-     (lambda-case
-      (((x y) #f #f #f () (_ _))
-       (if (primcall set-car!
-                     (lexical x _)
-                     (lexical y _))
-           (primcall not
-                     (primcall set-car!
-                               (lexical x _)
-                               (lexical y _)))
-           (const #f))))))
-
-  ;; Primitives that access mutable memory can propagate, as long as
-  ;; there is no intervening mutation.
-  (pass-if-cse
-    (lambda (x y)
-      (and (string-ref x y)
-           (begin
-             (string-ref x y)
-             (not (string-ref x y)))))
-    (lambda _
-     (lambda-case
-      (((x y) #f #f #f () (_ _))
-       (seq (primcall string-ref
-                      (lexical x _)
-                      (lexical y _))
-            (const #f))))))
-
-  ;; However, expressions with dependencies on effects do not propagate
-  ;; through a lambda.
-  (pass-if-cse
-    (lambda (x y)
-      (and (string-ref x y)
-           (lambda ()
-             (and (string-ref x y) #t))))
-    (lambda _
-     (lambda-case
-      (((x y) #f #f #f () (_ _))
-       (if (primcall string-ref
-                     (lexical x _)
-                     (lexical y _))
-           (lambda _
-             (lambda-case
-              ((() #f #f #f () ())
-               (if (primcall string-ref
-                             (lexical x _)
-                             (lexical y _))
-                   (const #t)
-                   (const #f)))))
-           (const #f))))))
-
-  ;; A mutation stops the propagation.
-  (pass-if-cse
-    (lambda (x y)
-      (and (string-ref x y)
-           (begin
-             (string-set! x #\!)
-             (not (string-ref x y)))))
-    (lambda _
-     (lambda-case
-      (((x y) #f #f #f () (_ _))
-       (if (primcall string-ref
-                     (lexical x _)
-                     (lexical y _))
-           (seq (primcall string-set!
-                          (lexical x _)
-                          (const #\!))
-                (primcall not
-                          (primcall string-ref
-                                    (lexical x _)
-                                    (lexical y _))))
-           (const #f))))))
-
-  ;; Predicates are only added to the database if they are in a
-  ;; predicate context.
-  (pass-if-cse
-    (lambda (x y)
-      (begin (eq? x y) (eq? x y)))
-    (lambda _
-     (lambda-case
-      (((x y) #f #f #f () (_ _))
-       (primcall eq? (lexical x _) (lexical y _))))))
-
-  ;; Conditional bailouts do cause primitives to be added to the DB.
-  (pass-if-cse
-    (lambda (x y)
-      (begin (unless (eq? x y) (throw 'foo)) (eq? x y)))
-    (lambda _
-     (lambda-case
-      (((x y) #f #f #f () (_ _))
-       (seq (if (primcall eq?
-                          (lexical x _) (lexical y _))
-                (void)
-                (primcall throw (const foo)))
-            (const #t))))))
-
-  ;; A chain of tests in a conditional bailout add data to the DB
-  ;; correctly.
-  (pass-if-cse
-    (lambda (x y)
-      (begin
-        (unless (and (struct? x) (eq? (struct-vtable x) x-vtable))
-          (throw 'foo))
-        (if (and (struct? x) (eq? (struct-vtable x) x-vtable))
-            (struct-ref x y)
-            (throw 'bar))))
-    (lambda _
-     (lambda-case
-      (((x y) #f #f #f () (_ _))
-       (seq
-         (fix (failure) (_)
-              ((lambda _
-                 (lambda-case
-                  ((() #f #f #f () ())
-                   (primcall throw (const foo))))))
-              (if (primcall struct? (lexical x _))
-                  (if (primcall eq?
-                                (primcall struct-vtable (lexical x _))
-                                (toplevel x-vtable))
-                      (void)
-                      (call (lexical failure _)))
-                  (call (lexical failure _))))
-         (primcall struct-ref (lexical x _) (lexical y _)))))))
-
-  ;; Strict argument evaluation also adds info to the DB.
-  (pass-if-cse
-    (lambda (x)
-      ((lambda (z)
-         (+ z (if (and (struct? x) (eq? (struct-vtable x) x-vtable))
-                  (struct-ref x 2)
-                  (throw 'bar))))
-       (if (and (struct? x) (eq? (struct-vtable x) x-vtable))
-           (struct-ref x 1)
-           (throw 'foo))))
-    
-    (lambda _
-      (lambda-case
-       (((x) #f #f #f () (_))
-        (let (z) (_)
-             ((fix (failure) (_)
-                   ((lambda _
-                      (lambda-case
-                       ((() #f #f #f () ())
-                        (primcall throw (const foo))))))
-                   (if (primcall struct? (lexical x _))
-                       (if (primcall eq?
-                                     (primcall struct-vtable (lexical x _))
-                                     (toplevel x-vtable))
-                           (primcall struct-ref (lexical x _) (const 1))
-                           (call (lexical failure _)))
-                       (call (lexical failure _)))))
-             (primcall + (lexical z _)
-                       (primcall struct-ref (lexical x _) (const 2))))))))
-
-  ;; Replacing named expressions with lexicals.
-  (pass-if-cse
-   (let ((x (car y)))
-     (cons x (car y)))
-   (let (x) (_) ((primcall car (toplevel y)))
-        (primcall cons (lexical x _) (lexical x _))))
-
-  ;; Dominating expressions only provide predicates when evaluated in
-  ;; test context.
-  (pass-if-cse
-   (let ((t (car x)))
-     (if (car x)
-         'one
-         'two))
-   ;; Actually this one should reduce in other ways, but this is the
-   ;; current reduction:
-   (seq
-     (primcall car (toplevel x))
-     (if (primcall car (toplevel x))
-         (const one)
-         (const two))))
-
-  (pass-if-cse
-   (begin (cons 1 2 3) 4)
-   (seq
-     (primcall cons (const 1) (const 2) (const 3))
-     (const 4)))
-
-  (pass-if "http://bugs.gnu.org/12883";
-    ;; In 2.0.6, compiling this code would trigger an out-of-bounds
-    ;; vlist access in CSE's traversal of its "database".
-    (procedure?
-     (compile '(lambda (v)
-                 (let ((failure (lambda () (bail-out 'match))))
-                   (if (and (pair? v)
-                            (null? (cdr v)))
-                       (let ((w foo)
-                             (x (cdr w)))
-                         (if (and (pair? x) (null? w))
-                             #t
-                             (failure)))
-                       (failure))))
-              #:from 'scheme))))


hooks/post-receive
-- 
GNU Guile