(module interp (lib "eopl.ss" "eopl")
  
  (let ((time-stamp "Time-stamp: <2005-01-31 22:12:10 Owner>"))
    (eopl:printf "lang3-3/interp.scm ~a~%"
      (substring time-stamp 13 29)))


  (require "../drscheme-init.scm")
 
  (require "lang.scm")
  (require "apply-primitive.scm")
  (require "letrec3.scm") ; choose 1 of letrec1 or letrec2 or letrec3.
  
  (require "store.scm")

  (provide value-of-program value-of-expression instrumentation)

;;;;;;;;;;;;;;;; switches for instrumentation ;;;;;;;;;;;;;;;;

  (define instrumentation (make-parameter #f))

  ;; say (instrumentation #t) to turn instrumentation on.
  ;;     (instrumentation #f) to turn it off again.

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

  (define value-of-program 
    (lambda (pgm)
      (cases program pgm
        (a-program (body)
          (value-of-expression body (init-env))))))

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

        (lit-exp (datum) datum)

        ;; changed
        (var-exp (id)
          (deref
            (apply-env env id)))

        ;; new
        (varassign-exp (id rhs-exp)    
          (begin
            (setref! 
              (apply-env env id)
              (value-of-expression rhs-exp env))
            1))

        (primapp-exp (prim rands)
          (let ((args (values-of-expressions rands env)))
            (apply-primitive prim args)))

        (if-exp (test-exp true-exp false-exp) 
          (if (true-value? (value-of-expression test-exp env))
            (value-of-expression true-exp env)
            (value-of-expression false-exp env)))

        (let-exp (ids rhss body)       
          (if (instrumentation)
            (pretty-display (list 'entering-let: exp)))
          (let ((vals (values-of-expressions rhss env)))
            (let ((new-env (extend-env ids vals env)))
            (begin
              (if (instrumentation)
                (pretty-display
                 (list 'entering-body: body new-env (get-store))))
              (value-of-expression body new-env)))))

        (proc-exp (bvars body) (closure bvars body env)) 

        (app-exp (rator rands)          
          (let ((proc (value-of-expression   rator env))
                (args (values-of-expressions rands env)))
            (if (procval? proc)
              (apply-procval proc args)
              (eopl:error 'value-of-expression
                "Attempt to apply non-procedure ~s" proc))))

        ;; proc-id -> proc-ids, etc.
        (letrec-exp (proc-ids bvarss proc-bodies letrec-body)
          (value-of-expression letrec-body
            (extend-env-recursively proc-ids bvarss proc-bodies env)))

        )))
  
  (define values-of-expressions
    (lambda (exps env)
      (map
        (lambda (exp) (value-of-expression exp env))
        exps)))

;;;;;;;;;;;;;;;; initial environment ;;;;;;;;;;;;;;;;
  
  (define init-env 
    (lambda ()
      (extend-env
        '(i v x)
        '(1 5 10)
        (empty-env))))

;;;;;;;;;;;;;;;; booleans ;;;;;;;;;;;;;;;;

  (define true-value?
    (lambda (x)
      (not (zero? x))))

  ;;;;;;;;;;;;;; procedures ;;;;;;;;;;;;;;
  
  ;; closures and environments are now mutually recursive, so they have 
  ;; to go in the same module.

  ;; arg -> args
  (define apply-procval
    (lambda (proc args)
      (cases procval proc
        (closure (bvars body env)
          (value-of-expression body
            (extend-env bvars args env))))))
  
  )