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 "CMU Common Lisp".
The branch, master has been updated via 9ca40a2b90607cd33577644c5cd5d38ae5fe1354 (commit) from d08b5bf8259bcd458beec17ba65a7b85f454edda (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 9ca40a2b90607cd33577644c5cd5d38ae5fe1354 Author: Raymond Toy toy.raymond@gmail.com Date: Thu Aug 28 19:37:32 2014 -0700
Fix round-quotient-bound to handle exclusive bounds better.
All the tests should pass now.
diff --git a/src/compiler/srctran.lisp b/src/compiler/srctran.lisp index c2e1a83..14c353c 100644 --- a/src/compiler/srctran.lisp +++ b/src/compiler/srctran.lisp @@ -1768,13 +1768,32 @@ (flet ((round-it (quot) (let ((lo (interval-low quot)) (hi (interval-high quot))) - (setf lo (if lo - (round (bound-value lo)) - nil)) - ;; For the upper bound, we need to be careful - (setf hi (if hi - (round (bound-value hi)) - nil)) + (when lo + ;; Need to handle carefully the case where the lower + ;; bound is exclusive. This is only a problem when + ;; the remainder is exactly +1/2 where the quotient + ;; has been rounded down. In this case, quotient + ;; should be one higher. For example (round 2.5) -> + ;; 2, 0.5, but (round 2.500001) -> 3, -0.49999. + (multiple-value-bind (q r) + (round (bound-value lo)) + (setf lo + (if (and (consp lo) (= r 1/2)) + (1+ q) + q)))) + (when hi + (multiple-value-bind (q r) + (round (bound-value hi)) + ;; Need to handle carefully the case where the upper + ;; bound is exclusive. This is only a problem when + ;; the remainder is exactly -1/2 where the quotient + ;; has been rounded up. In this case, quotient should + ;; be one less. For example but (round 1.5) -> 2, + ;; -0.5 but (round 1.49999) -> 1, .49999. + (setf hi + (if (and (= r -1/2) (consp hi)) + (1- q) + q)))) (make-interval :low lo :high hi)))) (case (interval-range-info quot) (+
-----------------------------------------------------------------------
Summary of changes: src/compiler/srctran.lisp | 33 ++++++++++++++++++++++++++------- 1 file changed, 26 insertions(+), 7 deletions(-)
hooks/post-receive