0.6.8.17:

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

diff --git a/src/compiler/seqtran.lisp b/src/compiler/seqtran.lisp
index 3bd162c..aa6fc0d 100644 (file)
--- a/src/compiler/seqtran.lisp
+++ b/src/compiler/seqtran.lisp
@@ -704,3 +704,21 @@
         (declare (type index start ,@(all-lengths)))
         ,@(forms)
         res))))
+\f
+;;;; 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)))))