[Guile-commits] GNU Guile branch, master, updated. v2.1.0-150-g79a6c3b

[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=79a6c3be6a7085e5a602f5306f162e5c93c1636a

The branch, master has been updated
       via  79a6c3be6a7085e5a602f5306f162e5c93c1636a (commit)
       via  71673fba930d735c09184d5ca115882239edabb3 (commit)
       via  73b98028f0bbc5acf98dfc55ac4130e2fc33bcc0 (commit)
      from  062888f7bbb192f758cd7179a4c0c3898e805371 (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 79a6c3be6a7085e5a602f5306f162e5c93c1636a
Merge: 062888f 71673fb
Author: Mark H Weaver <address@hidden>
Date:   Mon Aug 12 21:36:45 2013 -0400

    Merge remote-tracking branch 'origin/stable-2.0'

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

Summary of changes:
 module/language/tree-il/primitives.scm |   45 ++++++++++++++-----------------
 1 files changed, 20 insertions(+), 25 deletions(-)

diff --git a/module/language/tree-il/primitives.scm 
b/module/language/tree-il/primitives.scm
index f738b74..06b7a11 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)
@@ -199,8 +200,7 @@
 (define *negatable-primitives*
   '((even? . odd?)
     (exact? . inexact?)
-    (< . >=)
-    (> . <=)
+    ;; (< <= > >=) are not negatable because of NaNs.
     (char<? . char>=?)
     (char>? . char<=?)))
 
@@ -351,13 +351,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))
@@ -367,50 +368,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