;; JSJ

;; Problem: see p. 62 of text or notes from
;; Mon Jul  1 10:11:48 EST 1996

;; Allowable expressions:
;;   x
;;   (lambda (x) M)
;;   (M1 M2)

;; this version handles lambda lists of arbitrary number of formals 


;; We start with a cheap hack:

(define lambda-expression?
  (lambda (e)
    (and (list? e)
	 (eq? (car e) 'lambda))))




;; find-lexical-address-ONE operates on a single level environment (a
;; list of atoms) which contains the symbol e, which is a single atom. 

(define find-lexical-address-ONE
  (lambda (e cenv)
    (letrec
	((find-lexical-address
	  (lambda (cenv)
	    (cond
	     ((eq? (car cenv) e)
	      0)
	     (else
	      (+ 1 (find-lexical-address (cdr cenv))))))))
      (find-lexical-address cenv))))

;; find-lexical-address returns either an integer, or 'free

(define find-lexical-address 
  (lambda (e cenv)
    (call/cc
     (lambda (free-variable)
       (letrec
	   ((find-lexical-address
	     (lambda (cenv n)
	       (cond
		((null? cenv)		; reached end of environment!
		 (free-variable 'free))
		((memq e (car cenv))
		 (list n (find-lexical-address-ONE e (car cenv))))
		(else
		 (find-lexical-address (cdr cenv) (+ 1 n)))))))
	 (find-lexical-address cenv 0))))))


(define scope 
  (lambda (exp)
    (letrec
	((scope (lambda (e cenv)
		  (cond ((atom? e)
			 (list 
			  (find-lexical-address e cenv)
			  ':
			  e))
			((lambda-expression? e)
			 (list
			  'lambda
			  (cadr e)         ; formals
			  (scope (caddr e) ; expression
				 (cons     ; new env
				  (cadr e) cenv))))

			; application (assume we have a pair)

			(else		               
;                         (list (scope (car e) cenv)
;			       (scope (cadr e) cenv))
			 (cons (scope (car e) cenv)
			       (map (lambda (x) (scope x cenv))
				    (cdr e))))
			))))
      (scope exp '()))))


;; a potentially useful function to have around
;; (generates a type predicate based on symbol eq-ness)

(define type-of
  (lambda (sym)
    (lambda (x)
      (and (pair? x)
	   (eq? (car x) sym)))))