X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fprimordial-extensions.lisp;h=e91d56d1b261be5e43675c4e6e577ecb473a412a;hb=f25039178959a9b302b3399dd04a4d7ba492674d;hp=284b401b458726f476d1f5296bed78f6d023517b;hpb=f21e0f5b908263715ea0d867edb64ceba5a3d668;p=sbcl.git

diff --git a/src/code/primordial-extensions.lisp b/src/code/primordial-extensions.lisp
index 284b401..e91d56d 100644
--- a/src/code/primordial-extensions.lisp
+++ b/src/code/primordial-extensions.lisp
@@ -345,6 +345,21 @@
                                        (1- max))))
         (t nil)))
 
+(defun proper-list-p (x)
+  (unless (consp x)
+    (return-from proper-list-p (null x)))
+  (let ((rabbit (cdr x))
+        (turtle x))
+    (flet ((pop-rabbit ()
+             (when (eql rabbit turtle) ; circular
+               (return-from proper-list-p nil))
+             (when (atom rabbit)
+               (return-from proper-list-p (null rabbit)))
+             (pop rabbit)))
+      (loop (pop-rabbit)
+            (pop-rabbit)
+            (pop turtle)))))
+
 ;;; Helpers for defining error-signalling NOP's for "not supported
 ;;; here" operations.
 (defmacro define-unsupported-fun (name &optional