; http://c2.com/cgi/wiki?SameFringeProblem (define t1 '(((2 . 3) . 4) . (3 . (7 . (3 . 2))))) (define t2 '((((2 . 3) . 4) . 3) . ((7 . 3) . 2))) (define t3 '((((2 . 3) . 4) . 5) . ((7 . 3) . 2))) (define t4 '((((2 . 3) . 4) . 3) . ((7 . 3) . (2 . 3)))) (define (process f tr) (let rec ((tr tr)) (if (pair? tr) (begin (rec (car tr)) (rec (cdr tr))) (f tr)))) (define (start tr) (lambda (ret) (process ret tr))) (define (make-generator l) (let ((rescont #f) (retcont #f)) (lambda () (call/cc (lambda (ret) (set! retcont ret) (if (eq? rescont #f) (begin (l (lambda (x) (call/cc (lambda (res) (set! rescont res) (retcont (cons #t x)))))) (set! rescont 'eof) (retcont (cons #f 'eof))) (if (eq? rescont 'eof) (error "End of generator") (rescont)))))))) (define (same-fringe? tr1 tr2) (let ((gen1 (make-generator (start tr1))) (gen2 (make-generator (start tr2)))) (let rec () (let ((v1 (gen1))(v2 (gen2))) (or (not (or (car v1) (car v2))) (and (car v1) (car v2) (eqv? (cdr v1) (cdr v2)) (rec))))))) (list (same-fringe? t1 t2) (same-fringe? t1 t3) (same-fringe? t1 t4))