wingo pushed a commit to branch master
in repository guile.
commit 1432088f2780aff52cad7639d440e2f932478f60
Author: Andy Wingo <[email protected]>
AuthorDate: Fri May 7 16:13:09 2021 +0200
Minor tweak to truncate-bits
* module/system/base/types/internal.scm (truncate-bits): Use bits-case
in all cases.
---
module/system/base/types/internal.scm | 13 +++++--------
1 file changed, 5 insertions(+), 8 deletions(-)
diff --git a/module/system/base/types/internal.scm
b/module/system/base/types/internal.scm
index 0514d7b..546c6d2 100644
--- a/module/system/base/types/internal.scm
+++ b/module/system/base/types/internal.scm
@@ -231,21 +231,18 @@ may not fit into a word on the target platform."
(define (truncate-bits x bits signed?)
(define-syntax-rule (bits-case bits)
- (let ((umax (1- (ash 1 bits)))
- (smin (ash -1 (1- bits)))
- (smax (1- (ash 1 (1- bits)))))
+ (let ((umax (1- (ash 1 bits))))
(and (if signed?
- (<= smin x smax)
+ (let ((smin (ash -1 (1- bits)))
+ (smax (1- (ash 1 (1- bits)))))
+ (<= smin x smax))
(<= 0 x umax))
(logand x umax))))
(case bits
((16) (bits-case 16))
((32) (bits-case 32))
((64) (bits-case 64))
- (else
- (let ((x' (logand x (1- (ash 1 bits)))))
- (and (eq? x (if signed? (sign-extend x' bits) x'))
- x')))))
+ (else (bits-case bits))))
;; See discussion in tags.h and boolean.h.
(eval-when (expand)
