#lang racket

(define (listStreamTrace la)
  (displayln "10 ")
  (define (control-state return)
    (displayln "20 ")
    (define (loop lb)
      (display "30 ")
      (displayln lb)
      (if (null? lb) 
          (void)
          (begin
            (display "40 return is ")
            (displayln return)
            ; The set! avoids problems when threading
            (set! return (call/cc      ; need to call/cc here to assure that control-state is changed
                          (lambda (resume-here)
                            (displayln "50 ")
                            (set! control-state resume-here)
                            (displayln "60 ")
                            (return (car lb))
                            (displayln "65 ")
                            'KABOOM)))
            (display "70 return is ")
            (displayln return)
            (loop (cdr lb)))))
    (displayln "80 ")
    (loop la)
    (return '())
    (displayln "90 "))
  (define (iter)
    (displayln "100 ")
    (call/cc control-state))
  iter)

(define (listStream la)
  (define (control-state return)
    (define (loop lb)
      (if (null? lb) 
          (void)
          (begin
            ; The set! avoids problems when threading
            (set! return (call/cc      ; need to call/cc here to assure that control-state is changed
                          (lambda (resume-here)
                            (set! control-state resume-here)
                            (return (car lb))
                            "KABOOM")))
            (loop (cdr lb)))))
    (loop la)
    (return '()))
  (define (iter)
    (call/cc control-state))
  iter)

(define (orderedStreamCompare la lb)
  (let ((aFirst (la))
        (bFirst (lb)))
    (define (osc)    
      (cond
        ((null? aFirst)
         (if (null? bFirst)
             (void)
             (begin
               (display bFirst)
               (displayln " in second")
               (set! bFirst (lb))
               (osc))))
        ((null? bFirst)
         (begin
           (display aFirst)
           (displayln " in first")
           (set! aFirst (la))
           (osc)))
        ((= aFirst bFirst)
         (begin
           (display aFirst)
           (displayln " in both")
           (set! aFirst (la))
           (set! bFirst (lb))
           (osc)))
        ((< aFirst bFirst)
         (begin
           (display aFirst)
           (displayln " in first")
           (set! aFirst (la))
           (osc)))
        (else
         (begin
           (display bFirst)
           (displayln " in second")
           (set! bFirst (lb))
           (osc)))))
  (osc)))

#|
(displayln "example 1")
(orderedStreamCompare (listStream '(0 1 2 3)) (listStream '(2 3 4 5)))

(displayln "example 2")
(orderedStreamCompare (listStream '(0 1 3 5 7 11 13)) (listStream '(1 2 4 6 7 15 18)))
|#
(define (first l) (car l))

(define (second l) (car (cdr l)))

(define (third l) (car (cdr (cdr l))))

(define (treeInsert x root)
  (define (insert root)
    (cond
      ((null? root) (list x '() '()))
      ((= x (first root)) root)
      ((< x (first root)) (list (first root) 
                                (insert (second root)) 
                                (third root)))
      (else (list (first root) 
                  (second root) 
                  (insert (third root))))))
  (insert root))

(define (batchBuild l)
  (let ((tree '()))
    (define (build l)
      (if (null? l) 
          tree
          (begin
            (set! tree (treeInsert (car l) tree))
            (build (cdr l)))))
    (build l)))

(define (inorder l)
  (if (null? l) 
      (void)
      (begin
        (inorder (second l))
        (displayln (first l))
        (inorder (third l)))))

(define (dump2 num x)
#|
  (display x)
  (display " is returned to set! return for ")
  (displayln num)
|#
  x)

(define (inorderStream l)
  (define (switch return)  ; A call to return brings result here to go back to caller
    (define (inorder l)    ; l is a subtree root
      (if (null? l)
          (void)           ; This value should not get to the outside
          (begin
            (inorder (second l))
            ; The set! avoids problems when threading
            (set! return (dump2 (first l)
                  (call/cc                      ; Key will be returned to stream caller
                   (lambda (resume-here)        ; Get point of restart
                     (set! switch resume-here)  ; This lambda is restart entry point
                     ;(display "after (set! switch resume-here) for ")
                     ;(displayln (first l))
                     (return (first l))
                     "KABOOM"))))      ; Send back value
            (inorder (third l)))))
    (inorder l)
    (return '())) ; Repeat returning end indicator to caller
  (define (iter)
    ;(displayln "initial call/cc")
    (call/cc switch))  ; Resume at last stop
  iter)               ; Each call to this stream starts here

#|
(displayln "example 3")
(orderedStreamCompare 
 (inorderStream (batchBuild '(8 6 4 2 11 13 17)))
 (inorderStream (batchBuild '(1 3 5 7 4 6))))

(displayln "example 4")
(orderedStreamCompare 
 (inorderStream (batchBuild '(8 2 10 16 14 6 4 11 0 13 17)))
 (inorderStream (batchBuild '(1 17 3 7 13 5 11 9 2 4 6))))
|#

(define lwp-list '())

(define (lwp thunk)
  (set! lwp-list (append lwp-list (list thunk))))

(define (start)
  (if (null? lwp-list)
      (void)
      (let ([p (car lwp-list)])
        (set! lwp-list (cdr lwp-list))
        (p))))

(define (pause count)
  (call/cc
   (lambda (k)
     (if (> count 0)
         (lwp (lambda () (k #f)))
         (void))
     (start))))

(define (f initVal str)
  (call/cc (lambda (exit)
             (let 
                 ((count initVal))
               (define (g)
                 (pause count)
                 (if (< count 1)
                     (exit #t)
                     (void))
                 (display str) 
                 (set! count (- count 1)) 
                 (g))
               g))))


(lwp (f 8 "a"))
(lwp (f 6 "b"))
(lwp (f 3 "c"))
(lwp (f 5 "d"))
(lwp (f 4 "e"))
(lwp (f 8 "\n"))
;(start)

(define (grabcc)
  (call/cc (lambda (cc) (cc cc))))

(define (dump x)
  (displayln x)
  x)

#|
(define (silly)
  (let ((a 
         (begin
           (display "a ")
           (dump (grabcc))))
        (b
         (begin
           (display "b ")
           (dump (grabcc))))
        (c
         (begin
           (display "c ")
           (dump (grabcc)))))
    (displayln "here we go ")
    (displayln (a (lambda (k) 1)))
    (displayln ">>>>>>>>>")
    (displayln (b (lambda (k) 2)))
    (displayln "<<<<<<<<<")
    (displayln (c (lambda (k) 3)))
    (displayln "done")))
|#