;;;; arithmetic tests without side effects

;;;; This software is part of the SBCL system. See the README file for
;;;; more information.
;;;;
;;;; While most of SBCL is derived from the CMU CL system, the test
;;;; files (like this one) were written from scratch after the fork
;;;; from CMU CL.
;;;;
;;;; This software is in the public domain and is provided with
;;;; absolutely no warranty. See the COPYING and CREDITS files for
;;;; more information.

(defmacro define-compiled-fun (fun name)
  `(progn
    (declaim (notinline ,name))
    (defun ,name (&rest args)
     (declare (optimize safety))
     (case (length args)
       (1 (,fun (car args)))
       (2 (,fun (car args) (cadr args)))
       (t (apply #',fun args))))))

(define-compiled-fun min compiled-min)
(define-compiled-fun max compiled-max)
(define-compiled-fun + compiled-+)
(define-compiled-fun * compiled-*)
(define-compiled-fun logand compiled-logand)
(define-compiled-fun logior compiled-logior)
(define-compiled-fun logxor compiled-logxor)

(assert (null (ignore-errors (compiled-min '(1 2 3)))))
(assert (= (compiled-min -1) -1))
(assert (null (ignore-errors (compiled-min 1 #(1 2 3)))))
(assert (= (compiled-min 10 11) 10))
(assert (null (ignore-errors (compiled-min (find-package "CL") -5.0))))
(assert (= (compiled-min 5.0 -3) -3))
(assert (null (ignore-errors (compiled-max #c(4 3)))))
(assert (= (compiled-max 0) 0))
(assert (null (ignore-errors (compiled-max "MIX" 3))))
(assert (= (compiled-max -1 10.0) 10.0))
(assert (null (ignore-errors (compiled-max 3 #'max))))
(assert (= (compiled-max -3 0) 0))

(assert (null (ignore-errors (compiled-+ "foo"))))
(assert (= (compiled-+ 3f0) 3f0))
(assert (null (ignore-errors (compiled-+ 1 #p"tmp"))))
(assert (= (compiled-+ 1 2) 3))
(assert (null (ignore-errors (compiled-+ '(1 2 3) 3))))
(assert (= (compiled-+ 3f0 4f0) 7f0))
(assert (null (ignore-errors (compiled-* "foo"))))
(assert (= (compiled-* 3f0) 3f0))
(assert (null (ignore-errors (compiled-* 1 #p"tmp"))))
(assert (= (compiled-* 1 2) 2))
(assert (null (ignore-errors (compiled-* '(1 2 3) 3))))
(assert (= (compiled-* 3f0 4f0) 12f0))

(assert (null (ignore-errors (compiled-logand #(1)))))
(assert (= (compiled-logand 1) 1))
(assert (null (ignore-errors (compiled-logior 3f0))))
(assert (= (compiled-logior 4) 4))
(assert (null (ignore-errors (compiled-logxor #c(2 3)))))
(assert (= (compiled-logxor -6) -6))

(with-test (:name (coerce :overflow))
  (checked-compile-and-assert
      ()
      '(lambda (n) (coerce n 'single-float))
    (((expt 10 1000)) #+no-float-traps sb-ext:single-float-positive-infinity
                      #-no-float-traps (condition 'floating-point-overflow))))

(defun are-we-getting-ash-right (x y)
  (declare (optimize speed)
           (type (unsigned-byte 32) x)
           (type (integer -40 0) y))
  (ash x y))
(defun what-about-with-constants (x)
  (declare (optimize speed) (type (unsigned-byte 32) x))
  (ash x -32))

(dotimes (i 41)
  (assert (= (are-we-getting-ash-right (1- (ash 1 32)) (- i))
             (if (< i 32)
                 (1- (ash 1 (- 32 i)))
                 0))))
(assert (= (what-about-with-constants (1- (ash 1 32))) 0))

(defun one-more-test-case-to-catch-sparc (x y)
  (declare (optimize speed (safety 0))
           (type (unsigned-byte 32) x) (type (integer -40 2) y))
  (the (unsigned-byte 32) (ash x y)))
(assert (= (one-more-test-case-to-catch-sparc (1- (ash 1 32)) -40) 0))


(eval-when (:compile-toplevel :load-toplevel :execute)
  (defvar *n-fixnum-bits* (- sb-vm:n-word-bits sb-vm::n-fixnum-tag-bits))
  (defvar *shifts* (let ((list (list 0
                                     1
                                     (1- sb-vm:n-word-bits)
                                     sb-vm:n-word-bits
                                     (1+ sb-vm:n-word-bits))))
                     (append list (mapcar #'- list)))))

(macrolet ((nc-list ()
             `(list ,@(loop for i from 0 below (length *shifts*)
                         collect `(frob (nth ,i *shifts*)))))
           (c-list ()
             `(list ,@(loop for i from 0 below (length *shifts*)
                         collect `(frob ,(nth i *shifts*))))))
  (defun nc-ash (x)
    (macrolet ((frob (y)
                 `(list x ,y (ash x ,y))))
      (nc-list)))
  (defun c-ash (x)
    (macrolet ((frob (y)
                 `(list x ,y (ash x ,y))))
      (c-list)))
  (defun nc-modular-ash-ub (x)
    (macrolet ((frob (y)
                 `(list x ,y (logand most-positive-fixnum (ash x ,y)))))
      (nc-list)))
  (defun c-modular-ash-ub (x)
    (declare (type (and fixnum unsigned-byte) x)
             (optimize speed))
    (macrolet ((frob (y)
                 `(list x ,y (logand most-positive-fixnum (ash x ,y)))))
      (c-list))))

(let* ((values (list 0 1 most-positive-fixnum))
       (neg-values (cons most-negative-fixnum
                         (mapcar #'- values))))
  (labels ((test (value fun1 fun2)
             (let ((res1 (funcall fun1 value))
                   (res2 (funcall fun2 value)))
               (mapcar (lambda (a b)
                         (unless (equalp a b)
                           (error "ash failure for ~A vs ~A: ~A not EQUALP ~A"
                                  fun1 fun2
                                  a b)))
                       res1 res2))))
    (loop for x in values do
         (test x 'nc-ash 'c-ash)
         (test x 'nc-modular-ash-ub 'c-modular-ash-ub))
    (loop for x in neg-values do
         (test x 'nc-ash 'c-ash))))


(declaim (inline ppc-ldb-2))

(defun ppc-ldb-2 (fun value)
  (declare (type (signed-byte 32) value)
           (optimize (speed 3) (safety 0) (space 1) (debug 1)
                     (compilation-speed 0)))
  (funcall fun (ldb (byte 8 24) value))
  (funcall fun (ldb (byte 8 16) value))
  (funcall fun (ldb (byte 8 8) value))
  (funcall fun (ldb (byte 8 0) value))
  (values))

(defun ppc-ldb-1 (fun)
  (declare (optimize (speed 3) (safety 0) (space 1) (debug 1)
                     (compilation-speed 0)))
  (loop
     for param :across (make-array 1 :initial-element nil)
     for size :across (make-array 1 :element-type 'fixnum :initial-element 3)
     do (ppc-ldb-2 fun (if param size -1))))

(with-test (:name :ppc-ldb)
 (let ((acc '()))
   (ppc-ldb-1 (lambda (x)
                (push x acc)))
   (assert (equal acc '(#xff #xff #xff #xff)))))

(with-test (:name :ldb-word-cast)
  (checked-compile-and-assert
      ()
      `(lambda (x y)
         (truly-the fixnum (ldb (byte x y) 100)))
    ((100 0) 100)))

(with-test (:name :logbitp-negative-error)
  (checked-compile-and-assert
      (:optimize :safe)
      `(lambda (x y)
         (logbitp x y))
    ((-1 0) (condition 'type-error))
    ((-2 (1+ most-positive-fixnum)) (condition 'type-error))
    (((1- most-negative-fixnum) 1) (condition 'type-error))))

(with-test (:name :*-overflow-ratio)
  (checked-compile-and-assert
      (:optimize :safe)
      `(lambda (a)
         (the fixnum (* 8 a)))
    ((1/8) 1)))

#+64-bit
(with-test (:name :bignum-float)
  (checked-compile-and-assert
      ()
      `(lambda (d)
         (sb-sys:without-gcing
           (let ((res (sb-bignum:%allocate-bignum 2)))
             (setf (sb-bignum:%bignum-ref res 1) 529
                   (sb-bignum:%bignum-ref res 0) 9223372036854775807)
             (sb-kernel:set-header-data res 1)
             (unwind-protect
                  (< res d)
               (sb-kernel:set-header-data res 2)))))
    ((-9.223372036854776d18) nil)
    ((9.223372036854776d18) t)))

(with-test (:name :overflow-transform-nil)
  (checked-compile-and-assert
      (:allow-warnings t)
      `(lambda (v)
         (let ((i 0))
           (flet ((f (i)
                    (the fixnum i)
                    (svref v (+ i 26387449082611642302))))
             (f i)
             (incf i)
             (f i)
             (incf i)))))
  (checked-compile-and-assert
      (:allow-style-warnings t)
      `(lambda (s e)
         (subseq s 0 (when e
                       (- (length s) 12129535698721845515))))))

(with-test (:name :integer-length-union-derivation)
  (checked-compile-and-assert
      ()
      `(lambda (b)
         (integer-length
          (if (>= b 0)
              b
              -2)))
    ((-1) 1)
    ((0) 0)
    ((15) 4)))

(with-test (:name :isqrt-union)
  (assert-type
   (lambda (x)
     (declare ((or (integer 1 5) (integer 9 10)) x))
     (isqrt x))
   (integer 1 3)))

(with-test (:name :integer-length-union)
  (assert-type
   (lambda (x)
     (declare ((or (integer 1 5) (integer 9 10)) x))
     (integer-length x))
   (integer 1 4)))

(with-test (:name :rem-transform-erase-types)
  (checked-compile-and-assert
   ()
   `(lambda (a)
      (declare ((integer * 0) a))
      (zerop (rem a 2)))
   ((-1) nil)
   ((-2) t))
  (checked-compile-and-assert
   ()
   `(lambda (a)
      (declare ((member 7 -9) a))
      (zerop (rem a 8)))
   ((7) nil)
   ((-9) nil)))

(with-test (:name :unexpected-immediates-in-vops)
  (checked-compile
   `(lambda (n)
      (declare (fixnum n))
      (loop for i below 2
            do (print (logbitp i n))
               (the (satisfies minusp) i))))
  (checked-compile
   `(lambda ()
      (loop for i below 2
            do (print (lognot i))
               (the (satisfies minusp) i))))
  (checked-compile
   `(lambda ()
      (loop for i below 2
            do (print (- i))
               (the (satisfies minusp) i))))
  (checked-compile
   `(lambda ()
      (loop for i below 2
            do (print (* i 3))
               (the (satisfies minusp) i))))
  (checked-compile
   `(lambda ()
      (loop for i below 2
            do (print (* i 3))
               (the (satisfies minusp) i))))
  (checked-compile
   `(lambda ()
      (loop for i of-type fixnum below 2
            do (print (logand most-positive-word (* i 4)))
               (the (satisfies minusp) i)))))

(with-test (:name :/-by-integer-type)
  (assert-type
   (lambda (x y)
     (declare ((integer 1 9) x)
              (integer y))
     (/ x y))
   (or (rational -9 (0)) (rational (0) 9)))
  (assert-type
   (lambda (x y)
     (declare ((integer 1 9) x)
              ((integer 0) y))
     (/ x y))
   (rational (0) 9))
  (assert-type
   (lambda (x y)
     (declare ((rational 0 9) x)
              ((integer 0) y))
     (/ x y))
   (rational 0 9)))

(with-test (:name :truncate-unused-q)
  (checked-compile-and-assert
   ()
   `(lambda (a)
      (declare (fixnum a))
      (rem a 4))
   ((3) 3)
   ((-3) -3)
   ((4) 0)
   ((-4) 0)))

(with-test (:name :*-by-integer-type)
  (assert-type
   (lambda (x)
     (declare (integer x))
     (* x 5))
   (or (integer 5) (integer * -5) (integer 0 0))))

(with-test (:name :truncate-transform-unused-result)
  (assert-type
   (lambda (c)
     (declare ((integer -1000 0) c)
              (optimize speed))
     (values
      (truncate (truncate (rem c -89) -16) 20)))
   (or (integer 0 0))))

(with-test (:name :rem^2)
  (checked-compile-and-assert
   ()
   `(lambda (a)
      (declare (fixnum a))
      (rem a 2))
   ((-2) 0)
   ((-3) -1)
   ((2) 0)
   ((3) 1)))

(with-test (:name :deposit-field-derive-type)
  (assert-type
   (lambda (s)
     (declare ((member 8 10) s))
     (deposit-field -21031455 (byte s 9) 1565832649825))
   (or (integer 1565832320097 1565832320097) (integer 1565832713313 1565832713313))))

(with-test (:name :logior-negative-bound)
  (checked-compile-and-assert
   ()
   `(lambda (b c)
      (declare ((integer 7703 1903468060) c))
      (logandc1 (/ (logorc2 c b) -1) c))
   ((-1 7703) 7702)))

(with-test (:name :set-numeric-contagion)
  (assert-type
   (lambda (n)
     (loop for i below n
           sum (coerce n 'single-float)))
   (or (integer 0 0) single-float)))

(with-test (:name :overflow-transform-order)
  (checked-compile-and-assert
      (:optimize :safe)
      `(lambda (a m)
         (declare (fixnum a))
         (let ((j (* 44 a)))
           (when m
             (the fixnum j))))
    ((most-positive-fixnum nil) nil)
    ((most-positive-fixnum t) (condition 'type-error))))

(with-test (:name :logtest-memref-boxed)
  (checked-compile-and-assert
      ()
      `(lambda (b)
         (declare (sb-vm:word b))
         (when (oddp b)
           (lambda (m)
             (when m
               (setf b 1))
             b)))
    (((expt 2 (1- sb-vm:n-word-bits))) nil)
    (((1+ (expt 2 (1- sb-vm:n-word-bits)))) t :test (lambda (x y)
                                                      y
                                                      (functionp (car x))))))

(with-test (:name :range-unsigned)
  (assert-type
   (lambda (d)
     (declare (type (integer 1 109) d))
     (typep (- d) '(integer -47727025476642942 -2593702250735)))
   null))

(with-test (:name :signed-byte-8-p-unsigned
                  ;; these lack the necessary RANGE<= vop
                  :fails-on (:or :mips :ppc :ppc64 :sparc :riscv :loongarch64))
  (checked-compile
   `(lambda (a)
      (declare (type (simple-array sb-vm:word (*)) a)
               (optimize speed))
      (the (signed-byte 8) (aref a 0)))
   :allow-notes nil))

(with-test (:name :or-chain)
  (checked-compile-and-assert
   ()
   `(lambda (b)
      (declare (fixnum b))
      (case b ((0 -3) 1) (t 2)))
   ((0) 1)
   ((-3) 1)
   ((3) 2)
   ((1) 2)))

(with-test (:name :or-chain-types)
  (checked-compile-and-assert
   ()
   `(lambda (b)
      (declare ((integer -1 1) b))
      (case b
        ((-1 0) 0)
        (t 1)))
   ((-1) 0)
   ((0) 0)
   ((1) 1)))

(with-test (:name :or-chain-tagging)
  (checked-compile-and-assert
   ()
   `(lambda (x)
      (or (eq x -6)
          (eq x -2)))
   ((-6) t)
   ((-2) t)
   ((6) nil)
   ((2) nil)
   ((-12) nil)
   ((-4) nil))
  (checked-compile-and-assert
   ()
   `(lambda (x)
      (or (eq x 0)
          (eq x -4)))
   ((0) t)
   ((-4) t)
   ((4) nil)
   ((-8) nil))
  (checked-compile-and-assert
   ()
   `(lambda (x)
      (or (eq x 97)
          (eq x 65)))
   ((-4611686018427387807) nil)
   ((97) t)
   ((65) t))
  (checked-compile-and-assert
   ()
   `(lambda (x)
      (or (eq x -65)
          (eq x -97)))
   ((-97) t)
   ((-65) t))
  (checked-compile-and-assert
   ()
   `(lambda (x)
      (case x ((-3 -2 17) t)))
   ((4611686018427387902) nil)
   ((-3) t)
   ((-2) t)
   ((17) t)))

(with-test (:name :range<=-same)
  (checked-compile-and-assert
   ()
   `(lambda (a c)
      (declare (type fixnum a))
      (let ((v7 (if c
                    4611686018427387904
                    -6)))
        (if (> v7 a)
            a
            (if (<= a v7)
                0
                a))))
    ((-7 nil) -7)
    ((-7 t) -7)
    ((-6 nil) 0)
    ((-6 t) -6)
    ((-3 nil) -3)))

(with-test (:name :/-folding)
  (checked-compile-and-assert
      (:optimize :safe)
      `(lambda (a)
         (declare (bit a))
         (/ 1 a))
    (:return-type (values (eql 1) &optional))
    ((1) 1)
    ((0) (condition 'division-by-zero)))
  (checked-compile-and-assert
      (:optimize :safe)
      `(lambda (a)
         (declare (bit a))
         (= (/ 5 a) 5))
    (:return-type (values (eql t) &optional))
    ((1) t)
    ((0) (condition 'division-by-zero)))
  (checked-compile-and-assert
      (:optimize :safe)
      `(lambda (a)
         (declare (integer a))
         (/ 0 a))
    (:return-type (values (eql 0) &optional))
    ((1) 0)
    ((0) (condition 'division-by-zero)))
  (checked-compile-and-assert
      (:optimize :safe)
      `(lambda (a)
         (declare (integer a))
         (floor 0 a))
    (:return-type (values (eql 0) (eql 0) &optional))
    ((1) (values 0 0))
    ((0) (condition 'division-by-zero)))
  (checked-compile-and-assert
      (:optimize :safe)
      `(lambda (a)
         (floor 0 a))
    ((1.0) (values 0 0.0))
    ((0) (condition 'division-by-zero))))

(with-test (:name :dpb-size-overflow)
  (checked-compile-and-assert
   ()
   `(lambda (a)
      (declare ((unsigned-byte 8) a))
      (dpb a (byte 63 8)
           81))
   ((90) 23121))
  (checked-compile-and-assert
   ()
   `(lambda (a)
      (declare ((unsigned-byte 8) a))
      (dpb a (byte 32 32)
           1))
   ((1) 4294967297)))

(with-test (:name :mask-field-size-overflow)
  (checked-compile-and-assert
   ()
   `(lambda (a)
      (truly-the fixnum
                 (mask-field (byte 78 0) a)))
   ((35) 35)))
(with-test (:name :ash-count-integr)
  (checked-compile-and-assert
      (:optimize :safe)
      `(lambda (a b)
         (ash a b))
    ((1 -1.0) (condition 'type-error))
    (((expt 2 74) -1.0) (condition 'type-error))
    ((0 1.0) (condition 'type-error))
    (((expt 2 74) 1.0) (condition 'type-error))
    ((1 1d0) (condition 'type-error))
    (((expt 2 74) 1d0) (condition 'type-error))
    ((0 -3d0) (condition 'type-error))
    (((expt 2 74) -2d0) (condition 'type-error))))

(with-test (:name :log-integer-derive-type)
  (assert-type
   (lambda (x)
     (declare ((integer 1) x))
     (log x))
   (single-float 0.0))
  (assert-type
   (lambda (x)
     (declare ((integer 0) x))
     (log x))
   single-float)
  (assert-type
   (lambda (x)
     (declare (integer x))
     (log x))
   (or (complex single-float) single-float)))

(with-test (:name :floor-derive-type)
  (assert-type
   (lambda (a b)
     (declare ((integer -10 0) b)
              ((unsigned-byte 8) a))
     (floor a b))
   (values (integer -255 0) (integer -9 0) &optional)))

(with-test (:name :logbitp-on-integers
            :implemented-on (:vop-existsp logbitp))
  (assert (not (ctu:ir1-named-calls `(lambda (x)
                                       (logbitp 20 x))))))
(with-test (:name :bt-negative-bit)
  (checked-compile-and-assert
   ()
   `(lambda (c)
     (declare ((signed-byte 64) c))
     (logtest c -2199023255553))
   ((-2049990302793354782) t)
   ((0) nil)
   (((ash 1 41)) nil))
  (checked-compile-and-assert
   ()
   `(lambda (b)
      (declare (fixnum b))
      (logior b -4611686018427387905))
   ((-6) -1)))

(with-test (:name :float-cmp)
  (checked-compile-and-assert
      ()
      `(lambda (a b)
         (declare ((unsigned-byte 20) a)
                  (float b))
         (< a b))
    ((6 4.0) nil)
    ((1 1.1) t)))

(with-test (:name :complex+non-complex-type)
  (assert-type
   (lambda (a)
     (+ a #c(1.0 3.0)))
   (or (complex single-float) (complex double-float)))
  (assert-type
   (lambda (a)
     (* a #c(1d0 0d0)))
    (complex double-float)))

(with-test (:name :bignum-ash-modarith)
  (checked-compile-and-assert
      ()
      `(lambda (a)
         (declare (bignum a))
         (logand (ash a -1) 1))
    (((expt 2 129)) 0)
    (((+ (expt 2 129) 2)) 1)))

(with-test (:name :two-fixnum-eq-mask)
  (checked-compile-and-assert
      ()
      `(lambda (x)
         (declare (fixnum x))
         (typep x '(member -1 ,most-positive-fixnum)))
    ((-1) t)
    ((most-positive-fixnum) t)
    ((1) nil)
    ((0) nil)
    ((most-negative-fixnum) nil)
    (((1+ most-negative-fixnum)) nil)
    (((1- most-positive-fixnum)) nil)))

(with-test (:name :logior-derive-negative)
  (assert-type
   (lambda (x)
     (declare (fixnum x))
     (logior x 1))
   (or (integer #.(1+ most-negative-fixnum) -1)
       (integer 1 #.most-positive-fixnum)))
  (assert-type
   (lambda (x y)
     (declare (fixnum x)
              ((and (signed-byte 16) (not (eql 0))) y))
     (logior y x))
   (or (integer #.(1+ most-negative-fixnum) -1)
       (integer 1 #.most-positive-fixnum)))
  (assert-type
   (lambda (x)
     (declare (fixnum x))
     (logior x 10))
   (or (integer #.(+ most-negative-fixnum 10) -1)
       (integer 10 #.most-positive-fixnum))))

(with-test (:name :range<=low-address)
  (checked-compile-and-assert
   ()
   `(lambda (a)
      (typep a '(integer 1 13)))
    ((0.0) nil)
    ((0) nil)
    ((1) t)
    ((6) t)
    ((13) t)
    ((14) nil)))

(with-test (:name :ratio+integer-type)
  (assert-type
   (lambda (x r)
     (declare (integer x)
              (ratio r))
     (+ x r))
   ratio)
  (assert-type
   (lambda (x r)
     (declare (integer x)
              (ratio r))
     (+ r x))
   ratio)
  (assert-type
   (lambda (x r)
     (declare (integer x)
              (ratio r))
     (/ r x))
   ratio))

(with-test (:name :fixnum-gcd-overflow)
  (checked-compile-and-assert
      ()
      `(lambda (a b)
         (gcd a b))
    ((most-negative-fixnum most-negative-fixnum) (- most-negative-fixnum))
    ((most-negative-fixnum 48) 16)))

(with-test (:name :signed-word-minus1-division)
  (checked-compile-and-assert
      ()
      `(lambda (a b)
         (truncate
          (the sb-vm:signed-word a)
          (the (member -8 -1) b)))
    ((-2 -1) (values 2 0))
    ((-2 -8) (values 0 -2))
    (((- #1=(expt 2 (1- sb-vm:n-word-bits))) -1) (values #1# 0))
    (((- #1#) -8) (values (- (ash (- #1#) -3))
                          0))))

(with-test (:name :integer-length-minus1)
  (checked-compile-and-assert
      ()
      `(lambda (c)
         (declare ((and sb-vm:signed-word (integer * -1)) c))
         (integer-length c))
    ((-1) 0)
    ((-2) 1)))

(with-test (:name :truncate-rem-zerop-types)
  (checked-compile `(sb-int:named-lambda f (start end)
                      (declare (optimize (speed 3))
                               (type (unsigned-byte 8) start end))
                      (let ((half (/ (+ end start) 2)))
                        (f start half)
                        half))
                   :allow-notes nil))

(with-test (:name :dpb-computed-posn)
  (assert-type
   (lambda (n j count)
     (declare ((unsigned-byte 64) n))
     (dpb
      j
      (byte count (- 64 count))
      n))
   (unsigned-byte 64))
  (assert-type
   (lambda (n j count)
     (declare ((unsigned-byte 32) n))
     (dpb
      j
      (byte count (- 64 count))
      n))
   (unsigned-byte 64))
  (assert-type
   (lambda (n j count)
     (declare ((unsigned-byte 54) n))
     (dpb
      j
      (byte count (- 32 count))
      n))
   (unsigned-byte 54)))

(with-test (:name :ldb-computed-posn
            :fails-on (or :ppc64 :riscv :loongarch64))
  (assert-type
   (lambda (x y)
     (ldb (byte y (- 32 y)) x))
   (unsigned-byte 32))
  #+64-bit
  (assert (not (ctu:ir1-named-calls `(lambda (x y)
                                       (ldb (byte y (- 32 y)) x))))))

(with-test (:name :modarith-unknown)
  (checked-compile-and-assert
   ()
   `(lambda (a)
      (declare ((rational 6435247825949752037) a))
      (logand (1+ a) 138))
   ((6435247825949752037) 130))
  (checked-compile-and-assert
   ()
   `(lambda (x)
      (declare ((member 813472 -183 -1.0) x))
      (evenp (1+ x)))
   ((813472) nil)
   ((-183) t))
  (checked-compile-and-assert
   ()
   `(lambda (c)
      (logand (+ c (multiple-value-prog1 0)) 1))
   ((1) 1)
   ((2) 0))
  (checked-compile-and-assert
   ()
   `(lambda (a)
      (oddp (1+ (read-from-string a))))
   (("1") nil)
   (("-2") t)))

(with-test (:name :logtest-lognot)
  (checked-compile-and-assert
   ()
   `(lambda (a)
      (logtest -3 (lognot a)))
   ((5) t)
   ((-3) nil)))

(with-test (:name :transform-deleted-casts)
  (checked-compile-and-assert
   (:optimize :safe)
   `(lambda (x y)
      (declare ((integer 0 30) y))
      (dpb 3 (byte 2 y) (the (integer * 300) x)))
   ((400 2) (condition 'type-error))
   ((300 0) 303)))

(with-test (:name :truncate-unknown-integer
            :fails-on (or :arm :riscv :loongarch64))
  (assert (not (ctu:ir1-named-calls `(lambda (x)
                                       (declare (integer x))
                                       (values (the (signed-byte 25) (floor x 2)))))))
  (assert (not (ctu:ir1-named-calls `(lambda (x)
                                       (declare (unsigned-byte x))
                                       (values (the (signed-byte 25) (floor x 2)))))))
  (assert (not (ctu:ir1-named-calls `(lambda (x)
                                       (declare (integer x))
                                       (values (the (signed-byte 25) (truncate x 2)))))))
  (assert (not (ctu:ir1-named-calls `(lambda (x)
                                       (declare (unsigned-byte x))
                                       (values (the (signed-byte 25) (truncate x 2)))))))
  (assert (not (ctu:ir1-named-calls `(lambda (x)
                                       (declare (integer x))
                                       (values (the (signed-byte 25) (ceiling x 2)))))))
  (assert (not (ctu:ir1-named-calls `(lambda (x)
                                       (declare (unsigned-byte x))
                                       (values (the (signed-byte 25) (ceiling x 2))))))))

(with-test (:name :word-floor-ceiling
            :fails-on (or :ppc :arm :riscv :loongarch64 :sparc))
  (assert (not (ctu:ir1-named-calls `(lambda (x y)
                                       (declare (sb-vm:signed-word x y))
                                       (floor x y)))))
  (assert (not (ctu:ir1-named-calls `(lambda (x y)
                                       (declare (sb-vm:signed-word x y))
                                       (ceiling x y)))))
  (assert (not (ctu:ir1-named-calls `(lambda (x y)
                                       (declare (sb-vm:word x y))
                                       (ceiling x y)))))
  (assert (not (ctu:ir1-named-calls `(lambda (x y)
                                       (declare (sb-vm:word x y))
                                       (floor x y))))))

(with-test (:name :fixnum-*-by-unknown-overflow
            :implemented-on (:vop-existsp overflow*))
  (assert (not (ctu:ir1-named-calls `(lambda (x y)
                                       (declare (integer x)
                                                (fixnum y))
                                       (the fixnum (* x y))))))
  (assert (not (ctu:ir1-named-calls `(lambda (x y)
                                       (declare (integer x)
                                                (fixnum y))
                                       (the fixnum (* y x))))))
  (assert (not (ctu:ir1-named-calls `(lambda (x y)
                                       (declare (integer x y))
                                       (the fixnum (* x y))))))
  (assert (equal (ctu:ir1-named-calls `(lambda (x)
                                         (the fixnum (* x 2))))
                 '(sb-kernel:*-by-fixnum-to-fixnum))))

(with-test (:name :fixnum-*-by-unknown)
  (assert (equal (ctu:ir1-named-calls `(lambda (x)
                                         (the fixnum (* x 2))))
                 '(sb-kernel:*-by-fixnum-to-fixnum)))

  (checked-compile-and-assert
      (:optimize :safe)
      `(lambda (a)
         (declare ((integer -1 11094097273866491717) a))
         (the (integer 1)
              (truncate a 2305843009213693949)))
    ((11094097273866491717) (values 4 1870725237011715921))))

(with-test (:name :logxor-1-type)
  (assert-type
   (lambda (x)
     (logxor x (1- x)))
   (integer -1))
  (assert-type
   (lambda (x)
     (declare ((integer 1) x))
     (logxor x (1- x)))
   (integer 1))
  (assert-type
   (lambda (x)
     (logxor x (1+ x)))
   (integer -1))
  (assert-type
   (lambda (x)
     (unless (eql x -1)
      (logxor x (1+ x))))
   (or null (integer 1))))

(with-test (:name :logior--type)
  (assert-type
   (lambda (n)
     (logior n (- n)))
   (integer * 0))
  (assert-type
   (lambda (n)
     (declare ((unsigned-byte 64) n))
     (logior n (- n)))
   (integer -9223372036854775808 0))
  (assert-type
   (lambda (n)
     (declare ((signed-byte 64) n))
     (logior n (- n)))
   (integer -9223372036854775808 0))
  (assert-type
   (lambda (n)
     (declare ((integer -16 1024) n))
     (logior n (- n)))
   (integer -1024 0))
  (assert-type
   (lambda (n)
     (declare ((integer #.(1+ (- (ash 1 63))) 0) n))
     (logior n (- n)))
   (integer -4611686018427387904 0))
  (assert-type
   (lambda (n)
     (declare ((integer -100 -10) n))
     (logior n (- n)))
   (integer -64 -1))
  (assert-type
   (lambda (n)
     (declare ((integer 1) n))
     (logior n (- n)))
   (integer * -1)))

(with-test (:name :logand--type)
  (assert-type
   (lambda (n)
     (logand n (- n)))
   (integer 0 *))
  (assert-type
   (lambda (n)
     (declare ((unsigned-byte 64) n))
     (logand n (- n)))
   (integer 0 9223372036854775808))
  (assert-type
   (lambda (n)
     (declare ((signed-byte 64) n))
     (logand n (- n)))
   (integer 0 9223372036854775808))
  (assert-type
   (lambda (n)
     (declare ((integer -16 1024) n))
     (logand n (- n)))
   (integer 0 1024))
  (assert-type
   (lambda (n)
     (declare ((integer #.(1+ (- (ash 1 63))) 0) n))
     (logand n (- n)))
   (integer 0 4611686018427387904))
  (assert-type
   (lambda (n)
     (declare ((integer -100 -10) n))
     (logand n (- n)))
   (integer 1 64))
  (assert-type
   (lambda (n)
     (declare ((integer 1) n))
     (logand n (- n)))
   (integer 1 *)))

(with-test (:name :logxor--type)
  (assert-type
   (lambda (n)
     (logxor n (- n)))
   (integer * 0))
  (assert-type
   (lambda (n)
     (declare ((unsigned-byte 64) n))
     (logxor n (- n)))
   (integer -18446744073709551616 0))
  (assert-type
   (lambda (n)
     (declare ((signed-byte 64) n))
     (logxor n (- n)))
   (integer -18446744073709551616 0))
  (assert-type
   (lambda (n)
     (declare ((integer -16 1024) n))
     (logxor n (- n)))
   (integer -2048 0))
  (assert-type
   (lambda (n)
     (declare ((integer -1 0) n))
     (logxor n (- n)))
   (integer -2 0))
  (assert-type
   (lambda (n)
     (declare ((integer -2 -1) n))
     (logxor n (- n)))
   (integer -4 -2))
  (assert-type
   (lambda (n)
     (declare ((integer 1) n))
     (logxor n (- n)))
   (integer * -2))
  (assert-type
   (lambda (n)
     (declare ((integer * -1) n))
     (logxor n (- n)))
   (integer * -2)))

(with-test (:name :unsigned-byte-x-p)
  (checked-compile-and-assert
   ()
   `(lambda (a)
      (typep a '(unsigned-byte 128)))
   ((1) t)
   ((-1) nil)
   (((1- (expt 2 128))) t)
   (((expt 2 128)) nil)
   (((- (expt 2 128))) nil)
   (('a) nil))
  (checked-compile-and-assert
   ()
   `(lambda (a)
      (declare (unsigned-byte a))
      (typep a '(unsigned-byte 128)))
   ((1) t)
   (((1- (expt 2 128))) t)
   (((expt 2 128)) nil))
  (checked-compile-and-assert
   ()
   `(lambda (a)
      (declare (integer a))
      (typep a '(unsigned-byte 128)))
   ((1) t)
   ((-1) nil)
   (((1- (expt 2 128))) t)
   (((expt 2 128)) nil)
   (((- (expt 2 128))) nil))
  (checked-compile-and-assert
   ()
   `(lambda (a)
      (declare (bignum a))
      (typep a '(unsigned-byte 128)))
   (((1- (expt 2 128))) t)
   (((expt 2 128)) nil)
   (((- (expt 2 128))) nil))
  (checked-compile-and-assert
   ()
   `(lambda (a)
      (typep a '(unsigned-byte 80)))
   ((1) t)
   ((-1) nil)
   (((1- (expt 2 80))) t)
   (((expt 2 80)) nil)
   (((- (expt 2 80))) nil)
   (('a) nil))
  (checked-compile-and-assert
   ()
   `(lambda (a)
      (typep a '(unsigned-byte 160)))
   ((1) t)
   ((-1) nil)
   (((expt 2 80)) t)
   (((1- (expt 2 160))) t)
   (((expt 2 160)) nil)
   (((- (expt 2 160))) nil)
   (('a) nil)))


(with-test (:name :signed-byte-x-p)
  (checked-compile-and-assert
      ()
      `(lambda (a)
         (typep a '(signed-byte 128)))
    ((1) t)
    ((-2) t)
    (((1- (expt 2 127))) t)
    (((- (expt 2 127))) t)
    (((expt 2 127)) nil)
    (('a) nil))
  (checked-compile-and-assert
      ()
      `(lambda (a)
         (declare (integer a))
         (typep a '(signed-byte 128)))
    ((1) t)
    ((-2) t)
    (((1- (expt 2 127))) t)
    (((- (expt 2 127))) t)
    (((expt 2 127)) nil))
  (checked-compile-and-assert
      ()
      `(lambda (a)
         (declare (bignum a))
         (typep a '(signed-byte 128)))
    (((1- (expt 2 127))) t)
    (((- (expt 2 127))) t)
    (((expt 2 127)) nil)))

(with-test (:name :%bignum-length-type)
  (assert-type
   (lambda (x)
     (declare (sb-vm:signed-word x))
     (sb-bignum:%bignum-length x))
   (integer 1 1))
  (assert-type
   (lambda (x)
     (declare (word x))
     (sb-bignum:%bignum-length x))
   (integer 1 2)))

(with-test (:name :minus-eql-to-eq-reduction)
  (checked-compile-and-assert
      ()
      `(lambda (a c)
         (declare (integer c))
         (when (integerp a)
           (eql (- a c) 0)))
      (((eval '(expt 2 64)) (eval '(expt 2 64))) t)
      ((1 2) nil)))

(with-test (:name :unsigned-byte-64-p-move-to-word)
  (checked-compile-and-assert
   ()
   `(lambda (a m)
      (if (typep a '(unsigned-byte 64))
          (let ((j a))
            (declare ((unsigned-byte 64) j))
            (loop repeat 2
                  sum
                  (+ (funcall m (logand j #xFFFFFF))
                     (funcall m (logand j #xFFFFFF)))))))
   ((1234 #'+) 4936)
   ((3 #'-) -12)))

(with-test (:name :arith-negative-zero)
  (assert-type
   (lambda (x)
     (declare (double-float x))
     (+ (abs x) 0d0))
   (or (member 0.0d0) (double-float (0.0d0))))
  (assert-type
   (lambda (x)
     (declare (double-float x))
     (- (abs x) -0d0))
   (or (member 0.0d0) (double-float (0.0d0))))
  (assert-type
   (lambda (x)
     (declare (double-float x))
     (- -0d0 (abs x)))
   (or (member -0.0d0) (double-float * (0.0d0))))
  (assert-type
   (lambda (x)
     (declare (double-float x))
     (* (abs x) 2d0))
   (or (member 0.0d0) (double-float (0.0d0))))
  (assert-type
   (lambda (x y)
     (declare (double-float x y))
     (/ (abs x) (abs y)))
   (or (member 0.0d0) (double-float (0.0d0))))
  (assert-type
   (lambda (x)
     (declare ((double-float * -1d0) x))
     (/ 10d0 x))
   (or (member -0.0d0) (double-float -10.0d0 (0.0d0))))
  (assert-type
   (lambda (x y)
     (declare (double-float x y))
     (expt (abs x) y))
   (or (member 0.0d0) (double-float (0.0d0))))
  (assert-type
   (lambda (x)
     (declare (double-float x))
     (- (abs x)))
   (or (member -0.0d0) (double-float * (0.0d0)))))

(with-test (:name :truncate-type)
  (assert-type
   (lambda (x)
     (declare (double-float x))
     (nth-value 1 (truncate x)))
   (double-float -1.0d0 1.0d0))
  (assert-type
   (lambda (x)
     (declare (float x))
     (nth-value 1 (truncate (abs x))))
   (or (float (0.0) 1.0) (member 0f0 0d0)))
  (assert-type
   (lambda (x)
     (declare (double-float x))
     (nth-value 1 (floor x)))
   (double-float 0d0 1.0d0))
  (assert-type
   (lambda (x)
     (declare (double-float x))
     (nth-value 1 (floor (abs x))))
   (or (double-float (0d0) 1.0d0) (eql 0d0)))
  (assert-type
   (lambda (x)
     (declare (double-float x))
     (nth-value 1 (ceiling x)))
   (double-float -1.0d0 0d0))
  (assert-type
   (lambda (x)
     (declare (double-float x))
     (nth-value 1 (ceiling (abs x))))
   (double-float -1.0d0 0d0))
  (assert-type
   (lambda (x)
     (declare (float x))
     (nth-value 1 (ftruncate x)))
   (float -1.0 1.0))
  (assert-type
   (lambda (x)
     (declare (double-float x))
     (ftruncate (abs x)))
   (values (or (member 0.0d0) (double-float (0.0d0)))
           (or (member 0.0d0) (double-float (0.0d0) 1.0d0)) &optional))
  (assert-type
   (lambda (x)
     (declare (double-float x))
     (fceiling (abs x)))
   (values (or (member 0.0d0) (double-float (0.0d0)))
           (double-float -1.0d0 0.0d0) &optional))
  (assert-type
   (lambda (x)
     (declare (double-float x))
     (ffloor (abs x)))
   (values (or (member 0.0d0) (double-float (0.0d0)))
           (double-float 0.0d0 1.0d0) &optional))
  (assert-type
   (lambda ()
     (ffloor 0 -1))
   (values (eql -0.0) (eql 0) &optional))
  (assert-type
   (lambda (x)
     (declare ((integer 6671 6672) x))
     (values (ffloor -1333621864366 x)))
   (single-float -1.9991334e8 -1.9988338e8)))

(with-test (:name :reduce-logior-type)
  (assert-type
   (lambda (a)
     (reduce 'logior (the (simple-array (unsigned-byte 8)) a) :initial-value -7))
   (integer -7 -1)))

(with-test (:name :atanh-type)
  (assert-type
   (lambda (n)
     (atanh (the (real -1 1) n)))
   float))

(with-test (:name :unknown-*-transform)
  (checked-compile-and-assert
   (:optimize :safe)
   `(lambda (f n)
      (declare (fixnum f)
               ((unsigned-byte 65) n))
      (the fixnum (* f n)))
   ((0 (expt 2 64)) 0)
   ((1 (expt 2 64)) (condition 'type-error))
   ((2 2) 4))
  (checked-compile-and-assert
   (:optimize :safe)
   `(lambda (f)
      (declare (type fixnum f))
      (the fixnum (* f 25152445588928537400)))
   ((0) 0)
   ((1) (condition 'type-error)))
  (checked-compile-and-assert
   (:optimize :safe)
   `(lambda (a b)
      (declare (integer a b))
      (the fixnum (* a b)))
   ((0 (expt 2 64)) 0)
   ((1 (expt 2 64)) (condition 'type-error))
   ((2 2) 4))
  (checked-compile-and-assert
   (:optimize :safe)
   `(lambda (f)
      (declare (integer f))
      (the fixnum (* f 25152445588928537400)))
   ((0) 0)
   ((1) (condition 'type-error))))

(with-test (:name :ash-negative-type)
  (assert-type
   (lambda (x y)
     (declare ((real * 0) x))
     (ash x y))
   (integer * 0)))

(with-test (:name :ash-overflow
            :fails-on (or :sparc :ppc :ppc64))
  (checked-compile-and-assert
      ()
      `(lambda (a)
         (declare (fixnum a))
         (truly-the bit (ash a 90)))
    ((0) 0)
    ((1) 0)))

(with-test (:name :range-unsigned-comparison)
  (checked-compile-and-assert
      ()
      `(lambda (a)
         (typep a '(integer 1 2147483647)))
    ((-1) nil)
    ((1) t)
    ((2147483647) t)
    ((2147483648) nil)
    ((0.0) nil)))

(with-test (:name :ash-right-two-word)
  (checked-compile-and-assert
      ()
      `(lambda (a)
         (logand 4611686018427387903
                 (ash a -2)))
    ((10) 2)
    ((310805698068689180651640983330128115679) 585623305860541943)
    ((-7514499718243589878) 2733061088866490434)))

(with-test (:name :ash-left-add)
  (checked-compile-and-assert
      ()
      `(lambda (p d)
         (declare ((signed-byte 64) p)
                  ((unsigned-byte 63) d))
         (+ (ash p 63) d))
    ((0 5) 5)
    ((4 4) 36893488147419103236)
    ((-5 5) -46116860184273879035))
  (checked-compile-and-assert
      ()
      `(lambda (p d)
         (declare ((signed-byte #.sb-vm:n-word-bits) p)
                  ((unsigned-byte 8) d))
         (+ (ash p 8) d))
    ((0 5) 5)
    ((4 4) 1028)
    ((-5 4) -1276))
  (checked-compile-and-assert
      ()
      `(lambda (p d)
         (declare ((unsigned-byte 63) d))
         (+ (ash p 63) d))
    ((0 5) 5)
    ((4 4) 36893488147419103236)
    ((-5 5) -46116860184273879035))
  (checked-compile-and-assert
      ()
      `(lambda (p d)
         (declare ((unsigned-byte 8) d))
         (+ (ash p 8) d))
    ((0 5) 5)
    ((4 4) 1028)
    ((-5 4) -1276))
  (checked-compile-and-assert
      ()
      `(lambda (p d)
         (declare ((unsigned-byte 64) d))
         (+ (ash p 64) d))
    ((-1 17757265153539649207) -689478920169902409)
    ((-1 0) -18446744073709551616)))

(with-test (:name :remove-negate)
  (flet ((test (form count)
           (assert (= (count 'sb-kernel:%negate
                             (ctu:ir1-named-calls form nil))
                      count))))
    (test `(lambda (x y)
             (declare (integer x y))
             (- (* x (- 5 y))))
          0)
    (test `(lambda (x y)
             (- (truncate (- x) y)))
          0)
    (test `(lambda (x y)
             (- (if x
                    (- x)
                    (- y))))
          0)
    (test `(lambda (x y)
             (- (if x
                    4
                    (- y))))
          0)
    (test `(lambda (x y)
             (declare (optimize (sb-c::float-accuracy 0)))
             (- (* (/ x 4) (- y))))
          0)
    (test `(lambda (x y)
             (- (truncate (- y) (* x 4))))
          0)
    (test `(lambda (a b)
             (the integer (- (* a (- b)))))
          0)
    (test `(lambda (a b)
             (+ (- (* a (- b))) 10))
          0)
    (test `(lambda (x a b)
             (multiple-value-bind (a b) (if x
                                            (funcall x)
                                            (values 10 (- (* a (- b)))))
               (values a
                       (+ b 10))))
          0)
    (test `(lambda (x a b)
             (multiple-value-bind (a b)
                 (the (values t real)
                      (if x
                          (funcall x)
                          (values 10 (- (* a (- b))))))
               (values a
                       (+ b 10))))
          0)
    (test `(lambda (x a b)
             (multiple-value-bind (a b)
                 (the (values t integer)
                      (if x
                          (funcall x)
                          (values 10 (- (* a (- b))))))
               (values a b)))
          0)
    (checked-compile-and-assert
        ()
        `(lambda (a)
           (- (* (if a 1 2)
                 (if a 3 4)
                 -2)))
      ((nil) 16)
      ((t) 6))
    (test `(lambda (a) (- (* a 0))) 1)
    (test `(lambda (a) (- (* a 0.0))) 0)
    (checked-compile-and-assert
        ()
        `(lambda (a)
           (- (* a 0)))
      ((10.0) -0.0)
      ((10) 0))
    (checked-compile-and-assert
        ()
        `(lambda (a b c)
           (- (* 4
                 (if a
                     (- b)
                     (- c)))))
      ((1 2 3) 8)
      ((nil 2 3) 12))
    (checked-compile-and-assert
        ()
        `(lambda (a c d)
           (declare ((integer 4 9) d))
           (-
            (if c
                (+
                 (if a 0 1)
                 (if a 0 1)
                 1)
                (+ d 2))))
      ((nil t 5) -3)
      ((t nil 5) -7)
      ((t t 4) -1)
      ((nil nil 4) -6))
    (checked-compile-and-assert
     ()
     `(lambda (e f j)
        (-
         (if f
             (truncate
              (if e 0 100)
              (if j j -96))
             1)))
     ((nil 2 3) -33)
     ((nil nil 5) -1)
     ((nil t nil) 1))
    (checked-compile-and-assert
        ()
        `(lambda (a b c)
           (- (if a -3 (* (truncate 4 b) c))))
      ((nil 2 3) -6)
      ((t 4 5) 3))
    (checked-compile-and-assert
        ()
        `(lambda (a b)
           (- (* (* a 3) b)))
      ((0 4.0) -0.0))
    (checked-compile-and-assert
        ()
        `(lambda (a b)
           (- (* a (- b))))
      ((4.0 0) -0.0))
    (checked-compile-and-assert
        ()
        `(lambda (a b)
           (declare (integer b))
           (- (- (+ a 5)) b))
      ((-5.0 0) -0.0))
    (checked-compile-and-assert
        ()
        `(lambda (a)
           (cos (- a)))
      ((#C(0 2)) (cos #C(0 -2))))))

(with-test (:name :remove-negate.2)
  (flet ((test (form count)
           (assert (= (count 'sb-kernel:%negate
                             (ctu:ir1-named-calls form nil))
                      count))))
    (test `(lambda (x y)
             (declare (optimize (sb-c::float-accuracy 0)))
             (* (- x) (- y)))
          0)
    (test `(lambda (x y)
             (> (* (- x) (- y)) 10))
          0)
    (test `(lambda (a b d)
             (declare (optimize (sb-c::float-accuracy 0)))
             (- d (* a (- b))))
          0)
    (test `(lambda (x y)
             (abs (* (- x) y)))
          0)
    (test `(lambda (x y)
             (abs (if x
                      (- x)
                      y)))
          0)
    (test `(lambda (x)
             (lognot (- x)))
          0)
    (test `(lambda (x)
             (- (lognot x)))
          0)
    (test `(lambda (x)
             (- (the integer (- x))))
          0)
    (test `(lambda (a)
             (- (truncate a)))
          0)
    (test `(lambda (a)
             (declare (integer a))
             (- (ash (- a) -2)))
          0)
    (checked-compile-and-assert
        ()
        `(lambda (m a)
           (declare (integer a))
           (abs (if m
                    (ash (abs a) -5)
                    -9)))
      ((t 63) 1)
      ((nil 1) 9))
    (checked-compile-and-assert
        ()
        `(lambda (r)
           (declare (rational r))
           (values (fceiling (- r) 2)))
      ((0) 0.0))
    (checked-compile-and-assert
        ()
        `(lambda (r)
           (- (- r) 5))
      ((#C(.0 0)) #C(-5 -0.0)))
    (checked-compile-and-assert
        ()
        `(lambda (c)
           (- (* #C(4.0 3) c)))
      ((#C(-0.0 0)) #C(0 -0.0)))
    (checked-compile-and-assert
        ()
        `(lambda (a b)
           (declare ((complex float) a b))
           (- (* (- a) b)))
      ((#C(-4.0 -3) #C(-0.0 0)) #C(0 -0.0)))
    (checked-compile-and-assert
        ()
        `(lambda (f i)
           (- (* f (truncate i 20))))
      ((3.0 1) -0.0))
    (checked-compile-and-assert
        ()
        `(lambda (r c)
           (+ (- (the (not (eql 0)) r)) c))
      ((-2 #c(1.0 -0.0)) #C(3.0 0.0))
      ((-3 #c(1.0 -0.0)) (+ (opaque-identity 3) (opaque-identity #c(1.0 -0.0)))))
    (checked-compile-and-assert
        ()
        `(lambda (r c)
           (- c (- (the (not (eql 0)) r))))
      ((-1 #c(1.0 -0.0)) #C(0.0 -0.0))
      ((2.0 #c(1.0 -0.0)) (- (opaque-identity #c(1.0 -0.0)) (opaque-identity -2.0))))))

(with-test (:name :abs-match)
  (flet ((test (form count)
           (assert (= (count 'abs
                             (ctu:ir1-named-calls form nil))
                      count))))
    (test `(lambda (x y)
             (declare (real x))
             (abs (* (abs x) y)))
          1)
    (test `(lambda (x y)
             (declare (real x y))
             (/ (abs y) (abs x)))
          1)
    (test `(lambda (x)
             (declare (real x))
             (abs (* x x)))
          0)
    (test `(lambda (x y)
             (declare (real x))
             (abs (/ (* (abs x) y) 4)))
          1)
    (test `(lambda (a b c)
             (abs
              (if a
                  (abs b)
                  c)))
          1)
    (test `(lambda (a)
             (declare (real a))
             (= (abs a) 10))
          0)))

(with-test (:name :*-by-zero-type)
  (assert-type
   (lambda (d)
     (* (the (double-float -10d0 10d0) d) 0.0d0))
   (double-float 0d0 0d0))
  (assert-type
   (lambda (d)
     (* (the (double-float * 10d0) d) 0.0d0))
   (double-float * 0d0))
  (assert-type
   (lambda (x y)
     (* (the (single-float 0.0 0.0) x)
        (the (single-float -5.0 5.0) y)))
   (single-float 0.0 0.0))
  (assert-type
   (lambda (x)
     (* (the (integer -1 0) x) 4.0))
   (single-float -4.0 0.0))
  (assert-type
   (lambda (x)
     (* -0.0 (the (single-float 0.0 0.0) x)))
   (single-float 0.0 0.0))
  (assert-type
   (lambda (x)
     (abs (the (or (single-float -2.0 -1.0) (member -0.0)) x)))
   (or (single-float 1.0 2.0) (member 0.0))))

(with-test (:name :logior-signed-unsigned=>integer)
  (checked-compile-and-assert
   ()
   `(lambda (s u)
      (declare ((unsigned-byte 64) u))
      (logior (the fixnum s) u))
   ((-54327132 24) -54327108)
   ((54327132 15028999435905310454) 15028999435923161086)))

(with-test (:name :dpb-bit-overshoot)
  (checked-compile-and-assert
   ()
   `(lambda (p)
      (dpb 0 (byte 1 (the (mod 95) p)) #xFFFFFFFFFFF))
   ((0) #xFFFFFFFFFFE)
   ((63) #xFFFFFFFFFFF)
   ((64) #xFFFFFFFFFFF)
   ((79) #xFFFFFFFFFFF))
  (checked-compile-and-assert
   ()
   `(lambda (p)
      (dpb 0 (byte 1 (the (mod 95) p)) #xFFFFFFFFFFFFFFFF))
   ((0) #xFFFFFFFFFFFFFFFE)
   ((63) #x7FFFFFFFFFFFFFFF)
   ((64) #xFFFFFFFFFFFFFFFF)
   ((79) #xFFFFFFFFFFFFFFFF))
  (checked-compile-and-assert
   ()
   `(lambda (p)
      (dpb 1 (byte 1 (the (mod 95) p)) -10))
   ((0) -9)
   ((79) -10)))

(with-test (:name :ctz-transform
            :implemented-on (:vop-existsp sb-kernel:count-trailing-zeros))
  (assert (find 'sb-kernel:count-trailing-zeros
                (ctu:ir1-named-calls `(lambda (n)
                                        (declare ((unsigned-byte 64) n))
                                        (integer-length (ldb (byte 64 0) (lognor n (- n)))))
                                     nil)))
  (assert (find 'sb-kernel:count-trailing-zeros
                (ctu:ir1-named-calls `(lambda (n)
                                        (declare ((signed-byte 64) n))
                                        (integer-length (ldb (byte 64 0) (lognor n (- n)))))
                                     nil)))
  (assert (find 'sb-kernel:count-trailing-zeros
                (ctu:ir1-named-calls `(lambda (n)
                                        (declare (fixnum n))
                                        (integer-length (ldb (byte 64 0) (lognor n (- n)))))
                                     nil)))
  (assert (find 'sb-kernel:count-trailing-zeros
                (ctu:ir1-named-calls `(lambda (n)
                                        (declare ((signed-byte 32) n))
                                        (integer-length (ldb (byte 64 0) (lognor n (- n)))))
                                     nil)))
  (assert (find 'sb-kernel:count-trailing-zeros
                (ctu:ir1-named-calls `(lambda (n)
                                        (declare ((unsigned-byte 63) n))
                                        (integer-length (ldb (byte 64 0) (lognor n (- n)))))
                                     nil)))
  (assert (find 'sb-kernel:count-trailing-zeros
                (ctu:ir1-named-calls `(lambda (n)
                                        (declare ((unsigned-byte 62) n))
                                        (integer-length (ldb (byte 64 0) (lognor n (- n)))))
                                     nil))))

(with-test (:name :ctz)
  (checked-compile-and-assert
      ()
      `(lambda (n)
         (declare ((unsigned-byte 64) n))
         (integer-length (ldb (byte 64 0) (lognor n (- n)))))
    ((0) 64)
    ((1) 0)
    ((2) 1)
    (((ash 1 63)) 63))
  (checked-compile-and-assert
      ()
      `(lambda (n)
         (declare ((signed-byte 64) n))
         (integer-length (ldb (byte 64 0) (lognor n (- n)))))
    ((0) 64)
    ((1) 0)
    ((-1) 0)
    ((2) 1)
    ((-2) 1)
    (((ash 1 62)) 62)
    (((ash -1 63)) 63))
  (checked-compile-and-assert
      ()
      `(lambda (n)
         (declare (fixnum n))
         (integer-length (ldb (byte 64 0) (lognor n (- n)))))
    ((0) 64)
    ((1) 0)
    ((-1) 0)
    ((2) 1)
    ((-2) 1)
    (((ash 1 (- sb-vm:n-fixnum-bits 2))) (- sb-vm:n-fixnum-bits 2))
    (((ash -1 (- sb-vm:n-fixnum-bits 1))) (- sb-vm:n-fixnum-bits 1))))

(with-test (:name :ash-left-add
            :implemented-on (:vop-existsp sb-kernel:ash-left-add))
  (assert (find 'sb-kernel:ash-left-add
                (ctu:ir1-named-calls `(lambda (n)
                                        (declare (sb-vm:signed-word n))
                                        (+ (ash n 8) 8))
                                     nil)))
  (assert (find 'sb-kernel:ash-left-add
                (ctu:ir1-named-calls `(lambda (n)
                                        (declare (sb-vm:word n))
                                        (+ (ash n 8) 8))
                                     nil)))
  (assert (find 'sb-kernel:ash-left-add
                (ctu:ir1-named-calls `(lambda (n)
                                        (+ (ash n 8) 8))))))

(with-test (:name :ash-left-add)
  (checked-compile-and-assert
      ()
      `(lambda (n)
         (declare ((unsigned-byte 64) n))
         (+ (ash n 8) 8))
    ((0) 8)
    ((1) (+ (ash 1 8) 8))
    ((#xFFFFFFFFFFFFFFF) (+ (ash #xFFFFFFFFFFFFFFF 8) 8))
    ((#xFFFFFFFFFFFFFFFF) (+ (ash #xFFFFFFFFFFFFFFFF 8) 8)))
  (checked-compile-and-assert
      ()
      `(lambda (n)
         (declare ((signed-byte 64) n))
         (+ (ash n 8) 8))
    ((0) 8)
    ((1) (+ (ash 1 8) 8))
    ((-1) (+ (ash -1 8) 8))
    ((#xFFFFFFFFFFFFFFF) (+ (ash #xFFFFFFFFFFFFFFF 8) 8))
    ((#x-FFFFFFFFFFFFFFF) (+ (ash #x-FFFFFFFFFFFFFFF 8) 8))
    ((#x7FFFFFFFFFFFFFFF) (+ (ash #x7FFFFFFFFFFFFFFF 8) 8))
    (((- (expt 2 63))) (+ (ash (- (expt 2 63)) 8) 8)))
  (checked-compile-and-assert
      ()
      `(lambda (n)
         (+ (ash n 8) 8))
    ((0) 8)
    ((1) (+ (ash 1 8) 8))
    ((-1) (+ (ash -1 8) 8))
    ((#xFFFFFFFFFFFFFFF) (+ (ash #xFFFFFFFFFFFFFFF 8) 8))
    ((#x-FFFFFFFFFFFFFFF) (+ (ash #x-FFFFFFFFFFFFFFF 8) 8))
    ((#xFFFFFFFFFFFFFFFF) (+ (ash #xFFFFFFFFFFFFFFFF 8) 8))
    ((#x7FFFFFFFFFFFFFFF) (+ (ash #x7FFFFFFFFFFFFFFF 8) 8))
    (((- (expt 2 63))) (+ (ash (- (expt 2 63)) 8) 8))))

(with-test (:name :ash-right-two-words-transform
            :implemented-on (:vop-existsp sb-kernel:ash-right-two-words))
  (assert (find 'sb-kernel:ash-right-two-words
                (ctu:ir1-named-calls `(lambda (n)
                                        (logand (ash n -8) most-positive-fixnum))
                                     nil)))
  (assert (find 'sb-kernel:ash-right-two-words
                (ctu:ir1-named-calls `(lambda (n s)
                                        (declare ((integer -64 -1) s))
                                        (logand (ash n s) most-positive-fixnum))
                                     nil)))
  (assert (find 'sb-kernel:ash-right-two-words
                (ctu:ir1-named-calls `(lambda (n)
                                        (logand (ash n -8) most-positive-word))
                                     nil)))
  (assert (find 'sb-kernel:ash-right-two-words
                (ctu:ir1-named-calls `(lambda (n s)
                                        (declare ((integer -64 -1) s))
                                        (logand (ash n s) most-positive-word))
                                     nil))))

(with-test (:name :ash-right-two-words)
  (checked-compile-and-assert
      ()
      `(lambda (n)
         (logand (ash n -8) most-positive-fixnum))
    ((0) 0)
    (((ash 1 10)) (ash 1 2))
    (((ash -1 10)) (logand (ash -1 2) most-positive-fixnum))
    ((20473335672995943448) (logand 79973967472640404 most-positive-fixnum)))
  (checked-compile-and-assert
      ()
      `(lambda (n s)
         (declare ((integer -64 -1) s))
         (logand (ash n s) most-positive-fixnum))
    ((0 -10) 0)
    (((ash 1 12) -10) (ash 1 2))
    (((ash -1 12) -10) (logand (ash -1 2) most-positive-fixnum))
    ((325822690411775662515259164035444996112 -64) (logand 17662883439475955428 most-positive-fixnum)))
  (checked-compile-and-assert
      ()
      `(lambda (n)
         (logand (ash n -8) most-positive-word))
    ((0) 0)
    (((ash 1 10)) (ash 1 2))
    (((ash -1 10)) (logand (ash -1 2) most-positive-word))
    ((20473335672995943448) (logand 79973967472640404 most-positive-word)))
  (checked-compile-and-assert
      ()
      `(lambda (n s)
         (declare ((integer -64 -1) s))
         (logand (ash n s) most-positive-word))
    ((0 -10) 0)
    (((ash 1 12) -10) (ash 1 2))
    (((ash -1 12) -10) (logand (ash -1 2) most-positive-word))
    ((325822690411775662515259164035444996112 -64) (logand 17662883439475955428 most-positive-word))))


(with-test (:name :mask-signed-field-word-move)
  (checked-compile-and-assert
      ()
      `(lambda (n)
         (declare (word n))
         (logand (sb-c::mask-signed-field sb-vm:n-fixnum-bits n) most-positive-word))
    (((* most-positive-fixnum 2))
     (logand -2 most-positive-word))))

(with-test (:name :logand-cut-constants)
  ;; (assert (= (count-if
  ;;             (lambda (c)
  ;;               (member c '(logand logtest)))
  ;;             (ctu:ir1-named-calls `(lambda (x m)
  ;;                                     (declare ((unsigned-byte 32) x)
  ;;                                              ((unsigned-byte 8) m))
  ;;                                     (logtest m (logand x #xFF)))
  ;;                                  nil))
  ;;            1))
  (assert (= (count 'logand
                    (ctu:ir1-named-calls `(lambda (m)
                                            (declare ((unsigned-byte 8) m))
                                            (logand m #xFFFF))
                                         nil))
             0))
  (assert (= (count 'sb-c::mask-signed-field
                    (ctu:ir1-named-calls `(lambda (n m)
                                            (declare ((unsigned-byte 64) n)
                                                     ((unsigned-byte 8) m))
                                            (logand m (sb-c::mask-signed-field 63 n)))
                                         nil))
             0))
  (assert (= (count 'logior
                    (ctu:ir1-named-calls `(lambda (n)
                                            (logand #xF0 (logior n 1)))
                                         nil))
             0))
  (assert (= (count 'logxor
                    (ctu:ir1-named-calls `(lambda (n)
                                            (declare ((unsigned-byte 32) n))
                                            (logand #xF (logxor n #xF0)))
                                         nil))
             0))
  (assert-type
   (lambda (n)
     (logand #xFF (logior n #xFF)))
   (eql #xFF))
  (checked-compile-and-assert
      ()
      `(lambda (b d)
         (declare ((unsigned-byte 32) b d))
         (logand (the bit b)
                 (logior d 1)))
    ((0 3) 0)
    ((1 3) 1))
  (checked-compile-and-assert
      ()
      `(lambda (d)
         (logand
          73786976294838206461
          (logior
           (the (integer -3 -1) d)
           -288230376562614601)))
    ((-1) 73786976294838206461)
    ((-3) 73786976294838206461))
  (checked-compile-and-assert
      ()
      `(lambda (s)
         (logand (logior -10 s) 29953653503380140701))
    ((0) 29953653503380140692)
    ((1) 29953653503380140693)))

(with-test (:name :logand-cut-constants.2
            :fails-on (or :arm :mips :ppc :sparc))
  (assert (= (count-if (lambda (c)
                         (member c '(logand sb-kernel:two-arg-and)))
                       (ctu:ir1-named-calls `(lambda (n m)
                                               (declare ((unsigned-byte 64) n)
                                                        ((unsigned-byte 8) m))
                                               (logand m (logand n #xFFFF)))
                                            nil))
             1))
  #-arm
  (assert (= (count-if (lambda (c)
                         (member c '(logand sb-kernel:two-arg-and)))
                       (ctu:ir1-named-calls `(lambda (x m)
                                               (declare ((unsigned-byte 32) x)
                                                        ((unsigned-byte 8) m))
                                               (logand m (logand x #xFF)))
                                            nil))
             1)))

(with-test (:name :lognot)
  (assert (= (count 'lognot
                    (ctu:ir1-named-calls `(lambda (x)
                                            (declare (integer x))
                                            (lognot (lognot x)))
                                         nil))
             0)))

(with-test (:name :constant-association
            :fails-on :sbcl)
  (assert (= (count-if (lambda (c)
                         (member c '(+ sb-kernel:two-arg-+)))
                       (ctu:ir1-named-calls
                        `(lambda (x)
                           (+ (the integer (1+ x)) 20))
                        nil))
             1))
  (assert (= (count-if (lambda (c)
                         (member c '(* sb-kernel:two-arg-*)))
                       (ctu:ir1-named-calls
                        `(lambda (x)
                           (* (the integer (* x 3)) 5))
                        nil))
             1)))

(with-test (:name :0/0)
  (assert-error
      (/ (opaque-identity 0) (opaque-identity 0))
      division-by-zero))

(with-test (:name :assoc-*-const)
  (flet ((test (names form count)
           (assert (= (count-if (lambda (c)
                                  (member c names))
                                (ctu:ir1-named-calls form nil))
                      count))))
    (test '(* sb-kernel:two-arg-*)
          `(lambda (a b)
             (declare (rational a b))
             (* (* a (* b 3)) 5))
          2)
    (test '(* sb-kernel:two-arg-*)
          `(lambda (a b)
             (declare (rational a b))
             (* (/ (* b 5) a) 6))
          1)
    (test '(* sb-kernel:two-arg-*)
          `(lambda (a)
             (declare (rational a))
             (* (/ (* a 5) 4) 6))
          1)
    (test '(* sb-kernel:two-arg-*)
          `(lambda (a)
             (declare (rational a))
             (* (abs (* a 5)) 6))
          1)
    (test '(* sb-kernel:two-arg-*)
          `(lambda (a b)
             (declare (rational a b))
             (* (* a 3) (* b 5)))
          2)
    (test '(/ sb-kernel:two-arg-/)
          `(lambda (a)
             (declare (rational a))
             (* (/ a 3) 6))
          0)
    (test '(ash)
          `(lambda (a)
             (* (ash a 3) 5))
          0)
    ;; (test '(* sb-kernel:two-arg-*)
    ;;       `(lambda (a s)
    ;;          (declare (unsigned-byte s))
    ;;          (* (ash (* a 3) s) 5))
    ;;       1)
    ;; (test '(* sb-kernel:two-arg-* ash)
    ;;       `(lambda (a)
    ;;          (ash (* a 3) 2))
    ;;       1)
    (test '(truncate sb-kernel::truncate1)
          `(lambda (a)
             (declare (integer a))
             (values (truncate (* a 9) 3)))
          0)
    (test '(floor sb-kernel::floor1)
          `(lambda (a)
             (declare (integer a))
             (values (floor (* a 9) 3)))
          0)
    (test '(* sb-kernel:two-arg-*)
          `(lambda (a)
             (declare (rational a))
             (values (truncate (* a 3) 9)))
          0)
    (assert-type
     (lambda (a)
       (declare (integer a))
       (rem (* a 20) 10))
     (eql 0))
    (test '(truncate sb-kernel::truncate1)
          `(lambda (a)
             (declare (integer a))
             (values (truncate (truncate a 10) 20)))
          1)
    (test '(floor sb-kernel::floor1)
          `(lambda (a)
             (declare (integer a))
             (values (floor (floor a 10) 20)))
          1)
    (checked-compile-and-assert
        ()
        `(lambda (v)
           (declare (integer v))
           (values (round (round v -94) 40)))
      ((2396371438047407363) -637332829267928))
    (checked-compile-and-assert
        ()
        `(lambda (v)
           (declare (integer v))
           (values (ceiling (ceiling v 7) -3)))
      ((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 :assoc-*-const.2)
  (flet ((test (names form count)
           (assert (= (count-if (lambda (c)
                                  (member c names))
                                (ctu:ir1-named-calls form nil))
                      count))))
    (test '(truncate sb-kernel::truncate1 ash sb-c::ash-right)
          `(lambda (a)
             (declare (unsigned-byte a))
             (values (truncate (ash a -2) 5)))
          1)
    (test '(floor sb-kernel::floor1 ash sb-c::ash-right)
          `(lambda (a)
             (values (floor (ash a -2) 5)))
          1)
    (test '(ash sb-c::ash-right)
          `(lambda (n)
             (declare (integer n))
             (ash (floor n 5) -2))
          0)
    (test '(ash sb-c::ash-right)
          `(lambda (n)
             (declare (unsigned-byte n))
             (ash (truncate n 5) -2))
          0)
    (test '(truncate sb-kernel::truncate1)
          `(lambda (a)
             (declare (integer a))
             (values (truncate (truncate 9 a) 3)))
          1)
    (checked-compile-and-assert
        ()
        `(lambda (v)
           (declare (integer v))
           (values (truncate (abs (truncate 9 v)) -3)))
      ((2) -1)
      ((-10) 0))))

(with-test (:name :assoc-*-const.3)
  (flet ((test (names form count)
           (assert (= (count-if (lambda (c)
                                  (member c names))
                                (ctu:ir1-named-calls form nil))
                      count))))
    (test '(* sb-kernel:two-arg-*)
          `(lambda (a)
             (declare (rational a))
             (* (+ (* a 3) 3) 5))
          1)
    (test '(* sb-kernel:two-arg-*)
          `(lambda (a)
             (declare (rational a))
             (* (abs (- (* a 3) 3)) 5))
          1)
    (checked-compile-and-assert
        ()
        `(lambda (a)
           (declare (integer a))
           (* (+ (abs (* -3 a)) 3) -5))
      ((5) -90))
    (checked-compile-and-assert
        ()
        `(lambda (a)
           (declare (integer a))
           (values (floor (abs (floor 10 a)) 5)))
      ((-9) 0))
    (checked-compile-and-assert
        ()
        `(lambda (p)
           (declare (integer p))
           (values (ceiling (ceiling (* 10 p) -31)
                            41/50)))
      ((-97) 40))
    (checked-compile-and-assert
        ()
        `(lambda (n)
           (declare (integer n))
           (values (truncate (truncate n 190) 16/25)))
      ((46945) 385))
    (checked-compile-and-assert
        ()
        `(lambda (n)
           (declare (rational n))
           (values (truncate (truncate 4 n) 3)))
      ((1/3) 4))
    (checked-compile-and-assert
        ()
        `(lambda (n)
           (declare (integer n))
           (* (/ 23 (* 37 n)) -12))
      ((2) -138/37))
    (checked-compile-and-assert
        (:optimize :safe)
        `(lambda (n)
           (* (the integer (* #c(1 2) n)) 3))
      ((#c(1 -2)) 15)
      ((2) (condition 'type-error)))
    (checked-compile-and-assert
        (:optimize :safe)
        `(lambda (n)
           (* (the integer (* n 4)) 3))
      ((1/2) 6))
    (checked-compile-and-assert
        (:optimize :safe)
        `(lambda (n)
           (* (the integer (* #c(1 2) n)) 3))
      ((#c(1 -2)) 15)
      ((2) (condition 'type-error)))
    (checked-compile-and-assert
        (:optimize :safe)
        `(lambda (n)
           (* (the integer (* n 0)) 3))
      ((#c(1 -2)) 0))))

(with-test (:name :logtest-vop
            :implemented-on (and (:vop-existsp logtest) (not :ppc64)))
  (assert (= (count 'logtest
                    (ctu:ir1-named-calls `(lambda (a)
                                            (zerop (logand a 1)))
                                         nil))
             1))
  (assert (= (count 'logtest
                    (ctu:ir1-named-calls `(lambda (a)
                                            (declare (fixnum a))
                                            (plusp (logand a 6)))
                                         nil))
             1)))

(with-test (:name :logtest
            :fails-on :ppc64)
  (checked-compile-and-assert
      ()
      `(lambda (p1)
         (declare (type (integer -845794755782386 1048630) p1))
         (logtest p1 12115639945877374832))
    ((-845794755782386) t)
    ((145551) nil))
  (checked-compile-and-assert
      ()
      `(lambda (a)
         (logtest a (the (unsigned-byte 30) a)))
    ((8) t)
    ((0) nil)))

(with-test (:name :logtest-integer-fixnum
            :implemented-on (or :arm64 :x86-64 :x86))
  (assert (not (ctu:ir1-named-calls `(lambda (x y)
                                       (declare (integer x)
                                                (fixnum y))
                                       (logtest x y))))))

(with-test (:name :ash-mod)
  (checked-compile-and-assert
      ()
      `(lambda (a b)
         (declare ((integer -3 3) b))
         (logand #xF (+ (ash a b) 1)))
    ((-1 3) 9)
    ((-1 -3) 0)
    ((1 -3) 1))
  (checked-compile-and-assert
      ()
      `(lambda (a b)
         (declare (fixnum a b))
         (logand most-positive-word (ash a b)))
    ((1 2) 4)
    ((10 -2) 2)
    ((1 sb-vm:n-word-bits) 0)
    ((-1 sb-vm:n-word-bits) 0)
    ((1 (- sb-vm:n-word-bits)) 0)
    ((-1 (- sb-vm:n-word-bits)) most-positive-word))
  (checked-compile-and-assert
      ()
      `(lambda (a b)
         (declare (fixnum a b))
         (logand most-positive-word (ash a (- b))))
    ((1 -2) 4)
    ((10 2) 2)
    ((1 (- sb-vm:n-word-bits)) 0)
    ((-1 (- sb-vm:n-word-bits)) 0)
    ((1 sb-vm:n-word-bits) 0)
    ((-1 sb-vm:n-word-bits) most-positive-word)))

(with-test (:name :division-float-0-type)
  (assert-type
     (lambda (x y)
       (declare ((real 0) x y))
       (/ x y))
     (real 0)))

(with-test (:name :floor/ceiling-to-truncate)
  (assert (= (count-if (lambda (c)
                         (member c '(truncate)))
                       (ctu:ir1-named-calls
                        `(lambda (x y)
                           (declare ((real 0 *) x y))
                           (floor x y))
                        nil))
             1))
  (assert (= (count-if (lambda (c)
                         (member c '(truncate)))
                       (ctu:ir1-named-calls
                        `(lambda (x y)
                           (declare ((real * 0) x y))
                           (floor x y))
                        nil))
             1))
  (assert (= (count-if (lambda (c)
                         (member c '(truncate)))
                       (ctu:ir1-named-calls
                        `(lambda (x y)
                           (declare ((real * 0) x)
                                    ((real 0 *) y))
                           (ceiling x y))
                        nil))
             1)))
(with-test (:name :range<-empty)
  (if (vop-existsp 'sb-kernel:range<<=)
      (assert-type
       (lambda (v)
         (declare ((integer -50 0) v))
         (> v
            (if (> v -30)
                1
                -10)))
       null)
      (assert-type
       (lambda (v)
         (declare ((integer -50 0) v))
         (> v
            (if (> v -30)
                1
                -10)))
       boolean)))

(with-test (:name :ash-left-bignum)
  (checked-compile-and-assert
      ()
      `(lambda (b s)
         (declare (bignum b)
                  ((member -40 25) s))
         (logand #xffffffffffff (ash b s)))
    ((-1422907942930057474717222 25) 75401170780160)
    ((-1422907942930057474717222 -40) 280180849475450)))

(with-test (:name :truncate-ratios-by-float)
  (assert-type
   (lambda (r)
     (declare ((rational 9241088767394112609508907202529414093/970467704224781278
                         9241088767394112609508907202529414093/970467704224781277)
               r))
     (truncate r 1.0))
   (values (eql 9522303959679631360) (eql 0.0) &optional))
  (assert-type
   (lambda (x)
     (declare ((single-float 0.0 0.0) x))
     (nth-value 1 (truncate x)))
   (single-float 0.0 0.0))
  (assert-type
   (lambda (v1)
     (declare ((rational (96106637441700886132) (96106637441700886133)) v1))
     (truncate v1 1.0))
   (values (integer 96106640126225940480 96106640126225940480) (member 0.0) &optional)))

(with-test (:name :complex-division-minus-zero)
  (loop for x in (opaque-identity '(0 0.0 #c(0.0 0.0)))
        do (assert (eql (/ x #c(-1.0 3))
                        (opaque-identity #C(0.0 -0.0)))))
  (loop for x in (opaque-identity '(2 2.0 #c(2.0 0.0)))
        do (assert (eql (/ x #c(0.0 1.0))
                        (opaque-identity #C(0.0 -2.0)))))
  (checked-compile-and-assert
      ()
      `(lambda (f c)
         (declare (single-float f)
                  ((complex single-float) c))
         (/ f c))
    ((-2.0 #c(0.0 1.0)) #C(0.0 2.0))
    ((0.0 #c(1 -3.0)) (/ 0 #c(1 -3.0))))
  (checked-compile-and-assert
      ()
      `(lambda (f c)
         (declare (real f)
                  ((complex single-float) c))
         (/ f c))
    ((-2.0 #c(0.0 1.0)) #C(0.0 2.0))
    ((0.0 #c(1 -3.0)) (/ 0 #c(1 -3.0)))
    ((0  #C(3.0 -4)) (/ 0.0 #C(3.0 -4))))
  (checked-compile-and-assert
      ()
      `(lambda (c)
         (- (/ -3.0 c)))
    ((#c(0 3.0)) (- (opaque-identity (/ (opaque-identity -3.0)
                                        (opaque-identity #c(0 3.0)))))))
  (checked-compile-and-assert
      ()
      `(lambda (a b)
         (declare ((complex float) a b))
         (/ (- a) (- b)))
    ((#c(0.0 3.0) #c(0.0 3.0))
     (/ (opaque-identity (- #c(0.0 3.0)))
        (opaque-identity (- #c(0.0 3.0))))))
  (checked-compile-and-assert
      ()
      `(lambda (n)
         (declare (double-float n))
         (/ n #C(1.0 2.0)))
    ((5d0) #C(1.0d0 -2.0d0))))

(with-test (:name :truncate+/+complex)
  (checked-compile-and-assert
      ()
      `(lambda (a b)
         (values (truncate (/ a b))))
    ((#C(3 6) #C(1 2)) 3)))

(with-test (:name :ash-into-word
            :implemented-on (:vop-existsp sb-kernel:ash-right-two-words))
  (assert (not (ctu:ir1-named-calls
                `(lambda (x)
                   (ash (the (unsigned-byte ,(* 2 sb-vm:n-word-bits)) x)
                        ,(- sb-vm:n-word-bits))))))
  (assert (not (ctu:ir1-named-calls
                `(lambda (x)
                   (ash (the (signed-byte ,(* 2 sb-vm:n-word-bits)) x)
                        ,(- sb-vm:n-word-bits))))))
  (assert (not (ctu:ir1-named-calls
                `(lambda (x p3)
                   (declare (type (integer * ,(- sb-vm:n-word-bits)) p3)
                            ((unsigned-byte ,(* (- sb-vm:n-word-bits 4) 2)) x))
                   (ash x p3))))))

(with-test (:name :truncate-by-zero-type)
  (assert-type
   (lambda (n x)
     (declare ((integer -9 9) n)
              ((and integer (not (member 1 -1))) x))
     (truncate n x))
   (values (integer -4 4) (integer -9 9) &optional))
  (assert-type
   (lambda (n x)
     (declare ((integer -9 9) n)
              ((and integer (not (member 1 -1))) x))
     (/ n x))
   (rational -9/2 9/2)))


(with-test (:name :floor-by-integer-type)
  (assert-type
   (lambda (n x)
     (declare ((integer -5 5) n)
              (integer x))
     (floor n x))
   (values (integer -5 5) integer &optional))
  (assert-type
   (lambda (n x)
     (declare ((rational -6 5) n)
              (integer x))
     (ceiling n x))
   (values (integer -6 6) rational &optional))
  (assert-type
   (lambda (a b)
     (declare ((integer 4 5) a)
              ((integer -2 3) b))
     (truncate a b))
   (values (or (integer -5 -2) (integer 1 5)) (mod 3) &optional))
  (assert-type
   (lambda (a b)
     (declare ((rational -5 4) a)
              (integer b))
     (truncate a b))
   (values (integer -5 5) (rational -5 4) &optional)))

(with-test (:name :ash-modfx-constant-fold)
  (checked-compile-and-assert
      ()
      `(lambda (b)
         (declare (fixnum b))
         (when (eq b (1- sb-vm:n-fixnum-bits))
           (ldb (byte sb-vm:n-fixnum-bits 0) (ash 1 b))))
    (((1- sb-vm:n-fixnum-bits)) (ash 1 (1- sb-vm:n-fixnum-bits)))
    ((0) nil)))

(with-test (:name :mask-signed-field-fixnum-result)
  (checked-compile-and-assert
   ()
   `(lambda (x)
      (truly-the fixnum (sb-c::mask-signed-field sb-vm:n-word-bits x)))
   (((* most-positive-fixnum (ash 2 sb-vm:n-fixnum-tag-bits)))
    (ash -2 sb-vm:n-fixnum-tag-bits))
   ((10)
    10)))

(with-test (:name :ash-inverted)
  (checked-compile-and-assert
   ()
   `(lambda (x y)
      (declare ((integer -5 5) y)
               ((signed-byte 16) x))
      (ash x (- y)))
   ((1 -5) 32)))
