Relay-Version: version B 2.10 5/3/83; site utzoo.UUCP
Posting-Version: Notesfiles $Revision: 1.7.0.10 $; site uicsl
Path: utzoo!watmath!clyde!cbosgd!ihnp4!inuxc!pur-ee!uiucdcs!uicsl!pollack
From: pollack@uicsl.UUCP
Newsgroups: net.lang.lisp
Subject: Re: Pretty-printer
Message-ID: <6400004@uicsl>
Date: Sun, 16-Mar-86 18:01:00 EST
Article-I.D.: uicsl.6400004
Posted: Sun Mar 16 18:01:00 1986
Date-Received: Tue, 18-Mar-86 07:39:03 EST
References: <384@geowhiz.UUCP>
Lines: 39
Nf-ID: #R:geowhiz.UUCP:384:uicsl:6400004:000:1440
Nf-From: uicsl.UUCP!pollack    Mar 16 17:01:00 1986



Here is a minimal recursive pretty-printer translated into XLISP 1.4.
As proof, the function printed itself into this file.
Unfortunately, XLISP threw away all the comments!

Jordan
------------------------------

(defun pp (expr &optional sink indent &aux moreindent newlineflag)
          (or indent (setq indent 0))
          (or sink (setq sink *standard-output*))
          (setq moreindent 0)
          (princ "(" sink)
          (setq indent (1+ indent))
          (do ((tail expr (cdr tail)))
              ((null tail))
              (cond ((atom (car tail))
                     (cond (newlineflag (setq moreindent 0)))
                     (prin1 (car tail)
                      sink)
                     (setq moreindent (+ moreindent 1 (flatc (car tail))))
                     (cond ((cdr tail)
                            (spaces 1 sink)))
                     (setq newlineflag nil))
                    (t (cond (newlineflag (spaces moreindent sink)))
                       (pp (car tail)
                        sink (+ indent moreindent))
                       (cond ((cdr tail)
                              (terpri sink)
                              (spaces indent sink)))
                       (setq newlineflag t))))
          (princ ")" sink)
 nil)

(defun spaces (n &optional sink)
              (or sink (setq sink *standard-output*))
              (dotimes (i n)
                       (princ " " sink)))