;;; Continuation-passing interpreter
;;; representing continuations as Scheme procedures.

(module interp (lib "eopl.ss" "eopl")
  
  (require "drscheme-init.scm")

  (require "lang.scm")
  (require "data-structures.scm")
  (require "environments.scm")

  (provide value-of-program value-of)

;;;;;;;;;;;;;;;; the interpreter ;;;;;;;;;;;;;;;;

  ;; the-top-level-environment : Env

  (define the-top-level-environment (init-env))

  ;; value-of-program : program -> Answer

  (define value-of-program 
    (lambda (pgm)
      (cases program pgm
        (a-program (defns exp)
          (set! the-top-level-environment
                (extend-env-with-defns defns (init-env)))
          (value-of exp
                    the-top-level-environment
                    (lambda (v) v))))))

  ;; extend-env-with-defns : Listof[definition] * Env -> Env

  (define extend-env-with-defns
    (lambda (defns env)
      (cond ((null? defns)
             env)
            (else
             (cases definition (car defns)
               (proc-definition (id bvars body)
                 (extend-env-with-defns
                  (cdr defns)
                  (extend-env id
                              (proc-val (procedure bvars body))
                              env))))))))

  ;; value-of : Exp * Env * Cont -> Answer

  (define value-of
    (lambda (exp env cont)
      (cases expression exp

        (lit-exp (num) (apply-cont cont (num-val num)))

        (var-exp (id)
          (let ((val (apply-env env id)))
            (if (expval? val)
                (apply-cont cont val)
                (eopl:error 'value-of "Unbound variable"))))

        (binop-exp (op exp1 exp2)
          (value-of exp1
                    env
                    (lambda (val1)
                      (value-of exp2
                                env
                                (lambda (val2)
                                  (apply-binop op val1 val2 cont))))))

        (if-exp (exp1 exp2 exp3)
          (value-of exp1
                    env
                    (lambda (val1)
                      (if (expval->bool val1)
                          (value-of exp2 env cont)
                          (value-of exp3 env cont)))))

        (call-exp (rator rands)
          (value-of rator
                    env
                    (lambda (val0)
                      (let ((proc (expval->proc val0)))
                        (values-of rands
                                   env
                                   (lambda (args)
                                     (apply-procedure proc args cont)))))))

        )))

  ;; values-of : Listof[Exp] * Env * MCont -> Answer

  (define values-of
    (lambda (exps env mcont)
      (cond ((null? exps)
             (apply-mcont mcont '()))
            (else
             (value-of (car exps)
                       env
                       (lambda (val)
                         (values-of (cdr exps)
                                    env
                                    (lambda (vals)
                                      (apply-mcont mcont
                                                   (cons val vals))))))))))

  ;; apply-binop : binop * ExpVal * ExpVal * Cont -> Answer

  (define apply-binop
    (lambda (op val1 val2 cont)
      (apply-cont
       cont
       (cases binop op
         (op-plus    () (num-val (+ (expval->num val1)
                                    (expval->num val2))))
         (op-minus   () (num-val (- (expval->num val1)
                                    (expval->num val2))))
         (op-times   () (num-val (* (expval->num val1)
                                    (expval->num val2))))
         (op-less    () (bool-val (< (expval->num val1)
                                     (expval->num val2))))
         (op-equal   () (bool-val (= (expval->num val1)
                                     (expval->num val2))))
         (op-greater () (bool-val (> (expval->num val1)
                                     (expval->num val2))))))))

  ;; apply-procedure : Proc * ExpVal * Cont -> Answer

  (define apply-procedure
    (lambda (proc1 args cont)
      (cases proc proc1
        (procedure (bvars body)
          (value-of body
                    (extend-env* bvars args the-top-level-environment)
                    cont)))))

  ;; apply-cont : Cont * ExpVal -> Answer

  (define apply-cont
    (lambda (cont val)
      (cont val)))

  ;; apply-mcont : MCont * Listof[ExpVal] -> Answer

  (define apply-mcont
    (lambda (mcont vals)
      (mcont vals)))
  
  )