1 |
(in-package 'lisp) |
(in-package 'lisp) |
2 |
(export '(pprint-linear pprint-fill pprint-tabular pprint-logical-block)) |
(export '(pprint-linear |
3 |
|
pprint-fill |
4 |
|
pprint-tabular |
5 |
|
pprint-logical-block |
6 |
|
pprint-pop pprint-indent pprint-newline pprint-tab |
7 |
|
pprint-exit-if-list-exhausted)) |
8 |
(in-package 'si) |
(in-package 'si) |
9 |
|
|
10 |
|
|
36 |
(write-string z s) |
(write-string z s) |
37 |
nil)) |
nil)) |
38 |
|
|
39 |
(defun circlep-int (x y z) |
(defun circlep-int (x y) |
40 |
(let ((dz (cdr z))) |
(cond ((or (atom x) (atom y)) nil) |
41 |
(cond ((null dz) nil) |
((eq x y) t) |
42 |
((eq y dz) t) |
((eq x (cdr y)) t) |
43 |
((eq y z) (circlep-int x x dz)) |
((atom (cdr y)) nil) |
44 |
(t (circlep-int x (cdr y) z))))) |
((circlep-int (cdr x) (cddr y))))) |
45 |
|
|
46 |
(defmacro circlep (x) `(and (consp ,x) (circlep-int ,x ,x ,x))) |
(defmacro circlep (x) `(and (consp ,x) (circlep-int ,x (cdr ,x)))) |
47 |
|
|
48 |
(defmacro pprint-logical-block ((s x &key (prefix "") (per-line-prefix "") (suffix "")) &body body) |
(defmacro pprint-logical-block ((s x &key (prefix "") (per-line-prefix "") (suffix "")) &body body) |
49 |
(let ((nx (gensym)) (xx (gensym)) (count (gensym)) (end (gensym)) (eprefix (gensym)) |
(let ((nx (gensym)) (xx (gensym)) (count (gensym)) (end (gensym)) (eprefix (gensym)) |