Constant-fold backquote of constant expressions

[sbcl.git] / src / code / primordial-extensions.lisp

diff --git a/src/code/primordial-extensions.lisp b/src/code/primordial-extensions.lisp
index 284b401..e91d56d 100644 (file)
--- 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