[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] GNU Guile branch, master, updated. v2.1.0-150-g79a6c3b
From: |
Mark H Weaver |
Subject: |
[Guile-commits] GNU Guile branch, master, updated. v2.1.0-150-g79a6c3b |
Date: |
Tue, 13 Aug 2013 12:37:22 +0000 |
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
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Guile-commits] GNU Guile branch, master, updated. v2.1.0-150-g79a6c3b,
Mark H Weaver <=