X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fseqtran.lisp;h=aa6fc0d0675fb69b9655b4088c9efc00cf3a547b;hb=77360ee4a1f94c41b807be7ad0e8687199fceef1;hp=3bd162c522fdc2362c9325ce7ae761ec775d902f;hpb=eca808df33f27cdc23a8a3a845e211000119b630;p=sbcl.git

diff --git a/src/compiler/seqtran.lisp b/src/compiler/seqtran.lisp
index 3bd162c..aa6fc0d 100644
--- a/src/compiler/seqtran.lisp
+++ b/src/compiler/seqtran.lisp
@@ -704,3 +704,21 @@
 	 (declare (type index start ,@(all-lengths)))
 	 ,@(forms)
 	 res))))
+
+;;;; CONS accessor DERIVE-TYPE optimizers
+
+(defoptimizer (car derive-type) ((cons))
+  (let ((type (continuation-type cons))
+	(null-type (specifier-type 'null)))
+    (cond ((eq type null-type)
+	   null-type)
+	  ((cons-type-p type)
+	   (cons-type-car-type type)))))
+
+(defoptimizer (cdr derive-type) ((cons))
+  (let ((type (continuation-type cons))
+	(null-type (specifier-type 'null)))
+    (cond ((eq type null-type)
+	   null-type)
+	  ((cons-type-p type)
+	   (cons-type-cdr-type type)))))