Sketchy LISP

An Introduction to Functional Programming in Scheme

4.2 The DRAW-TREE Program

The draw-tree program draws box diagrams of its input, which may be a Scheme atom or pair. It does not support vectors. The program is purely functional and uses side effects only for output. It works by rewriting the internal structure discussed in the previous section.

The first lines of the code already contain a subtle hack that needs some explanation:

(define *nothing* (cons 'N '()))

(define *visited* (cons 'V '()))

The tags used to represent visited lists and nothing in the internal structure impose a problem: how do you render a structure like ((N)), which contains the nothing tag as data? Draw-tree renders this input just fine, but how does it do it?

The above definitions of *nothing* and *visited* make use of a subtle side effect which is caused by the following two properties of Scheme:

• Cons always returns a fresh pair.
• Eq returns #t only for identical objects.

So the formula

(eq? (cons x '()) (cons x '())) => #f

holds for any value of x.

By defining *nothing* and *visited* as fresh pairs and checking them with eq?, collisions between *nothing* and (N) and *visited* and (V) are excluded.

The following predicates check whether an object is nothing and whether a list is currently being visited, respectively:

(define (empty? x) (eq? x *nothing*))

(define (visited? x) (eq? (car x) *visited*))

Mark-visited marks a list as visited, members-of returns the members of a list that is being visited:

(define (mark-visited x) (cons *visited* x))

(define (members-of x) (cdr x))

The done? predicate checks whether a (sub)list has been rendered completely:

(define (done? x)
  (and (visited? x)
       (null? (cdr x))))

The void procedure is used to indicate an uninteresting value. It is returned by procedures that are called exclusively for their side effects.

(define (void) (if #f #f))

The idea behind the draw-fixed-string procedure (below) is to print single-character and two-character atoms directly under the bar connecting the atom to a box:

[o|o]---[o|o]---[o|/]
 |       |       |
 a       bc     def

The procedure draws a string with a fixed length of eight characters. If the string to be printed is longer than seven characters, it is truncated to seven characters. If it is shorter than three characters, a blank is appended in front of it. The resulting string is left-adjusted in a field of eight blanks and emitted.

(define (draw-fixed-string s)
  (let* ((b (make-string 8 #\space))
         (k (string-length s))
         (s (if (> k 7) (substring s 0 7) s))
         (s (if (< k 3) (string-append " " s) s))
         (k (string-length s)))
    (display (string-append
               s
               (substring b 0 (- 8 k))))))

The bottom procedure, which is used by draw-atom (below), is not part of Scheme. In fact it is (or should be) undefined and serves only as an indicator that something went wrong. If your Scheme environment refuses to run a program containing an undefined symbol, you may include a definition like this one:

(define (bottom x) (quotient x 0))

Draw-atom converts an atomic Scheme datum into a string and renders it using draw-fixed-string.

(define (draw-atom n)
  (cond ((null? n)
          (draw-fixed-string "()"))
        ((symbol? n)
          (draw-fixed-string (symbol->string n)))
        ((number? n)
          (draw-fixed-string (number->string n)))
        ((string? n)
          (draw-fixed-string (string-append "\"" n "\"")))
        ((char? n)
          (draw-fixed-string (string-append "#\\" (string n))))
        ((eq? n #t)
          (draw-fixed-string "#t"))
        ((eq? n #f)
          (draw-fixed-string "#f"))
        (else
          (bottom "draw-atom: unknown type" n))))

Draw-conses displays a spine of boxes corresponding to a list. If the list is an improper list, it prints an atom at the end of the spine and otherwise it prints a box containing a slash in the cdr part. For instance:

(draw-conses '(a b . c))  displays  [o|o]---[o|o]--- c
(draw-conses '(a b c))    displays  [o|o]---[o|o]---[o|/]

The function returns the list that was passed to it.

(define (draw-conses n)
  (letrec
    ((d-conses
       (lambda (n)
         (cond ((not (pair? n))
                 (draw-atom n))
               ((null? (cdr n))
                 (display "[o|/]"))
               (else
                 (display "[o|o]---")
                 (d-conses (cdr n)))))))
    (d-conses n)
    n))

The draw-bars procedure traverses a visited list, drawing a bar for each non-(N) member and a blank for each (N) member. Bars of embedded visited lists are rendered recursively. For instance,

(draw-bars `(,*visited* (a b) ,*nothing* (,*visited* c d)))

generates the following output (underscores denote spaces):

_|_______________|_______|______

The first bar will connect to (a b), the gap is caused by ,*nothing*, the final two bars will connect to c and d respectively.

(define (draw-bars n)
  (letrec
    ((d-bars
       (lambda (n)
         (cond ((not (pair? n))
                 (void))
               ((empty? (car n))
                 (draw-fixed-string "")
                 (d-bars (cdr n)))
               ((and (pair? (car n))
                     (visited? (car n)))
                 (d-bars (cdar n))
                 (d-bars (cdr n)))
               (else
                 (draw-fixed-string "|")
                 (d-bars (cdr n)))))))
    (d-bars (members-of n))))

Skip-empty is used to skip over empty slots in visited lists, e.g.:

(skip-empty `(,*nothing* (,*visited*) (foo))) => ((foo))

In combination with remove-trailing-nothing it is used to remove trailing empty slots from internal lists:

(define (skip-empty n)
  (letrec
    ((skip2
       (lambda (n)
         (cond ((null? n)
                 '())
               ((or (empty? (car n))
                    (done? (car n)))
                 (skip2 (cdr n)))
               (else
                 n)))))
    (skip2 n)))

(define (remove-trailing-nothing n)
  (reverse (skip-empty (reverse n))))

The draw-members procedure renders the members that are attached to a spine by bars. This includes the spines of embedded lists:

Input                           Rendered Output
`(,*visited* a b c))            _a_______b_______c______
`(,*visited* ,*nothing* (a b))  ________[o|o]---[o|/]
`(,*visited* a (b c)))          _a______[o|o]---[o|/]

Draw-members also rewrites its input in the following ways: it replaces atoms with (N) and marks trailing not-yet-visited lists as visited. It also removes trailing empty slots:

Input                           Result
`(,*visited* a b c))            ((V))
`(,*visited* ,*nothing* (a b))  ((V) (N) ((V) a b)))
`(,*visited* a (b c)))          ((V) (N) ((V) b c)))

The procedure implements most of the algorithm outlined at the end of the previous section.

(define (draw-members n)
  (letrec
    ((d-members
       (lambda (n r)
         (cond ((not (pair? n))
                 (reverse r))
               ((empty? (car n))
                 (draw-fixed-string "")
                 (d-members (cdr n)
                            (cons *nothing* r)))
               ((not (pair? (car n)))
                 (draw-atom (car n))
                 (d-members (cdr n)
                            (cons *nothing* r)))
               ((null? (cdr n))
                 (d-members (cdr n)
                            (cons (draw-final (car n)) r)))
               (else
                 (draw-fixed-string "|")
                 (d-members (cdr n)
                            (cons (car n) r)))))))
    (mark-visited
      (remove-trailing-nothing
        (d-members (members-of n) '())))))

The draw-final procedure is called by draw-members to render the last slot of a visited list. If it contains an atom, the atom is simply emitted. When the slot contains a list that is already being visited, its members are drawn recursively. When the slot contains a not-yet-visited list, it is tagged visited and its spine is rendered.

Draw-final rewrites the value of the slot in the same way as draw-members and returns it.

(define (draw-final n)
  (cond ((not (pair? n))
          (draw-atom n)
          *nothing*)
        ((visited? n)
          (draw-members n))
        (else
          (mark-visited (draw-conses n)))))

Unsurprisingly, draw-tree is the main procedure of the program. It renders a box diagram corresponding to its argument and returns an uninteresting value. The body of its letrec handles atomic input and the embedded d-tree procedure iterates over input in form of a list until all of its members have been displayed.

(define (draw-tree n)
  (letrec
    ((d-tree
       (lambda (n)
         (cond ((done? n)
                 (void))
               (else
                 (newline)
                 (draw-bars n)
                 (newline)
                 (d-tree (draw-members n)))))))
    (if (not (pair? n))
        (draw-atom n)
        (d-tree (mark-visited (draw-conses n))))
    (newline)))

Of course draw-tree is a long word to type, so:

(define dt draw-tree)