From 9c80670d310414dabbbf096a456a5840dfa9d97c Mon Sep 17 00:00:00 2001
From: rtoy <rtoy>
Date: Mon, 22 Dec 2008 22:10:36 +0000
Subject: [PATCH] INNER-COERCE-REAL-BOUND needs to coerce to
 DOUBLE-DOUBLE-FLOAT, when available.  Without this, we get things like

(c::specifier-type '(real 1d0 100/9)) ->
#<UNION-TYPE (OR (SINGLE-FLOAT 1.0 11.111111)
                 (DOUBLE-FLOAT 1.0d0 11.11111111111111d0)
                 (DOUBLE-DOUBLE-FLOAT 1.0w0
                  11.1111111111111107163651467999443w0)
                 (RATIONAL 1 100/9))>

instead of

#<UNION-TYPE (OR (SINGLE-FLOAT 1.0 11.111111)
                 (DOUBLE-FLOAT 1.0d0 11.11111111111111d0)
                 (DOUBLE-DOUBLE-FLOAT 1.0w0
                  11.1111111111111111111111111111111w0)
                 (RATIONAL 1 100/9))>

The bound for double-double-float is not quite correct in the former
result, and is correct in the latter.
---
 code/type.lisp | 5 +++--
 1 file changed, 3 insertions(+), 2 deletions(-)

diff --git a/code/type.lisp b/code/type.lisp
index fba7f9003..56c0e09be 100644
--- a/code/type.lisp
+++ b/code/type.lisp
@@ -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.77 2008/05/23 03:51:23 rtoy Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/type.lisp,v 1.78 2008/12/22 22:10:36 rtoy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -2379,7 +2379,8 @@
 	       bound
 	       ;; Coerce to the widest float format available, to
 	       ;; avoid unnecessary loss of precision:
-	       (coerce bound 'long-float)))))
+	       (coerce bound #-double-double 'long-float
+		             #+double-double 'double-double-float)))))
 
 (defun coerced-real-bound (bound type)
   (coerce-bound bound type #'inner-coerce-real-bound))
-- 
GitLab