;;; Vikram Subramaniam
;;; C311/S96 Assignment 3
;;; Static properties

;;; A set abstract data type (ADT)
(define member?
  (lambda (e set)
    (cond
      ((null? set) #f)
      ((eq? (car set) e) #t)
      (else (member? e (cdr set))))))

(define adjoin
  (lambda (e set)
    (cond
      ((member? e set) set)
      (else (cons e set)))))

(define empty-set?
  (lambda (set)
    (null? set)))

(define union
  (lambda (set1 set2)
    (cond
      ((empty-set? set1) set2)
      (else (adjoin (car set1) (union (cdr set1) set2))))))

(define remove
  (lambda (e set)
    (cond
      ((null? set) (quote ()))
      ((eq? e (car set)) (cdr set))
      (else (cons (car set) (remove e (cdr set)))))))

(define difference
  (lambda (set1 set2)
    (cond
      ((null? set2) set1)
      (else (remove (car set2) (difference set1 (cdr set2)))))))

(define grandunion
  (lambda (lsets)
    (cond
      ((null? lsets) (quote ()))
      (else (union (car lsets) (grandunion (cdr lsets)))))))
;;; --------------------------------------------------------------------------------


;;; Predicates syntactic forms.
(define variable? symbol?)
(define variable-reference? variable?)
(define abstraction?
  (lambda (expr)
    (if (atom? expr)
	#f
	(eq? (car expr) 'lambda))))
(define conditional?
  (lambda (expr)
    (if (atom? expr)
	#f
	(eq? (car expr) 'if))))
;;; --------------------------------------------------------------------------------

(define free-vars
  (lambda (expr)
    (cond
      ((variable-reference? expr) (list expr))
      ((abstraction? expr) (difference (free-vars (caddr expr)) (cadr expr)))
      (else (union (free-vars (car expr)) (free-vars (cadr expr)))))))

(define bound-vars
  (lambda (expr)
    (cond
      ((variable-reference? expr) '())
      ((abstraction? expr) (abs-helper
			     (bound-vars (caddr expr))
			     (free-vars (caddr expr))
			     (cadr expr)))
      (else (union (bound-vars (car expr)) (bound-vars (cadr expr)))))))

(define abs-helper
  (lambda (bvs fvs formals)
    (cond
      ((null? formals) bvs)
      ((member? (car formals) fvs)
       (cons (car formals) (abs-helper bvs fvs (cdr formals))))
      (else (abs-helper bvs fvs (cdr formals))))))


;;; --------------------------------------------------------------------------------

(define free?
  (lambda (var expr)
    (member? var (free-vars expr))))

(define bound?
  (lambda (var expr)
    (member? var (bound-vars expr))))

;;; --------------------------------------------------------------------------------

(define lookup
  (lambda (v cenv)
    (lu-help v cenv 0)))

(define lu-help
  (lambda (v cenv d)
    (if (null? cenv)
	#f
	(let ((r (member v (car cenv))))
	  (if r
	      (list d (- (length (car cenv)) (length r)))
	      (lu-help v (cdr cenv) (add1 d)))))))

(define lexical-address
  (lambda (expr)
    (lexical-address-helper expr '())))

(define lexical-address-helper
  (lambda (expr cenv)
    (cond
      ((null? expr) '())
      ((variable-reference? expr)
       (let ((r (lookup expr cenv)))
	 (if r (cons expr (cons ': r)) (list expr ': 'free))))
      ((abstraction? expr)
       (list 'lambda (cadr expr)
	 (lexical-address-helper (caddr expr) (cons (cadr expr) cenv))))
      ((conditional? expr)
       (list 'if
	 (lexical-address-helper (cadr expr) cenv)
	 (lexical-address-helper (caddr expr) cenv)
	 (lexical-address-helper (cadddr expr) cenv)))
      (else
	(map (lambda (exp) (lexical-address-helper exp cenv)) expr)))))