From 796b1dc30c9c8ba08f0d4d73b1f65f02d9e25fff Mon Sep 17 00:00:00 2001 From: rtoy <rtoy> Date: Tue, 14 Dec 2004 21:51:35 +0000 Subject: [PATCH] o Remove the :derive-type option from the defknowns for concatenate and make-sequence o Add derive-type optimizers for concatenate and make-sequence that only derives the type when the output sequence specifier is a subtype of sequence. (Only done for constant specifiers.) These changes fix the bug where the compiler deletes all code, including the return for (defun foo () (concatenate 'fixnum '(1 2 3))). This is caused by confusion in the compiler where derive-node-type conflicts with the declared return type and causes all trailing blocks to be deleted. --- compiler/fndb.lisp | 21 +++++++++------------ compiler/seqtran.lisp | 24 ++++++++++++++++++++++-- 2 files changed, 31 insertions(+), 14 deletions(-) diff --git a/compiler/fndb.lisp b/compiler/fndb.lisp index 032a955eb..372c20606 100644 --- a/compiler/fndb.lisp +++ b/compiler/fndb.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/fndb.lisp,v 1.127 2004/12/09 21:48:21 rtoy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/fndb.lisp,v 1.128 2004/12/14 21:51:35 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -404,20 +404,17 @@ (defknown nreverse (sequence) sequence () :derive-type #'result-type-first-arg/reverse) -;; I (rtoy) changed the result types for make-sequence and concatenate -;; from consed-sequence to t because the compiler will sometimes -;; delete all following code when given a bad type-specifier. For -;; example (defun foo () (concatenate 'fixnum '(a b c))) deletes -;; everything, including the return from foo, so we get an illegal -;; instruction when the PC runs into the arg-count error. Similar -;; thing happens with make-sequence. -(defknown make-sequence (type-specifier index &key (:initial-element t)) t +(defknown make-sequence (type-specifier index &key (:initial-element t)) consed-sequence (movable flushable unsafe) - :derive-type (result-type-specifier-nth-arg 1)) + ;; Nope: If the type-specifier isn't a consed-sequence, we get confused. + ;;:derive-type (result-type-specifier-nth-arg 1) + ) -(defknown concatenate (type-specifier &rest sequence) t +(defknown concatenate (type-specifier &rest sequence) consed-sequence (flushable) - :derive-type (result-type-specifier-nth-arg 1)) + ;; Nope: If the type-specifier isn't a consed-sequence, we get confused. + ;;:derive-type (result-type-specifier-nth-arg 1) + ) (defknown map (type-specifier callable sequence &rest sequence) consed-sequence (flushable call dynamic-extent-closure-safe) diff --git a/compiler/seqtran.lisp b/compiler/seqtran.lisp index 33eb91196..d207815c9 100644 --- a/compiler/seqtran.lisp +++ b/compiler/seqtran.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/seqtran.lisp,v 1.29 2004/12/09 21:49:03 rtoy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/seqtran.lisp,v 1.30 2004/12/14 21:51:35 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -580,4 +580,24 @@ (if spec (specifier-type spec) (specifier-type 'null))))) - + +(defun output-spec-sequence (output-spec) + ;; Check that the given output-spec is a subtype of sequence. If + ;; so, the result is the output-spec. Give a warning if it's not a + ;; sequence specifier. + (when (constant-continuation-p output-spec) + ;; Only handle constant continuations. + (let ((spec (continuation-value output-spec))) + (if (subtypep spec 'sequence) + (specifier-type spec) + (compiler-warning "Specified output type ~S is not a sequence type" spec))))) + +(defoptimizer (concatenate derive-type) ((output-spec seq &rest more-seq)) + ;; The result type of CONCATENATE is OUTPUT-SPEC, but check to see + ;; if it makes sense. + (output-spec-sequence output-spec)) + +(defoptimizer (make-sequence derive-type) ((output-spec seq &rest more-seq)) + ;; The result type of MAKE-SEQUENCE is OUTPUT-SPEC, but check to see + ;; if it makes sense. + (output-spec-sequence output-spec)) -- GitLab