[prev in list] [next in list] [prev in thread] [next in thread] 

List:       sbcl-commits
Subject:    [Sbcl-commits] master: Transform fixnum-mod-p based on the input type.
From:       stassats via Sbcl-commits <sbcl-commits () lists ! sourceforge ! net>
Date:       2023-06-30 11:52:46
Message-ID: 1688125967.209060.20260 () sfp-scm-5 ! v30 ! lw ! sourceforge ! com
[Download RAW message or body]

The branch "master" has been updated in SBCL:
       via  ce39b45f8c1dfe3b530fd80f3d88b738a2d63b28 (commit)
      from  4db65e138279635308288f7070570529a784d10f (commit)

- Log -----------------------------------------------------------------
commit ce39b45f8c1dfe3b530fd80f3d88b738a2d63b28
Author: Stas Boukarev <stassats@gmail.com>
Date:   Fri Jun 30 14:29:30 2023 +0300

    Transform fixnum-mod-p based on the input type.
    
    (typep (the (or array (unsigned-byte 8)) x) '(unsigned-byte 32))
    =>
    (fixnump x)
    
    (typep (the (or array (signed-byte 8)) x) '(unsigned-byte 32))
    =>
    (typep x '(unsigned-byte 7))
    
    (typep (the (signed-byte 8) x) '(unsigned-byte 32))
    =>
    (>= x 0)
---
 src/compiler/typetran.lisp | 20 ++++++++++++++++++++
 1 file changed, 20 insertions(+)

diff --git a/src/compiler/typetran.lisp b/src/compiler/typetran.lisp
index 7a625e3d3..bee42d8a3 100644
--- a/src/compiler/typetran.lisp
+++ b/src/compiler/typetran.lisp
@@ -1584,3 +1584,23 @@
     (if pred
         `(not (,pred object))
         (give-up-ir1-transform))))
+
+(when-vop-existsp (:translate fixnum-mod-p)
+  (deftransform fixnum-mod-p ((x mod) (t (constant-arg fixnum)) * :important nil)
+    (let* ((type (lvar-type x))
+           (mod (lvar-value mod))
+           (intersect (type-intersection type (specifier-type 'fixnum)))
+           (mod-type (specifier-type `(mod ,(1+ mod)))))
+      (cond ((csubtypep intersect mod-type)
+             `(fixnump x))
+            ((and (csubtypep type (specifier-type 'fixnum))
+                  (csubtypep (type-intersection type (specifier-type 'unsigned-byte))
+                             mod-type))
+             `(>= x 0))
+            ((let ((int (type-approximate-interval intersect)))
+               (when int
+                 (let ((power-of-two (1- (ash 1 (integer-length (interval-high int))))))
+                   (when (< 0 power-of-two mod)
+                     `(fixnum-mod-p x ,power-of-two))))))
+            (t
+             (give-up-ir1-transform))))))

-----------------------------------------------------------------------


hooks/post-receive
-- 
SBCL


_______________________________________________
Sbcl-commits mailing list
Sbcl-commits@lists.sourceforge.net
https://lists.sourceforge.net/lists/listinfo/sbcl-commits
[prev in list] [next in list] [prev in thread] [next in thread]