;;; variable.ss

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

(define <variable-language> ; EOPL Figure 5.1.1
  (class ()
    (base <literal-language>)
    (base-inst-vars test-clauses)
    (base-methods (base-parse parse))
    (base-init)
    (inst-vars
      (define <empty-environment>
	(class ()
	  (base <environment>)
	  (methods
	    (define apply 
	      (method (name)
		(error '<empty-environment> "~s is not bound" name)))
	    (define domain
	      (method () '())))))
      (define empty-environment (<empty-environment>))
      (define <extended-environment>
	(class (env names values)
	  (base <environment>)
	  (inst-vars env names
	    (define values-vector (list->vector values))
	    (define names-length (length names)))
	  (methods
	    (define apply
	      (method (name)
		(let ((x (memq name names)))
		  (if x
		    (vector-ref values-vector (- names-length (length x)))
		    (apply env name)))))
	    (define domain
	      (method ()
		(append names (domain env)))))))
      (define <variable>
	(class (name)
	  (base <syntax>)
	  (inst-vars name)
	  (methods
	    (define eval
	      (method ()
		(apply initial-environment name)))
	    (define unparse
	      (method () name)))))
      (define initial-environment
	(<extended-environment> empty-environment
	  '(emptylist)
	  (list '())))
      (set! test-clauses
	(append
	  '((emptylist ()))
	  test-clauses)))
    (methods
      (define name
	(method () 'variable))
      (define parse
	(method (datum)
	  (form-case datum
	    (variable name
	      (<variable> name))
	    (else (base-parse this datum))))))))