From 8ca3c25b1eb655d1d731fae8e151cdad7ea384b3 Mon Sep 17 00:00:00 2001 From: rtoy <rtoy> Date: Tue, 5 Oct 2004 21:57:27 +0000 Subject: [PATCH] Don't use NTH to determine if a list is a named structure because the list may not be a proper list. Instead, use a special version of NTHCDR that will exit early if we reach the end of a non-proper list. --- code/defstruct.lisp | 21 +++++++++++++++++++-- 1 file changed, 19 insertions(+), 2 deletions(-) diff --git a/code/defstruct.lisp b/code/defstruct.lisp index d3a2f2191..4a68ec8de 100644 --- a/code/defstruct.lisp +++ b/code/defstruct.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/defstruct.lisp,v 1.94 2004/09/03 03:05:58 rtoy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/defstruct.lisp,v 1.95 2004/10/05 21:57:27 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -1272,12 +1272,29 @@ (if (eq ltype 'list) `((defun ,pred (object) (and (typep object 'list) - (eq (nth ,index object) ',name)))) + (defstruct-list-p ,index object ',name)))) `((defun ,pred (object) (and (typep object 'vector) (array-in-bounds-p object ,index) (eq (aref object ,index) ',name))))))))) +;; A predicate to determine if the given list is a defstruct object of +;; :type list. This used to be done using (eq (nth index object) +;; name), but that fails if the (nth index object) doesn't work +;; because object is not a proper list. +(defun defstruct-list-p (index list name) + ;; Basically do (nth index list), but don't crash if the list is not + ;; a proper list. + (declare (type index index) + (type list list)) + (do ((i index (1- i)) + (result list (cdr result))) + ((or (atom result) (not (plusp i))) + (unless (atom result) + (eq (car result) name))) + (declare (type index i)))) + + ;;;; Load time support for default structures (%DEFSTRUCT) ;;; -- GitLab