[elpa] externals/compat 9688d79 05/99: Split proper-list-p into two implementations

[ELPA Syncer]

branch: externals/compat
commit 9688d790d8bf28e66fba631f35b71355e9ebb733
Author: Philip Kaludercic <philipk@posteo.net>
Commit: Philip Kaludercic <philipk@posteo.net>

    Split proper-list-p into two implementations
    
    For 26.1 onwards, length throws an error when the list contains a
    cycle.  This can be caught, and told to return a nil value.
    
    For older versions, a variation of Richard P. Brent's cycle detection
    algorithm is used, before length is called if we make sure that the
    list contains no cycles.
    
    Once more, thanks to Mattias Engdegård for suggesting these
    improvements.
---
 compat-27.1.el | 41 ++++++++++++++++++++++++++++-------------
 1 file changed, 28 insertions(+), 13 deletions(-)

diff --git a/compat-27.1.el b/compat-27.1.el
index dfd7802..45b7947 100644
--- a/compat-27.1.el
+++ b/compat-27.1.el
@@ -35,19 +35,34 @@
   "Return OBJECT's length if it is a proper list, nil otherwise.
 A proper list is neither circular nor dotted (i.e., its last cdr
 is nil)."
-  (catch 'improper
-    (let ((length 0) prev)
-      (while object
-        (unless (consp object)
-          ;; dotted
-          (throw 'improper nil))
-        (when (memq object prev)
-          ;; circular
-          (throw 'improper nil))
-        (setq prev (cons object prev)
-              object (cdr object)
-              length (1+ length)))
-      length)))
+  :min-version "26.1"
+  :max-version "26.3"
+  :realname compat--proper-list-p-length-signal
+  (condition-case nil
+      (length object)
+    (wrong-type-argument nil)
+    (circular-list nil)))
+
+(compat-defun proper-list-p (object)
+  "Return OBJECT's length if it is a proper list, nil otherwise.
+A proper list is neither circular nor dotted (i.e., its last cdr
+is nil)."
+  :max-version "25.3"
+  :realname compat--proper-list-p-tortoise-hare
+  (when (listp object)
+    (catch 'cycle
+      (let ((hare object) (tortoise object)
+            (max 2) (q 2) )
+        (while (consp hare)
+          (setq hare (cdr hare))
+          (when (and (or (/= 0 (setq q (1- q)))
+                         (ignore
+                          (setq max (ash max 1)
+                                q max
+                                tortoise hare)))
+                     (eq hare tortoise))
+            (throw 'cycle nil)))
+        (and (null hare) (length object))))))
 
 (compat-defun string-distance (string1 string2 &optional bytecompare)
   "Return Levenshtein distance between STRING1 and STRING2.