[Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.9-68-g71673fb

[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=71673fba930d735c09184d5ca115882239edabb3

The branch, stable-2.0 has been updated
       via  71673fba930d735c09184d5ca115882239edabb3 (commit)
      from  73b98028f0bbc5acf98dfc55ac4130e2fc33bcc0 (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 71673fba930d735c09184d5ca115882239edabb3
Author: Mark H Weaver <address@hidden>
Date:   Mon Aug 12 19:40:32 2013 -0400

    Common numeric operations are left-to-right associative.
    
    * module/language/tree-il/primitives.scm (define-primitive-expander):
      Use 'match-lambda*' instead of 'case-lambda' for pattern matching.
      (*primitive-expand-table*): In primitive expanders for '+', '*', '-',
      '/', 'logior', and 'logand', assume conventional left-to-right
      associativity.

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

Summary of changes:
 module/language/tree-il/primitives.scm |   42 ++++++++++++++-----------------
 1 files changed, 19 insertions(+), 23 deletions(-)

diff --git a/module/language/tree-il/primitives.scm 
b/module/language/tree-il/primitives.scm
index 43f0fb4..15b5c44 100644
--- a/module/language/tree-il/primitives.scm
+++ b/module/language/tree-il/primitives.scm
@@ -20,6 +20,7 @@
 
 (define-module (language tree-il primitives)
   #:use-module (system base pmatch)
+  #:use-module (ice-9 match)
   #:use-module (rnrs bytevectors)
   #:use-module (system base syntax)
   #:use-module (language tree-il)
@@ -318,13 +319,14 @@
      (else (error "bad consequent yall" exp))))
   `(hashq-set! *primitive-expand-table*
                ',sym
-               (case-lambda
+               (match-lambda*
                 ,@(let lp ((in clauses) (out '()))
                     (if (null? in)
-                        (reverse (cons '(else #f) out))
+                        (reverse (cons '(_ #f) out))
                         (lp (cddr in)
                             (cons `((src . ,(car in))
-                                    ,(consequent (cadr in))) out)))))))
+                                    ,(consequent (cadr in)))
+                                  out)))))))
 
 (define-primitive-expander zero? (x)
   (= x 0))
@@ -334,50 +336,44 @@
 (define-primitive-expander +
   () 0
   (x) (values x)
-  (x y) (if (and (const? y)
-                 (let ((y (const-exp y)))
-                   (and (number? y) (exact? y) (= y 1))))
+  (x y) (if (and (const? y) (eqv? (const-exp y) 1))
             (1+ x)
-            (if (and (const? y)
-                     (let ((y (const-exp y)))
-                       (and (number? y) (exact? y) (= y -1))))
+            (if (and (const? y) (eqv? (const-exp y) -1))
                 (1- x)
-                (if (and (const? x)
-                         (let ((x (const-exp x)))
-                           (and (number? x) (exact? x) (= x 1))))
+                (if (and (const? x) (eqv? (const-exp x) 1))
                     (1+ y)
-                    (+ x y))))
-  (x y z . rest) (+ x (+ y z . rest)))
-  
+                    (if (and (const? x) (eqv? (const-exp x) -1))
+                        (1- y)
+                        (+ x y)))))
+  (x y z ... last) (+ (+ x y . z) last))
+
 (define-primitive-expander *
   () 1
   (x) (values x)
-  (x y z . rest) (* x (* y z . rest)))
+  (x y z ... last) (* (* x y . z) last))
   
 (define-primitive-expander -
   (x) (- 0 x)
-  (x y) (if (and (const? y)
-                 (let ((y (const-exp y)))
-                   (and (number? y) (exact? y) (= y 1))))
+  (x y) (if (and (const? y) (eqv? (const-exp y) 1))
             (1- x)
             (- x y))
-  (x y z . rest) (- x (+ y z . rest)))
+  (x y z ... last) (- (- x y . z) last))
   
 (define-primitive-expander /
   (x) (/ 1 x)
-  (x y z . rest) (/ x (* y z . rest)))
+  (x y z ... last) (/ (/ x y . z) last))
   
 (define-primitive-expander logior
   () 0
   (x) (logior x 0)
   (x y) (logior x y)
-  (x y z . rest) (logior x (logior y z . rest)))
+  (x y z ... last) (logior (logior x y . z) last))
 
 (define-primitive-expander logand
   () -1
   (x) (logand x -1)
   (x y) (logand x y)
-  (x y z . rest) (logand x (logand y z . rest)))
+  (x y z ... last) (logand (logand x y . z) last))
 
 (define-primitive-expander caar (x) (car (car x)))
 (define-primitive-expander cadr (x) (car (cdr x)))


hooks/post-receive
-- 
GNU Guile