;;; Interpreter for lambda calculus expressions
;;; This code is a compilation of code presented in EOPL (2nd ed)
#lang racket
(require "chez-init.rkt")
(require racket/trace)

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

(define top-level-eval
  (lambda (form)
    (eval-expression form (halt-cont) (extend-env '(a b) '(3 4) (global-env)))))


(define eval-expression
  (lambda (exp cont env)
    (cases expression exp
      [lit-exp (val) (apply-cont cont val)]
      [var-exp (id) (apply-cont cont (apply-env env id))]
      [if-exp (test-exp iftrue-exp iffalse-exp)
              (eval-expression test-exp (if-cont iftrue-exp iffalse-exp cont env) env)]
               
      [else (error 'eval-expression "not implemented ~s" exp)])))
(trace eval-expression)
;;; Continuations

(define-datatype continuation continuation?
  (halt-cont)
  (if-cont
   (true-exp expression?)
   (false-exp expression?)
   (cont continuation?)
   (env list?)))


(define apply-cont
  (lambda (cont val)
    (cases continuation cont
	   [halt-cont () val]
	   [if-cont (if-true-exp if-false-exp next-cont env)
		    (if val
			(eval-expression if-true-exp next-cont env)
			(eval-expression if-false-exp next-cont env))])))
(trace apply-cont)



;;; parser

(define-datatype expression expression?
  (lit-exp
   (value anything?))
  (var-exp
   (id symbol?))
  (if-exp
   (test-exp expression?)
   (true-exp expression?)
   (false-exp expression?)))


(define anything?
  (lambda (v) #t))

(define parse-expression
  (lambda (datum)
    (cond [(symbol? datum) (var-exp datum)]
	  [(number? datum) (lit-exp datum)]
          [(boolean? datum) (lit-exp datum)]
	  [(pair? datum)
           (cond [(eq? (car datum) 'quote) (lit-exp (cadr datum))]
                 [(eqv? (car datum) 'if)
		  (if-exp (parse-expression (cadr datum))
			  (parse-expression (caddr datum))
			  (parse-expression (cadddr datum)))]
		 [(eqv? (car datum) 'quote)
		  (lit-exp (cadr datum))])]
	  [else (error 'parse-expression
			    "Invalid concrete syntax ~s" datum)])))



;;; Rib cage implementation using:
;;; A list of symbols and
;;; A vector of values

(define empty-env
  (lambda ()
    '()))

(define extend-env
  (lambda (syms vals env)
    (cons (cons syms (list->vector vals)) env)))

(define apply-env
  (lambda (env sym)
    (if (null? env)
	(error 'apply-env "No binding for ~s" sym)
	(let ([syms (car (car env))]
	      [vals (cdr (car env))]
	      [env (cdr env)])
	  (let ([pos (find-position sym syms)])
	    (if (number? pos)
		(vector-ref vals pos)
		(apply-env (cdr env) sym)))))))

(define find-position
  (lambda (sym ls)
    (cond [(null? ls) #f]
	  [(eq? sym (car ls)) 0]
	  [else (let ([index (find-position sym (cdr ls))])
		  (if (number? index)
		      (+ index 1)
		      #f))])))


(define global-env
  (lambda ()
    (empty-env)))