;;; assign.ss

(load "/u/c311/ss/proc.ss")

(define <assign-language> ; EOPL Figure 5.5.1
  (class ()
    (base <proc-language>)
    (base-inst-vars <variable> <closure> <extended-environment>
      initial-environment empty-environment test-clauses)
    (base-methods (base-parse parse))
    (base-init)
    (inst-vars      
      (define <assign>
	(class (name exp)
	  (base <syntax>)
	  (inst-vars name exp)
	  (methods
	    (define eval
	      (method (env)
		(store (apply env name) (eval exp env))))
	    (define unparse
	      (method ()
		(list 'assign name (unparse exp)))))))
      (set! <variable>
	(class (name)
	  (base <variable>)
	  (base-inst-vars name)
	  (base-init name)
	  (methods
	    (define eval
	      (method (env)
		(fetch (apply env name)))))))
      (set! <extended-environment>
	(class (env names values)
	  (base <extended-environment>)
	  (base-inst-vars values-vector)
	  (base-init env names values)
	  (inst-vars
	    (set! values-vector
	      (list->vector
		(map <cell> (vector->list values-vector)))))))
      (set! initial-environment
	(<extended-environment> empty-environment
	  (domain initial-environment)
	  (map (lambda (name) (apply initial-environment name))
	    (domain initial-environment))))
      (set! test-clauses
	(append
	  '(((let ((x 3)) ((proc (y) x) (assign x 4))) 4))
	  test-clauses)))
    (methods
      (define name
	(method () 'assign))
      (define parse
	(method (datum)
	  (form-case datum
	    (assign (name exp)
	      (<assign> name (parse this exp)))
	    (else (base-parse this datum))))))))