From: Nikodemus Siivola <demoss@us...>  20060829 13:35:27

Update of /cvsroot/sbcl/sbcl/src/code In directory sc8prcvs8.sourceforge.net:/tmp/cvsserv9142/src/code Modified Files: earlyextensions.lisp pred.lisp Log Message: 0.9.16.6: better circularity detection in fasl dumper * We need to detect carcircularity too, which can get expensive, so we approximate: CYCLICLISTP => MAYBECYCLICP * Reported by Marco Monteiro on sbcldevel. Index: earlyextensions.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/code/earlyextensions.lisp,v retrieving revision 1.77 retrieving revision 1.78 diff u d r1.77 r1.78  earlyextensions.lisp 9 Sep 2005 14:16:18 0000 1.77 +++ earlyextensions.lisp 29 Aug 2006 13:35:23 0000 1.78 @@ 127,16 +127,39 @@ ;;;; typeish predicates ;;; Is X a list containing a cycle? (defun cycliclistp (x) +;;; X may contain cycles  a conservative approximation. This +;;; occupies a somewhat uncomfortable niche between being fast for +;;; common cases (we don't want to allocate a hashtable), and not +;;; falling down to exponential behaviour for large trees (so we set +;;; an arbitrady depth limit beyond which we punt). +(defun maybecyclicp (x &optional (depthlimit 12)) (and (listp x)  (labels ((safecddr (x) (if (listp (cdr x)) (cddr x))))  (do ((y x (safecddr y))  (startedp nil t)  (z x (cdr z)))  ((not (and (consp z) (consp y))) nil)  (when (and startedp (eq y z))  (return t)))))) + (labels ((safecddr (cons) + (let ((cdr (cdr cons))) + (when (consp cdr) + (cdr cdr)))) + (checkcycle (object seen depth) + (when (and (consp object) + (or (> depth depthlimit) + (member object seen) + (circularp object seen depth))) + (returnfrom maybecyclicp t))) + (circularp (list seen depth) + ;; Almost regular circular list detection, with a twist: + ;; we also check each element of the list for upward + ;; references using CHECKCYCLE. + (do ((fast (cons (car list) (cdr list)) (safecddr fast)) + (slow list (cdr slow))) + ((not (consp fast)) + ;; Not CDRcircular, need to check remaining CARs yet + (do ((tail slow (and (cdr tail)))) + ((not (consp tail)) + nil) + (checkcycle (car tail) (cons tail seen) (1+ depth)))) + (checkcycle (car slow) (cons slow seen) (1+ depth)) + (when (eq fast slow) + (return t))))) + (circularp x (list x) 0)))) ;;; Is X a (possiblyimproper) list of at least N elements? (declaim (ftype (function (t index)) listoflengthatleastp)) Index: pred.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/code/pred.lisp,v retrieving revision 1.24 retrieving revision 1.25 diff u d r1.24 r1.25  pred.lisp 3 Jun 2006 20:26:52 0000 1.24 +++ pred.lisp 29 Aug 2006 13:35:23 0000 1.25 @@ 221,10 +221,9 @@ (defun equal (x y) #!+sbdoc  "Return T if X and Y are EQL or if they are structured components  whose elements are EQUAL. Strings and bitvectors are EQUAL if they  are the same length and have identical components. Other arrays must be  EQ to be EQUAL." + "Return T if X and Y are EQL or if they are structured components whose +elements are EQUAL. Strings and bitvectors are EQUAL if they are the same +length and have identical components. Other arrays must be EQ to be EQUAL." ;; Nontail selfrecursion implemented with a local auxiliary function ;; is a lot faster than doing it the straightforward way (at least ;; on x86oids) due to calling convention differences.  JES, 20051230 