
(display
  (+ 1
    (call/cc
      (lambda (k)
        (+ 2 3)))))
(newline)

(display
  (+ 1
    (call/cc
      (lambda (k)
        (+ 2 (k 3))))))
(newline)

(define r #f)

(display
  (+ 1
    (call/cc
      (lambda (k)
        (set! r k)
        (+ 2 (k 3))))))
(newline)

(display
  (((call/cc (lambda (k) k)) (lambda (x) x)) "HEY"))
(newline)

; ???? following doesnt work
; (display (r 5))
; (newline)

; list product using call/cc

(define (list-product s) 
  (call/cc 
    (lambda (exit) 
      (let recur ((s s)) 
        (if (null? s)
          1 
          (if (zero? (car s))
            (exit 0) 
            (* (car s) (recur (cdr s)))))))))

(display (list-product '(1 2 0 3 4)))
(newline)
(display (list-product '(1 2 3 4)))
(newline)

; same fringe using purely functional approach

(define (same-fringe? tree1 tree2) 
  (let loop ((ftree1 (flatten tree1)) 
             (ftree2 (flatten tree2))) 
    (cond ((and (null? ftree1) (null? ftree2)) #t) 
          ((or (null? ftree1) (null? ftree2)) #f) 
          ((eq? (car ftree1) (car ftree2)) 
           (loop (cdr ftree1) (cdr ftree2))) 
          (else #f))))

(define (append2 x y)
  (cond
    ((null? x) y)
    (else
      (cons
        (car x)
        (append2 (cdr x) y)))))

(define (flatten tree) 
  (cond ((null? tree) '()) 
        ((pair? (car tree)) 
         (append2 (flatten (car tree)) 
                  (flatten (cdr tree)))) 
        (else 
         (cons (car tree) 
               (flatten (cdr tree))))))

(display (same-fringe? '(a (b c)) '((a b) c)) )
(newline)
(display (same-fringe? '(a b c) '(a (c b))) )
(newline)

; same fringe using call/cc

(define tree->generator 
  (lambda (tree) 
    (let ((caller '*)) 
      (letrec 
          ((generate-leaves 
            (lambda () 
              (let loop ((tree tree)) 
                (cond ((null? tree) 'skip) 
                      ((pair? tree) 
                       (loop (car tree)) 
                       (loop (cdr tree))) 
                      (else 
                       (call/cc 
                        (lambda (rest-of-tree) 
                          (set! generate-leaves 
                            (lambda () 
                              (rest-of-tree 'resume))) 
                          (caller tree)))))) 
              (caller '())))) 
        (lambda () 
          (call/cc 
           (lambda (k) 
             (set! caller k) 
             (generate-leaves)))))))) 

(define same-fringe? 
  (lambda (tree1 tree2) 
    (let ((gen1 (tree->generator tree1)) 
          (gen2 (tree->generator tree2))) 
      (let loop () 
        (let ((leaf1 (gen1)) 
              (leaf2 (gen2))) 
          (if (eq? leaf1 leaf2) 
              (if (null? leaf1) #t (loop)) 
              #f)))))) 

(display (same-fringe? '(a (b c)) '((a b) c)) )
(newline)
(display (same-fringe? '(a b c) '(a (c b))) )
(newline)

(display
  (call/cc
    (lambda (exit)
      (for-each
        (lambda (x)
          (if (negative? x)
            (exit x)))
        '(54 0 37 -3 245 19))
      #t)))
(newline)
