;; CS 3520
;; Fall 2000
;; HW 3 example solution

;; 3.1 

;; EoPL 1.19, page 31

; Usual lambda calculus:
; <exp> = <sym>
;       | (lambda (<sym>) <exp>)
;       | (<exp> <exp>)

; free-vars-helper : exp list-of-syms -> list-of-syms
;  Find the free variables in an expression, given a list
;  of variables bound in the expression's context. Variables
;  are duplicated in the list if they appear free multiple times
;  in the expression.
;   (free-vars-helper 'y '()) = _(y)_
;   (free-vars-helper 'y '(y)) = _()_
;   (free-vars-helper '(lambda (x) ((y y) (x (z z)))) '(y)) = _(z z)_
(define (free-vars-helper e bound-vars)
  (cond
   [(symbol? e) (if (member e bound-vars)
		    '()
		    (list e))]
   [(eq? (car e) 'lambda)
    (free-vars-helper (caddr e)
		      (cons (caadr e) bound-vars))]
   [else (append
	  (free-vars-helper (car e) bound-vars)
	  (free-vars-helper (cadr e) bound-vars))]))

; free-vars : exp -> list-of-syms
;   (free-vars 'y) = _(y)_
;   (free-vars '(lambda (y) y)) = _()_
;   (free-vars '(lambda (y) (lambda (x) ((y y) (x (z z)))))) = _(z)_
(define (free-vars e)
  (remove-duplicates (free-vars-helper e '())))

; remove-duplicates : list-of-syms -> list-of-syms
;  Removes duplicate instances of a symbol from the list
;   (remove-duplicates '()) = _()_
;   (remove-duplicates '(a a b)) = _(a b)_
;   (remove-duplicates '(a b a b)) = _(a b)_
(define (remove-duplicates l)
  (cond
   [(null? l) '()]
   [else (cond
	  [(member (car l) (cdr l))
	   (remove-duplicates (cdr l))]
	  [else
	   (cons (car l) (remove-duplicates (cdr l)))])]))

;; Tests:
(equal? (free-vars-helper 'y '())
	'(y))
(equal? (free-vars-helper 'y '(y))
	'())
(equal? (free-vars-helper '(lambda (x) ((y y) (x (z z)))) '(y))
	'(z z))

(equal? (free-vars 'y)
	'(y))
(equal? (free-vars '(lambda (y) y))
	'())
(equal? (free-vars '(lambda (y) (lambda (x) ((y y) (x (z z))))))
	'(z))

; bound-vars-helper : exp list-of-syms -> list-of-syms
;  Find the bound variables in an expression, given a list
;  of variables bound in the expression's context. Variables
;  are duplicated in the list if they appear bound multiple times
;  in the expression.
;   (bound-vars-helper 'y '()) = _()_
;   (bound-vars-helper 'y '(y)) = _(y)_
;   (bound-vars-helper '(lambda (x) ((y y) (x (z z)))) '(y)) = _(y y x)_
(define (bound-vars-helper e bound-vars)
  (cond
   [(symbol? e) (if (member e bound-vars)
		    (list e)               ;; <<<< This is the only change,
		    '())]                  ;; <<<< compared to free-vars
   [(eq? (car e) 'lambda)
    (bound-vars-helper (caddr e)
		       (cons (caadr e) bound-vars))]
   [else (append
	  (bound-vars-helper (car e) bound-vars)
	  (bound-vars-helper (cadr e) bound-vars))]))

; bound-vars : exp -> list-of-syms
;   (bound-vars 'y) = _()_
;   (bound-vars '(lambda (y) y)) = _(y)_
;   (bound-vars '(lambda (y) (lambda (x) ((y y) (x (z z)))))) = _(y x)_
(define (bound-vars e)
  (remove-duplicates (bound-vars-helper e '())))

;; Tests:
(equal? (bound-vars-helper 'y '(y))
	'(y))
(equal? (bound-vars-helper 'y '())
	'())
(equal? (bound-vars-helper '(lambda (x) ((y y) (x (z z)))) '(y))
	'(y y x))

(equal? (bound-vars 'y)
	'())
(equal? (bound-vars '(lambda (y) y))
	'(y))
(equal? (bound-vars '(lambda (y) (lambda (x) (y (x z)))))
	'(y x))


;; EoPL 1.21, page 31

(define answer-for-1.21
  (lambda ()
    '((lambda (x) x) x)))



;; 3.2
;; EoPL 1.31, page 37

; <expression> defined on page 37
; <la-expression> = (<identifier> . <position>)
;                 | (if <la-expression> <la-expression> <la-expression>)
;                 | (lambda (<identifier>*)  <la-expression>)
;                 | ( <la-expression> <la-expression>*)
; <position> = (free)
;            | (: <num> <num>)

; lexical-address-helper : expressions list-of-list-of-symbol -> la-expression
;  Converts an expression to a la-expression by computing 
;  lexical addresses. The bindings argument supplies the
;  context of the expression, where each list is a list of bindings;
;  the first list is the closest countour, etc.
;    (lexical-address-helper 'x '()) = _(x free)_
;    (lexical-address-helper '(lambda (x) x) '()) = _(lambda (x) (: x 0 0))_
;    (lexical-address-helper '(lambda (x) y) '((a y))) = _(lambda (x) (: y 0 1))_
;    (lexical-address-helper '(lambda (x) y) '((b) (a y))) = _(lambda (x) (: y 1 1))_
(define (lexical-address-helper e bindings)
  (cond
   [(symbol? e) (cons e
		      (find-symbol-position/countours e bindings 0))]
   [(eq? 'if (car e))
    (list
     'if
     (lexical-address-helper (cadr e) bindings)
     (lexical-address-helper (caddr e) bindings)
     (lexical-address-helper (cadddr e) bindings))]
   [(eq? 'lambda (car e))
    (list
     'lambda
     (cadr e)
     (lexical-address-helper (caddr e) 
			     (cons (cadr e)
				   bindings)))]
   [else (cons
	  (lexical-address-helper (car e) bindings)
	  (lexical-address-helper/list (cdr e) bindings))]))

; find-symbol-position/countours: symbol
;                                 list-of-list-of-symbol
;                                 num
;                                 -> position
;  Finds the lexical position of e in bindings, counting
;  countours from countour. Returns _(free)_ if the symbol not
;  in any list, or _(: c p)_ if it is in countour c and
;  position p.
;   (find-symbol-position 'a '((b c) (e)) 2) = _(free)_
;   (find-symbol-position 'a '((b a c) (e)) 2) = _(: 0 1)_
;   (find-symbol-position 'e '((b a c) (e)) 2) = _(: 1 0)_
(define (find-symbol-position/countours e bindings contour)
  (cond
   [(null? bindings) (list 'free)]
   [else (let ([r (find-symbol-position e (car bindings) 0)])
	   (if r
	       (list ': contour r)
	       (find-symbol-position/countours e 
					       (cdr bindings) 
					       (+ contour 1))))]))

; find-symbol-position: symbol
;                       list-of-symbol
;                       num
;                       -> num-or-#f
;  Finds the position of e in bindings, counting
;  from pos, returning #f if the symbol is not in the list.
;   (find-symbol-position 'a '(b c) 2) = #f
;   (find-symbol-position 'a '(b a c) 2) = 3
(define (find-symbol-position e bindings pos)
  (cond
   [(null? bindings) #f]
   [else (cond
	  [(eq? e (car bindings)) pos]
	  [else (find-symbol-position e (cdr bindings) (+ pos 1))])]))

; lexical-address-helper/list : list-of-expressions 
;                               list-of-list-of-symbol 
;                               -> list-of-la-expression
(define (lexical-address-helper/list l bindings)
  (cond
   [(null? l) '()]
   [else (cons
	  (lexical-address-helper (car l) bindings)
	  (lexical-address-helper/list (cdr l) bindings))]))

; lexical-address-helper : expressions -> la-expression
(define (lexical-address e)
  (lexical-address-helper e '()))

;; Tests:
(equal? (lexical-address '(lambda (a b c)
			    (if (eqv? b c)
				((lambda (c)
				   (cons a c))
				 a)
				b)))
	'(lambda (a b c)
	   (if ((eqv? free) (b : 0 1) (c : 0 2))
	       ((lambda (c)
		  ((cons free) (a : 1 0) (c : 0 0)))
		(a : 0 0))
	       (b : 0 1))))

;; 3.3
;; EoPL 2.7, page 53

;; From the book:
(define-datatype
 expression expression?
 (var-exp
  (id symbol?))
 (lambda-exp
  (id symbol?)
  (body expression?))
 (app-exp
  (rator expression?)
  (rand expression?)))

; free-vars-helper2 : expression list-of-syms -> list-of-syms
;  Find the free variables in an expression, given a list
;  of variables bound in the expression's context
;   (free-vars-helper2 (var-exp 'y) '()) = _(y)_
;   (free-vars-helper2 (var-exp 'y) '(y)) = _()_
;   (free-vars-helper2 (lambda-exp 'x 
;                                  (app-exp (app-exp (var-exp 'y)
;                                                    (var-exp 'y))
;                                           (app-exp (var-exp 'x)
;                                                    (app-exp (var-exp 'z)
;                                                             (var-exp 'z)))))
;                      '(y)) = _(z z)_
(define (free-vars-helper2 e bound-vars)
  (cases 
   expression e
   [var-exp (id) (if (member id bound-vars)
		     '()
		     (list id))]
   [lambda-exp (id body)
	       (free-vars-helper2 body
				  (cons id bound-vars))]
   [app-exp (rator rand)
	    (append
	     (free-vars-helper2 rator bound-vars)
	     (free-vars-helper2 rand bound-vars))]))

; free-vars-helper : exp -> list-of-syms
;   (free-vars2 (var-exp 'y)) = _(y)_
;   (free-vars2 (lambda-exp 'y (var-exp 'y))) = _()_
;   (free-vars2 (lambda-exp 'y 
;                         (lambda-exp 'x
;                                  (app-exp (app-exp (var-exp 'y)
;                                                    (var-exp 'y))
;                                           (app-exp (var-exp 'x)
;                                                    (app-exp (var-exp 'z)
;                                                             (var-exp 'z))))))
;                      = _(z)_
(define (free-vars2 e)
  (remove-duplicates (free-vars-helper2 e '())))

;; Tests:
(equal? (free-vars-helper2 (var-exp 'y) '())
	'(y))
(equal? (free-vars-helper2 (var-exp 'y) '(y))
	'())
(equal? (free-vars-helper2 
	 (lambda-exp 'x (app-exp (app-exp (var-exp 'y)
					  (var-exp 'y))
				 (app-exp (var-exp 'x)
					  (app-exp (var-exp 'z)
						   (var-exp 'z)))))
	 '(y))
	'(z z))

(equal? (free-vars2 (var-exp 'y))
	'(y))
(equal? (free-vars2 (lambda-exp 'y (var-exp 'y)))
	'())
(equal? (free-vars2 
	 (lambda-exp 'y
		     (lambda-exp 'x 
				 (app-exp (app-exp (var-exp 'y)
						   (var-exp 'y))
					  (app-exp (var-exp 'x)
						   (app-exp (var-exp 'z)
							    (var-exp 'z)))))))
	'(z))


; bound-vars-helper2 : expression list-of-syms -> list-of-syms
;  Find the bound variables in an expression, given a list
;  of variables bound in the expression's context
;   (bound-vars-helper2 (var-exp 'y) '()) = _()_
;   (bound-vars-helper2 (var-exp 'y) '(y)) = _(y)_
;   (bound-vars-helper2 (lambda-exp 'x 
;                                  (app-exp (app-exp (var-exp 'y)
;                                                    (var-exp 'y))
;                                           (app-exp (var-exp 'x)
;                                                    (app-exp (var-exp 'z)
;                                                             (var-exp 'z)))))
;                      '(y)) = _(y y x)_
(define (bound-vars-helper2 e bound-vars)
  (cases 
   expression e
   [var-exp (id) (if (member id bound-vars)
		     (list id)              ;; << Again, the only difference
		     '())]                  ;; <<
   [lambda-exp (id body)
	       (bound-vars-helper2 body
				  (cons id bound-vars))]
   [app-exp (rator rand)
	    (append
	     (bound-vars-helper2 rator bound-vars)
	     (bound-vars-helper2 rand bound-vars))]))

; bound-vars-helper : exp -> list-of-syms
;   (bound-vars2 (var-exp 'y)) = _()_
;   (bound-vars2 (lambda-exp 'y (var-exp 'y))) = _(y)_
;   (bound-vars2 (lambda-exp 'y 
;                         (lambda-exp 'x
;                                  (app-exp (app-exp (var-exp 'y)
;                                                    (var-exp 'y))
;                                           (app-exp (var-exp 'x)
;                                                    (app-exp (var-exp 'z)
;                                                             (var-exp 'z))))))
;                      = _(y x)_
(define (bound-vars2 e)
  (remove-duplicates (bound-vars-helper2 e '())))

;; Tests:
(equal? (bound-vars-helper2 (var-exp 'y) '())
	'())
(equal? (bound-vars-helper2 (var-exp 'y) '(y))
	'(y))
(equal? (bound-vars-helper2 
	 (lambda-exp 'x 
		     (app-exp (app-exp (var-exp 'y)
				       (var-exp 'y))
			      (app-exp (var-exp 'x)
				       (app-exp (var-exp 'z)
						(var-exp 'z)))))
	 '(y))
	'(y y x))
(equal? (bound-vars2 (var-exp 'y))
	'())
(equal? (bound-vars2 (lambda-exp 'y (var-exp 'y)))
	'(y))
(equal? (bound-vars2
	 (lambda-exp 'y
		     (lambda-exp 'x 
				 (app-exp (app-exp (var-exp 'y)
						   (var-exp 'y))
					  (app-exp (var-exp 'x)
						   (app-exp (var-exp 'z)
							    (var-exp 'z)))))))
	'(y x))


;; 3.4

(define (empty-env/pos)
  (lambda (cn pn)
    (eopl:error "can't get that position")))

(define (extend-env/pos vals env)
  (lambda (cn pn)
    (if (zero? cn)
	(list-ref vals pn)
	(env (- cn 1) pn))))

(define (apply-env/pos env cn pn)
  (env cn pn))

;; Tests:
(equal? (apply-env/pos (extend-env/pos '(10 20 30) (empty-env/pos)) 0 0)
	10)
(equal? (apply-env/pos (extend-env/pos '(10 20 30) (empty-env/pos)) 0 1)
	20)
(equal? (apply-env/pos (extend-env/pos '(10 20 30) (empty-env/pos)) 0 2)
	30)
(equal? (apply-env/pos (extend-env/pos '(40 50) 
				       (extend-env/pos '(10 20 30) 
						       (empty-env/pos))) 
		       0 1)
	50)
(equal? (apply-env/pos (extend-env/pos '(40 50) (extend-env/pos '(10 20 30) 
								(empty-env/pos)))
		       1 1)
	20)

;; 3.5

(define-datatype
  env/pos env/pos?
  (empty-env/pos)
  (extended-env/pos
   (vals list?)
   (env env/pos?)))

(define (empty-env/pos2)
  (empty-env/pos))

(define (extend-env/pos2 vals env)
  (extended-env/pos
   vals
   env))

(define (apply-env/pos2 env cn pn)
  (cases 
   env/pos env
   (empty-env/pos ()
		  (eopl:error "can't get that position"))
   (extended-env/pos (vals old-env)
		     (if (zero? cn)
			 (list-ref vals pn)
			 (apply-env/pos2 old-env (- cn 1) pn)))))

;; Tests:
(equal? (apply-env/pos2 (extend-env/pos2 '(10 20 30) (empty-env/pos2)) 0 0)
	10)
(equal? (apply-env/pos2 (extend-env/pos2 '(10 20 30) (empty-env/pos2)) 0 1)
	20)
(equal? (apply-env/pos2 (extend-env/pos2 '(10 20 30) (empty-env/pos2)) 0 2)
	30)
(equal? (apply-env/pos2 (extend-env/pos2 '(40 50) 
					 (extend-env/pos2 '(10 20 30) 
							  (empty-env/pos2))) 
			0 1)
	50)
(equal? (apply-env/pos2 (extend-env/pos2 '(40 50) (extend-env/pos2 '(10 20 30) 
								   (empty-env/pos2)))
			1 1)
	20)

;; 3.6

(define (empty-env/pos3)
  '())

(define (extend-env/pos3 vals env)
  (cons
   (list->vector vals)
   env))

(define (apply-env/pos3 env cn pn)
  (vector-ref (list-ref env cn) pn))

;; Tests:
(equal? (apply-env/pos3 (extend-env/pos3 '(10 20 30) (empty-env/pos3)) 0 0)
	10)
(equal? (apply-env/pos3 (extend-env/pos3 '(10 20 30) (empty-env/pos3)) 0 1)
	20)
(equal? (apply-env/pos3 (extend-env/pos3 '(10 20 30) (empty-env/pos3)) 0 2)
	30)
(equal? (apply-env/pos3 (extend-env/pos3 '(40 50) 
					 (extend-env/pos3 '(10 20 30) 
							  (empty-env/pos3))) 
			0 1)
	50)
(equal? (apply-env/pos3 (extend-env/pos3 '(40 50) (extend-env/pos3 '(10 20 30) 
								   (empty-env/pos3)))
			1 1)
	20)