[plt-scheme] Tail recursion and the Visitor Pattern

On Sat, 30 Dec 2006, wooks . wrote:

> Thought I'd try and make this tail recursive and got into a tangle.
>
> class ButLastV extends EmptyException implements IList{
>   public AList forCons(Object first, AList rest) {
>     return rest.isEmpty() ?
>       Empty.ONLY :
>       new Cons(first, ((AList)rest.accept(this)));
>   }
> }

Hi Wooks,

I was just checking: what are you looking at?  Are you looking at 
something else like "A Little Java, A Few Patterns"?  The code you've 
shown so far reminds me of it, but all I see in the book are examples of 
food.


In any case, I thought it might be fun (and perverse) to try to do the 
visitor pattern in PLT's object system, so here's what I've got so far. 
(My apologies for the lack of comments!)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(module visitors mzscheme
   (require (lib "class.ss"))

   (provide (all-defined))

   (define list-visitor<%> (interface () for-cons for-empty))
   (define list<%> (interface () is-empty? accept))


   (define empty%
     (class* object% (list<%>)
       (define/public (is-empty?) #t)
       (define/public (accept a-visitor)
         (send a-visitor for-empty))
       (super-new)))


   (define cons%
     (class* object% (list<%>)
       (init first rest)
       (define -first first)
       (define -rest rest)

       (define/public (is-empty?) #f)
       (define/public (accept a-visitor)
         (send a-visitor for-cons -first -rest))
       (super-new)))


   (define butlast-visitor%
     (class* object% (list-visitor<%>)

       (define/public (for-empty)
         (new empty%))

       (define/public (for-cons first rest)
         (cond
           [(send rest is-empty?)
            (new empty%)]
           [else
            (new cons%
                 [first first]
                 [rest (send rest accept this)])]))
       (super-new)))


   (define to-sexp-visitor%
     (class* object% (list-visitor<%>)
       (define/public (for-empty)
         '())
       (define/public (for-cons first rest)
         (cons first
               (send rest accept this)))
       (super-new)))


   (define (test)
     (define mylist
       (new cons%
            [first 3]
            [rest
             (new cons%
                  [first 1]
                  [rest
                   (new cons%
                        [first 4]
                        [rest
                         (new empty%)])])]))
     (send (send mylist accept (new butlast-visitor%))
           accept (new to-sexp-visitor%))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


To turn all the calls here into tail calls can be done by using a 
continuation-passing-style approach.  Concretely, something like:

   (define (factorial x)
     (if (= x 0)
         1
         (* x (factorial (sub1 x)))))

can be transformed into:

   (define (factorial/k x k)
     (if (= x 0)
         (k 1)
         (factorial/k (sub1 x)
                      (lambda (v) (k (* x v))))))

Even though the second version looks bizarre, they both behave similarly:

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
> (factorial 10)
3628800
> (factorial/k 10 (lambda (x) x))
3628800
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;



And we can take such an approach to turn all the calls in the 
butlast-visitor into tail calls (although the code will be a bit ugly). 
We can even do without building lambdas, and do this just through objects 
and message passing. Here's what this looks like:

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(module visitors-with-continuations mzscheme
   (require (lib "class.ss"))

   (provide (all-defined))

   (define list-visitor<%> (interface () for-cons for-empty))
   (define list<%> (interface () is-empty? accept))
   (define cont<%> (interface () apply-cont))


   (define empty%
     (class* object% (list<%>)
       (define/public (is-empty?) #t)
       (define/public (accept a-visitor a-cont)
         (send a-visitor for-empty a-cont))
       (super-new)))


   (define cons%
     (class* object% (list<%>)
       (init first rest)
       (define -first first)
       (define -rest rest)

       (define/public (is-empty?) #f)
       (define/public (accept a-visitor a-cont)
         (send a-visitor for-cons -first -rest a-cont))
       (super-new)))


   (define butlast-visitor%
     (class* object% (list-visitor<%>)

       (define/public (for-empty a-cont)
         (send a-cont apply-cont (new empty%)))

       (define/public (for-cons first rest a-cont)
         (cond
           [(send rest is-empty?)
            (send a-cont apply-cont (new empty%))]
           [else
            (send rest accept this
                  (new (class* object% (cont<%>)
                         (define/public (apply-cont v)
                           (send a-cont apply-cont
                                 (new cons% [first first] [rest v])))
                         (super-new))))]))
       (super-new)))


   (define to-sexp-visitor%
     (class* object% (list-visitor<%>)
       (define/public (for-empty a-cont)
         (send a-cont apply-cont '()))
       (define/public (for-cons first rest a-cont)
         (send rest accept this
               (new (class* object% (cont<%>)
                      (define/public (apply-cont v)
                        (send a-cont apply-cont (cons first v)))
                      (super-new)))))
       (super-new)))


   (define identity-cont%
     (class* object% (cont<%>)
       (define/public (apply-cont v)
         v)
       (super-new)))


   (define (test)
     (define mylist
       (new cons%
            [first 3]
            [rest
             (new cons%
                  [first 1]
                  [rest
                   (new cons%
                        [first 4]
                        [rest
                         (new empty%)])])]))
     (send (send mylist accept (new butlast-visitor%) (new identity-cont%))
           accept (new to-sexp-visitor%) (new identity-cont%))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


Best of wishes!