[cmucl-commit] CMUCL commit: src (3 files)

[Raymond Toy]

    Date: Sunday, August 21, 2011 @ 08:16:01
  Author: rtoy
    Path: /project/cmucl/cvsroot/src

Modified: compiler/ltv.lisp compiler/main.lisp general-info/release-20c.txt

Improve type progagation for LOAD-TIME-VALUE.

Patch from Helmut Eller, cmucl-imp 2011-06-11.


------------------------------+
 compiler/ltv.lisp            |    6 +++---
 compiler/main.lisp           |   13 ++++++++-----
 general-info/release-20c.txt |    1 +
 3 files changed, 12 insertions(+), 8 deletions(-)


Index: src/compiler/ltv.lisp
diff -u src/compiler/ltv.lisp:1.4 src/compiler/ltv.lisp:1.5
--- src/compiler/ltv.lisp:1.4	Mon Apr 19 08:08:20 2010
+++ src/compiler/ltv.lisp	Sun Aug 21 08:16:01 2011
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /project/cmucl/cvsroot/src/compiler/ltv.lisp,v 1.4 2010/04/19 15:08:20 rtoy Rel $")
+  "$Header: /project/cmucl/cvsroot/src/compiler/ltv.lisp,v 1.5 2011/08/21 15:16:01 rtoy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -35,10 +35,10 @@
 	  (compile-load-time-value (if read-only-p
 				       form
 				       `(make-value-cell ,form)))
-	(declare (ignore type))
 	(ir1-convert start cont
 		     (if read-only-p
-			 `(%load-time-value ',handle)
+			 `(truly-the ,(type-specifier type)
+				     (%load-time-value ',handle))
 			 `(value-cell-ref (%load-time-value ',handle)))))
       (let ((value
 	     (handler-case (eval form)
Index: src/compiler/main.lisp
diff -u src/compiler/main.lisp:1.160 src/compiler/main.lisp:1.161
--- src/compiler/main.lisp:1.160	Mon Mar 28 05:07:34 2011
+++ src/compiler/main.lisp	Sun Aug 21 08:16:01 2011
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /project/cmucl/cvsroot/src/compiler/main.lisp,v 1.160 2011/03/28 12:07:34 rtoy Exp $")
+  "$Header: /project/cmucl/cvsroot/src/compiler/main.lisp,v 1.161 2011/08/21 15:16:01 rtoy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -1246,10 +1246,13 @@
   (let ((lambda (compile-load-time-stuff form name t)))
     (values
      (fasl-dump-load-time-value-lambda lambda *compile-object*)
-     (let ((type (leaf-type lambda)))
-       (if (function-type-p type)
-	   (single-value-type (function-type-returns type))
-	   *wild-type*)))))
+     (or (let ((return (lambda-return lambda)))
+	   (if return
+	       (single-value-type (return-result-type return))))
+	 (let ((type (leaf-type lambda)))
+	   (if (function-type-p type)
+	       (single-value-type (function-type-returns type))))
+	 *wild-type*))))
 
 ;;; COMPILE-MAKE-LOAD-FORM-INIT-FORMS  --  internal.
 ;;;
Index: src/general-info/release-20c.txt
diff -u src/general-info/release-20c.txt:1.28 src/general-info/release-20c.txt:1.29
--- src/general-info/release-20c.txt:1.28	Sun Aug 21 00:43:39 2011
+++ src/general-info/release-20c.txt	Sun Aug 21 08:16:01 2011
@@ -57,6 +57,7 @@
     - CMUCL no longer exits if you specify a core file with an
       executable image.  A warning is printed instead and the core
       file is used.
+    - Improve type propagation for LOAD-TIME-VALUE.
 
   * ANSI compliance fixes:
     - Fixes for signaling errors with READ-CHAR and READ-BYTE