[Guile-commits] 01/02: Minor tweak to truncate-bits

[Andy Wingo]

wingo pushed a commit to branch master
in repository guile.

commit 1432088f2780aff52cad7639d440e2f932478f60
Author: Andy Wingo <wingo@pobox.com>
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)