Path: utzoo!utgpu!news-server.csri.toronto.edu!cs.utexas.edu!sdd.hp.com!think.com!snorkelwacker.mit.edu!ai-lab!gerber!jaffer
From: jaffer@gerber.ai.mit.edu (Aubrey Jaffer)
Newsgroups: comp.lang.scheme
Subject: call-with-current-continuations and leaf compare
Message-ID: <13141@life.ai.mit.edu>
Date: 2 Feb 91 06:21:14 GMT
Sender: news@ai.mit.edu
Lines: 35

;;; The function leaf-eq? attempts to compare the leaves of 2
;;; arbitrary trees constructed of lists.  Unfortunately, it doesn't
;;; work right.  It compares the leaves correctly until one of the
;;; trees run out.  That next-leaf-generator then starts out at
;;; the beginning of the tree again.  This doesn't happen when a
;;; single leaf-generator is made and repeatedly called.  The
;;; following code has write statements in it to illustrate each
;;; comparison. WHAT IS WRONG HERE?

(define (next-leaf-generator obj eot)
  (letrec ((return #f)
	   (cont (lambda (x) (recurse obj) (set! cont eot) (eot #t)))
	   (recurse (lambda (obj)
		      (if (pair? obj)
			  (for-each recurse obj)
			  (call-with-current-continuation
			   (lambda (c)
			     (set! cont c)
			     (return obj)))))))
    (lambda () (call-with-current-continuation
		(lambda (ret) (set! return ret) (cont #f))))))

(define (leaf-eq? x y)
  (let* ((eot (list 4))
	 (eotf (lambda (x) eot))
	 (xf (next-leaf-generator x eotf))
	 (yf (next-leaf-generator y eotf)))
	(letrec ((loop (lambda (x y)
			(write x) (display " ") (write y) (newline)
			(cond ((not (eq? x y)) #f)
			      ((eq? eot x) #t)
			      (else (loop (xf) (yf)))))))
		(loop (xf) (yf)))))

(write (leaf-eq? '(a b c) '((a) b c)))