(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))
((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
;;;;
;;; the function is made the new value for the collection. As a
;;; totally magical special-case, FUNCTION may be COLLECT, which tells
;;; us to build a list in forward order; this is the default. If an
-;;; INITIAL-VALUE is supplied for Collect, the stuff will be RPLACD'd
+;;; INITIAL-VALUE is supplied for COLLECT, the stuff will be RPLACD'd
;;; onto the end. Note that FUNCTION may be anything that can appear
;;; in the functional position, including macros and lambdas.
(defmacro collect (collections &body body)
(binds ()))
(dolist (spec collections)
(unless (proper-list-of-length-p spec 1 3)
- (error "malformed collection specifier: ~S." spec))
+ (error "malformed collection specifier: ~S" spec))
(let* ((name (first spec))
(default (second spec))
(kind (or (third spec) 'collect))
;;; The code for initializing the cache is wrapped in a form with
;;; the specified name. (:INIT-WRAPPER is set to COLD-INIT-FORMS
;;; in type system definitions so that caches will be created
-;;; before top-level forms run.)
+;;; before top level forms run.)
(defmacro define-hash-cache (name args &key hash-function hash-bits default
(init-wrapper 'progn)
(values 1))
(n-cache (gensym)))
(unless (= (length default-values) values)
- (error "The number of default values ~S differs from :VALUES ~D."
+ (error "The number of default values ~S differs from :VALUES ~W."
default values))
(collect ((inlines)
;;; 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) missing-arg))
+(defun missing-arg ()
#!+sb-doc
- (/show0 "entering REQUIRED-ARGUMENT")
+ (/show0 "entering MISSING-ARG")
(error "A required &KEY or &OPTIONAL argument was not supplied."))
;;; like CL:ASSERT and CL:CHECK-TYPE, but lighter-weight
(if (typep possibly-logical-pathname 'logical-pathname)
(translate-logical-pathname possibly-logical-pathname)
possibly-logical-pathname))
+
+(defun deprecation-warning (bad-name &optional good-name)
+ (warn "using deprecated ~S~@[, should use ~S instead~]"
+ bad-name
+ good-name))