;;; Continuation management for Scheme meta-circular evaluators.
;;; Based on EOPL, Fig, 9.2.5.

;;; Constructors

(define (make-final-val-cont)
  (list 'final-val))

(define (make-proc-val-cont args env k)
  (list 'proc-val args env k))

(define (make-application-cont proc k)
  (list 'application proc k))

(define (make-test-val-cont consequent alternative env k)
  (list 'test-val consequent alternative env k))

(define (make-define-cont var  env k)
  (list 'define var env k))

(define (make-assign-cont var env k)
  (list 'assign var env k))

(define (make-first-args-cont args env k)
  (list 'first-args args env k))

(define (make-rest-args-cont first k)
  (list 'rest-args first k))

(define (make-first-seq-cont exps env k)
  (list 'first-seq exps env k))

;;; Apply continuation

(define (apply-cont k val)
  (case (car k)
	((final-val) val)
	((proc-val) 
	  (let ((proc val) (args (cadr k)) (env (caddr k)) (k (cadddr k)))
		(mc-eval-args args env (make-application-cont proc k))))
	((application)
	  (let ((args val) (proc (cadr k)) (k (caddr k)))
		(mc-apply proc args k)))
	((test-val)
	  (let ((test val) (consequent (cadr k)) (alternative (caddr k)) 
			(env (cadddr k)) (k (caddddr k)))
		 (if test
			 (mc-eval consequent env k)
			 (mc-eval alternative env k))))
	((define)
	  (let ((val val) (var (cadr k)) (env (caddr k)) (k (cadddr k)))
		(define-var! var val env)
		(apply-cont k var)))
	((assign)
	  (let ((val val) (var (cadr k)) (env (caddr k)) (k (cadddr k)))
		(set-var-value! var val env)
		(apply-cont k val)))
	((first-args)
	  (let ((first val) (args (cadr k)) (env (caddr k)) (k (cadddr k)))
		(mc-eval-args (cdr args) env 
					  (make-rest-args-cont first k))))
	((rest-args)
	  (let ((rest val) (first (cadr k)) (k (caddr k)))
		(apply-cont k (cons first rest))))
	((first-seq)
	  (let ((exps (cadr k)) (env (caddr k)) (k (cadddr k)))
		(eval-sequence (cdr exps) env k)))
	(else 
	  (error "invalid continuation:" k))))

(define (caddddr x) (cadr (cdddr x)))

;;; eof