Another update from ingydotnet^djgoku

Task/Same-Fringe/Racket/same-fringe-1.rkt

@@ -0,0 +1,19 @@
+#lang racket
+
+(module same-fringe lazy
+  (provide same-fringe?)
+  (define (same-fringe? t1 t2)
+    (! (equal? (flatten t1) (flatten t2))))
+  (define (flatten tree)
+    (if (list? tree)
+      (apply append (map flatten tree))
+      (list tree))))
+
+(require 'same-fringe)
+
+(module+ test
+  (require rackunit)
+  (check-true (same-fringe? '((1 2 3) ((4 5 6) (7 8)))
+                            '(((1 2 3) (4 5 6)) (7 8))))
+  (check-false (same-fringe? '((1 2 3) ((4 5 6) (7 8)))
+                             '(((1 2 3) (4 6)) (8)))))

Task/Same-Fringe/Racket/same-fringe-2.rkt

@@ -0,0 +1,15 @@
+#lang racket
+
+(define (fringe->channel tree)
+  (define ch (make-channel))
+  (thread (λ() (let loop ([tree tree])
+                 (if (list? tree) (for-each loop tree) (channel-put ch tree)))
+               (channel-put ch (void)))) ; mark the end
+  ch)
+
+(define (same-fringe? tree1 tree2)
+  (define ch1 (fringe->channel tree1))
+  (define ch2 (fringe->channel tree2))
+  (let loop ()
+    (let ([x1 (channel-get ch1)] [x2 (channel-get ch2)])
+      (and (equal? x1 x2) (or (void? x1) (loop))))))

Task/Same-Fringe/Racket/same-fringe-3.rkt

@@ -0,0 +1,15 @@
+#lang racket
+
+(define (pipe-fringe tree)
+  (define-values [I O] (make-pipe 100))
+  (thread (λ() (let loop ([tree tree])
+                 (if (list? tree) (for-each loop tree) (fprintf O "~s\n" tree)))
+               (close-output-port O)))
+  I)
+
+(define (same-fringe? tree1 tree2)
+  (define i1 (pipe-fringe tree1))
+  (define i2 (pipe-fringe tree2))
+  (let loop ()
+    (let ([x1 (read i1)] [x2 (read i2)])
+      (and (equal? x1 x2) (or (eof-object? x1) (loop))))))

Task/Same-Fringe/Racket/same-fringe-4.rkt

@@ -0,0 +1,14 @@
+#lang racket
+(require racket/generator)
+
+(define (fringe-generator tree)
+  (generator ()
+    (let loop ([tree tree])
+      (if (list? tree) (for-each loop tree) (yield tree)))))
+
+(define (same-fringe? tree1 tree2)
+  (define g1 (fringe-generator tree1))
+  (define g2 (fringe-generator tree2))
+  (let loop ()
+    (let ([x1 (g1)] [x2 (g2)])
+      (and (equal? x1 x2) (or (void? x1) (loop))))))

Task/Same-Fringe/Racket/same-fringe-5.rkt

@@ -0,0 +1,18 @@
+#lang racket
+
+(require racket/control)
+
+(define (fringe-iterator tree)
+  (λ() (let loop ([tree tree])
+         (if (list? tree) (for-each loop tree) (fcontrol tree)))
+       (fcontrol (void))))
+
+(define (same-fringe? tree1 tree2)
+  (let loop ([iter1 (fringe-iterator tree1)]
+             [iter2 (fringe-iterator tree2)])
+    (% (iter1)
+       (λ (x1 iter1)
+         (% (iter2)
+            (λ (x2 iter2)
+              (and (equal? x1 x2)
+                   (or (void? x1) (loop iter1 iter2)))))))))

Task/Same-Fringe/Racket/same-fringe.rkt

@@ -1,30 +0,0 @@
-#lang racket
-(require racket/control)
-
-(define (make-fringe-getter tree)
-  (λ ()
-    (let loop ([tree tree])
-      (match tree
-        [(cons a d) (loop a)
-                    (loop d)]
-        ['()        (void)]
-        [else       (fcontrol tree)]))
-    (fcontrol 'done)))
-
-(define (same-fringe? tree1 tree2)
-  (let loop ([get-fringe1 (make-fringe-getter tree1)]
-             [get-fringe2 (make-fringe-getter tree2)])
-    (% (get-fringe1)
-       (λ (fringe1 get-fringe1)
-         (% (get-fringe2)
-            (λ (fringe2 get-fringe2)
-              (and (equal? fringe1 fringe2)
-                   (or (eq? fringe1 'done)
-                       (loop get-fringe1 get-fringe2)))))))))
-
-;; unit tests
-(require rackunit)
-(check-true (same-fringe? '((1 2 3) ((4 5 6) (7 8)))
-                          '(((1 2 3) (4 5 6)) (7 8))))
-(check-false (same-fringe? '((1 2 3) ((4 5 6) (7 8)))
-                           '(((1 2 3) (4 6)) (8))))