diff --git a/src/compiler/ir1opt.lisp b/src/compiler/ir1opt.lisp
index 176f996dd..869c3829d 100644
--- a/src/compiler/ir1opt.lisp
+++ b/src/compiler/ir1opt.lisp
@@ -1089,6 +1089,32 @@
                                   (give-up-ir1-transform)))
                   :note "auto-DX"))
 
+(defun check-proper-sequences (combination info)
+  (map-combination-args-and-types
+   (lambda (lvar type lvars annotations)
+     (declare (ignore type lvars))
+     (when (constant-lvar-p lvar)
+       (loop with value = (lvar-value lvar)
+             for annotation in annotations
+             when
+             (case annotation
+               (proper-list
+                (and (listp value)
+                     (not (proper-list-p value))))
+               (proper-sequence
+                (and (typep value 'sequence)
+                     (not (proper-sequence-p value))))
+               (proper-or-circular-list
+                (and (listp value)
+                     (not (proper-or-circular-list-p value))))
+               (proper-or-dotted-list
+                (and (listp value)
+                     (not (proper-or-dotted-list-p value)))))
+             do
+             (setf (combination-kind combination) :error)
+             (return-from check-proper-sequences))))
+   combination info))
+
 ;;; Do IR1 optimizations on a COMBINATION node.
 (declaim (ftype (function (combination) (values)) ir1-optimize-combination))
 (defun ir1-optimize-combination (node)
@@ -1106,6 +1132,7 @@
                  (setf (lvar-reoptimize arg) nil))))
            (process-info ()
              (check-important-result node info)
+             (check-proper-sequences node info)
              (let ((fun (fun-info-derive-type info)))
                (when fun
                  (let ((res (funcall fun node)))