common-lisp/sbcl.sbcl
1
0
Fork 0
mirror of git://git.code.sf.net/p/sbcl/sbcl synced 2026-09-10 07:26:40 -04:00
Code Issues Actions 8 Packages Projects Releases Wiki Activity

Fix (ceiling (abs (ceiling ..)) ..) transform

Browse source 
The signs should be matching.
This commit is contained in:
Stas Boukarev 2026-01-14 09:11:27 +03:00
parent a4d44b2dc1
commit 6b7b3b5524
2 changed files with 39 additions and 2 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

17
src/compiler/srctran.lisp
View file

@ -5278,6 +5278,12 @@
(give-up-ir1-transform)))
(defun integer-type-sign (type)
(cond ((csubtypep type (specifier-type '(integer 0)))
1)
((csubtypep type (specifier-type '(integer * 0)))
-1)))
(defvar *amc-abs*)
(defun associate-multiplication-constants (lvar constant outer-node &key divide
@ -5357,7 +5363,16 @@
(eq name divide)
(or (eq name 'truncate)
;; The outer divisor has to be positive
(plusp constant)))
(plusp constant))
(or (not *amc-abs*)
(let ((sign (integer-type-sign (lvar-type (first args))))
(d-sign (signum (lvar-value (second args)))))
(case name
(ceiling
(eql sign d-sign))
(floor
(and sign
(/= sign d-sign)))))))
(let ((d (value (second args))))
(when (and (integerp d)
(not (eql d 0)))

24
tests/arith-2.pure.lisp
View file

@ -2008,7 +2008,29 @@
`(lambda (v)
(declare (integer v))
(values (ceiling (ceiling v 7) -3)))
((15) -1))))
((15) -1))
(checked-compile-and-assert
()
`(lambda (v)
(declare (integer v))
(values (floor (abs (floor v 5)) 4)))
((-19) 1))
(checked-compile-and-assert
()
`(lambda (v)
(declare (integer v))
(values (ceiling (abs (ceiling v -5)) 10)))
((1) 0))
(test '(floor sb-kernel::floor1)
`(lambda (a)
(declare (unsigned-byte a))
(values (floor (abs (floor a -10)) 20)))
1)
(test '(ceiling sb-kernel::ceiling1)
`(lambda (a)
(declare (unsigned-byte a))
(values (ceiling (abs (ceiling a 10)) 20)))
1)))
(with-test (:name :logtest)
(when (ctu:vop-existsp 'logtest)