`(,',fun ,x 1)))))
(frob truncate)
(frob round)
- #!+sb-propagate-float-type
+ #-sb-xc-host ; (See CROSS-FLOAT-INFINITY-KLUDGE.)
(frob floor)
- #!+sb-propagate-float-type
+ #-sb-xc-host ; (See CROSS-FLOAT-INFINITY-KLUDGE.)
(frob ceiling))
(def-source-transform lognand (x y) `(lognot (logand ,x ,y)))
;;;; numeric-type has everything we want to know. Reason 2 wins for
;;;; now.
-#!+sb-propagate-float-type
+#-sb-xc-host ; (See CROSS-FLOAT-INFINITY-KLUDGE.)
(progn
;;; The basic interval type. It can handle open and closed intervals.
:high high))
(numeric-contagion x y))))
-#!+(or sb-propagate-float-type sb-propagate-fun-type)
+#-sb-xc-host ; (See CROSS-FLOAT-INFINITY-KLUDGE.)
(progn
;;; simple utility to flatten a list
) ; PROGN
\f
-#!-sb-propagate-float-type
+#+sb-xc-host ; (See CROSS-FLOAT-INFINITY-KLUDGE.)
(progn
(defoptimizer (+ derive-type) ((x y))
(derive-integer-type
) ; PROGN
-#!+sb-propagate-float-type
+#-sb-xc-host ; (See CROSS-FLOAT-INFINITY-KLUDGE.)
(progn
(defun +-derive-type-aux (x y same-arg)
(if (and (numeric-type-real-p x)
;;; and it's hard to avoid that calculation in here.
#-(and cmu sb-xc-host)
(progn
-#!-sb-propagate-fun-type
+#+sb-xc-host ; (See CROSS-FLOAT-INFINITY-KLUDGE.)
(defoptimizer (ash derive-type) ((n shift))
;; Large resulting bounds are easy to generate but are not
;; particularly useful, so an open outer bound is returned for a
:complexp :real)))))))))
*universal-type*))
-#!+sb-propagate-fun-type
+#-sb-xc-host ; (See CROSS-FLOAT-INFINITY-KLUDGE.)
(defun ash-derive-type-aux (n-type shift same-arg)
(declare (ignore same-arg))
(flet ((ash-outer (n s)
(ash-outer n-high s-high))))))
*universal-type*)))
-#!+sb-propagate-fun-type
+#-sb-xc-host ; (See CROSS-FLOAT-INFINITY-KLUDGE.)
(defoptimizer (ash derive-type) ((n shift))
(two-arg-derive-type n shift #'ash-derive-type-aux #'ash))
) ; PROGN
-#!-sb-propagate-float-type
+#+sb-xc-host ; (See CROSS-FLOAT-INFINITY-KLUDGE.)
(macrolet ((frob (fun)
`#'(lambda (type type2)
(declare (ignore type2))
(defoptimizer (lognot derive-type) ((int))
(derive-integer-type int int (frob lognot))))
-#!+sb-propagate-float-type
+#-sb-xc-host ; (See CROSS-FLOAT-INFINITY-KLUDGE.)
(defoptimizer (lognot derive-type) ((int))
(derive-integer-type int int
(lambda (type type2)
(numeric-type-class type)
(numeric-type-format type))))))
-#!+sb-propagate-float-type
+#-sb-xc-host ; (See CROSS-FLOAT-INFINITY-KLUDGE.)
(defoptimizer (%negate derive-type) ((num))
(flet ((negate-bound (b)
(and b
:high (negate-bound (numeric-type-low type))))
#'-)))
-#!-sb-propagate-float-type
+#+sb-xc-host ; (See CROSS-FLOAT-INFINITY-KLUDGE.)
(defoptimizer (abs derive-type) ((num))
(let ((type (continuation-type num)))
(if (and (numeric-type-p type)
nil)))
(numeric-contagion type type))))
-#!+sb-propagate-float-type
+#-sb-xc-host ; (See CROSS-FLOAT-INFINITY-KLUDGE.)
(defun abs-derive-type-aux (type)
(cond ((eq (numeric-type-complexp type) :complex)
;; The absolute value of a complex number is always a
:high (coerce-numeric-bound
(interval-high abs-bnd) bound-type))))))
-#!+sb-propagate-float-type
+#-sb-xc-host ; (See CROSS-FLOAT-INFINITY-KLUDGE.)
(defoptimizer (abs derive-type) ((num))
(one-arg-derive-type num #'abs-derive-type-aux #'abs))
-#!-sb-propagate-float-type
+#+sb-xc-host ; (See CROSS-FLOAT-INFINITY-KLUDGE.)
(defoptimizer (truncate derive-type) ((number divisor))
(let ((number-type (continuation-type number))
(divisor-type (continuation-type divisor))
divisor-low divisor-high))))
*universal-type*)))
-#!+sb-propagate-float-type
+#-sb-xc-host ; (See CROSS-FLOAT-INFINITY-KLUDGE.)
(progn
(defun rem-result-type (number-type divisor-type)
;; anything about the result.
`integer)))))
-#!-sb-propagate-float-type
+#+sb-xc-host ; (See CROSS-FLOAT-INFINITY-KLUDGE.)
(defun integer-rem-derive-type
(number-low number-high divisor-low divisor-high)
(if (and divisor-low divisor-high)
0
'*))))
-#!-sb-propagate-float-type
+#+sb-xc-host ; (See CROSS-FLOAT-INFINITY-KLUDGE.)
(defoptimizer (random derive-type) ((bound &optional state))
(let ((type (continuation-type bound)))
(when (numeric-type-p type)
((or (consp high) (zerop high)) high)
(t `(,high))))))))
-#!+sb-propagate-float-type
+#-sb-xc-host ; (See CROSS-FLOAT-INFINITY-KLUDGE.)
(defun random-derive-type-aux (type)
(let ((class (numeric-type-class type))
(high (numeric-type-high type))
((or (consp high) (zerop high)) high)
(t `(,high))))))
-#!+sb-propagate-float-type
+#-sb-xc-host ; (See CROSS-FLOAT-INFINITY-KLUDGE.)
(defoptimizer (random derive-type) ((bound &optional state))
(one-arg-derive-type bound #'random-derive-type-aux nil))
\f
(or (null min) (minusp min))))
(values nil t t)))
-#!-sb-propagate-fun-type
+#+sb-xc-host ; (See CROSS-FLOAT-INFINITY-KLUDGE.)
(progn
(defoptimizer (logand derive-type) ((x y))
) ; PROGN
-#!+sb-propagate-fun-type
+#-sb-xc-host ; (See CROSS-FLOAT-INFINITY-KLUDGE.)
(progn
(defun logand-derive-type-aux (x y &optional same-leaf)
;;;
;;; FIXME: Why should constant argument be second? It would be nice to
;;; find out and explain.
-#!-sb-propagate-float-type
+#+sb-xc-host ; (See CROSS-FLOAT-INFINITY-KLUDGE.)
(defun ir1-transform-< (x y first second inverse)
(if (same-leaf-ref-p x y)
nil
`(,inverse y x))
(t
(give-up-ir1-transform))))))
-#!+sb-propagate-float-type
+#-sb-xc-host ; (See CROSS-FLOAT-INFINITY-KLUDGE.)
(defun ir1-transform-< (x y first second inverse)
(if (same-leaf-ref-p x y)
nil
(deftransform > ((x y) (integer integer) * :when :both)
(ir1-transform-< y x x y '<))
-#!+sb-propagate-float-type
+#-sb-xc-host ; (See CROSS-FLOAT-INFINITY-KLUDGE.)
(deftransform < ((x y) (float float) * :when :both)
(ir1-transform-< x y x y '>))
-#!+sb-propagate-float-type
+#-sb-xc-host ; (See CROSS-FLOAT-INFINITY-KLUDGE.)
(deftransform > ((x y) (float float) * :when :both)
(ir1-transform-< y x x y '<))
\f
projects / sbcl.git / blobdiff