C311 Assignment 2 (Static Properties)

;;
;; C311 Assignment 2
;; Static Properties
;; Due F 09/20/96 @ 5:00pm
;;


;; bound-vars
;; bound-vars gets an expression in the lambda calculus syntax, and
;; returns the set of variables that are bound in the expression.
;; it uses a helper procedure, b-vars that takes an expression and
;; a list of variables found to be bound earlier in the process (bsf
;; stands for "bounds-so-far".

(define bound-vars
  (letrec
    ([b-vars
       (lambda (exp bsf)
	 (if (variable? exp)
	     bsf			; base case? return the bsf set.
	     (record-case exp
	       (lambda (formals body)	; (car formals) is a new boud var
		 (if (memq (car formals) bsf) ; already there?
		     (b-vars body bsf)	; don't include it and check the body
		     (b-vars body (cons (car formals) bsf))))
	       				; include it and check the body
	       (else			; check rand and then rator
		 (b-vars (rator exp) (b-vars (rand exp) bsf))))))])
    (lambda (exp)
      (b-vars exp '()))))



;; bound?
;; bound? gets a variable and an expression in the lambda calculus
;; syntax, and returns #t if the variable is bound in that expression.

(define bound?
  (lambda (var exp)
    (if (variable? exp)			; variable alone? it is not bound
	#f
	(record-case exp
	  (lambda (formals body)	
	    (or (eq? (car formals) var)	; bound if the var is the formal
		(bound? var body)))	; or if it appears bound in the body
	  (else
	    (or
	      (bound? var (rator exp))	; bound if appears bound in rator/rand
	      (bound? var (rand exp))))))))



;; lexical-address
;; lexical-address takes any expression and returns the expression wih
;; every variable reference v replaced by a list (v : d p) where d is
;; the lexical depth and p is its declaration position, using zero-based
;; index for both p and d.
;; lex-addres is the procedure that does the work. It takes the expression
;; and an environment of the form ( (var00 var01 ... var0n) (var10 var11 ...
;; var1m) ... (vark0 vark1 ... varkl) ), where (var00 var01 ... var0n) is
;; the formals list of the expression nearest enclosing lambda. For instance,
;; when your whole expression is:
;;		(lambda (a b c)
;;		  (lambda (d e)
;;		    (lambda ()
;;		      (+ a b c d e))))
;; the environment when evaluating (+ a b c d e) will be:
;;		(() (d e) (a b c))
;; getaddress is another helper procedure that takes a variable, an
;; environment and a depth (initially 0) and returns the variable reference
;; with the format (v : d p), or (v : free) if v is not in the environment.
;; For instance, (getaddress 'a '(() (d e) (a b c)) 0) ==> '(a : 2 0)

(define lexical-address
  (letrec ([lex-address
	     (lambda (exp env)
	       (if (variable? exp)
		   (getaddress exp env 0)
		   (record-case exp
		     (lambda (formals body)
		       `(lambda ,formals
			  ,(lex-address body (cons formals env))))
		     (if (test then else)
			 `(if
			    ,(lex-address test env)
			    ,(lex-address then env)
			    ,(lex-address else env)))
		     (else (map (lambda (x) (lex-address x env)) exp)))))]
	   [getaddress
	     (lambda (var env depth)
	       (if (null? env)
		   (list var ': 'free)
		   (let ([offset (list-index var (car env))])
		     (if (=? offset -1)
			 (getaddress var (cdr env) (add1 depth))
			 (list var ': depth offset)))))])
    (lambda (exp)
      (lex-address exp '()))))

;; helper procedures.

(define variable? symbol?)
(define rator car)
(define rand cadr)

(define list-index
  (lambda (a ls)
    (letrec ([list-index-hlp
               (lambda (ls n)
                 (cond
                   [(null? ls) -1]
                   [(eq? (car ls) a) n]
                   [else (list-index-hlp
                           (cdr ls)
                           (add1 n))]))])
      (list-index-hlp ls 0))))