From bcc832e81530dbdaa590c22b51d9fb9d9fafa5bf Mon Sep 17 00:00:00 2001 From: rtoy <rtoy> Date: Sun, 21 Aug 2011 15:16:01 +0000 Subject: [PATCH] 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(-) diff --git a/compiler/ltv.lisp b/compiler/ltv.lisp index 7907814d4..68ad11393 100644 --- a/compiler/ltv.lisp +++ b/compiler/ltv.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/compiler/ltv.lisp,v 1.4 2010/04/19 15:08:20 rtoy Rel $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/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) diff --git a/compiler/main.lisp b/compiler/main.lisp index 1636200a9..e168ebb46 100644 --- a/compiler/main.lisp +++ b/compiler/main.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/compiler/main.lisp,v 1.160 2011/03/28 12:07:34 rtoy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/main.lisp,v 1.161 2011/08/21 15:16:01 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -1246,10 +1246,13 @@ in the user USER-INFO slot of STREAM-SOURCE-LOCATIONs.") (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. ;;; diff --git a/general-info/release-20c.txt b/general-info/release-20c.txt index b76f9b36d..b5dbcdd7e 100644 --- a/general-info/release-20c.txt +++ b/general-info/release-20c.txt @@ -57,6 +57,7 @@ New in this release: - 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 -- GitLab