(load "chez-init.ss")
(load "env.ss")
(load "cont.ss")
(load "parser.ss")
(define (rl) (load "interpreter.ss"))

(define eval-one-exp
  (lambda (exp)
    (top-level-eval (parse-expression exp))))


(define rep
  (lambda ()
    (display ">> ")
    (let ([input (read)])
      (if (equal? input '(exit))
	  (printf "Bye...~%")
	  (let* ([parse-tree (parse-expression input)]
		 [response (top-level-eval parse-tree)])
	    response
	    (rep))))))


(define top-level-eval
  (lambda (form)
    (eval-expression form (halt-cont) global-env)))


(define eval-expression
  (lambda (exp cont env)
    (cases expression exp
	   [lit-exp (val) (apply-cont cont val)]
	   [var-exp (sym) (apply-cont cont (apply-env env sym))]
           [let-exp (syms vals bodies)
		    (eval-expressions-cps vals (let-cont syms bodies env cont) env)]
           [set-exp (sym val)
		    (eval-expression val (change-cont sym env cont) env)]
	   [for-exp (init-exp test-exp update-exps body)
		    (eval-expression init-exp (for-init-cont test-exp update-exps body env cont) env)]
	   [or-exp (exps)
		   (if (null? exps)
		       (apply-cont cont #f)
		       (eval-expression (car exps) (or-cont (cdr exps) env cont) env))]
	   [if-exp (test-exp true-exp false-exp)
		   (eval-expression test-exp
				    (if-cont true-exp false-exp cont env)
				    env)]
           [app-exp (all-of-it)
		    (eval-expressions-cps all-of-it
					  (proc-cont cont)
					  env)]
	   [else (eopl:error 'eval-expression
			     "Invalid expression ~s" expression)])))


(define eval-expressions-cps
  (lambda (exps cont env)
    (if (null? exps)
	(apply-cont cont '())
	(eval-expression (car exps) (eval-exps-cont (cdr exps) cont env) env))))


(define eval-bodies
  (lambda (exps k env)
    (if (null? (cdr exps))
	(eval-expression (car exps) k env)
	(eval-expression (car exps)
			 (eval-bodies-cont (cdr exps) k env)
			 env))))


(define apply-primitive-procedure
  (lambda (name args cont)
    (apply-cont cont 
		(case name
		  [(+) (apply + args)]
		  [(*) (apply * args)]
		  [(/) (apply / args)]
		  [(-) (apply - args)]
		  [(<) (< (car args) (cadr args))]
		  [(list) args]
		  [(cons) (cons (car args) (cadr args))]
		  [(=) (= (car args) (cadr args))]
		  [(car) (caar args)]
		  [(cdr) (cdar args)]
		  [(display) (car args)]))))


(define-datatype proc proc?
  [primitive
   (name symbol?)])


(define primitive-procedure-names '(+ - * / display list cons car cdr = <))

(define global-env
  (extend-env primitive-procedure-names
	      (map primitive primitive-procedure-names)
	      (empty-env)))