0.9.6.23:

[sbcl.git] / src / compiler / ir1opt.lisp

diff --git a/src/compiler/ir1opt.lisp b/src/compiler/ir1opt.lisp
index 4944949..f2152d3 100644 (file)
--- a/src/compiler/ir1opt.lisp
+++ b/src/compiler/ir1opt.lisp
@@ -637,6 +637,14 @@
 #!+sb-show
 (defvar *show-transforms-p* nil)
 
+(defun check-important-result (node info)
+  (when (and (null (node-lvar node))
+             (ir1-attributep (fun-info-attributes info) important-result))
+    (let ((*compiler-error-context* node))
+      (compiler-style-warn
+       "The return value of ~A should not be discarded."
+       (lvar-fun-name (basic-combination-fun node))))))
+
 ;;; Do IR1 optimizations on a COMBINATION node.
 (declaim (ftype (function (combination) (values)) ir1-optimize-combination))
 (defun ir1-optimize-combination (node)
@@ -661,15 +669,17 @@
          (when arg
            (setf (lvar-reoptimize arg) nil)))
        (when info
+         (check-important-result node info)
          (let ((fun (fun-info-destroyed-constant-args info)))
            (when fun
              (let ((destroyed-constant-args (funcall fun args)))
                (when destroyed-constant-args
-                 (warn 'constant-modified
-                       :fun-name (lvar-fun-name
-                                  (basic-combination-fun node)))
-                 (setf (basic-combination-kind node) :error)
-                 (return-from ir1-optimize-combination)))))
+                 (let ((*compiler-error-context* node))
+                   (warn 'constant-modified
+                         :fun-name (lvar-fun-name
+                                    (basic-combination-fun node)))
+                   (setf (basic-combination-kind node) :error)
+                   (return-from ir1-optimize-combination))))))
          (let ((fun (fun-info-derive-type info)))
            (when fun
              (let ((res (funcall fun node)))
@@ -681,16 +691,17 @@
        (dolist (arg args)
          (when arg
            (setf (lvar-reoptimize arg) nil)))
-
+       (check-important-result node info)
        (let ((fun (fun-info-destroyed-constant-args info)))
          (when fun
            (let ((destroyed-constant-args (funcall fun args)))
              (when destroyed-constant-args
-               (warn 'constant-modified
-                     :fun-name (lvar-fun-name
-                                (basic-combination-fun node)))
+               (let ((*compiler-error-context* node))
+                 (warn 'constant-modified
+                       :fun-name (lvar-fun-name
+                                  (basic-combination-fun node)))
                  (setf (basic-combination-kind node) :error)
-                 (return-from ir1-optimize-combination)))))
+                 (return-from ir1-optimize-combination))))))
 
        (let ((attr (fun-info-attributes info)))
          (when (and (ir1-attributep attr foldable)