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

Fixes for constrain-float-type.

parent 3cb270c8
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/constraint.lisp,v 1.19 1998/05/29 06:41:24 dtc Exp $") "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/constraint.lisp,v 1.20 1999/01/25 12:25:47 dtc Exp $")
;;; ;;;
;;; ********************************************************************** ;;; **********************************************************************
;;; ;;;
...@@ -329,49 +329,38 @@ ...@@ -329,49 +329,38 @@
(labels ((exclude (x) (labels ((exclude (x)
(cond ((not x) nil) (cond ((not x) nil)
(or-equal x) (or-equal x)
(greater ((consp x) x)
(if (consp x) (t (list x))))
(car x)
x))
(t
(if (consp x)
x
(list x)))))
(bound (x) (bound (x)
(if greater (numeric-type-low x) (numeric-type-high x))) (if greater (numeric-type-low x) (numeric-type-high x)))
(max-lower-bound (x y) (max-lower-bound (x y)
;; Both x and y are not null. Find the max. (cond ((< (bound-value x) (bound-value y)) y)
(let ((res (max (bound-value x) (bound-value y)))) ((> (bound-value x) (bound-value y)) x)
;; An open lower bound is greater than a close ((not or-equal) (list (bound-value x)))
;; lower bound because the open bound doesn't ((consp x) x)
;; contain the bound, so choose an open lower (t y)))
;; bound.
(set-bound res (or (consp x) (consp y)))))
(min-upper-bound (x y) (min-upper-bound (x y)
;; Same as above, but for the min of upper bounds (cond ((< (bound-value x) (bound-value y)) x)
;; Both x and y are not null. Find the min. ((> (bound-value x) (bound-value y)) y)
(let ((res (min (bound-value x) (bound-value y)))) ((not or-equal) (list (bound-value x)))
;; An open upper bound is less than a closed ((consp x) x)
;; upper bound because the open bound doesn't (t y)))
;; contain the bound, so choose an open lower
;; bound.
(set-bound res (or (consp x) (consp y)))))
(validate (x) (validate (x)
(let ((x-lo (numeric-type-low x)) (let* ((low (numeric-type-low x))
(x-hi (numeric-type-high x))) (low-val (bound-value low))
(if (and x-lo x-hi (> (bound-value x-lo) (bound-value x-hi))) (high (numeric-type-high x))
(high-val (bound-value high)))
(if (and low high (or (> low-val high-val)
(and (= low-val high-val)
(or (consp low) (consp high)))))
*empty-type* *empty-type*
x)))) x))))
(let* ((x-bound (bound x)) (let* ((x-bound (bound x))
(y-bound (exclude (bound y))) (y-bound (exclude (bound y)))
(new-bound (cond ((not x-bound) (new-bound (cond ((not x-bound) y-bound)
y-bound) ((not y-bound) x-bound)
((not y-bound) (greater (max-lower-bound x-bound y-bound))
x-bound) (t (min-upper-bound x-bound y-bound))))
(greater
(max-lower-bound x-bound y-bound))
(t
(min-upper-bound x-bound y-bound))))
(res (copy-numeric-type x))) (res (copy-numeric-type x)))
(if greater (if greater
(setf (numeric-type-low res) new-bound) (setf (numeric-type-low res) new-bound)
......
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