Assert types for NCONC.

src/compiler/fndb.lisp

@@ -1020,9 +1020,8 @@
 ;;; express that in this syntax, append-call-type-deriver does that.
 (defknown append (&rest t) t (flushable)
   :call-type-deriver #'append-call-type-deriver)
-(defknown sb-impl::append2 (list t) t
-  (flushable no-verify-arg-count)
-  :call-type-deriver #'append-call-type-deriver)
+(defknown sb-impl::append2 (proper-list t) t
+  (flushable no-verify-arg-count))
 
 (defknown copy-list (proper-or-dotted-list) list (flushable)
   :derive-type (sequence-result-nth-arg 0 :preserve-dimensions t))
@@ -1032,7 +1031,8 @@
 (defknown copy-tree (t) t (flushable recursive))
 (defknown revappend (proper-list t) t (flushable))
 
-(defknown nconc (&rest (modifying t :butlast t)) t ())
+(defknown nconc (&rest (modifying t :butlast t)) t ()
+  :call-type-deriver #'nconc-call-type-deriver)
 
 (defknown nreconc ((modifying list) t) t (important-result))
 (defknown butlast (proper-or-dotted-list &optional unsigned-byte) list (flushable))

src/compiler/knownfun.lisp

@@ -571,6 +571,25 @@
                      (not trusted))
             (reoptimize-lvar arg)))))
 
+(defun nconc-call-type-deriver (call trusted)
+  (let* ((policy (lexenv-policy (node-lexenv call)))
+         (args (combination-args call))
+         (list-type (specifier-type 'list)))
+    ;; All but the last argument should be proper lists
+    (loop for (arg next) on args
+          while next
+          do
+          (add-annotation
+           arg
+           (make-lvar-proper-sequence-annotation
+            :kind 'proper-or-dotted-list))
+          (when (policy policy (> check-constant-modification 0))
+            (add-annotation arg
+                            (make-lvar-modified-annotation :caller 'nconc)))
+          (when (and (assert-lvar-type arg list-type policy)
+                     (not trusted))
+            (reoptimize-lvar arg)))))
+
 ;;; It's either (number) or (real real)
 (defun atan-call-type-deriver (call trusted)
   (let* ((policy (lexenv-policy (node-lexenv call)))

src/compiler/srctran.lisp

@@ -270,6 +270,9 @@
       (specifier-type t)
       (specifier-type 'list)))
 
+(setf (fun-info-externally-checkable-type (fun-info-or-lose 'nconc))
+      #'append-externally-checkable-type-optimizer)
+
 (flet ((remove-nil (fun args)
          (let ((remove
                  (loop for (arg . rest) on args