Search code examples
lispcommon-lispcircular-referencecircular-list

Check for proper list in Common Lisp


Is there a standard function in Common Lisp that can check against improper lists (i.e. circular and dotted lists) without signaling an error? list-length can check against circular lists (it returns nil for them), but signals type-error when given a dotted list.

Scheme's list? traverses the whole list to make sure it is not dotted or circular; Common Lisp's listp only checks that it's given nil or a cons cell.

Here's the simplest I could come up with:

(defun proper-list-p (x)
  (not (null (handler-case (list-length x) (type-error () nil)))))

Since several implementations have been suggested and many unexpected problems have been found, here's a test suite for aspiring proper-list-p writers:

(defun circular (xs)
  (let ((xs (copy-list xs)))
    (setf (cdr (last xs)) xs)
    xs))

(assert (eql t (proper-list-p '())))
(assert (eql t (proper-list-p '(1))))
(assert (eql t (proper-list-p '(1 2))))
(assert (eql t (proper-list-p '(1 2 3))))

(assert (not (proper-list-p 1)))
(assert (not (proper-list-p '(1 . 2))))
(assert (not (proper-list-p '(1 2 . 3))))
(assert (not (proper-list-p '(1 2 3 . 4))))

(assert (not (proper-list-p (circular '(1)))))
(assert (not (proper-list-p (circular '(1 2)))))
(assert (not (proper-list-p (circular '(1 2 3)))))
(assert (not (proper-list-p (list* 1 (circular '(2))))))
(assert (not (proper-list-p (list* 1 2 (circular '(3 4))))))

Solution

  • There is no standard function to do this, perhaps because such a function was seen as rather expensive if it was to be correct, but, really, this just seems like am omission from the language to me.

    A minimal (not very performant) implementation, which does not rely on handling errors (Python people think that's a reasonable way to program, I don't, although this is a stylistic choice), is, I think

    (defun proper-list-p (l)
      (typecase l
        (null t)
        (cons
         (loop for tail = l then (cdr tail)
               for seen = (list tail) then (push tail seen)
               do (cond ((null tail)
                         (return t))
                        ((not (consp tail))
                         (return nil))
                        ((member tail (rest seen))
                         (return nil)))))))
    

    This takes time quadratic in the length of l, and conses proportional to the length of l. You can obviously do better using an hashtable for the occurs check, and you can use a tortoise-&-hare algorithm do avoid the occurs check (but I'm not sure what the complexity of that is off the top of my head).

    I am sure there are much better functions than this in libraries. In particular Alexandria has one.


    While thinking about this question, I also wrote this function:

    (defun classify-list (l)
      "Classify a possible list, returning four values.
    
    The first value is a symbol which is
    - NULL if the list is empty;
    - LIST if the list is a proper list;
    - CYCLIC-LIST if it contains a cycle;
    - IMPROPER-LIST if it does not end with nil;
    - NIL if it is not a list.
    
    The second value is the total number of conses in the list (following
    CDRs only).  It will be 0 for an empty list or non-list.
    
    The third value is the cons at which the cycle in the list begins, or
    NIL if there is no cycle or the list isn't a list.
    
    The fourth value is the number if conses in the cycle, or 0 if there is no cycle.
    
    Note that you can deduce the length of the leading element of the list
    by subtracting the total number of conses from the number of conses in
    the cycle: you can then use NTHCDR to pull out the cycle."
      ;; This is written as a tail recursion, I know people don't like
      ;; that in CL, but I wrote it for me.
      (typecase l
        (null (values 'null 0 nil 0 0))
        (cons
         (let ((table (make-hash-table)))
           (labels ((walk (tail previous-tail n)
                      (typecase tail
                        (null
                         (values 'list n nil 0))
                        (cons
                         (let ((m (gethash tail table nil)))
                           (if m
                               (values 'cyclic-list n tail (- n m))
                             (progn
                               (setf (gethash tail table) n)
                               (walk (cdr tail) tail (1+ n))))))
                        (t
                         (values 'improper-list n previous-tail 0)))))
             (walk l nil 0))))
        (t (values nil 0 nil 0))))
    

    This can be used to get a bunch of information about a list: how long it is, if it is proper, if not if it's cyclic, and where the cycle is. Beware that in the cases of cyclic lists this will return circular structure as its third value. I believe that you need to use an occurs check to do this – tortoise & hare will tell you if a list is cyclic, but not where the cycle starts.