;; Answers for Exam 2 in CIS 352, Spring 2008
;;
;; DISTRIBUTION OF SCORES
;;  range:   scores
;; 41- 50:   41
;; 51- 60:   56 60
;; 61- 70;   61 62 64
;; 71- 80:   71 73 73 74 76
;; 81- 90:   80 84 86 
;; 91-100:   94 97
;;
;; Average = 72   Median = 73.5
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define displayln 
  (lambda lst
    (let ((show (lambda (x) (display x) (display " "))))
      (map show lst) 
      (newline))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; QUESTION 1
(define x '(10 20 30))
(define y '(r a t))
(define z 100)
(define lst '( (9 8 (7)) (6 5) ((4) 3) ))
  
(define puzzle   (let ((x 1) 
                       (y 2))
                   (let ((x (* 10 y)) 
                         (w x))
                     w) 
                   ))

(displayln "\nQuestion 1")
(displayln "   a: " (cddar lst) )
(displayln "   b: " (append y (cdr x)))
(displayln "   c: " (map car lst) )
(displayln "   d: " (apply length (list x) ) )
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; QUESTION 2
(define a '(Flopsy Mopsy Cottontail))
(define b (cons a (list 1)))
(set! a (list 1 20 300 4000))
(define c (cdr a))
(define d '(car a))
(set-car! (cdr d) 'Peter)
(set-cdr! (cdr c) (cdr b))

(displayln "\nQuestion 2")
(displayln "   a = " a)
(displayln "   b = " b)
(displayln "   c = " c)
(displayln "   d = " d)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; QUESTION 3 (20 points)
;; Choose **four** of the following **six** terms, and 
;; for each choice, give **both**
;;   (i)  a definition and 
;;   (ii) an example or application of the notion.  
;; Only the first four answers will be graded.
;; REMEBER: an example != a definition!!!
;;   a. beta reduction
;;   b. closure
;;   c. denoted value
;;   d. free variable
;;   e. lexical scoping
;;   f. shadowed variables
;;
;; ANSWER  go look these up

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; QUESTION 5
(define old 100)
(define prev
  (let ((old 0) (ans 0))
    (lambda (x)
      (begin (set! ans old)
             (set! old x)
             ans))))   

(displayln "\nQuestion 4")
(displayln "   (prev 97) returns: " (prev 97))
(displayln "   (prev 14) returns: " (prev 14))
(displayln "   old       returns: " old)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; QUESTION 5 
;; Beta-reduce the following expressions as far as possible, i.e.,
;; until there are no beta-redices left.  Show each step and underline
;; the redex being reduced.  You may reduce things in any order you
;; choose. 
;;
;; a. ((lambda (x) (x y)) (w z)) 
;;    ==========================
;;    (x y)[x/(w z)] = ((w z) y)
;;
;; b. Here is one possible reduction sequence.
;;
;;    ((lambda (x) (x x)) ((lambda (z) (x y)) (z w)))
;;                        ==========================
;;    ((lambda (x) (x x)) {(x y)[z/(z w)]} ) 
;;     = 
;;    ((lambda (x) (x x)) (x y))
;;    ==========================
;;     (x x) [x/(x y)] =
;;    ((x y) (x y))
;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; QUESTION 6
;; Consider the following (corrected) code: 
;; 
;;  let b = 10 
;;      c = 20 
;;   in 
;;      let f = proc(a) +(a,c) 
;;          g = proc(a,c) *(b,c) 
;;       in 
;;          let h = proc(b) (g b (f b)) 
;;           in 
;;              (h 1) 
;; a) Under lexical scoping, what is the value of this expression? 
;;
;; ANSWER
;;   e0 = initial-environment
;;   
;;   e1 : (b   c)   vars
;;        [10|20]   vals
;;        e0        env
;;
;;   e2:  (f   g)   vars
;;        [c1|c2]   vals       c1 = the closure for f
;;        e1        env        c2 = the closure for g
;;
;;   e3:  (h)       vars   
;;        [c3]      vals       c3 = the closure for h
;;        e2        env
;;
;;   evaluate (h 1) in e3
;;    
;;   e4: (b)       vars
;;       [1]       vals
;;       e1        env
;;      
;;   evaluate (g b (f b)) in e4
;;
;;   e5: (a)       vars
;;       [1]       vals
;;       e1        env
;;   
;;   evaluate +(a,c) == +(1,20) == 21
;;
;;   e6: (a  c)    vars
;;       [1|21]    vals
;;       e1        env
;;   
;;   evaluate *(b,c) = *(10,21) = 210
      

;; b) Under dynamic scoping, what is the value of this expression? 
;;
;; ANSWER
;;       b | 10
;;       c | 20
;;       f | c1
;;       g | c2
;;       h | c3
;;   evaluate (h 1)
;;       b | 1
;;   evaluate (g b (f b))      evaluation of (f b)
;;                                    a | 1
;;                             evaluate +(a,c) = +(1,20) = 21 
;;                             (the a|1 binding is now popped off the stack)
;;       a | 1
;;       c | 21
;;   evaluate *(b,c) = *(1,21) = 21

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; QUESTION 7

;; See the marked sections below.

(define eval-exp
  (lambda (exp)
    (eval exp init-env)))

(define ns-eval 
  (lambda (exp env)
    (cond
      ((number? exp) exp)
      ((symbol? exp) (apply-env env exp))
      ((eqv? 'lambda (car exp)) 
       (makeClosure exp env))

      ((eqv? 'if (car exp))                                  ;;; Question 7b
       (if (zero? (ns-eval (getTest exp) env))               ;;; Question 7b
           (ns-eval (getElse exp) env)                       ;;; Question 7b
           (ns-eval (getThen exp) env)))                     ;;; Question 7b
      
      ((eqv? 'while (car exp))                               ;;; Question 7c
       (let ((testproc (ns-eval (getTestProc exp) env))      ;;; Question 7c
             (nextproc (ns-eval (getNextProc exp) env))      ;;; Question 7c
             (state    (ns-eval (getState exp) env)))        ;;; Question 7c
         (letrec                                             ;;; Question 7c
             ((loop (lambda (st)                             ;;; Question 7c
                      (if (zero? (ns-apply testproc st))     ;;; Question 7c
                          st                                 ;;; Question 7c
                          (loop  (ns-apply nextproc st)))))) ;;; Question 7c
           (loop state))))                                   ;;; Question 7c

      ((eqv? 'whileToo (car exp))                            ;;; Question 7c Alt
       (let ((testproc (ns-eval (getTestProc exp) env))      ;;; Question 7c Alt
             (nextproc (ns-eval (getNextProc exp) env))      ;;; Question 7c Alt
             (state    (ns-eval (getState exp) env)))        ;;; Question 7c Alt
         (do-while testproc nextproc state)))                ;;; Question 7c Alt
      
      ((member (car exp) prim-list)
       (apply-prim (getOpExp exp) (ns-eval (getRandExp exp) env)))
      (else (ns-apply (ns-eval (getOpExp exp) env) 
                   (ns-eval (getRandExp exp) env))))))

(define do-while                                             ;;; Question 7c Alt
  (lambda (testproc nextproc st)                             ;;; Question 7c Alt
    (if (zero? (ns-apply testproc st))                       ;;; Question 7c Alt
        st                                                   ;;; Question 7c Alt 
        (do-while testproc nextproc (ns-apply nextproc st))))) ;;; Question 7c Alt

(define ns-apply
  (lambda (op rand)
    (let ((formal (getFormal op))
          (body   (getBody op))
          (env    (getEnv op)))
      (ns-eval body (extend-env env formal rand)))))

(define apply-prim
  (lambda (prim rand)
    (cond 
      ((eqv? prim 'add1) (+ rand 1))
      ((eqv? prim 'sub1) (- rand 1))                         ;;; Question 7a
      ((eqv? prim 'square) (* rand rand))                    ;;; Question 7a
      ((eqv? prim 'zero?) (if (zero? rand) 1 0))             ;;; Question 7a
      )))

(define prim-list '(add1 sub1 square zero?))                 ;;; Question 7a

;; Closures:        closure ::= ( formal body env )
(define makeClosure 
  (lambda (exp env)
    (list (caadr exp) (caddr exp) env)))
(define getFormal   car)
(define getBody     cadr)
(define getEnv      caddr)

;; Environments:    env ::= ( {(<id> <value>)}^* )
(define apply-env 
  (lambda (env var) 
    (cond 
      ((null? env)            'error)
      ((eqv? var (caar env))  (cadar env))
      (else                   (apply-env (cdr env) var)))))

(define extend-env  
  (lambda (env var val) 
    (cons (list var val) env)))

(define init-env '((x 2) (y 14)))

;; Syntax extractors
(define getOpExp    car)
(define getRandExp  cadr)

(define getTest     cadr)
(define getThen     caddr)
(define getElse     cadddr)

(define getTestProc cadr)
(define getNextProc caddr)
(define getState    cadddr)