;; 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)


;; We start with a cheap hack:

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



;; 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)
	       (cond
		((null? cenv)
		 (free-variable 'free))
		((eq? (car cenv) e)
		 0)
		(else
		 (+ 1 (find-lexical-address (cdr cenv))))))))
	 (find-lexical-address cenv))))))


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

			; application (assume we have a pair)

			(else		               
                         (list (scope (car e) cenv)
			       (scope (cadr e) cenv)))))))
      (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)))))