;;; FLOAT function return the correct ranges if the input has some
;;; defined range. Quite useful if we want to convert some type of
;;; bounded integer into a float.
;;; FLOAT function return the correct ranges if the input has some
;;; defined range. Quite useful if we want to convert some type of
;;; bounded integer into a float.
(one-arg-derive-type num #',aux-name #',fun))))))
(frob %single-float single-float)
(frob %double-float double-float))
(one-arg-derive-type num #',aux-name #',fun))))))
(frob %single-float single-float)
(frob %double-float double-float))
(destructuring-bind (name type) stuff
(let ((type (specifier-type type)))
(setf (function-info-derive-type (function-info-or-lose name))
(destructuring-bind (name type) stuff
(let ((type (specifier-type type)))
(setf (function-info-derive-type (function-info-or-lose name))
- #'(lambda (call)
- (declare (type combination call))
- (when (csubtypep (continuation-type
- (first (combination-args call)))
- type)
- (specifier-type 'float)))))))
+ (lambda (call)
+ (declare (type combination call))
+ (when (csubtypep (continuation-type
+ (first (combination-args call)))
+ type)
+ (specifier-type 'float)))))))
;;; Handle monotonic functions of a single variable whose domain is
;;; possibly part of the real line. ARG is the variable, FCN is the
;;; function, and DOMAIN is a specifier that gives the (real) domain
;;; Handle monotonic functions of a single variable whose domain is
;;; possibly part of the real line. ARG is the variable, FCN is the
;;; function, and DOMAIN is a specifier that gives the (real) domain
(defun merged-interval-expt (x y)
(let* ((x-int (numeric-type->interval x))
(y-int (numeric-type->interval y)))
(defun merged-interval-expt (x y)
(let* ((x-int (numeric-type->interval x))
(y-int (numeric-type->interval y)))
(defun log-derive-type-aux-2 (x y same-arg)
(let ((log-x (log-derive-type-aux-1 x))
(log-y (log-derive-type-aux-1 y))
(defun log-derive-type-aux-2 (x y same-arg)
(let ((log-x (log-derive-type-aux-1 x))
(log-y (log-derive-type-aux-1 y))
- (result '()))
- ;; log-x or log-y might be union types. We need to run through
- ;; the union types ourselves because /-derive-type-aux doesn't.
+ (accumulated-list nil))
+ ;; LOG-X or LOG-Y might be union types. We need to run through
+ ;; the union types ourselves because /-DERIVE-TYPE-AUX doesn't.
(dolist (x-type (prepare-arg-for-derive-type log-x))
(dolist (y-type (prepare-arg-for-derive-type log-y))
(dolist (x-type (prepare-arg-for-derive-type log-x))
(dolist (y-type (prepare-arg-for-derive-type log-y))
- (push (/-derive-type-aux x-type y-type same-arg) result)))
- (setf result (flatten-list result))
- (if (rest result)
- (make-union-type result)
- (first result))))
+ (push (/-derive-type-aux x-type y-type same-arg) accumulated-list)))
+ (apply #'type-union (flatten-list accumulated-list))))
;;; Make REALPART and IMAGPART return the appropriate types. This
;;; should help a lot in optimized code.
;;; Make REALPART and IMAGPART return the appropriate types. This
;;; should help a lot in optimized code.
(defun realpart-derive-type-aux (type)
(let ((class (numeric-type-class type))
(format (numeric-type-format type)))
(defun realpart-derive-type-aux (type)
(let ((class (numeric-type-class type))
(format (numeric-type-format type)))
#!+(or propagate-fun-type propagate-float-type)
(defoptimizer (realpart derive-type) ((num))
(one-arg-derive-type num #'realpart-derive-type-aux #'realpart))
#!+(or propagate-fun-type propagate-float-type)
(defoptimizer (realpart derive-type) ((num))
(one-arg-derive-type num #'realpart-derive-type-aux #'realpart))
(defun imagpart-derive-type-aux (type)
(let ((class (numeric-type-class type))
(format (numeric-type-format type)))
(defun imagpart-derive-type-aux (type)
(let ((class (numeric-type-class type))
(format (numeric-type-format type)))
#!+(or propagate-fun-type propagate-float-type)
(defoptimizer (imagpart derive-type) ((num))
(one-arg-derive-type num #'imagpart-derive-type-aux #'imagpart))
#!+(or propagate-fun-type propagate-float-type)
(defoptimizer (imagpart derive-type) ((num))
(one-arg-derive-type num #'imagpart-derive-type-aux #'imagpart))
(make-numeric-type :class (numeric-type-class element-type)
:format (numeric-type-format element-type)
:complexp (if rat-result-p
(make-numeric-type :class (numeric-type-class element-type)
:format (numeric-type-format element-type)
:complexp (if rat-result-p
;;; produce a minimal range for the result; the result is the widest
;;; possible answer. This gets around the problem of doing range
;;; reduction correctly but still provides useful results when the
;;; inputs are union types.
;;; produce a minimal range for the result; the result is the widest
;;; possible answer. This gets around the problem of doing range
;;; reduction correctly but still provides useful results when the
;;; inputs are union types.
- #'(lambda (arg)
- ;; Derive the bounds if the arg is in [-pi/2, pi/2].
- (trig-derive-type-aux
- arg
- (specifier-type `(float ,(- (/ pi 2)) ,(/ pi 2)))
- #'sin
- -1 1))
+ (lambda (arg)
+ ;; Derive the bounds if the arg is in [-pi/2, pi/2].
+ (trig-derive-type-aux
+ arg
+ (specifier-type `(float ,(- (/ pi 2)) ,(/ pi 2)))
+ #'sin
+ -1 1))
- #'(lambda (arg)
- ;; Derive the bounds if the arg is in [0, pi].
- (trig-derive-type-aux arg
- (specifier-type `(float 0d0 ,pi))
- #'cos
- -1 1
- nil))
+ (lambda (arg)
+ ;; Derive the bounds if the arg is in [0, pi].
+ (trig-derive-type-aux arg
+ (specifier-type `(float 0d0 ,pi))
+ #'cos
+ -1 1
+ nil))
- #'(lambda (arg)
- ;; Derive the bounds if the arg is in [-pi/2, pi/2].
- (trig-derive-type-aux arg
- (specifier-type `(float ,(- (/ pi 2)) ,(/ pi 2)))
- #'tan
- nil nil))
+ (lambda (arg)
+ ;; Derive the bounds if the arg is in [-pi/2, pi/2].
+ (trig-derive-type-aux arg
+ (specifier-type `(float ,(- (/ pi 2)) ,(/ pi 2)))
+ #'tan
+ nil nil))