Improving readability of non-recursive depth first search function in Lisp

Question

As a free-time activity in order to learn some Lisp I had to implement depth first directed graph search. Due to large graph size (800K nodes, 5M arcs) recursion-based approach I could devise didn't work.

Below is my stack-based implementation that I would like to improve in terms of readability if nothing else. Any comments on style, use of Lisp idioms, code smell are welcome.

(defun depth-first-search (adjacency-array visit-function &optional (init-function nil init-function-supplied-p))
  (let* ((num-nodes (array-dimension adjacency-array 0))
         (init most-negative-fixnum)
         (nodes-seen (make-array num-nodes :element-type 'fixnum :initial-element init))
         (results (make-array num-nodes :element-type 'fixnum :initial-element init)))
    (labels ((visited-p (node) (not (eql init (aref results (1- node)))))
             (seen-p (node) (not (eql init (aref nodes-seen (1- node)))))
             (mark-seen (node) (setf (aref nodes-seen (1- node)) 1))
             (mark-visited (node)  (setf (aref results (1- node)) (funcall visit-function)))
             (visit (node)
               (unless (visited-p node)
                 (when init-function-supplied-p (funcall init-function node))
                 (mark-seen node)
                 (loop with stack = (list node)
                       until (null stack)
                       for head = (first stack)
                       for tails = (aref adjacency-array (1- head)) 
                       for fresh-tails = (unless (visited-p head) 
                                           (loop for tail in tails
                                                 unless (or (visited-p tail)
                                                            (seen-p tail))
                                                 collect tail))
                       do (if fresh-tails 
                            (progn
                              (mapcar #'mark-seen fresh-tails)
                              (setq stack (append fresh-tails stack)))
                            (progn
                              (pop stack)
                              (unless (visited-p head) (mark-visited head))))))))
      (loop for node from 1 to num-nodes
            unless (or (null node)
                     (visited-p node))
            do (visit node)
            finally (return results)))))

Some details:

• adjacency-array for a graph 1->2;1->3;3->1 would be #((2 3) nil (1)).
• visit-function returns a "visited" value for a node.
• init-function makes necessary actions when new subgraph search starts.

Answer 1

This usage of LOOP is not supported by ANSI Common Lisp. You can't have an UNTIL clause (only in a main clause in LOOP syntax) before a FOR clause (a variable clause).

See: Macro LOOP.

Answer 2

If-else functionality is build-it into loop (no way).

This fragment inside the loop can be rewritten:

do (if fresh-tails 
     (progn
       (mapcar #'mark-seen fresh-tails)
       (setq stack (append fresh-tails stack)))
     (progn
       (pop stack)
       (unless (visited-p head) (mark-visited head))))

Using loop's if-else:

if fresh-tails do
  (mapcar #'mark-seen fresh-tails)
  (setq stack (append fresh-tails stack))                       
else do
  (pop stack)
  (unless (visited-p head) (mark-visited head))

Less clutter, however requires manual formatting.