Commit cb674c89 authored by rtoy's avatar rtoy
Browse files

This big of code causes CMUCL to spend huge amounts of time trying to

simplify the union of disjoint double-float types:

(defun foo (arg)
  (declare (type double-double-float arg)
	   (optimize (speed 3) (space 0)))
  (let* ((x arg)
	 (xx 0w0)
	 (k 0)
	 (px (coerce k 'double-double-float))
	 (qx 0w0))
    (declare (type double-double-float x xx px qx)
	     (notinline poly-eval poly-eval-1))
    (setf x (- (- x (* px log2-c1)) (* px log2-c2)))
    (+ x 0d0)
    ))

Fix it:

code/type.lisp:
o Rename SIMPLIFY-BIG-INTEGER-UNION to SIMPLIFY-BIG-UNION
o SIMPLIFY-BIG-UNION takes an extra arg to specify the resulting type.
o Modify SIMPLIFY-UNIONS to handle float unions as well as integer
  unions.

general-info/release-20a.txt:
o Update
parent 8bd5d96d
......@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain.
;;;
(ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/type.lisp,v 1.80 2008/12/23 14:36:58 rtoy Exp $")
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/type.lisp,v 1.81 2009/03/20 14:54:28 rtoy Rel $")
;;;
;;; **********************************************************************
;;;
......@@ -1137,7 +1137,7 @@
((null (cdr simplified)) (car simplified))
(t (make-union-type simplified)))))
(defun simplify-big-integer-union (first rest)
(defun simplify-big-union (type first rest)
;;
(let ((lowest (numeric-type-low first))
(highest (numeric-type-high first)))
......@@ -1151,7 +1151,7 @@
(if (and (numberp highest) (numberp type-hi))
(setf highest (max highest type-hi))
(setf highest nil))))
(list (specifier-type `(integer ,(or lowest '*) ,(or highest '*))))))
(list (specifier-type `(,type ,(or lowest '*) ,(or highest '*))))))
(defparameter *union-length-threshold* 50
......@@ -1168,16 +1168,28 @@
(values (car types) (cdr types)))
(cond
((and (> (length rest) *union-length-threshold*)
(csubtypep first (specifier-type 'integer))
(every #'(lambda (x)
(and (numeric-type-p x)
(eq (numeric-type-class x) 'integer)))
(cons first rest)))
;; FIXME: We sometimes spend huge amounts of time computing
;; the union of a bunch of disjoint integer types. This is a
;; the union of a bunch of disjoint numeric types. This is a
;; hack to shortcut that. If the union is long enough and
;; they're all integer types, we give up and try to return an
;; interval that is a superset of each type.
(simplify-big-integer-union first rest))
;; they're all of the same type, we give up and try to return
;; an interval that is a superset of each type.
(simplify-big-union 'integer first rest))
((and (> (length rest) *union-length-threshold*)
(csubtypep first (specifier-type 'float))
(let ((class (numeric-type-class first))
(format (numeric-type-format first)))
(every #'(lambda (x)
(and (numeric-type-p x)
(eq (numeric-type-class x) class)
(eq (numeric-type-format x) format)))
(cons first rest))))
;; Same as above, but for floats.
(simplify-big-union (or (numeric-type-format first) 'float) first rest))
(t
(let ((rest (simplify-unions rest)) u)
(dolist (r rest (cons first rest))
......
......@@ -24,6 +24,10 @@ New in this release:
* ANSI compliance fixes:
* Bugfixes:
- CMUCL sometimes gets "stuck" during compilation where it is
trying to simplify the union of a large number of disjoint
numeric types. Previously, we handled the case of integer
types. Extend this to handle floats as well.
* Trac Tickets:
#31: pathname bug with :case :common
......
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