X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fdefstruct.lisp;h=a25f997eb41663d3b4d7fd9333a0398f12252540;hb=bb7c5beef3a2c45f0ff99f8038409dc4787aa295;hp=2a7cebe9e1d7238702977d4c2d1669874b41ae08;hpb=25e76ec2b1083ac6a4bba42af7ad7b5a8239f2b8;p=sbcl.git

diff --git a/src/code/defstruct.lisp b/src/code/defstruct.lisp
index 2a7cebe..a25f997 100644
--- a/src/code/defstruct.lisp
+++ b/src/code/defstruct.lisp
@@ -426,11 +426,20 @@
 	(predicate-name (dd-predicate-name defstruct))
 	(argname (gensym)))
     (when (and predicate-name (dd-named defstruct))
-      (let ((ltype (dd-lisp-type defstruct)))
+      (let ((ltype (dd-lisp-type defstruct))
+	    (name-index (cdr (car (last (find-name-indices defstruct))))))
 	`((defun ,predicate-name (,argname)
 	    (and (typep ,argname ',ltype)
+		 ,(cond
+		   ((subtypep ltype 'list)
+		    `(consp (nthcdr ,name-index (the ,ltype ,argname))))
+		   ((subtypep ltype 'vector)
+		    `(= (length (the ,ltype ,argname))
+		        ,(dd-length defstruct)))
+		   (t (bug "Uncatered-for lisp type in typed DEFSTRUCT: ~S."
+			   ltype)))
 		 (eq (elt (the ,ltype ,argname)
-			  ,(cdr (car (last (find-name-indices defstruct)))))
+			  ,name-index)
 		     ',name))))))))
 
 ;;; Return a list of forms to create a copier function of a typed DEFSTRUCT.