(define-datatype procval procval?
  (closure
    (params pdeclarations?)
    (body expression?)	
    (env environment?))
  (closure-rec
    (params pdeclarations?)
    (body expression?)	
    (rec-proc-ids (list-of symbol?))
    (env environment?))
  (closure-class
    (params pdeclarations?)
    (i-decls i-vars?)
    (mids (list-of symbol?))
    (m-decls (list-of target?))
    (env environment?))
  )

(define closure-params
  (lambda (proc)
    (cases procval proc
      (closure (params body env) params)
      (closure-rec (params body rec-proc-ids env) params)
      (closure-class (params i-decls mids mprocs env) params)
      )
    )
  )

(define extend-rec-env
  (lambda (rec-proc-ids calling-env creation-env)
    (if (not (null? rec-proc-ids))
        (extend-env rec-proc-ids
                    (map (lambda (id) (apply-env calling-env id)) rec-proc-ids)
                    creation-env)
        creation-env
        )
    )
  )

;; connect two environments
(define link-env
  (lambda (h-env t-env)
    (cases environment h-env
      (empty-env-rec () t-env)
      (extend-env-rec (syms vals env)
         ;; direct construction
         (extend-env-rec syms vals (link-env env t-env)))
      )
    )
  )

(define apply-method
  (lambda (mproc args object-env)
    (cases procval mproc
      (closure (params body env)
          (eval-expression 
                  body 
                  (extend-env (get-param-ids params) args (link-env object-env env))))
      (else (eopl:error 'apply-method "Illegal method call"))
      )
    )
  )

(define apply-procval
  (lambda (proc args calling-env)
    (cases procval proc
      (closure (params body env)
          (eval-expression 
                  body 
                  (extend-env (get-param-ids params) args env)))
      (closure-rec (params body rec-proc-ids env)
          (eval-expression 
                  body 
                  (extend-env (get-param-ids params) 
                              args (extend-rec-env rec-proc-ids calling-env env))))
      (closure-class (params i-decls mids mprocs env)
         (let* (;; evaluate instance variables
                (ivs (evaluate-ivars i-decls 
                                     (extend-env (get-param-ids params) args env)))
                ;; ivars env
                (pstate (extend-env (car ivs) (cadr ivs) (empty-env)))
                ;; build references into pstate (fresh references)
                (rivs (map (lambda (id) (indirect-target (apply-env-ref pstate id))) 
                           (car ivs)))
                ;; build method env
                (pmethods (extend-env mids mprocs (empty-env)))
                ;; build image symbols
                (iids (cons 'self (car ivs)))
                ;; build temporary image
                (istate (cons (direct-target 0) rivs))
                ;; build temporary environment
                (objenv (extend-env iids istate (empty-env)))
                ;; build object value
                (objval (object pstate pmethods objenv)))
                (begin
                  ;; set 'self'
                  (setref! (apply-env-ref objenv 'self) objval)
                  ;; return objval
                  objval)))
      )
    )
  )

(define evaluate-ivars
  (lambda (i-decls env)
    (cases i-vars i-decls
      (empty-ivars () '())
      (ivar-decls (ids rands)
          (list ids (map (lambda (i) (direct-target (eval-expression i env))) rands)))
      )
    )
  )
  
(define evaluate-methods
  (lambda (m-decls env)
    (cases methods m-decls
      (empty-methods () '())
      (method-decls (mids params bodies)
           ;; use no-recursive closures
          (list mids (map (lambda (p b) (direct-target (closure p b env))) params bodies)))
      )
    )
  )