diff --git a/compiler/fndb.lisp b/compiler/fndb.lisp index d8249701eaf3fdfacf39932fc21c06a95d26251e..3962096a445e88982f4c97adcc9968fbb7da84e7 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.134 2005/11/09 01:48:22 rtoy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/fndb.lisp,v 1.135 2005/11/09 19:08:06 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -404,7 +404,7 @@ (defknown nreverse (sequence) sequence () :derive-type #'result-type-first-arg/reverse :destroyed-constant-args (nth-constant-nonempty-sequence-args 1) - :result-not-used #'function-result-not-used-p) + :result-not-used (list-function-result-not-used 1)) (defknown make-sequence (type-specifier index &key (:initial-element t)) consed-sequence (movable flushable unsafe) @@ -491,7 +491,7 @@ (flushable call dynamic-extent-closure-safe) :derive-type (sequence-result-nth-arg 2) :destroyed-constant-args (nth-constant-nonempty-sequence-args 2) - :result-not-used #'function-result-not-used-p) + :result-not-used (list-function-result-not-used 2)) (defknown nsubstitute (t t sequence &key (:from-end t) (:test callable) @@ -509,7 +509,7 @@ (flushable call dynamic-extent-closure-safe) :derive-type (sequence-result-nth-arg 2) :destroyed-constant-args (nth-constant-nonempty-sequence-args 2) - :result-not-used #'function-result-not-used-p) + :result-not-used (list-function-result-not-used 2)) (defknown (nsubstitute-if nsubstitute-if-not) (t callable sequence &key (:from-end t) (:start index) (:end sequence-end) @@ -533,7 +533,7 @@ (flushable call dynamic-extent-closure-safe) :derive-type (sequence-result-nth-arg 1) :destroyed-constant-args (nth-constant-nonempty-sequence-args 1) - :result-not-used #'function-result-not-used-p) + :result-not-used (list-function-result-not-used 1)) (defknown find (t sequence &key (:test callable) (:test-not callable) (:start index) (:from-end t) (:end sequence-end) (:key callable)) @@ -582,7 +582,7 @@ (call dynamic-extent-closure-safe) :derive-type (sequence-result-nth-arg 1) :destroyed-constant-args (nth-constant-nonempty-sequence-args 1) - :result-not-used #'sort-result-not-used-p) + :result-not-used (list-function-result-not-used 1)) (defknown merge (type-specifier sequence sequence callable &key (:key callable)) @@ -590,7 +590,9 @@ (flushable call dynamic-extent-closure-safe) :derive-type (result-type-specifier-nth-arg 1) :destroyed-constant-args (nth-constant-nonempty-sequence-args 2 3) - :result-not-used #'function-result-not-used-p) + ;; FIXME! This is a little complicated. + ;;:result-not-used #'function-result-not-used-p + ) (defknown read-sequence (sequence stream &key (:start index) (:end sequence-end) diff --git a/compiler/knownfun.lisp b/compiler/knownfun.lisp index b6564713f9def986f1aa001e3d0432433b822b21..31f763ac3815b4738d562e5fcd76c03365b53df1 100644 --- a/compiler/knownfun.lisp +++ b/compiler/knownfun.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/knownfun.lisp,v 1.31 2005/11/09 16:01:27 rtoy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/knownfun.lisp,v 1.32 2005/11/09 19:08:06 rtoy Rel $") ;;; ;;; ********************************************************************** ;;; @@ -443,17 +443,10 @@ (setf indices (cdr indices))))))) (defun function-result-not-used-p (node) - ;; Is the result of the function used? + ;; Is the result of the function used? Return non-NIL if result is + ;; not used. (null (continuation-dest (node-cont node)))) -(defun sort-result-not-used-p (node) - (let* ((args (combination-args node)) - (seq-type (continuation-type (first args)))) - ;; Make sure we use the result of SORT if the sequence could be a - ;; list. - (when (csubtypep (specifier-type 'list) seq-type) - (function-result-not-used-p node)))) - (defun adjust-array-result-not-used-p (node) (let* ((args (combination-args node)) (array-type (continuation-type (first args)))) @@ -462,3 +455,12 @@ (when (and (array-type-p array-type) (not (eql (array-type-complexp array-type) t))) (function-result-not-used-p node)))) + +;; Create a function that checks to see if the List-arg'th arg could +;; be a list. If so, check to see if the result is used. +(defun list-function-result-not-used (list-arg) + (lambda (node) + (let* ((arg (elt (combination-args node) (1- list-arg))) + (arg-type (continuation-type arg))) + (when (csubtypep (specifier-type 'list) arg-type) + (function-result-not-used-p node)))))