blob: 4ca17bbc9d1ccce28c0cf97b13f93ad4b8e719ef (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
|
; prints recursive list structure
;(let (seen-list)
(setf seenlist nil)
(defun seenp (l) (member l seenlist :test 'eq))
(defun make-seen (l) (setf seenlist (cons l seenlist)))
(defun printrec (l) (printrec-any l) (setf seenlist nil))
(defun printrec-any (l)
(cond ((atom l) (prin1 l) (princ " "))
((seenp l) (princ "<...> "))
(t
(make-seen l)
(princ "(")
(printrec-list l)
(princ ") ")))
nil)
(defun printrec-list (l)
(printrec-any (car l))
(cond ((cdr l)
(cond ((seenp (cdr l))
(princ "<...> "))
((atom (cdr l))
(princ ". ")
(prin1 (cdr l))
(princ " "))
(t
(make-seen (cdr l))
(printrec-list (cdr l))))))
nil)
; )
|
