Skip to content
Snippets Groups Projects
Commit f58b5d23 authored by dtc's avatar dtc
Browse files

Fix for the ceiling derive type optimizer which in some cases was

creating integers with non-canonicalised exclusive bounds; call
specifier-type to create the result type which canonicalises the
bounds.
parent f4b6d8f4
No related branches found
No related tags found
No related merge requests found
...@@ -5,7 +5,7 @@ ...@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain. ;;; Carnegie Mellon University, and has been placed in the public domain.
;;; ;;;
(ext:file-comment (ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/srctran.lisp,v 1.98 2000/04/13 05:29:07 dtc Exp $") "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/srctran.lisp,v 1.99 2000/06/21 17:01:48 dtc Exp $")
;;; ;;;
;;; ********************************************************************** ;;; **********************************************************************
;;; ;;;
...@@ -1820,35 +1820,22 @@ ...@@ -1820,35 +1820,22 @@
divisor-interval)))) divisor-interval))))
(specifier-type `(integer ,(or (interval-low quot) '*) (specifier-type `(integer ,(or (interval-low quot) '*)
,(or (interval-high quot) '*))))) ,(or (interval-high quot) '*)))))
;; Compute type of remainder ;; Compute type of remainder
(defun ,r-aux (number-type divisor-type) (defun ,r-aux (number-type divisor-type)
(let* ((divisor-interval (let* ((divisor-interval
(numeric-type->interval divisor-type)) (numeric-type->interval divisor-type))
(rem (,r-name divisor-interval)) (rem (,r-name divisor-interval))
(result-type (rem-result-type number-type divisor-type))) (result-type (rem-result-type number-type divisor-type)))
(multiple-value-bind (class format) (when (member result-type '(float single-float double-float
(ecase result-type #+long-float long-float))
(integer ;; Make sure the limits on the interval have the right type.
(values 'integer nil)) (setf rem (interval-func #'(lambda (x)
(rational (coerce x result-type))
(values 'rational nil)) rem)))
((or single-float double-float #+long-float long-float) (specifier-type `(,result-type ,(or (interval-low rem) '*)
(values 'float result-type)) ,(or (interval-high rem) '*)))))
(float
(values 'float nil))
(real
(values nil nil)))
(when (member result-type '(float single-float double-float
#+long-float long-float))
;; Make sure the limits on the interval have
;; the right type.
(setf rem (interval-func #'(lambda (x)
(coerce x result-type))
rem)))
(make-numeric-type :class class
:format format
:low (interval-low rem)
:high (interval-high rem)))))
;; The optimizer itself ;; The optimizer itself
(defoptimizer (,name derive-type) ((number divisor)) (defoptimizer (,name derive-type) ((number divisor))
(flet ((derive-q (n d same-arg) (flet ((derive-q (n d same-arg)
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment