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

;; 3.1

(define (answer-for-3.1.1)
  '(let ([a 1]) (let ([b 2]) b)))

(define (answer-for-3.1.2)
  '(let ([a (let ([b 2]) b)]) a))

(define (answer-for-3.1.3)
  '(let* ([a 8][b 4]) b))

(define (answer-for-3.1.4)
  '(let ([a (lambda (b) b)]) (a a)))

(define (answer-for-3.1.5)
  '(letrec ([a (lambda (b) (a b))]) (let ([c (lambda (d) 10)][e (lambda (f) (a f))]) (e 1))))

(define (answer-for-3.1.6)
  '(letrec ([a (lambda (b) (a b))]) (letrec ([c (lambda (d) 10)][e (lambda (f) (c f))]) (e 1))))

(define (answer-for-3.1.7)
  '(letrec ([a (lambda (b) (a b))]) (let* ([c (lambda (d) 10)][e (lambda (f) (c f))]) (e 1))))

;; 3.2

(define-datatype primitive primitive?
  (add-prim)
  (subtract-prim)
  (mult-prim)
  (incr-prim)
  (decr-prim))

(define-datatype expression expression?
  (lit-exp
   (datum number?))
  (var-exp
   (id symbol?))
  (primapp-exp
   (rator primitive?)
   (rands (list-of expression?)))
  (if-exp
   (test-exp expression?)
   (then-exp expression?)
   (else-exp expression?))
  (let-exp
   (ids (list-of symbol?))
   (rands (list-of expression?))
   (body expression?)))

(define (answer-for-3.2.1)
  (lit-exp 1))

(define (answer-for-3.2.2)
  (var-exp 'x))

(define (answer-for-3.2.3)
  (primapp-exp (add-prim)
	       (list (lit-exp 1)
		     (lit-exp 2))))

(define (answer-for-3.2.4)
  (if-exp (lit-exp 0)
	  (var-exp 'x)
	  (var-exp 'y)))

(define (answer-for-3.2.5)
  (let-exp (list 'x)
	   (list (lit-exp 5))
	   (var-exp 'x)))

(define (answer-for-3.2.6)
  (let-exp (list 'x)
	   (list (let-exp (list 'x)
			  (list (lit-exp 2))
			  (var-exp 'x)))
	   (var-exp 'x)))

;; 3.3

;; free-vars : expr -> list-of-sym
(define (free-vars e)
  (cases expression e
    (lit-exp (n) '())
    (var-exp (id) (list id))
    (primapp-exp (prim rands)
		 (free-varses rands))
    (if-exp (test then else)
	    (append
	     (free-vars test)
	     (free-vars then)
	     (free-vars else)))
    (let-exp (ids rands body)
	     (append
	      (free-varses rands)
	      (removes
	       (free-vars body)
	       ids)))))

;; free-varses : list-of-expr -> list-of-sym
(define (free-varses es)
  (cond
   [(null? es) '()]
   [else (append
	  (free-vars (car es))
	  (free-varses (cdr es)))]))

;; remove : list-of-sym sym -> list-of-sym
(define (remove l s)
  (cond
   [(null? l) '()]
   [else (cond
          [(eq? (car l) s) (remove (cdr l) s)]
          [else (cons (car l) (remove (cdr l) s))])]))

;; removes : list-of-sym list-of-sym -> list-of-sym
(define (removes l ss)
  (cond
   [(null? ss) l]
   [else (remove (removes l (cdr ss)) (car ss))]))


;; Tests:
(free-vars (answer-for-3.2.1))
(free-vars (answer-for-3.2.2))
(free-vars (answer-for-3.2.3))
(free-vars (answer-for-3.2.4))
(free-vars (answer-for-3.2.5))
(free-vars (answer-for-3.2.6))

(define (large-example)
  (let-exp (list 'x 'y 't)
	   (list (var-exp 'z) (lit-exp 1) (lit-exp 5))
	   (primapp-exp (subtract-prim)
			(list (primapp-exp (add-prim) 
					   (list (var-exp 'x)
						 (var-exp 'y)))
			      (var-exp 'w)))))

(free-vars (large-example))

;; 3.4

;; bound-vars : expr -> list-of-sym
(define (bound-vars e)
  (cases expression e
    (lit-exp (n) '())
    (var-exp (id) '())
    (primapp-exp (prim rands)
		 (bound-varses rands))
    (if-exp (test then else)
	    (append
	     (bound-vars test)
	     (bound-vars then)
	     (bound-vars else)))
    (let-exp (ids rands body)
	     (append
	      (bound-varses rands)
	      (keeps
	       ids
	       (free-vars body))))))

;; bound-varses : list-of-expr -> list-of-sym
(define (bound-varses es)
  (cond
   [(null? es) '()]
   [else (append
	  (bound-vars (car es))
	  (bound-varses (cdr es)))]))


;; keeps : list-of-sym list-of-sym -> list-of-sym
(define (keeps l ss)
  ;; remove from l anything that isn't in ss:
  (removes l (removes l ss)))

;; Tests:
(bound-vars (answer-for-3.2.1))
(bound-vars (answer-for-3.2.2))
(bound-vars (answer-for-3.2.3))
(bound-vars (answer-for-3.2.4))
(bound-vars (answer-for-3.2.5))
(bound-vars (answer-for-3.2.6))
(bound-vars (large-example))