[Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.5-178-g2874f66

[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=2874f66017b7bfae256e85af84689d00ecc418ab

The branch, stable-2.0 has been updated
       via  2874f66017b7bfae256e85af84689d00ecc418ab (commit)
       via  5cfa385db721222069aa5a74421cbac6e6cee26a (commit)
       via  4d1ae112792cb8faaa1f42b5c7332e9de05001ee (commit)
       via  378daa5fa51f1d193f7236c2691acba59e9af539 (commit)
      from  03fcf93bff9f02a3d12ab86be4e67b996310aad4 (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 2874f66017b7bfae256e85af84689d00ecc418ab
Author: Andy Wingo <address@hidden>
Date:   Fri Jun 22 12:30:39 2012 +0200

    add char->integer, number->string etc to interesting primitives
    
    * module/language/tree-il/primitives.scm (*interesting-primitive-names*):
      (*effect-free-primitives*): Add string->number, number->string,
      integer->char, and char->integer to allow for constant folding and
      better effects analysis.

commit 5cfa385db721222069aa5a74421cbac6e6cee26a
Author: Andy Wingo <address@hidden>
Date:   Fri Jun 22 12:29:08 2012 +0200

    update version-etc copyright year
    
    * module/ice-9/command-line.scm (version-etc): Update copyright year to
      2012.

commit 4d1ae112792cb8faaa1f42b5c7332e9de05001ee
Author: Andy Wingo <address@hidden>
Date:   Fri Jun 22 12:25:34 2012 +0200

    cse: expressions evaluated for effect do not provide predicates
    
    * module/language/tree-il/cse.scm (cse): When trying to fold
      conditionals, only look at entries in the database that were added in
      test context.
    
    * test-suite/tests/cse.test ("cse"): Add a test case.

commit 378daa5fa51f1d193f7236c2691acba59e9af539
Author: Andy Wingo <address@hidden>
Date:   Mon Jun 11 12:25:24 2012 +0200

    scandir: select? takes basenames, operates on (sub)dirs also
    
    * module/ice-9/ftw.scm (scandir): Run the select? procedure on all
      items, including subdirs and the `.' and `..' entries.  Pass it the
      basename of the file in question instead of the full name.
    
    * test-suite/tests/ftw.test ("scandir"): Adapt expectation for the .test
      selector.  Add test for a selector that rejects everything.

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

Summary of changes:
 module/ice-9/command-line.scm          |    2 +-
 module/ice-9/ftw.scm                   |   19 +++++++++++--------
 module/language/tree-il/cse.scm        |    4 ++--
 module/language/tree-il/primitives.scm |    3 +++
 test-suite/tests/cse.test              |   17 ++++++++++++++++-
 test-suite/tests/ftw.test              |    7 +++++--
 6 files changed, 38 insertions(+), 14 deletions(-)

diff --git a/module/ice-9/command-line.scm b/module/ice-9/command-line.scm
index 8aed74e..62a2c9e 100644
--- a/module/ice-9/command-line.scm
+++ b/module/ice-9/command-line.scm
@@ -66,7 +66,7 @@ There is NO WARRANTY, to the extent permitted by law."))
 (define* (version-etc package version #:key
                       (port (current-output-port))
                       ;; FIXME: authors
-                      (copyright-year 2011)
+                      (copyright-year 2012)
                       (copyright-holder "Free Software Foundation, Inc.")
                       (copyright (format #f "Copyright (C) ~a ~a"
                                          copyright-year copyright-holder))
diff --git a/module/ice-9/ftw.scm b/module/ice-9/ftw.scm
index 96422b5..6c9db27 100644
--- a/module/ice-9/ftw.scm
+++ b/module/ice-9/ftw.scm
@@ -538,26 +538,29 @@ of file names is sorted according to ENTRY<?, which 
defaults to
   (define (enter? dir stat result)
     (and stat (string=? dir name)))
 
-  (define (leaf name stat result)
-    (if (select? name)
-        (and (pair? result)                      ; must have a "." entry
-             (cons (basename name) result))
+  (define (visit basename result)
+    (if (select? basename)
+        (cons basename result)
         result))
 
+  (define (leaf name stat result)
+    (and result
+         (visit (basename name) result)))
+
   (define (down name stat result)
-    (list "."))
+    (visit "." '()))
 
   (define (up name stat result)
-    (cons ".." result))
+    (visit ".." result))
 
   (define (skip name stat result)
     ;; All the sub-directories are skipped.
-    (cons (basename name) result))
+    (visit (basename name) result))
 
   (define (error name* stat errno result)
     (if (string=? name name*)             ; top-level NAME is unreadable
         result
-        (cons (basename name*) result)))
+        (visit (basename name*) result)))
 
   (and=> (file-system-fold enter? leaf down up skip error #f name stat)
          (lambda (files)
diff --git a/module/language/tree-il/cse.scm b/module/language/tree-il/cse.scm
index ceef15f..b8e7229 100644
--- a/module/language/tree-il/cse.scm
+++ b/module/language/tree-il/cse.scm
@@ -276,11 +276,11 @@
            #f)))
        (_
         (cond
-         ((find-dominating-expression exp effects #f db)
+         ((find-dominating-expression exp effects 'test db)
           ;; We have an EXP fact, so we infer #t.
           (log 'inferring exp #t)
           (make-const (tree-il-src exp) #t))
-         ((find-dominating-expression (negate exp 'test) effects #f db)
+         ((find-dominating-expression (negate exp 'test) effects 'test db)
           ;; We have a (not EXP) fact, so we infer #f.
           (log 'inferring exp #f)
           (make-const (tree-il-src exp) #f))
diff --git a/module/language/tree-il/primitives.scm 
b/module/language/tree-il/primitives.scm
index dba31bd..a1c5adc 100644
--- a/module/language/tree-il/primitives.scm
+++ b/module/language/tree-il/primitives.scm
@@ -54,6 +54,8 @@
 
     char<? char<=? char>=? char>?
 
+    integer->char char->integer number->string string->number
+
     acons cons cons*
 
     list vector
@@ -154,6 +156,7 @@
     pair? null? list? symbol? vector? struct? string? number? char?
     complex? real? rational? inf? nan? integer? exact? inexact? even? odd?
     char<? char<=? char>=? char>?
+    integer->char char->integer number->string string->number
     struct-vtable
     string-length
     ;; These all should get expanded out by expand-primitives!.
diff --git a/test-suite/tests/cse.test b/test-suite/tests/cse.test
index ee31285..d01d318 100644
--- a/test-suite/tests/cse.test
+++ b/test-suite/tests/cse.test
@@ -271,4 +271,19 @@
    (let ((x (car y)))
      (cons x (car y)))
    (let (x) (_) ((apply (primitive car) (toplevel y)))
-        (apply (primitive cons) (lexical x _) (lexical x _)))))
+        (apply (primitive 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:
+   (begin
+     (apply (primitive car) (toplevel x))
+     (if (apply (primitive car) (toplevel x))
+         (const one)
+         (const two)))))
diff --git a/test-suite/tests/ftw.test b/test-suite/tests/ftw.test
index 805c779..33537d0 100644
--- a/test-suite/tests/ftw.test
+++ b/test-suite/tests/ftw.test
@@ -310,14 +310,17 @@
   (pass-if "test-suite"
     (let ((select? (cut string-suffix? ".test" <>)))
       (match (scandir (string-append %test-dir "/tests") select?)
-        (("." ".." "00-initial-env.test" (? select?) ...)
+        (("00-initial-env.test" (? select?) ...)
          #t))))
 
   (pass-if "flat file"
     (not (scandir (string-append %test-dir "/Makefile.am"))))
 
   (pass-if "EACCES"
-    (not (scandir "/.does-not-exist."))))
+    (not (scandir "/.does-not-exist.")))
+
+  (pass-if "no select"
+    (null? (scandir %test-dir (lambda (_) #f)))))
 
 ;;; Local Variables:
 ;;; eval: (put 'with-file-tree 'scheme-indent-function 2)


hooks/post-receive
-- 
GNU Guile