[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.9-68-g71673f
From: |
Mark H Weaver |
Subject: |
[Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.9-68-g71673fb |
Date: |
Tue, 13 Aug 2013 00:06:10 +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=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
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.9-68-g71673fb,
Mark H Weaver <=