MIT 6.001                                       Fall, 1997
Instructor: A. Meyer

                 Recitation #7, Notes for Fri., 11/21/97

We explained how to use a stack to come up with a tail-recursive
definition of FLATTEN:

The familiar recursive version is:

(define (flatten tree)
  (cond ((null? tree) '())
        ((symbol? tree) tree)
        (else
         (append (flatten (car tree))
                 (flatten (cdr tree))))))

To turn this into a tail-recursive procedure, we look at the
non-tail-recursive calls above and think of the successive computational
task which remain to do after each call.

One such call is  (flatten (car tree))
and the other is  (flatten (cdr tree))

We could do either of these calls first.  Suppose want the call of flatten
on the car of the tree to be done first.  Just after this call returns the
flattened car of the tree, what remains to be done?  We have to call
flatten on the cdr of the tree, then append the just-computed flattened
car and the flattened cdr, and return the result.

To represent this remaining task, we package up the cdr of the tree with
some tag identifying this kind of task.  As an aid to our memory, we'll
use the string
                   "(append [] (flatten (cdr tree)))"
as the tag.  Here the ``hole'', "[]", indicates how the remaining task
uses the just-computed flattened car.  (The choice of identifying tag is
arbitrary, for example, if we wanted short tags, we could use the number 1
instead of the string above.)  We'll represent the particular task with a
list
                               (TAG CDRTR)
where TAG is the string above and CDRTR is the cdr of tree.

Now to process this remaining task, we have to do the second call to
flatten the cdr.  Once that's done, the remaining task is to append the
flattened car to the just-computed value of the flattened cdr, and return
the result.  We represent this task as a list
                     ("(append flattened-car [])" FLATCAR)
where FLATCAR is the flattened-car obtained from the first call.

Assuming that APPEND is tail-recursive (and we know how to define it so it
would be), then there are no other non-tail-recursive calls.  So we're
ready to write our tail-recursive FLATTEN.

The idea is to write a tail-recursive procedure TR-FLATTEN which acts like
recursive FLATTEN, except that instead of RETURNING the flattened tree,
its "contract" is to call a special RETURN procedure, which is also
tail-recursive, with the value of the flattened tree:

(define (tr-flatten tree)
  (cond ((null? tree) (RETURN '()))
        ((symbol? tree)
         (RETURN (list tree)))
        (else ...)))

The "contract" of the RETURN procedure is to use the value it initially
gets from TR-FLATTEN to carry out the next task.  The next tasks are
stored on a STACK which is shared by the TR-FLATTEN and RETURN procedures.
The RETURN procedure POP's the stack to get the next task.  If the stack
is empty, which means there is no next task, then RETURN really returns
the value it gets.

So TR-FLATTEN can fulfill its contract by pushing the next task
         ("(append [] (flatten (cdr tree)))" CDRTR)))
onto the stack and calling itself on the car of the tree.  Assuming
TR-FLATTEN fulfills its contract on the subtree, the call to itself will
result in a call
           (RETURN <flattened-car>).
According to the RETURN contract, RETURN will pop the above task off the
stack and use <flattened-car> to complete the task.  Namely, RETURN will
append <flattened-car> to the flattened CDRTR and return the result.

(define (tr-flatten tree)
  (cond ((null? tree) (return '()))
        ((symbol? tree)
         (return (list tree)))
        (else
	 (let ((next-task
		(list
		 "(append [] (flatten (cdr tree)))"
		 (cdr tree))))
	   (begin
	     (push next-task)
	     (tr-flatten (car tree)))))))

Now we have to define a tail-recursive RETURN procedure which carries out
the two kinds of tasks.  But that's not hard since RETURN can use
TR-FLATTEN:

(define (return val)
  (if (stack-empty?)
      val
      (let* ((next-task (pop))
             (tag (car next-task)))
        (cond
         ((string=? "(append [] (flatten (cdr tree)))" tag)
          (let ((cdrtr (cadr next-task))
		(further-task
		 (list
		  "(append flattened-car [])"
		  val)))		;VAL is the flattened car
            (begin
              (push further-task)
              (tr-flatten cdrtr))))
         ((string=? "(append flattened-car [])" tag)
          (let ((flatcar (cadr next-task)))
            (return (append flatcar val)))) ;VAL is the flattened cdr
	 (else (error "RETURN: unknown task" next-task))))))


The tail-recursive FLATTEN clears the stack and calls TR-FLATTEN:

(define (flatten tree)
  (begin
    (clear-stack!)
    (tr-flatten tree)))


;;; TRACE OF TR-FLATTEN and RETURN in the evaluation of
;;;                  (FLATTEN '((A B) C))
; The stack is shown after each PUSH.

(tr-flatten ((a b) c))
stack:
(("(append [] (flatten (cdr tree)))" (c)))

(tr-flatten (a b))
stack:
(("(append [] (flatten (cdr tree)))" (b))
 ("(append [] (flatten (cdr tree)))" (c)))

(tr-flatten a)
(return (a))
stack:
(("(append flattened-car [])" (a))
 ("(append [] (flatten (cdr tree)))" (c)))

(tr-flatten (b))
stack:
(("(append [] (flatten (cdr tree)))" #f)
 ("(append flattened-car [])" (a))
 ("(append [] (flatten (cdr tree)))" (c)))

(tr-flatten b)
(return (b))
stack:
(("(append flattened-car [])" (b))
 ("(append flattened-car [])" (a))
 ("(append [] (flatten (cdr tree)))" (c)))

(tr-flatten #f)
(return #f)
(return (b))
(return (a b))
stack:
(("(append flattened-car [])" (a b)))

(tr-flatten (c))
stack:
(("(append [] (flatten (cdr tree)))" #f)
 ("(append flattened-car [])" (a b)))

(tr-flatten c)
(return (c))
stack:
(("(append flattened-car [])" (c))
 ("(append flattened-car [])" (a b)))

(tr-flatten #f)
(return #f)
(return (c))
(return (a b c))
;Value: (a b c)



                   ;;THE STACK IMPLEMENATION

(define the-stack '(uninitialized))

(define (clear-stack!)
  (set-car! the-stack '()))

(define (pop)
  (if (stack-empty?)
      (error "POP: empty stack")
      (let ((top (caar the-stack)))
	(begin
	  (set-car! the-stack (cdar the-stack))
	  top))))

(define (stack-empty?)
  (null? (car the-stack)))

(define (push v)
  (begin
    (set-car! the-stack (cons v (car the-stack)))))