diff --git a/code/error.lisp b/code/error.lisp
index c06c742e6a78391a4ae23556059f4228545a1a81..b864890ddd60eddd50a5842752608f1f6121fba7 100644
--- a/code/error.lisp
+++ b/code/error.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/error.lisp,v 1.82 2005/10/18 13:29:12 rtoy Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/error.lisp,v 1.83 2005/10/19 13:44:00 rtoy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -22,6 +22,7 @@
 (export '(layout-invalid condition-function-name simple-control-error
 	  simple-file-error simple-program-error simple-parse-error
           simple-style-warning simple-undefined-function
+	  constant-modified
           #+stack-checking stack-overflow
           #+heap-overflow-check heap-overflow))
 
@@ -1046,6 +1047,13 @@
 (define-condition simple-undefined-function (simple-condition
 					     undefined-function) ())
 
+(define-condition constant-modified (warning)
+  ((function-name :initarg :function-name :reader constant-modified-function-name))
+  (:report (lambda (c s)
+             (format s "~@<Destructive function ~S called on ~
+                         constant data.~@:>"
+                     (constant-modified-function-name c)))))
+  
 (define-condition arithmetic-error (error)
   ((operation :reader arithmetic-error-operation :initarg :operation
 	      :initform nil)
diff --git a/compiler/fndb.lisp b/compiler/fndb.lisp
index 27e316d91654902282257d704d1611506fe291ca..ebdfb812223724d1d3722cee745e40e3c5bfffc1 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.132 2005/06/13 14:29:25 rtoy Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/fndb.lisp,v 1.133 2005/10/19 13:44:01 rtoy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -401,8 +401,9 @@
 (defknown reverse (sequence) consed-sequence (flushable)
   :derive-type #'result-type-first-arg/reverse)
 
-(defknown nreverse (sequence) sequence ()
-  :derive-type #'result-type-first-arg/reverse)
+(defknown nreverse (sequence) sequence (important-result)
+  :derive-type #'result-type-first-arg/reverse
+  :destroyed-constant-args (nth-constant-nonempty-sequence-args 1))
 
 (defknown make-sequence (type-specifier index &key (:initial-element t)) consed-sequence
   (movable flushable unsafe)
@@ -424,7 +425,8 @@
 (defknown map-into (sequence callable &rest sequence)
   sequence
   (call dynamic-extent-closure-safe)
-  :derive-type #'result-type-first-arg)
+  :derive-type #'result-type-first-arg
+  :destroyed-constant-args (nth-constant-nonempty-sequence-args 1))
 
 ;;; Returns predicate result... 
 (defknown some (callable sequence &rest sequence) t
@@ -441,12 +443,14 @@
 
 (defknown fill (sequence t &key (:start index) (:end sequence-end)) sequence
   (unsafe)
-  :derive-type #'result-type-first-arg)
+  :derive-type #'result-type-first-arg
+  :destroyed-constant-args (nth-constant-nonempty-sequence-args 1))
 
 (defknown replace (sequence sequence &key (:start1 index) (:end1 sequence-end)
 			    (:start2 index) (:end2 sequence-end))
   sequence ()
-  :derive-type #'result-type-first-arg)
+  :derive-type #'result-type-first-arg
+  :destroyed-constant-args (nth-constant-nonempty-sequence-args 1))
 
 (defknown remove
   (t sequence &key (:from-end t) (:test callable)
@@ -483,8 +487,9 @@
      (:test-not callable) (:start index) (:end sequence-end)
      (:count sequence-count) (:key callable))
   sequence
-  (flushable call dynamic-extent-closure-safe)
-  :derive-type (sequence-result-nth-arg 2))
+  (flushable call dynamic-extent-closure-safe important-result)
+  :derive-type (sequence-result-nth-arg 2)
+  :destroyed-constant-args (nth-constant-nonempty-sequence-args 2))
 
 (defknown nsubstitute
   (t t sequence &key (:from-end t) (:test callable)
@@ -492,21 +497,24 @@
      (:count sequence-count) (:key callable))
   sequence
   (flushable call dynamic-extent-closure-safe)
-  :derive-type (sequence-result-nth-arg 3))
+  :derive-type (sequence-result-nth-arg 3)
+  :destroyed-constant-args (nth-constant-nonempty-sequence-args 3))
 
 (defknown (delete-if delete-if-not)
   (callable sequence &key (:from-end t) (:start index) (:end sequence-end)
 	    (:count sequence-count) (:key callable))
   sequence
-  (flushable call dynamic-extent-closure-safe)
-  :derive-type (sequence-result-nth-arg 2))
+  (flushable call dynamic-extent-closure-safe important-result)
+  :derive-type (sequence-result-nth-arg 2)
+  :destroyed-constant-args (nth-constant-nonempty-sequence-args 2))
 
 (defknown (nsubstitute-if nsubstitute-if-not)
   (t callable sequence &key (:from-end t) (:start index) (:end sequence-end)
      (:count sequence-count) (:key callable))
   sequence
   (flushable call dynamic-extent-closure-safe)
-  :derive-type (sequence-result-nth-arg 3))
+  :derive-type (sequence-result-nth-arg 3)
+  :destroyed-constant-args (nth-constant-nonempty-sequence-args 3))
 
 (defknown remove-duplicates
   (sequence &key (:test callable) (:test-not callable) (:start index) (:from-end t)
@@ -519,8 +527,9 @@
   (sequence &key (:test callable) (:test-not callable) (:start index) (:from-end t)
 	    (:end sequence-end) (:key callable))
   sequence
-  (flushable call dynamic-extent-closure-safe)
-  :derive-type (sequence-result-nth-arg 1))
+  (flushable call dynamic-extent-closure-safe important-result)
+  :derive-type (sequence-result-nth-arg 1)
+  :destroyed-constant-args (nth-constant-nonempty-sequence-args 1))
 
 (defknown find (t sequence &key (:test callable) (:test-not callable)
 		  (:start index) (:from-end t) (:end sequence-end) (:key callable))
@@ -567,13 +576,15 @@
 ;;; Not flushable, since vector sort guaranteed in-place...
 (defknown (stable-sort sort) (sequence callable &key (:key callable)) sequence
   (call dynamic-extent-closure-safe)
-  :derive-type (sequence-result-nth-arg 1))
+  :derive-type (sequence-result-nth-arg 1)
+  :destroyed-constant-args (nth-constant-nonempty-sequence-args 1))
 
 (defknown merge (type-specifier sequence sequence callable
 				&key (:key callable))
   sequence
-  (flushable call dynamic-extent-closure-safe)
-  :derive-type (result-type-specifier-nth-arg 1))
+  (flushable call dynamic-extent-closure-safe important-result)
+  :derive-type (result-type-specifier-nth-arg 1)
+  :destroyed-constant-args (nth-constant-nonempty-sequence-args 2 3))
 
 (defknown read-sequence (sequence stream &key (:start index)
 					      (:end sequence-end)
@@ -616,25 +627,40 @@
 (defknown copy-alist (list) list (flushable))
 (defknown copy-tree (t) t (flushable))
 (defknown revappend (list t) t (flushable))
-(defknown nconc (&rest t) t ())
-(defknown nreconc (list t) list ())
+(defknown nconc (&rest t) t ()
+  :destroyed-constant-args (remove-non-constants-and-nils #'butlast))
+(defknown nreconc (list t) list (important-result)
+  :destroyed-constant-args (nth-constant-nonempty-sequence-args 1) )
 (defknown butlast (list &optional unsigned-byte) list (flushable))
-(defknown nbutlast (list &optional unsigned-byte) list ())
+(defknown nbutlast (list &optional unsigned-byte) list ()
+  :destroyed-constant-args (nth-constant-nonempty-sequence-args 1))
 (defknown ldiff (list t) list (flushable))
-(defknown (rplaca rplacd) (cons t) list (unsafe))
+(defknown (rplaca rplacd) (cons t) list (unsafe)
+  :destroyed-constant-args (nth-constant-args 1))
+
+(defknown subst (t t t &key (:key callable) (:test callable)
+                   (:test-not callable))
+  t (flushable unsafe call))
 
-(defknown (nsubst subst) (t t t &key (:key callable) (:test callable)
+(defknown (nsubst) (t t t &key (:key callable) (:test callable)
 			    (:test-not callable))
-  list (flushable unsafe call dynamic-extent-closure-safe))
+  list (flushable unsafe call dynamic-extent-closure-safe)
+  :destroyed-constant-args (nth-constant-nonempty-sequence-args 3))
 
 (defknown (subst-if subst-if-not nsubst-if nsubst-if-not)
 	  (t t t &key (:key callable))
-  list (flushable unsafe call dynamic-extent-closure-safe))
+  list (flushable unsafe call dynamic-extent-closure-safe)
+  :destroyed-constant-args (nth-constant-nonempty-sequence-args 3))
 
-(defknown (sublis nsublis) (list t &key (:key callable) (:test callable)
+(defknown (sublis) (list t &key (:key callable) (:test callable)
 				 (:test-not callable))
   list (flushable unsafe call dynamic-extent-closure-safe))
 
+(defknown nsublis (list t &key (:key callable) (:test callable)
+                        (:test-not callable))
+  t (flushable unsafe call)
+  :destroyed-constant-args (nth-constant-nonempty-sequence-args 2))
+
 (defknown member (t list &key (:key callable) (:test callable)
 		    (:test-not callable))
   list (foldable flushable call dynamic-extent-closure-safe))
@@ -655,7 +681,8 @@
 (defknown (nunion nintersection nset-difference nset-exclusive-or)
 	  (list list &key (:key callable) (:test callable) (:test-not callable))
   list
-  (foldable flushable call dynamic-extent-closure-safe))
+  (foldable flushable call dynamic-extent-closure-safe important-result)
+  :destroyed-constant-args (nth-constant-nonempty-sequence-args 1 2))
 
 (defknown subsetp (list list &key (:key callable) (:test callable)
 			(:test-not callable))
@@ -673,7 +700,8 @@
 	  (foldable flushable call dynamic-extent-closure-safe))
 
 (defknown (memq assq) (t list) list (foldable flushable unsafe))
-(defknown delq (t list) list (flushable unsafe))
+(defknown delq (t list) list (flushable unsafe)
+  :destroyed-constant-args (nth-constant-nonempty-sequence-args 2))
   
 
 ;;;; In the "Hash Tables" chapter:
@@ -688,11 +716,14 @@
 (defknown hash-table-p (t) boolean (movable foldable flushable))
 (defknown gethash (t hash-table &optional t) (values t boolean)
   (foldable flushable unsafe))
-(defknown %puthash (t hash-table t) t (unsafe))
-(defknown remhash (t hash-table) boolean ())
+(defknown %puthash (t hash-table t) t (unsafe)
+  :destroyed-constant-args (nth-constant-args 2))
+(defknown remhash (t hash-table) boolean ()
+  :destroyed-constant-args (nth-constant-args 2))
 (defknown maphash (callable hash-table) null
   (foldable flushable call dynamic-extent-closure-safe))
-(defknown clrhash (hash-table) hash-table ())
+(defknown clrhash (hash-table) hash-table ()
+  :destroyed-constant-args (nth-constant-args 1))
 (defknown hash-table-count (hash-table) index (foldable flushable))
 (defknown hash-table-rehash-size (hash-table) (or (integer 1) (float (1.0)))
   (foldable flushable))
@@ -732,6 +763,7 @@
 (defknown bit ((array bit) &rest index) bit (foldable flushable))
 (defknown sbit ((simple-array bit) &rest index) bit (foldable flushable))
 
+;;; FIXME: :DESTROYED-CONSTANT-ARGS for these is complicated.
 (defknown (bit-and bit-ior bit-xor bit-eqv bit-nand bit-nor bit-andc1 bit-andc2
 		   bit-orc1 bit-orc2)
   ((array bit) (array bit) &optional (or (array bit) (member nil t)))
@@ -746,10 +778,16 @@
 
 (defknown array-has-fill-pointer-p (array) boolean (movable foldable flushable))
 (defknown fill-pointer (vector) index (foldable flushable))
-(defknown vector-push (t vector) (or index null) ())
-(defknown vector-push-extend (t vector &optional index) index ())
-(defknown vector-pop (vector) t ())
-
+(defknown vector-push (t vector) (or index null) ()
+  :destroyed-constant-args (nth-constant-args 2))
+(defknown vector-push-extend (t vector &optional index) index ()
+  :destroyed-constant-args (nth-constant-args 2))
+(defknown vector-pop (vector) t ()
+  :destroyed-constant-args (nth-constant-args 1))
+
+;;; FIXME: complicated :DESTROYED-CONSTANT-ARGS
+;;; Also, an important-result warning could be provided if the array
+;;; is known to be not expressly adjustable.
 (defknown adjust-array
   (array (or index list) &key (:element-type type-specifier)
 	 (:initial-element t) (:initial-contents t)
@@ -793,7 +831,8 @@
 
 (defknown (nstring-upcase nstring-downcase nstring-capitalize)
   (string &key (:start index) (:end sequence-end))
-  string ())
+  string ()
+  :destroyed-constant-args (nth-constant-nonempty-sequence-args 1))
 
 (defknown string (stringable) string
   (flushable explicit-check))
@@ -939,6 +978,7 @@
 (defknown write-byte (integer stream) integer
   (explicit-check))
 
+;;; FIXME: complicated :DESTROYED-CONSTANT-ARGS
 (defknown format ((or streamlike string) (or string function) &rest t)
   (or string null)
   (explicit-check))
@@ -1201,25 +1241,36 @@
 
 ;;;; Setf inverses:
 
-(defknown %aset (array &rest t) t (unsafe))
-(defknown %set-row-major-aref (array index t) t (unsafe))
-(defknown %rplaca (cons t) t (unsafe))
+(defknown %aset (array &rest t) t (unsafe)
+  :destroyed-constant-args (nth-constant-args 1))
+(defknown %set-row-major-aref (array index t) t (unsafe)
+  :destroyed-constant-args (nth-constant-args 1))
+(defknown %rplaca (cons t) t (unsafe)
+  :destroyed-constant-args (nth-constant-args 1))
 (defknown %rplacd (cons t) t (unsafe))
 (defknown %put (symbol t t) t (unsafe))
-(defknown %setelt (sequence index t) t (unsafe))
-(defknown %svset (simple-vector index t) t (unsafe))
-(defknown %bitset ((array bit) &rest index) bit (unsafe))
-(defknown %sbitset ((simple-array bit) &rest index) bit (unsafe))
-(defknown %charset (string index character) character (unsafe))
-(defknown %scharset (simple-string index character) character (unsafe))
+(defknown %setelt (sequence index t) t (unsafe)
+  :destroyed-constant-args (nth-constant-args 1))
+(defknown %svset (simple-vector index t) t (unsafe)
+  :destroyed-constant-args (nth-constant-args 1))
+(defknown %bitset ((array bit) &rest index) bit (unsafe)
+  :destroyed-constant-args (nth-constant-args 1))
+(defknown %sbitset ((simple-array bit) &rest index) bit (unsafe)
+  :destroyed-constant-args (nth-constant-args 1))
+(defknown %charset (string index character) character (unsafe)
+  :destroyed-constant-args (nth-constant-args 1))
+(defknown %scharset (simple-string index character) character (unsafe)
+  :destroyed-constant-args (nth-constant-args 1))
 (defknown %set-symbol-value (symbol t) t (unsafe))
 (defknown fset (symbol function) function (unsafe))
 (defknown %set-symbol-plist (symbol t) t (unsafe))
 (defknown (setf documentation) ((or string null) t symbol)
   (or string null)
   ())
-(defknown %setnth (index list t) t (unsafe))
-(defknown %set-fill-pointer (vector index) index (unsafe))
+(defknown %setnth (index list t) t (unsafe)
+  :destroyed-constant-args (nth-constant-args 2))
+(defknown %set-fill-pointer (vector index) index (unsafe)
+  :destroyed-constant-args (nth-constant-args 1))
 
 
 ;;;; Internal type predicates:
diff --git a/compiler/ir1opt.lisp b/compiler/ir1opt.lisp
index 600b9df58424fb5c092459321457116d8feefa32..c0dfeaaea06f78877b2d77284fce1ad9620de40a 100644
--- a/compiler/ir1opt.lisp
+++ b/compiler/ir1opt.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/ir1opt.lisp,v 1.83 2004/08/30 14:55:38 rtoy Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ir1opt.lisp,v 1.84 2005/10/19 13:44:01 rtoy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -754,6 +754,15 @@
 	    (dolist (merge (merges))
 	      (merge-tail-sets merge))))))))
 
+(defun check-important-result (node kind)
+  (let ((attr (function-info-attributes kind)))
+    (when (and attr
+	       (ir1-attributep attr important-result)
+	       (null (continuation-dest (node-cont node))))
+      (let ((*compiler-error-context* node))
+	(compiler-warning "The return value of ~A should not be discarded."
+			  (continuation-function-name (basic-combination-fun node)))))))
+
 
 ;;;; Combination IR1 optimization:
 
@@ -785,6 +794,19 @@
 	 (when arg
 	   (setf (continuation-reoptimize arg) nil)))
 
+       (check-important-result node kind)
+       
+       (let ((fun (function-info-destroyed-constant-args kind)))
+	 (when fun
+	   (let ((destroyed-constant-args (funcall fun args)))
+	     (when destroyed-constant-args
+	       (let ((*compiler-error-context* node))
+		 (warn 'kernel:constant-modified
+		       :function-name (continuation-function-name
+				       (basic-combination-fun node)))
+		 (setf (basic-combination-kind node) :error)
+		 (return-from ir1-optimize-combination))))))
+       
        (let ((attr (function-info-attributes kind)))
 	 (when (and (ir1-attributep attr foldable)
 		    (not (ir1-attributep attr call))
diff --git a/compiler/knownfun.lisp b/compiler/knownfun.lisp
index b019977e9db757630b51d832bc2df73d5a2ebf7e..d5e6b130fcb581b1c2e231636b1012a64e69ac10 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.27 2005/03/22 14:33:53 rtoy Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/knownfun.lisp,v 1.28 2005/10/19 13:44:01 rtoy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -80,7 +80,12 @@
   explicit-check
   ;;
   ;; Safe to stack-allocate function args that are closures.
-  dynamic-extent-closure-safe)
+  dynamic-extent-closure-safe
+  ;; Return value is important and ignoring it is probably a mistake.
+  ;; This is for things like not using the result of nreverse.  This
+  ;; is only for warnings and has no effect on optimization.
+  important-result
+  )
 
 (defstruct (function-info
 	    (:print-function %print-function-info)
@@ -129,7 +134,11 @@
   ;; If non-null, use this function to generate the byte code for this known
   ;; call.  This function can only give up if there is a byte-annotate function
   ;; that arranged for the functional to be pushed onto the stack.
-  (byte-compile nil :type (or function null)))
+  (byte-compile nil :type (or function null))
+  ;; A function computing the constant or literal arguments which are
+  ;; destructively modified by the call.
+  (destroyed-constant-args nil :type (or function null))
+  )
 
 (defprinter function-info
   (transforms :test transforms)
@@ -201,13 +210,14 @@
 ;;;    Make a function-info structure with the specified type, attributes and
 ;;; optimizers.
 ;;;
-(defun %defknown (names type attributes &key derive-type optimizer)
+(defun %defknown (names type attributes &key derive-type optimizer destroyed-constant-args)
   (declare (list names type) (type attributes attributes)
 	   (type (or function null) derive-type optimizer))
   (let ((ctype (specifier-type type))
 	(info (make-function-info :attributes attributes
 				  :derive-type derive-type
-				  :optimizer optimizer))
+				  :optimizer optimizer
+				  :destroyed-constant-args destroyed-constant-args))
 	(target-env (or (backend-info-environment *target-backend*)
 			*info-environment*)))
     (dolist (name names)
@@ -383,3 +393,44 @@
 	    (eq if-does-not-exist nil))
       (specifier-type `(or null ,class))
       (specifier-type class))))
+
+(defun remove-non-constants-and-nils (fun)
+  (lambda (list)
+    (remove-if-not #'continuation-value
+                   (remove-if-not #'constant-continuation-p (funcall fun list)))))
+
+;;; FIXME: bad name (first because it uses 1-based indexing; second
+;;; because it doesn't get the nth constant arguments)
+(defun nth-constant-args (&rest indices)
+  (lambda (list)
+    (let (result)
+      (do ((i 1 (1+ i))
+           (list list (cdr list))
+           (indices indices))
+          ((null indices) (nreverse result))
+        (when (= i (car indices))
+          (when (constant-continuation-p (car list))
+            (push (car list) result))
+          (setf indices (cdr indices)))))))
+
+;;; FIXME: a number of the sequence functions not only do not destroy
+;;; their argument if it is empty, but also leave it alone if :start
+;;; and :end bound a null sequence, or if :count is 0.  This test is a
+;;; bit complicated to implement, verging on the impossible, but for
+;;; extra points (fill #\1 "abc" :start 0 :end 0) should not cause a
+;;; warning.
+(defun nth-constant-nonempty-sequence-args (&rest indices)
+  (lambda (list)
+    (let (result)
+      (do ((i 1 (1+ i))
+           (list list (cdr list))
+           (indices indices))
+          ((null indices)
+	   (nreverse result))
+        (when (= i (car indices))
+          (when (constant-continuation-p (car list))
+            (let ((value (continuation-value (car list))))
+              (unless (or (typep value 'null)
+                          (typep value '(vector * 0)))
+                (push (car list) result))))
+          (setf indices (cdr indices)))))))