Commit 17e30810 authored by Raymond Toy's avatar Raymond Toy
Browse files

Clean up one- and two-arg-derive-type.

srctran.lisp::
 * The optional convert-type arg is always true, so remove it and
   update the local functions to convert always.
 * Clean up some comments as well.

float-tran.lisp::
 * Fix up one place where we were supplying a value for the optional
   convert-type arg.
parent 0ecc7f4c
......@@ -553,7 +553,7 @@
;;;
(defoptimizer (scale-float derive-type) ((f ex))
(two-arg-derive-type f ex #'scale-float-derive-type-aux
#'scale-float t))
#'scale-float))
;;; toy@rtp.ericsson.se:
;;;
......
......@@ -1189,11 +1189,9 @@
;;; compute the result otherwise the member type is first converted to a
;;; numeric type and the derive-fcn is call.
;;;
(defun one-arg-derive-type (arg derive-fcn member-fcn
&optional (convert-type t))
(defun one-arg-derive-type (arg derive-fcn member-fcn)
(declare (type function derive-fcn)
(type (or null function) member-fcn)
)
(type (or null function) member-fcn))
(let ((arg-list (prepare-arg-for-derive-type (continuation-type arg))))
(when arg-list
(flet ((deriver (x)
......@@ -1203,18 +1201,14 @@
(with-float-traps-masked
(:underflow :overflow :divide-by-zero)
(specifier-type `(eql ,(funcall member-fcn
(first (member-type-members x))))))
(first (member-type-members x))))))
;; Otherwise convert to a numeric type.
(let ((result-type-list
(funcall derive-fcn (convert-member-type x))))
(if convert-type
(convert-back-numeric-type-list result-type-list)
result-type-list))))
(convert-back-numeric-type-list result-type-list))))
(numeric-type
(if convert-type
(convert-back-numeric-type-list
(funcall derive-fcn (convert-numeric-type x)))
(funcall derive-fcn x)))
(convert-back-numeric-type-list
(funcall derive-fcn (convert-numeric-type x))))
(t
*universal-type*))))
;; Run down the list of args and derive the type of each one, saving
......@@ -1238,63 +1232,53 @@
;;; (* x x), which should always be positive. If we didn't do this, we
;;; wouldn't be able to tell.
;;;
;;; Without the negative-zero-is-not-zero feature, numeric types are first
;;; converted to the negative-zero-is-not-zero conventions as expected by the
;;; deriver function.
;;;
;;; For the case of two member types, the result may be derived by calling the
;;; given function FCN but if a NaN is generated then an unbounded type is
;;; returned. Alternatively a tighter, less conservative, type can often be
;;; returned by converting to numeric types and calling the deriver function,
;;; which is the default behavior without the conservative-float-type feature.
;;;
(defun two-arg-derive-type (arg1 arg2 derive-fcn fcn
&optional (convert-type t))
(labels ((maybe-convert-numeric-type (type)
(if convert-type (convert-numeric-type type) type))
(maybe-convert-back-type-list (type)
(if convert-type (convert-back-numeric-type-list type) type))
(deriver (x y same-arg)
(cond ((and (member-type-p x) (member-type-p y))
(let* ((x (first (member-type-members x)))
(y (first (member-type-members y)))
(result (with-float-traps-masked
(:underflow :overflow :divide-by-zero
:invalid)
(funcall fcn x y))))
(cond ((null result))
((and (floatp result) (float-nan-p result))
(make-numeric-type :class 'float
:format (type-of result)
:complexp :real))
(t
(specifier-type `(eql ,result))))))
((and (member-type-p x) (numeric-type-p y))
(let* ((x (convert-member-type x))
(y (maybe-convert-numeric-type y))
(result (funcall derive-fcn x y same-arg)))
(maybe-convert-back-type-list result)))
((and (numeric-type-p x) (member-type-p y))
(let* ((x (maybe-convert-numeric-type x))
(y (convert-member-type y))
(result (funcall derive-fcn x y same-arg)))
(maybe-convert-back-type-list result)))
((and (numeric-type-p x) (numeric-type-p y))
(let* ((x (maybe-convert-numeric-type x))
(y (maybe-convert-numeric-type y))
(result (funcall derive-fcn x y same-arg)))
(maybe-convert-back-type-list result)))
(t
*universal-type*)))
(non-const-same-leaf-ref-p (x y)
;; Just like same-leaf-ref-p, but we don't care if the
;; value of the leaf is constant or not.
(declare (type continuation x y))
(let ((x-use (continuation-use x))
(y-use (continuation-use y)))
(and (ref-p x-use)
(ref-p y-use)
(eq (ref-leaf x-use) (ref-leaf y-use))))))
;;; Numeric types are first converted to the negative-zero-is-not-zero
;;; conventions as expected by the deriver function. See
;;; CONVERT-NUMERIC-TYPE for the negative-zero-is-not-zero convention.
;;;
(defun two-arg-derive-type (arg1 arg2 derive-fcn fcn)
(flet
((deriver (x y same-arg)
(cond ((and (member-type-p x) (member-type-p y))
(let* ((x (first (member-type-members x)))
(y (first (member-type-members y)))
(result (with-float-traps-masked
(:underflow :overflow :divide-by-zero
:invalid)
(funcall fcn x y))))
(cond ((null result))
((and (floatp result) (float-nan-p result))
(make-numeric-type :class 'float
:format (type-of result)
:complexp :real))
(t
(specifier-type `(eql ,result))))))
((and (member-type-p x) (numeric-type-p y))
(let* ((x (convert-member-type x))
(y (convert-numeric-type y))
(result (funcall derive-fcn x y same-arg)))
(convert-back-numeric-type-list result)))
((and (numeric-type-p x) (member-type-p y))
(let* ((x (convert-numeric-type x))
(y (convert-member-type y))
(result (funcall derive-fcn x y same-arg)))
(convert-back-numeric-type-list result)))
((and (numeric-type-p x) (numeric-type-p y))
(let* ((x (convert-numeric-type x))
(y (convert-numeric-type y))
(result (funcall derive-fcn x y same-arg)))
(convert-back-numeric-type-list result)))
(t
*universal-type*)))
(non-const-same-leaf-ref-p (x y)
;; Just like same-leaf-ref-p, but we don't care if the
;; value of the leaf is constant or not.
(declare (type continuation x y))
(let ((x-use (continuation-use x))
(y-use (continuation-use y)))
(and (ref-p x-use)
(ref-p y-use)
(eq (ref-leaf x-use) (ref-leaf y-use))))))
(let ((same-arg (non-const-same-leaf-ref-p arg1 arg2))
(a1 (prepare-arg-for-derive-type (continuation-type arg1)))
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment