#|

A scheme-exp is either:
  - (make-num= scheme-exp scheme-exp)

  - (make-kons scheme-exp scheme-exp)
  - (make-hd scheme-exp)
  - (make-tl scheme-exp)
  - (make-null-test scheme-exp)

  - (make-app symbol scheme-exp)
  - symbol
  - (make-kond scheme-exp scheme-exp scheme-exp)

  - scheme-val
  
A scheme-val is:
  - boolean
  - number
  - (cons scheme-val scheme-val)
  - '()
  
A scheme-def is:
  - (make-def symbol symbol scheme-exp)

A list-of-scheme-defs is either:
  - empty
  - (cons scheme-def list-of-scheme-defs)
|#

(define-struct num= (lhs rhs))
(define-struct kons (hd tl))
(define-struct hd (arg))
(define-struct tl (arg))
(define-struct null-test (arg))
(define-struct app (rator rand))
(define-struct kond (test thn els))
(define-struct def (name param body))

;; evaluate : scheme-exp list-of-scheme-defs -> scheme-val
(define (evaluate a-se a-losd)
  (cond
    [(num=? a-se) (= (evaluate (num=-lhs a-se) a-losd)
                     (evaluate (num=-rhs a-se) a-losd))]
    [(kons? a-se) (cons (evaluate (kons-hd a-se) a-losd)
                        (evaluate (kons-tl a-se) a-losd))]
    [(hd? a-se) (car (evaluate (hd-arg a-se) a-losd))]
    [(tl? a-se) (cdr (evaluate (tl-arg a-se) a-losd))]
    [(app? a-se)
     (let ([def (lookup-def (app-rator a-se) a-losd)])
       (evaluate
        (subst (def-param def)
               (evaluate (app-rand a-se) a-losd)
               (def-body def))
        a-losd))]
    [(symbol? a-se) (error 'evaluate "free variable")]
    [(kond? a-se)
     (if (evaluate (kond-test a-se) a-losd)
         (evaluate (kond-thn a-se) a-losd)
         (evaluate (kond-els a-se) a-losd))]
    [(null-test? a-se)
     (null? (evaluate (null-test-arg a-se) a-losd))]
    [else ;; scheme-val
     a-se]))

;; lookup-def : symbol list-of-scheme-defs -> def
;; finds the def for name in a-losd, or calls error if there isn't one
(define (lookup-def name a-losd)
  (cond
    [(null? a-losd) (error 'lookup-def "not found: ~a" name)]
    [else (if (eq? name (def-name (car a-losd)))
              (car a-losd)
              (lookup-def name (cdr a-losd)))]))

;; subst : number or cons symbol scheme-exp -> scheme-exp
;; substitutes val for var in body
(define (subst var val body)
  (cond
    [(num=? body) (make-num=
                   (subst var val (num=-lhs body))
                   (subst var val (num=-rhs body)))]
    
    [(kons? body) (make-kons (subst var val (kons-hd body))
                             (subst var val (kons-tl body)))]
    [(hd? body) (make-hd (subst var val (hd-arg body)))]
    [(tl? body) (make-tl (subst var val (tl-arg body)))]
    [(app? body)
     (make-app (app-rator body)
               (subst var val (app-rand body)))]
    [(symbol? body) 
     (if (eq? var body)
         val
         body)]
    [(kond? body)
     (make-kond (subst var val (kond-test body))
                (subst var val (kond-thn body))
                (subst var val (kond-els body)))]
    [(null-test? body) 
     (make-null-test (subst var val (null-test-arg body)))]
    [else ;; scheme-val
     body]))

;; examples as tests
(subst 'x 1 2)
2

(subst 'x 1 'x)
1

(subst 'x 1 'y)
'y

(subst 'x 1 #t)
#t

(subst 'x 1 (make-num= 'x 'y))
(make-num= 1 'y)

(subst 'x 1 (make-kons 'x 'y))
(make-kons 1 'y)

(subst 'x 1 '())
'()

(subst 'x 1 (make-hd 'x))
(make-hd 1)

(subst 'x 1 (make-tl 'x))
(make-hd 1)

(subst 'x 1 (make-tl 'x))
(make-tl 1)

(subst 'x 1 (make-app 'f 'x))
(make-app 'f 1)

(subst 'x 1 (make-kond 'x 'y 'z))
(make-kond 1 'y 'z)

(subst 'x 1 (make-null-test 'x))
(make-null-test 1)

(define defs
  (cons 
   (make-def 'f 'x (make-kons 1 'x))
   (cons
    (make-def 'g 'x (make-kons 3 (make-tl 'x)))
    (cons
     (make-def 'h 'x (make-num= 'x 1))
     '()))))

(lookup-def 'f defs)
(make-def 'f 'x (make-kons 1 'x))

(lookup-def 'g defs)
(make-def 'g 'x (make-kons 3 (make-tl 'x)))

(evaluate 2 defs)
2

(evaluate (make-num= 1 2) defs)
#f

(evaluate (make-num= 1 1) defs)
#t

(evaluate (make-kons 1 '()) defs)
(cons 1 '())

(evaluate (make-hd (make-kons 1 '())) defs)
1

(evaluate (make-tl (make-kons 1 '())) defs)
'()

(evaluate (make-null-test (make-kons 1 '())) defs)
#f

(evaluate (make-null-test '()) defs)
#t

(evaluate (make-kond (make-null-test '()) 1 2) defs)
1

(evaluate (make-kond (make-null-test (make-kons 1 '())) 1 2) defs)
2

(evaluate (make-app 'h '1) defs)
#t

#|

(define (contains-five? a-lon)
  (cond
    [(null? a-lon) #f]
    [else (cond
            [(= (car a-lon) 5) #t]
            [else (contains-five? (cdr a-lon))])]))

(contains-five? '())
(contains-five? (cons 1 '()))
(contains-five? (cons 5 '()))
(contains-five? (cons 3 (cons 4 (cons 5 (cons 6 (cons 7 '()))))))
|#

(define contains-five-def
  (make-def 'contains-five?
            'a-lon
            (make-kond
             (make-null-test 'a-lon)
             #f
             (make-kond
              (make-num= (make-hd 'a-lon) 5)
              #t
              (make-app 'contains-five?
                        (make-tl 'a-lon))))))

(define test1 (make-app 'contains-five? '()))
(define test2 (make-app 'contains-five? (make-kons 1 '())))
(define test3 (make-app 'contains-five? (make-kons 5 '())))
(define test4 (make-app 'contains-five? (make-kons 3 (make-kons 4 (make-kons 5 (make-kons 6 (make-kons 7 '())))))))

(evaluate test1 (cons contains-five-def '()))
#f

(evaluate test2 (cons contains-five-def '()))
#f

(evaluate test3 (cons contains-five-def '()))
#t

(evaluate test4 (cons contains-five-def '()))
#t