[Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.9-174-g4dc4b86

[Mark H Weaver]

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=4dc4b86e858d391d20d0ea2551614a89fa3bd4d1

The branch, stable-2.0 has been updated
       via  4dc4b86e858d391d20d0ea2551614a89fa3bd4d1 (commit)
       via  ca5e0414e96886177d883a249edd957d2331db65 (commit)
       via  a7a4ba6a2de7dee9b5c9e2fa5e0c3caf022c0b14 (commit)
      from  3e2e49650c7360f7bba03219943334e2eabd3d91 (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 4dc4b86e858d391d20d0ea2551614a89fa3bd4d1
Author: Mark H Weaver <address@hidden>
Date:   Tue Jan 28 17:44:22 2014 -0500

    Primitive expand numerical comparisons with more than 2 arguments.
    
    * module/language/tree-il/primitives.scm (chained-comparison-expander):
      New procedure.
      (*primitive-expand-table*): Add primitive expanders for '<', '>',
      '<=', '>=', and '='.

commit ca5e0414e96886177d883a249edd957d2331db65
Author: Mark H Weaver <address@hidden>
Date:   Tue Jan 28 16:54:10 2014 -0500

    Add 'positive?' and 'negative?' as primitives.
    
    * module/language/tree-il/primitives.scm (*interesting-primitive-names*)
      (*effect-free-primitives*): Add 'positive?' and 'negative?'.
      (*primitive-expand-table*): Add primitive expanders for 'positive?'
      and 'negative?'.

commit a7a4ba6a2de7dee9b5c9e2fa5e0c3caf022c0b14
Author: Andy Wingo <address@hidden>
Date:   Tue Jan 28 22:28:08 2014 +0100

    Minor for-each speedup
    
    * module/ice-9/boot-9.scm (for-each): Minor speedup by unrolling
      tortoise/hare loop.

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

Summary of changes:
 module/ice-9/boot-9.scm                |   21 ++++++++++-----------
 module/language/tree-il/primitives.scm |   32 +++++++++++++++++++++++++++++---
 2 files changed, 39 insertions(+), 14 deletions(-)

diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm
index fe9ae78..98cefe9 100644
--- a/module/ice-9/boot-9.scm
+++ b/module/ice-9/boot-9.scm
@@ -687,23 +687,22 @@ information is unavailable."
 (define for-each
   (case-lambda
     ((f l)
-     (let for-each1 ((hare l) (tortoise l) (move? #f))
+     (let for-each1 ((hare l) (tortoise l))
        (if (pair? hare)
-           (if move?
-               (if (eq? tortoise hare)
-                   (scm-error 'wrong-type-arg "for-each" "Circular list: ~S"
-                              (list l) #f)
+           (begin
+             (f (car hare))
+             (let ((hare (cdr hare)))
+               (if (pair? hare)
                    (begin
+                     (when (eq? tortoise hare)
+                       (scm-error 'wrong-type-arg "for-each" "Circular list: 
~S"
+                                  (list l) #f))
                      (f (car hare))
-                     (for-each1 (cdr hare) (cdr tortoise) #f)))
-               (begin
-                 (f (car hare))
-                 (for-each1 (cdr hare) tortoise #t)))
-           
+                     (for-each1 (cdr hare) (cdr tortoise))))))
            (if (not (null? hare))
                (scm-error 'wrong-type-arg "for-each" "Not a list: ~S"
                           (list l) #f)))))
-    
+
     ((f l1 l2)
      (let for-each2 ((h1 l1) (h2 l2) (t1 l1) (t2 l2) (move? #f))
        (cond
diff --git a/module/language/tree-il/primitives.scm 
b/module/language/tree-il/primitives.scm
index 15b5c44..e9fd0e9 100644
--- a/module/language/tree-il/primitives.scm
+++ b/module/language/tree-il/primitives.scm
@@ -35,7 +35,7 @@
 
 ;; When adding to this, be sure to update *multiply-valued-primitives*
 ;; if appropriate.
-(define *interesting-primitive-names* 
+(define *interesting-primitive-names*
   '(apply @apply
     call-with-values @call-with-values
     call-with-current-continuation @call-with-current-continuation
@@ -45,7 +45,7 @@
     values
     eq? eqv? equal?
     memq memv
-    = < > <= >= zero?
+    = < > <= >= zero? positive? negative?
     + * - / 1- 1+ quotient remainder modulo
     ash logand logior logxor lognot
     not
@@ -150,7 +150,7 @@
 (define *effect-free-primitives*
   `(values
     eq? eqv? equal?
-    = < > <= >= zero?
+    = < > <= >= zero? positive? negative?
     ash logand logior logxor lognot
     + * - / 1- 1+ quotient remainder modulo
     not
@@ -331,6 +331,12 @@
 (define-primitive-expander zero? (x)
   (= x 0))
 
+(define-primitive-expander positive? (x)
+  (> x 0))
+
+(define-primitive-expander negative? (x)
+  (< x 0))
+
 ;; FIXME: All the code that uses `const?' is redundant with `peval'.
 
 (define-primitive-expander +
@@ -485,6 +491,26 @@
 (define-primitive-expander f64vector-set! (vec i x)
   (bytevector-ieee-double-native-set! vec (* i 8) x))
 
+(define (chained-comparison-expander prim-name)
+  (case-lambda
+    ((src) (make-const src #t))
+    ((src a) #f)
+    ((src a b) #f)
+    ((src a b . rest)
+     (make-conditional src
+                       (make-application src
+                                         (make-primitive-ref src prim-name)
+                                         (list a b))
+                       (make-application src
+                                         (make-primitive-ref src prim-name)
+                                         (cons b rest))
+                       (make-const src #f)))))
+
+(for-each (lambda (prim-name)
+            (hashq-set! *primitive-expand-table* prim-name
+                        (chained-comparison-expander prim-name)))
+          '(< > <= >= =))
+
 ;; Appropriate for use with either 'eqv?' or 'equal?'.
 (define maybe-simplify-to-eq
   (case-lambda


hooks/post-receive
-- 
GNU Guile