0.pre7.82:

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

diff --git a/src/code/early-extensions.lisp b/src/code/early-extensions.lisp
index 7946088..916d03a 100644 (file)
--- a/src/code/early-extensions.lisp
+++ b/src/code/early-extensions.lisp
@@ -110,8 +110,8 @@
                                         (1- max))))
          (t nil))))
 
-;;; Is X a circular list?
-(defun circular-list-p (x)
+;;; Is X a list containing a cycle?
+(defun cyclic-list-p (x)
   (and (listp x)
        (labels ((safe-cddr (x) (if (listp (cdr x)) (cddr x)))) 
         (do ((y x (safe-cddr y))
@@ -146,6 +146,13 @@
               ((or (= r 0) (> d q)) (/= r 0))
             (declare (fixnum inc))
             (multiple-value-setq (q r) (truncate x d))))))
+
+;;; Could this object contain other objects? (This is important to
+;;; the implementation of things like *PRINT-CIRCLE* and the dumper.)
+(defun compound-object-p (x)
+  (or (consp x)
+      (typep x 'instance)
+      (typep x '(array t *))))
 \f
 ;;;; the COLLECT macro
 ;;;;
@@ -289,6 +296,15 @@
 (declaim (inline neq))
 (defun neq (x y)
   (not (eq x y)))
+
+;;; not really an old-fashioned function, but what the calling
+;;; convention should've been: like NTH, but with the same argument
+;;; order as in all the other dereferencing functions, with the
+;;; collection first and the index second
+(declaim (inline nth-but-with-sane-arg-order))
+(declaim (ftype (function (list index) t) nth-but-with-sane-arg-order))
+(defun nth-but-with-sane-arg-order (list index)
+  (nth index list))
 \f
 ;;;; miscellaneous iteration extensions
 
@@ -599,11 +615,11 @@
         nil)))
 
 ;;; This function is to be called just before a change which would
-;;; affect that. (We don't absolutely have to call this function
-;;; before such changes, since such changes are given as undefined
-;;; behavior. In particular, we don't if the runtime cost would be
-;;; annoying. But otherwise it's nice to do so.)
-(defun about-to-modify (symbol)
+;;; affect the symbol value. (We don't absolutely have to call this
+;;; function before such changes, since such changes are given as
+;;; undefined behavior. In particular, we don't if the runtime cost
+;;; would be annoying. But otherwise it's nice to do so.)
+(defun about-to-modify-symbol-value (symbol)
   (declare (type symbol symbol))
   (let ((reason (symbol-self-evaluating-p symbol)))
     (when reason
@@ -673,10 +689,10 @@
 ;;; error indicating that a required &KEY argument was not supplied.
 ;;; This function is also useful for DEFSTRUCT slot defaults
 ;;; corresponding to required arguments.
-(declaim (ftype (function () nil) required-argument))
-(defun required-argument ()
+(declaim (ftype (function () nil) required-arg))
+(defun required-arg ()
   #!+sb-doc
-  (/show0 "entering REQUIRED-ARGUMENT")
+  (/show0 "entering REQUIRED-ARG")
   (error "A required &KEY or &OPTIONAL argument was not supplied."))
 
 ;;; like CL:ASSERT and CL:CHECK-TYPE, but lighter-weight