;; 
;;; in racket:
  # lang scheme

(load "test-check.scm")
(load "pmatch.scm")
(load "sugar.scm")

;; Scheme

(+ 1 2)
(+ (+ 1 2) (+ 3 4))
(+ 3 7)
((lambda (x) (+ x 1)) 1)
((lambda () 1))
(if (= 1 1) 2 (/ 1 0))

((if (= 1 1) - +) 2 1)
(((lambda () +)) 1 2)
((lambda () (display "hello")))
+

(define a 1)
a
(define inc (lambda (x) (+ x 1)))
(inc 1)

(define adder
  (lambda (x)
    (lambda (y)
      (+ x y))))
(adder 1) ;; #<procedure>
  3

(cons 1
      (cons 2 '())
      )
  ( 1 . ' ( 2 . ' ( ) ) )
  ( 1 2 )
(cdr  (cons 'a 'd))
(pair? (cons 1 2)) ;; #t
(list? (cons 1 2)) ;; #f
(null? '()) ;; #t
(null? (cons 1 '())) ;; #f
(cons 'a (cons 'b 'c))

;;; Proper List
;;; either:
  ( 1 ) empty list
  ( 2 ) a pair whose cdr is a proper list

(cadr '(1 2 3))
(car (cdr '(1 2 3)))

(append '(1 2 3) '(4 5 6))
(define append
  (lambda (xs ys)
    (if (null? xs)
        ys
        (cons (car xs) (append (cdr xs) ys)))))

(define append
  (lambda (xs ys)
    (cond
     ((null? xs) ys)
     (else (cons (car xs) (append (cdr xs) ys))))))

(rember 'a '(a b c))   ;; '(b c)
(rember 'b '(a b c b)) ;; '(a c)
(rember 'b '(a (b a) c b)) ;; '(a (a) c)
(rember 'b '(a (b b (b) a b) c b))
(define rember
  (lambda (x xs)
    (cond
     ((null? xs) '())

     ((pair? (car xs))
      (cons (rember x (car xs))
            (rember x (cdr xs))))

     ((eq? x (car xs))
      (rember x (cdr xs)))
     (else
      (cons (car xs)
            (rember x (cdr xs)))))))


(define foo '(hello there))
`(,foo ,foo)
  ( 3 7 )
  ( 3 ( + 3 4 ) )

;;;; -------------------------------------------------

;; Interpreters

;;; Call-By-Value (same as in Scheme)

;;; x, y, z (variables)
;;; e = x           (variable)
;;;     (lambda (x) e_0) (abstraction)
;;;     (e_1 e_2)   (application)

;;; env: variable name -> value
(define empty-env
  (lambda (x) (error 'env-lookup "unbound variable")))

(define eval-exp
  (lambda (exp env)
    (pmatch
     exp
     (,x (guard (symbol? x)) (env x))
     (,n (guard (number? n)) n)
     (,b (guard (boolean? b)) b)
     ((zero? ,e)
      (zero? (eval-exp e env)))
     ((sub1 ,e)
      (sub1 (eval-exp e env)))
     ((* ,e1 ,e2)
      (* (eval-exp e1 env) (eval-exp e2 env)))
  ' ( if ( zero ? 1 ) 1 2 ) c will become ' ( zero ? 1 )
      (if (eval-exp c env)
          (eval-exp a env)
          (eval-exp b env)))
     ((lambda (,x) ,body) ;; lambda syntax
      (lambda (a) ;; closure representation
        (eval-exp body
                  (lambda (y) ;; env extension
                    (if (eq? y x)
                        a
                        (env y))))))
     ((,e1 ,e2)
      ((eval-exp e1 env)
       (eval-exp e2 env))))))

(define eval-top
  (lambda (exp)
    (eval-exp exp empty-env)))

(eg (eval-exp 'x
              (lambda (y) (if (eq? y 'x) 1 (empty-env y))))
    1)

(eg (eval-top '((lambda (x) 1) 2))
    1)

(eg (eval-exp '((lambda (x) x) 2)
              empty-env)
    2)

;; (eval-exp '((lambda (x) (x x)) (lambda (x) (x x))) empty-env)

(eg (eval-exp '((lambda (y) y) x)
              (lambda (y) (if (eq? y 'x) 1 (empty-env y))))
    1)

(eval-top '(((lambda (fun)
              ((lambda (F)
                 (F F))
               (lambda (F)
                 (fun (lambda (x) ((F F) x))))))
            (lambda (factorial)
              (lambda (n)
                (if (zero? n)
                    1
                    (* n (factorial (sub1 n)))))))
           6))

  Program Transformations

  CPS : continuation - passing style

;;; continuations
;;; representation of the rest of the work to be done

(+ 1 2 (+ 3 4))
((lambda (v) v) (+ 1 2 (+ 3 4)))
  12
((lambda (v) (+ 1 v (+ 3 4))) 2)

(+ (+ 1 2) (+ 3 4))
((lambda (v) (+ v (+ 3 4))) (+ 1 2))
((lambda (v) (+ (+ 1 2) v)) (+ 3 4))

(lambda (v) v) ;; identity continuation

  Continuation - Passing Style

;;; direct-style
(define factorial
  (lambda (n)
    (if (= n 0)
        1
        (* n (factorial (- n 1))))))
(trace factorial)
;;(factorial -1)

;;; accumulator
(define factorial-iter
  (lambda (n acc)
    (if (= n 0)
        acc
        (factorial-iter (- n 1) (* acc n)))))
(define factorial
  (lambda (n)
    (factorial-iter n 1)))
(trace factorial-iter)
;;(factorial -1)

;;; Steps
;;; - Change the name with -cps.
;;; - Add k argument to lambda.
;;; - Return by applying k.
;;; - Serious calls need to be transformed.

(define factorial-cps
  (lambda (n k)
    (if (= n 0)
        (k 1)
        (factorial-cps (- n 1) (lambda (v)
                                 (k (* n v)))))))
(define factorial
  (lambda (n)
    (factorial-cps n (lambda (v) v))))
(factorial 5)
(trace factorial-cps)

;;; direct-style
(define fib
  (lambda (n)
    (if (< n 2) n
        (+ (fib (- n 1)) (fib (- n 2))))))

(define fib-cps
  (lambda (n k)
    (if (< n 2) (k n)
        (fib-cps (- n 2)
                 (lambda (v2)
                   (fib-cps (- n 1) (lambda (v1)
                                      (k (+ v1 v2)))))))))
(define fib
  (lambda (n)
    (fib-cps n (lambda (v) v))))
(fib 5)

;;; Trampolining

(define factorial-cps
  (lambda (n k)
    (lambda ()
      (if (= n 0)
          (k 1)
          (factorial-cps (- n 1) (lambda (v)
                                   (k (* n v))))))))

(define factorial-cps
  (lambda (n k)
    (if (= n 0)
        (lambda () (k 1))
        (lambda () (factorial-cps (- n 1) (lambda (v)
                                       (k (* n v))))))))
(define factorial
  (lambda (n)
    (let ((r (factorial-cps n (lambda (v) v))))
      (while (procedure? r)
             (set! r (r)) ;; body of the while
             r)) ;; return after the while
    ))

(define factorial
  (lambda (n)
    (let loop ((r (factorial-cps n (lambda (v) v))))
      (if (procedure? r)
          (loop (r))
          r))))

  CPS - ing interpreter

(define empty-env
  (lambda (x) (error 'env-lookup "unbound variable")))

(define eval-exp-cps
  (lambda (exp env k)
    (pmatch
     exp
     (,x (guard (symbol? x)) (k (env x)))
     (,n (guard (number? n)) (k n))
     (,b (guard (boolean? b)) (k b))
     ((zero? ,e)
      (eval-exp-cps e env (lambda (v)
                            (k (zero? v)))))
     ((sub1 ,e)
      (eval-exp-cps e env (lambda (v)
                            (k (sub1 v)))))
     ((* ,e1 ,e2)
      (eval-exp-cps e1 env (lambda (v1)
                             (eval-exp-cps e2 env (lambda (v2)
                                                    (k (* v1 v2)))))))
     ((if ,c ,a ,b)
      (eval-exp-cps c env (lambda (vc)
                            (if vc
                                (eval-exp-cps a env k)
                                (eval-exp-cps b env k)))))
     ((lambda (,x) ,body)
      (k (lambda (a k^)
           (eval-exp-cps body
                         (lambda (y)
                           (if (eq? y x)
                               a
                               (env y)))
                         k^))))
     ((,e1 ,e2)
      (eval-exp-cps e1 env (lambda (p)
                             (eval-exp-cps e2 env (lambda (a)
                                                    (p a k)))))))))

(define eval-top
  (lambda (exp)
    (eval-exp-cps exp empty-env (lambda (v) v))))

(trace eval-exp-cps)
(eg (eval-top '((lambda (x) 1) 2))
    1)

(eval-top '(((lambda (fun)
              ((lambda (F)
                 (F F))
               (lambda (F)
                 (fun (lambda (x) ((F F) x))))))
            (lambda (factorial)
              (lambda (n)
                (if (zero? n)
                    1
                    (* n (factorial (sub1 n)))))))
           6))

  Representation Independence wrt to Continuations
(let ()
  (define apply-k
    (lambda (k v)
      (k v)))

  (define empty-k
    (lambda ()
      (lambda (v) v)))

  (define factorial-k
    (lambda (n k)
       (lambda (v)
         (apply-k k (* n v)))))

  (define factorial-cps
    (lambda (n k)
      (if (= n 0)
          (apply-k k 1)
          (factorial-cps (- n 1)
                         (factorial-k n k)))))
  (define factorial
    (lambda (n)
      (factorial-cps n (empty-k))))

  (eg (factorial 5) 120)
  )

;;; First-Order Representation for continuations
;;; Defunctionalization

(let ()
  (trace-define apply-k
    (lambda (k^ v)
      (pmatch
       k^
       ((empty-k)
        v)
       ((factorial-k ,n ,k)
        (apply-k k (* n v)))
       ;(,k^ (guard (procedure? k^))
       ;     (k^ v))
       )))

  (define empty-k
    (lambda ()
      `(empty-k)))

  (define factorial-k
    (lambda (n k)
      `(factorial-k ,n ,k)))

  (trace-define factorial-cps
    (lambda (n k)
      (if (= n 0)
          (apply-k k 1)
          (factorial-cps (- n 1)
                         (factorial-k n k)))))
  (define factorial
    (lambda (n)
      (factorial-cps n (empty-k))))

  (eg (factorial 5) 120)
  )

  Representation Independence wrt environment
(let ()

  (define apply-env
    (lambda (env x)
      (env x)))

  (define empty-env
    (lambda ()
      (lambda (x) (error 'env-lookup "unbound variable"))))

  (define extend-env
    (lambda  (x a env)
      (lambda (y)
        (if (eq? y x)
            a
            (apply-env env y)))))

(define eval-exp-cps
  (lambda (exp env k)
    (pmatch
     exp
     (,x (guard (symbol? x)) (k (apply-env env x)))
     (,n (guard (number? n)) (k n))
     (,b (guard (boolean? b)) (k b))
     ((zero? ,e)
      (eval-exp-cps e env (lambda (v)
                            (k (zero? v)))))
     ((sub1 ,e)
      (eval-exp-cps e env (lambda (v)
                            (k (sub1 v)))))
     ((* ,e1 ,e2)
      (eval-exp-cps e1 env (lambda (v1)
                             (eval-exp-cps e2 env (lambda (v2)
                                                    (k (* v1 v2)))))))
     ((if ,c ,a ,b)
      (eval-exp-cps c env (lambda (vc)
                            (if vc
                                (eval-exp-cps a env k)
                                (eval-exp-cps b env k)))))
     ((lambda (,x) ,body)
      (k (lambda (a k^)
           (eval-exp-cps body
                         (extend-env x a env)
                         k^))))
     ((,e1 ,e2)
      (eval-exp-cps e1 env (lambda (p)
                             (eval-exp-cps e2 env (lambda (a)
                                                    (p a k)))))))))

(define eval-top
  (lambda (exp)
    (eval-exp-cps exp (empty-env) (lambda (v) v))))

(eg (eval-top '((lambda (x) 1) 2))
    1)

(eval-top '(((lambda (fun)
              ((lambda (F)
                 (F F))
               (lambda (F)
                 (fun (lambda (x) ((F F) x))))))
            (lambda (factorial)
              (lambda (n)
                (if (zero? n)
                    1
                    (* n (factorial (sub1 n)))))))
           6))
)

;;;
(let ()

  (define apply-env
    (lambda (env^ y)
      (pmatch
       env^
       ((empty-env)
        (error 'apply-env "unbound variable"))
       ((extend-env ,x ,a ,env)
        (if (eq? y x)
            a
            (apply-env env y)))
       (,env^ (guard (procedure? env^))
        (env^ x)))))

  (define empty-env
    (lambda ()
      `(empty-env)))

  (define extend-env
    (lambda  (x a env)
      `(extend-env ,x ,a ,env)))

(trace-define eval-exp-cps
  (lambda (exp env k)
    (pmatch
     exp
     (,x (guard (symbol? x)) (k (apply-env env x)))
     (,n (guard (number? n)) (k n))
     (,b (guard (boolean? b)) (k b))
     ((zero? ,e)
      (eval-exp-cps e env (lambda (v)
                            (k (zero? v)))))
     ((sub1 ,e)
      (eval-exp-cps e env (lambda (v)
                            (k (sub1 v)))))
     ((* ,e1 ,e2)
      (eval-exp-cps e1 env (lambda (v1)
                             (eval-exp-cps e2 env (lambda (v2)
                                                    (k (* v1 v2)))))))
     ((if ,c ,a ,b)
      (eval-exp-cps c env (lambda (vc)
                            (if vc
                                (eval-exp-cps a env k)
                                (eval-exp-cps b env k)))))
     ((lambda (,x) ,body)
      (k (lambda (a k^)
           (eval-exp-cps body
                         (extend-env x a env)
                         k^))))
     ((,e1 ,e2)
      (eval-exp-cps e1 env (lambda (p)
                             (eval-exp-cps e2 env (lambda (a)
                                                    (p a k)))))))))

(define eval-top
  (lambda (exp)
    (eval-exp-cps exp (empty-env) (lambda (v) v))))

(eg (eval-top '((lambda (x) 1) 2))
    1)

(eval-top '(((lambda (fun)
              ((lambda (F)
                 (F F))
               (lambda (F)
                 (fun (lambda (x) ((F F) x))))))
            (lambda (factorial)
              (lambda (n)
                (if (zero? n)
                    1
                    (* n (factorial (sub1 n)))))))
           6))
)

(let ()

  (define apply-env
    (lambda (env^ y)
      (cond
       ((assq y env^) => cdr)
       (else (error 'apply-env "unbound variable")))))

  (define empty-env
    (lambda ()
      `()))

  (define extend-env
    (lambda  (x a env)
      (cons (cons x a) env)))

(trace-define eval-exp-cps
  (lambda (exp env k)
    (pmatch
     exp
     (,x (guard (symbol? x)) (k (apply-env env x)))
     (,n (guard (number? n)) (k n))
     (,b (guard (boolean? b)) (k b))
     ((zero? ,e)
      (eval-exp-cps e env (lambda (v)
                            (k (zero? v)))))
     ((sub1 ,e)
      (eval-exp-cps e env (lambda (v)
                            (k (sub1 v)))))
     ((* ,e1 ,e2)
      (eval-exp-cps e1 env (lambda (v1)
                             (eval-exp-cps e2 env (lambda (v2)
                                                    (k (* v1 v2)))))))
     ((if ,c ,a ,b)
      (eval-exp-cps c env (lambda (vc)
                            (if vc
                                (eval-exp-cps a env k)
                                (eval-exp-cps b env k)))))
     ((lambda (,x) ,body)
      (k (lambda (a k^)
           (eval-exp-cps body
                         (extend-env x a env)
                         k^))))
     ((,e1 ,e2)
      (eval-exp-cps e1 env (lambda (p)
                             (eval-exp-cps e2 env (lambda (a)
                                                    (p a k)))))))))

(define eval-top
  (lambda (exp)
    (eval-exp-cps exp (empty-env) (lambda (v) v))))

(eg (eval-top '((lambda (x) 1) 2))
    1)

(eval-top '(((lambda (fun)
              ((lambda (F)
                 (F F))
               (lambda (F)
                 (fun (lambda (x) ((F F) x))))))
            (lambda (factorial)
              (lambda (n)
                (if (zero? n)
                    1
                    (* n (factorial (sub1 n)))))))
           6))
)

;;; adding call/cc

(let ()

  (define apply-env
    (lambda (env^ y)
      (cond
       ((assq y env^) => cdr)
       (else (error 'apply-env "unbound variable")))))

  (define empty-env
    (lambda ()
      `()))

  (define extend-env
    (lambda  (x a env)
      (cons (cons x a) env)))

(trace-define eval-exp-cps
  (lambda (exp env k)
    (pmatch
     exp
     (,x (guard (symbol? x)) (k (apply-env env x)))
     (,n (guard (number? n)) (k n))
     (,b (guard (boolean? b)) (k b))
     ((zero? ,e)
      (eval-exp-cps e env (lambda (v)
                            (k (zero? v)))))
     ((sub1 ,e)
      (eval-exp-cps e env (lambda (v)
                            (k (sub1 v)))))
     ((* ,e1 ,e2)
      (eval-exp-cps e1 env (lambda (v1)
                             (eval-exp-cps e2 env (lambda (v2)
                                                    (k (* v1 v2)))))))
     ((if ,c ,a ,b)
      (eval-exp-cps c env (lambda (vc)
                            (if vc
                                (eval-exp-cps a env k)
                                (eval-exp-cps b env k)))))
     ((call/cc ,e) ;; (call/cc (lambda (cont) ...))
      (eval-exp-cps e env (lambda (p)
                            (p (lambda (v k^) (k v)) k))))
     ((lambda (,x) ,body)
      (k (lambda (a k^)
           (eval-exp-cps body
                         (extend-env x a env)
                         k^))))
     ((,e1 ,e2)
      (eval-exp-cps e1 env (lambda (p)
                             (eval-exp-cps e2 env (lambda (a)
                                                    (p a k)))))))))

(define eval-top
  (lambda (exp)
    (eval-exp-cps exp (empty-env) (lambda (v) v))))

(eg (eval-top '((lambda (x) 1) 2))
    1)

(eval-top '(((lambda (fun)
              ((lambda (F)
                 (F F))
               (lambda (F)
                 (fun (lambda (x) ((F F) x))))))
            (lambda (factorial)
              (lambda (n)
                (if (zero? n)
                    1
                    (* n (factorial (sub1 n)))))))
            6))
(eg (eval-top '(call/cc (lambda (k) (* 3 2))))
    6)

(eg (eval-top '(call/cc (lambda (k) (* 3 (k 2)))))
    2)

(eg (eval-top '(call/cc (lambda (k) (* (k 2) 0))))
    2)

(eg (eval-top '(* 3 (call/cc (lambda (k) (* (k 2) 0)))))
    6)
)


 
 in racket:
 Scheme
 #<procedure>
 #t
 #f
 #t
 #f
 Proper List
 either:
 '(b c)
 '(a c)
 '(a (a) c)
 -------------------------------------------------
 Interpreters
 Call-By-Value (same as in Scheme)
 x, y, z (variables)
 e = x           (variable)
     (lambda (x) e_0) (abstraction)
     (e_1 e_2)   (application)
 env: variable name -> value
 lambda syntax
 closure representation
 env extension
 (eval-exp '((lambda (x) (x x)) (lambda (x) (x x))) empty-env)
 continuations
 representation of the rest of the work to be done
 identity continuation
 direct-style
(factorial -1)
 accumulator
(factorial -1)
 Steps
 - Change the name with -cps.
 - Add k argument to lambda.
 - Return by applying k.
 - Serious calls need to be transformed.
 direct-style
 Trampolining
 body of the while
 return after the while
 First-Order Representation for continuations
 Defunctionalization
(,k^ (guard (procedure? k^))
     (k^ v))

 adding call/cc
 (call/cc (lambda (cont) ...))
  # lang scheme

(load "test-check.scm")
(load "pmatch.scm")
(load "sugar.scm")


(+ 1 2)
(+ (+ 1 2) (+ 3 4))
(+ 3 7)
((lambda (x) (+ x 1)) 1)
((lambda () 1))
(if (= 1 1) 2 (/ 1 0))

((if (= 1 1) - +) 2 1)
(((lambda () +)) 1 2)
((lambda () (display "hello")))
+

(define a 1)
a
(define inc (lambda (x) (+ x 1)))
(inc 1)

(define adder
  (lambda (x)
    (lambda (y)
      (+ x y))))
  3

(cons 1
      (cons 2 '())
      )
  ( 1 . ' ( 2 . ' ( ) ) )
  ( 1 2 )
(cdr  (cons 'a 'd))
(cons 'a (cons 'b 'c))

  ( 1 ) empty list
  ( 2 ) a pair whose cdr is a proper list

(cadr '(1 2 3))
(car (cdr '(1 2 3)))

(append '(1 2 3) '(4 5 6))
(define append
  (lambda (xs ys)
    (if (null? xs)
        ys
        (cons (car xs) (append (cdr xs) ys)))))

(define append
  (lambda (xs ys)
    (cond
     ((null? xs) ys)
     (else (cons (car xs) (append (cdr xs) ys))))))

(rember 'b '(a (b b (b) a b) c b))
(define rember
  (lambda (x xs)
    (cond
     ((null? xs) '())

     ((pair? (car xs))
      (cons (rember x (car xs))
            (rember x (cdr xs))))

     ((eq? x (car xs))
      (rember x (cdr xs)))
     (else
      (cons (car xs)
            (rember x (cdr xs)))))))


(define foo '(hello there))
`(,foo ,foo)
  ( 3 7 )
  ( 3 ( + 3 4 ) )





(define empty-env
  (lambda (x) (error 'env-lookup "unbound variable")))

(define eval-exp
  (lambda (exp env)
    (pmatch
     exp
     (,x (guard (symbol? x)) (env x))
     (,n (guard (number? n)) n)
     (,b (guard (boolean? b)) b)
     ((zero? ,e)
      (zero? (eval-exp e env)))
     ((sub1 ,e)
      (sub1 (eval-exp e env)))
     ((* ,e1 ,e2)
      (* (eval-exp e1 env) (eval-exp e2 env)))
  ' ( if ( zero ? 1 ) 1 2 ) c will become ' ( zero ? 1 )
      (if (eval-exp c env)
          (eval-exp a env)
          (eval-exp b env)))
        (eval-exp body
                    (if (eq? y x)
                        a
                        (env y))))))
     ((,e1 ,e2)
      ((eval-exp e1 env)
       (eval-exp e2 env))))))

(define eval-top
  (lambda (exp)
    (eval-exp exp empty-env)))

(eg (eval-exp 'x
              (lambda (y) (if (eq? y 'x) 1 (empty-env y))))
    1)

(eg (eval-top '((lambda (x) 1) 2))
    1)

(eg (eval-exp '((lambda (x) x) 2)
              empty-env)
    2)


(eg (eval-exp '((lambda (y) y) x)
              (lambda (y) (if (eq? y 'x) 1 (empty-env y))))
    1)

(eval-top '(((lambda (fun)
              ((lambda (F)
                 (F F))
               (lambda (F)
                 (fun (lambda (x) ((F F) x))))))
            (lambda (factorial)
              (lambda (n)
                (if (zero? n)
                    1
                    (* n (factorial (sub1 n)))))))
           6))

  Program Transformations

  CPS : continuation - passing style


(+ 1 2 (+ 3 4))
((lambda (v) v) (+ 1 2 (+ 3 4)))
  12
((lambda (v) (+ 1 v (+ 3 4))) 2)

(+ (+ 1 2) (+ 3 4))
((lambda (v) (+ v (+ 3 4))) (+ 1 2))
((lambda (v) (+ (+ 1 2) v)) (+ 3 4))


  Continuation - Passing Style

(define factorial
  (lambda (n)
    (if (= n 0)
        1
        (* n (factorial (- n 1))))))
(trace factorial)

(define factorial-iter
  (lambda (n acc)
    (if (= n 0)
        acc
        (factorial-iter (- n 1) (* acc n)))))
(define factorial
  (lambda (n)
    (factorial-iter n 1)))
(trace factorial-iter)


(define factorial-cps
  (lambda (n k)
    (if (= n 0)
        (k 1)
        (factorial-cps (- n 1) (lambda (v)
                                 (k (* n v)))))))
(define factorial
  (lambda (n)
    (factorial-cps n (lambda (v) v))))
(factorial 5)
(trace factorial-cps)

(define fib
  (lambda (n)
    (if (< n 2) n
        (+ (fib (- n 1)) (fib (- n 2))))))

(define fib-cps
  (lambda (n k)
    (if (< n 2) (k n)
        (fib-cps (- n 2)
                 (lambda (v2)
                   (fib-cps (- n 1) (lambda (v1)
                                      (k (+ v1 v2)))))))))
(define fib
  (lambda (n)
    (fib-cps n (lambda (v) v))))
(fib 5)


(define factorial-cps
  (lambda (n k)
    (lambda ()
      (if (= n 0)
          (k 1)
          (factorial-cps (- n 1) (lambda (v)
                                   (k (* n v))))))))

(define factorial-cps
  (lambda (n k)
    (if (= n 0)
        (lambda () (k 1))
        (lambda () (factorial-cps (- n 1) (lambda (v)
                                       (k (* n v))))))))
(define factorial
  (lambda (n)
    (let ((r (factorial-cps n (lambda (v) v))))
      (while (procedure? r)
    ))

(define factorial
  (lambda (n)
    (let loop ((r (factorial-cps n (lambda (v) v))))
      (if (procedure? r)
          (loop (r))
          r))))

  CPS - ing interpreter

(define empty-env
  (lambda (x) (error 'env-lookup "unbound variable")))

(define eval-exp-cps
  (lambda (exp env k)
    (pmatch
     exp
     (,x (guard (symbol? x)) (k (env x)))
     (,n (guard (number? n)) (k n))
     (,b (guard (boolean? b)) (k b))
     ((zero? ,e)
      (eval-exp-cps e env (lambda (v)
                            (k (zero? v)))))
     ((sub1 ,e)
      (eval-exp-cps e env (lambda (v)
                            (k (sub1 v)))))
     ((* ,e1 ,e2)
      (eval-exp-cps e1 env (lambda (v1)
                             (eval-exp-cps e2 env (lambda (v2)
                                                    (k (* v1 v2)))))))
     ((if ,c ,a ,b)
      (eval-exp-cps c env (lambda (vc)
                            (if vc
                                (eval-exp-cps a env k)
                                (eval-exp-cps b env k)))))
     ((lambda (,x) ,body)
      (k (lambda (a k^)
           (eval-exp-cps body
                         (lambda (y)
                           (if (eq? y x)
                               a
                               (env y)))
                         k^))))
     ((,e1 ,e2)
      (eval-exp-cps e1 env (lambda (p)
                             (eval-exp-cps e2 env (lambda (a)
                                                    (p a k)))))))))

(define eval-top
  (lambda (exp)
    (eval-exp-cps exp empty-env (lambda (v) v))))

(trace eval-exp-cps)
(eg (eval-top '((lambda (x) 1) 2))
    1)

(eval-top '(((lambda (fun)
              ((lambda (F)
                 (F F))
               (lambda (F)
                 (fun (lambda (x) ((F F) x))))))
            (lambda (factorial)
              (lambda (n)
                (if (zero? n)
                    1
                    (* n (factorial (sub1 n)))))))
           6))

  Representation Independence wrt to Continuations
(let ()
  (define apply-k
    (lambda (k v)
      (k v)))

  (define empty-k
    (lambda ()
      (lambda (v) v)))

  (define factorial-k
    (lambda (n k)
       (lambda (v)
         (apply-k k (* n v)))))

  (define factorial-cps
    (lambda (n k)
      (if (= n 0)
          (apply-k k 1)
          (factorial-cps (- n 1)
                         (factorial-k n k)))))
  (define factorial
    (lambda (n)
      (factorial-cps n (empty-k))))

  (eg (factorial 5) 120)
  )


(let ()
  (trace-define apply-k
    (lambda (k^ v)
      (pmatch
       k^
       ((empty-k)
        v)
       ((factorial-k ,n ,k)
        (apply-k k (* n v)))
       )))

  (define empty-k
    (lambda ()
      `(empty-k)))

  (define factorial-k
    (lambda (n k)
      `(factorial-k ,n ,k)))

  (trace-define factorial-cps
    (lambda (n k)
      (if (= n 0)
          (apply-k k 1)
          (factorial-cps (- n 1)
                         (factorial-k n k)))))
  (define factorial
    (lambda (n)
      (factorial-cps n (empty-k))))

  (eg (factorial 5) 120)
  )

  Representation Independence wrt environment
(let ()

  (define apply-env
    (lambda (env x)
      (env x)))

  (define empty-env
    (lambda ()
      (lambda (x) (error 'env-lookup "unbound variable"))))

  (define extend-env
    (lambda  (x a env)
      (lambda (y)
        (if (eq? y x)
            a
            (apply-env env y)))))

(define eval-exp-cps
  (lambda (exp env k)
    (pmatch
     exp
     (,x (guard (symbol? x)) (k (apply-env env x)))
     (,n (guard (number? n)) (k n))
     (,b (guard (boolean? b)) (k b))
     ((zero? ,e)
      (eval-exp-cps e env (lambda (v)
                            (k (zero? v)))))
     ((sub1 ,e)
      (eval-exp-cps e env (lambda (v)
                            (k (sub1 v)))))
     ((* ,e1 ,e2)
      (eval-exp-cps e1 env (lambda (v1)
                             (eval-exp-cps e2 env (lambda (v2)
                                                    (k (* v1 v2)))))))
     ((if ,c ,a ,b)
      (eval-exp-cps c env (lambda (vc)
                            (if vc
                                (eval-exp-cps a env k)
                                (eval-exp-cps b env k)))))
     ((lambda (,x) ,body)
      (k (lambda (a k^)
           (eval-exp-cps body
                         (extend-env x a env)
                         k^))))
     ((,e1 ,e2)
      (eval-exp-cps e1 env (lambda (p)
                             (eval-exp-cps e2 env (lambda (a)
                                                    (p a k)))))))))

(define eval-top
  (lambda (exp)
    (eval-exp-cps exp (empty-env) (lambda (v) v))))

(eg (eval-top '((lambda (x) 1) 2))
    1)

(eval-top '(((lambda (fun)
              ((lambda (F)
                 (F F))
               (lambda (F)
                 (fun (lambda (x) ((F F) x))))))
            (lambda (factorial)
              (lambda (n)
                (if (zero? n)
                    1
                    (* n (factorial (sub1 n)))))))
           6))
)

(let ()

  (define apply-env
    (lambda (env^ y)
      (pmatch
       env^
       ((empty-env)
        (error 'apply-env "unbound variable"))
       ((extend-env ,x ,a ,env)
        (if (eq? y x)
            a
            (apply-env env y)))
       (,env^ (guard (procedure? env^))
        (env^ x)))))

  (define empty-env
    (lambda ()
      `(empty-env)))

  (define extend-env
    (lambda  (x a env)
      `(extend-env ,x ,a ,env)))

(trace-define eval-exp-cps
  (lambda (exp env k)
    (pmatch
     exp
     (,x (guard (symbol? x)) (k (apply-env env x)))
     (,n (guard (number? n)) (k n))
     (,b (guard (boolean? b)) (k b))
     ((zero? ,e)
      (eval-exp-cps e env (lambda (v)
                            (k (zero? v)))))
     ((sub1 ,e)
      (eval-exp-cps e env (lambda (v)
                            (k (sub1 v)))))
     ((* ,e1 ,e2)
      (eval-exp-cps e1 env (lambda (v1)
                             (eval-exp-cps e2 env (lambda (v2)
                                                    (k (* v1 v2)))))))
     ((if ,c ,a ,b)
      (eval-exp-cps c env (lambda (vc)
                            (if vc
                                (eval-exp-cps a env k)
                                (eval-exp-cps b env k)))))
     ((lambda (,x) ,body)
      (k (lambda (a k^)
           (eval-exp-cps body
                         (extend-env x a env)
                         k^))))
     ((,e1 ,e2)
      (eval-exp-cps e1 env (lambda (p)
                             (eval-exp-cps e2 env (lambda (a)
                                                    (p a k)))))))))

(define eval-top
  (lambda (exp)
    (eval-exp-cps exp (empty-env) (lambda (v) v))))

(eg (eval-top '((lambda (x) 1) 2))
    1)

(eval-top '(((lambda (fun)
              ((lambda (F)
                 (F F))
               (lambda (F)
                 (fun (lambda (x) ((F F) x))))))
            (lambda (factorial)
              (lambda (n)
                (if (zero? n)
                    1
                    (* n (factorial (sub1 n)))))))
           6))
)

(let ()

  (define apply-env
    (lambda (env^ y)
      (cond
       ((assq y env^) => cdr)
       (else (error 'apply-env "unbound variable")))))

  (define empty-env
    (lambda ()
      `()))

  (define extend-env
    (lambda  (x a env)
      (cons (cons x a) env)))

(trace-define eval-exp-cps
  (lambda (exp env k)
    (pmatch
     exp
     (,x (guard (symbol? x)) (k (apply-env env x)))
     (,n (guard (number? n)) (k n))
     (,b (guard (boolean? b)) (k b))
     ((zero? ,e)
      (eval-exp-cps e env (lambda (v)
                            (k (zero? v)))))
     ((sub1 ,e)
      (eval-exp-cps e env (lambda (v)
                            (k (sub1 v)))))
     ((* ,e1 ,e2)
      (eval-exp-cps e1 env (lambda (v1)
                             (eval-exp-cps e2 env (lambda (v2)
                                                    (k (* v1 v2)))))))
     ((if ,c ,a ,b)
      (eval-exp-cps c env (lambda (vc)
                            (if vc
                                (eval-exp-cps a env k)
                                (eval-exp-cps b env k)))))
     ((lambda (,x) ,body)
      (k (lambda (a k^)
           (eval-exp-cps body
                         (extend-env x a env)
                         k^))))
     ((,e1 ,e2)
      (eval-exp-cps e1 env (lambda (p)
                             (eval-exp-cps e2 env (lambda (a)
                                                    (p a k)))))))))

(define eval-top
  (lambda (exp)
    (eval-exp-cps exp (empty-env) (lambda (v) v))))

(eg (eval-top '((lambda (x) 1) 2))
    1)

(eval-top '(((lambda (fun)
              ((lambda (F)
                 (F F))
               (lambda (F)
                 (fun (lambda (x) ((F F) x))))))
            (lambda (factorial)
              (lambda (n)
                (if (zero? n)
                    1
                    (* n (factorial (sub1 n)))))))
           6))
)


(let ()

  (define apply-env
    (lambda (env^ y)
      (cond
       ((assq y env^) => cdr)
       (else (error 'apply-env "unbound variable")))))

  (define empty-env
    (lambda ()
      `()))

  (define extend-env
    (lambda  (x a env)
      (cons (cons x a) env)))

(trace-define eval-exp-cps
  (lambda (exp env k)
    (pmatch
     exp
     (,x (guard (symbol? x)) (k (apply-env env x)))
     (,n (guard (number? n)) (k n))
     (,b (guard (boolean? b)) (k b))
     ((zero? ,e)
      (eval-exp-cps e env (lambda (v)
                            (k (zero? v)))))
     ((sub1 ,e)
      (eval-exp-cps e env (lambda (v)
                            (k (sub1 v)))))
     ((* ,e1 ,e2)
      (eval-exp-cps e1 env (lambda (v1)
                             (eval-exp-cps e2 env (lambda (v2)
                                                    (k (* v1 v2)))))))
     ((if ,c ,a ,b)
      (eval-exp-cps c env (lambda (vc)
                            (if vc
                                (eval-exp-cps a env k)
                                (eval-exp-cps b env k)))))
      (eval-exp-cps e env (lambda (p)
                            (p (lambda (v k^) (k v)) k))))
     ((lambda (,x) ,body)
      (k (lambda (a k^)
           (eval-exp-cps body
                         (extend-env x a env)
                         k^))))
     ((,e1 ,e2)
      (eval-exp-cps e1 env (lambda (p)
                             (eval-exp-cps e2 env (lambda (a)
                                                    (p a k)))))))))

(define eval-top
  (lambda (exp)
    (eval-exp-cps exp (empty-env) (lambda (v) v))))

(eg (eval-top '((lambda (x) 1) 2))
    1)

(eval-top '(((lambda (fun)
              ((lambda (F)
                 (F F))
               (lambda (F)
                 (fun (lambda (x) ((F F) x))))))
            (lambda (factorial)
              (lambda (n)
                (if (zero? n)
                    1
                    (* n (factorial (sub1 n)))))))
            6))
(eg (eval-top '(call/cc (lambda (k) (* 3 2))))
    6)

(eg (eval-top '(call/cc (lambda (k) (* 3 (k 2)))))
    2)

(eg (eval-top '(call/cc (lambda (k) (* (k 2) 0))))
    2)

(eg (eval-top '(* 3 (call/cc (lambda (k) (* (k 2) 0)))))
    6)
)

