;;; call.ss

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

(define <call-language> ; EOPL Figure 5.1.1
  (class ()
    (base <variable-language>)
    (base-inst-vars <extended-environment> initial-environment test-clauses)
    (base-methods (base-parse parse))
    (base-init)
    (inst-vars
      (define <call>
	(class (rator rands)
	  (base <syntax>)
	  (inst-vars rator rands)
	  (methods
	    (define eval
	      (method ()
		(apply (eval rator) (eval rands))))
	    (define unparse
	      (method ()
		(cons (unparse rator) (unparse rands)))))))
      (define <exps>
	(class (exps)
	  (base <syntax>)
	  (inst-vars exps)
	  (methods
	    (define eval
	      (method ()
		(map eval exps)))
	    (define unparse
	      (method ()
		(map unparse exps))))))
      (define <primitive>
	(let ((apply-proc apply))
	  (class (proc)
	    (base <procedure>)
	    (inst-vars proc)
	    (methods
	      (define apply
		(method (args)
		  (apply-proc proc args)))))))
      (set! initial-environment
	(<extended-environment> initial-environment
	  '(+ - * add1 sub1)
	  (map <primitive>
	    (list + - *
	      (lambda (n) (+ n 1))
	      (lambda (n) (- n 1))))))
      (set! test-clauses
	(append
	  '(((+ 1 2) 3)
	    ((* (- 5 3) (add1 (sub1 3))) 6))
	  test-clauses)))
    (methods
      (define name
	(method () 'call))
      (define parse
	(method (datum)
	  (form-case datum
	    (call (rator . rands)
	      (<call> (parse this rator)
		(<exps> (map (lambda (rand) (parse this rand))
			  rands))))
	    (else (base-parse this datum))))))))