;;; Vikram Subramaniam
;;; HW 8

(load "/usr4/c311/ss/form-case.ss")
;(load "/usr4/c311/vikram/prelims-for-hw8.ss")

(define dynamic-variable?
     (lambda (var)
       (char=? #\: 
         (string-ref (symbol->string var) 0))))

(define <static&dynamic-language>
  (class ()
    (base <let-language>)
    (base-inst-vars
      <literal>
      <call>
      <exps>
      <if>
      <empty-environment>
      <extended-environment>
      <proc>
      <closure>
      initial-environment
      test-clauses)
    (base-methods (base-parse parse))
    (base-init)
    (inst-vars
      (set! test-clauses
	(append
	  '(((let ((x 3) (y 4))
	       (let ((f (proc (a) (+ a y)))
		     (y 5))
		 (f x))) 7)
	    ((let ((x 3) (:y 4))
	       (let ((f (proc (a) (+ a :y)))
		     (:y 5))
		 (f x))) 8)
	    ((let ((x 3)
		   (:y 4)
		   (:z 5))
	       (let ((:y 6)
		     (g (proc () (+ x :y :z))))
		 (g))) 14)
	    ((let ((x 3)
		   (y 4)
		   (z 5))
	       (let ((y 6)
		     (g (proc () (+ x y z))))
		 (g))) 12))
	  test-clauses))
      (define <static-variable>
	(class (name)
	  (base <syntax>)
	  (inst-vars name)
	  (methods
	    (define eval
	      (method (s-env d-env)
		(apply s-env name)))
	    (define unparse
	      (method () name)))))
      (define <dynamic-variable>
	(class (name)
	  (base <syntax>)
	  (inst-vars name)
	  (methods
	    (define eval
	      (method (s-env d-env)
		(apply d-env name)))
	    (define unparse
	      (method () name)))))
      (set! <literal>
	(class (datum)
	  (base <literal>)
	  (base-inst-vars datum)
	  (base-init datum)
	  (methods
	    (define eval
	      (method (s-env d-env)
		datum)))))
      (set! <call>
	(class (rator rands)
	  (base <call>)
	  (base-inst-vars rator rands)
	  (base-init rator rands)
	  (methods
	    (define eval
	      (method (s-env d-env)
		(let ((proc (eval rator s-env d-env))
		      (args (eval rands s-env d-env)))
		  (if (isa? proc <closure>)
		    (apply
		      proc
		      args
		      d-env)
		    (apply proc args))))))))
      (set! <exps>
	(class (exps)
	  (base <exps>)
	  (base-inst-vars exps)
	  (base-init exps)
	  (methods
	    (define eval
	      (method (s-env d-env)
		(map (lambda (exp) (eval exp s-env d-env))
		  exps))))))
      (set! <if>
	(class (test consequent alternative)
	  (base <if>)
	  (base-inst-vars test consequent alternative)
	  (base-init test consequent alternative)
	  (methods
	    (define eval
	      (method (s-env d-env)
		(if (not (zero? (eval test s-env d-env)))
		  (eval consequent s-env d-env)
		  (eval alternative  s-env d-env)))))))
      (set! <proc>
	(class (formals body)
	  (base <proc>)
	  (base-inst-vars formals body)
	  (base-init formals body)
	  (methods
	    (define eval
	      (method (s-env d-env)
		(<closure> formals body s-env))))))
      (set! <closure>
	(class (formals body env)
	  (base <closure>)
	  (base-inst-vars formals body env)
	  (base-init formals body env)
	  (methods
	    (define apply
	      (method (args d-env)
		(letrec ((h-static
			   (lambda (f-ls a-ls s-env)
			     (cond
			       ((null? f-ls) s-env)
			       ((not (dynamic-variable? (car f-ls)))
				(h-static
				  (cdr f-ls)
				  (cdr a-ls)
				  (<extended-environment>
				    s-env
				    (list (car f-ls))
				    (list (car a-ls)))))
			       (else
				 (h-static
				   (cdr f-ls)
				   (cdr a-ls)
				   s-env)))))
			 (h-dynamic
			   (lambda (f-ls a-ls d-env)
			     (cond
			       ((null? f-ls) d-env)
			       ((dynamic-variable? (car f-ls))
				(h-dynamic
				  (cdr f-ls)
				  (cdr a-ls)
				  (<extended-environment>
				    d-env
				    (list (car f-ls))
				    (list (car a-ls)))))
			       (else
				 (h-dynamic
				   (cdr f-ls)
				   (cdr a-ls)
				   d-env))))))
		  (eval
		      body
		      (h-static formals args env)
		      (h-dynamic formals args d-env)))))))))
    (methods
      (define name
	(method () 'static-and-dynamic))
      (define parse
	(method (datum)
	  (form-case datum
	    (variable name
	      (if (dynamic-variable? name)
		(<dynamic-variable> name)
		(<static-variable> name)))
	    (else (base-parse this datum)))))
      (define evaluate
	(method (datum)
	  (eval (parse this datum) initial-environment (<empty-environment>)))))))