;;6.001 Spring '00       Sections 7 & 8         Prof. Albert R. Meyer

             ;ABSTRACT SYNTAX FOR ARITHMETIC EXPRESSIONS

;;USER OPERATIONS

 ;;EVALUATION

(define (eval-arith expr env)
  (cond ((number-expr? expr) expr)
        ((sum? expr)
         (let ((rand1
                (eval-arith (addend expr) env))
               (rand2
                (eval-arith (augend expr) env)))
           (+ rand1 rand2)))
        ((product? expr)
         (let ((rand1
                (eval-arith (multiplier expr) env))
               (rand2
                (eval-arith (multiplicand expr) env)))
           (* rand1 rand2)))
        ((variable? expr)
         (lookup expr env))
        (else (error "Bad expression" expr))))


 ;;OUTPUT

(define (expr->infix-tree expr)
  (cond ((number-expr? expr) expr)
        ((variable? expr) (variable-name expr))
        ((sum? expr)
         (let ((addend-tree (expr->infix-tree (addend expr)))
               (augend-tree (expr->infix-tree (augend expr))))
           (list addend-tree '+ augend-tree)))
        ((product? expr)
         (let ((multiplier-tree (expr->infix-tree (multiplier expr)))
               (multiplicand-tree (expr->infix-tree (multiplicand expr))))
           (list multiplier-tree '* multiplicand-tree)))
        (else (error "Bad expression" expr))))


(define (expr->prefix-tree expr)
  (cond ((number-expr? expr) expr)
        ((variable? expr) (variable-name expr))
        ((sum? expr)
         (let ((addend-tree (expr->prefix-tree (addend expr)))
               (augend-tree (expr->prefix-tree (augend expr))))
           (list '+ addend-tree augend-tree)))
        ((product? expr)
         (let ((multiplier-tree (expr->prefix-tree (multiplier expr)))
               (multiplicand-tree (expr->prefix-tree (multiplicand expr))))
           (list '* multiplier-tree multiplicand-tree)))
        (else (error "Bad expression" expr))))

(define (expr->infix-string expr)
  (cond ((number-expr? expr) (number->string expr))
        ((variable? expr) (symbol->string (variable-name expr)))
        ((sum? expr)
         (let ((addend-string (expr->infix-string (addend expr)))
               (augend-string (expr->infix-string (augend expr))))
           (string-append
            "(" addend-string "+" augend-string ")")))
        ((product? expr)
         (let ((multiplier-string (expr->infix-string (multiplier expr)))
               (multiplicand-string (expr->infix-string (multiplicand expr))))
           (string-append "(" multiplier-string "*" multiplicand-string ")")))
        (else (error "Bad expression" expr))))

  ;;INPUT

(define (infix-tree->expr input)
  (cond ((number-expr? input) input)
        ((symbol? input) (make-variable input))
        (else (if (and (pair? input)    ;length 3 list?
                       (pair? (cdr input))
                       (pair? (cddr input)))
                  ((cond
                    ((eq? '+ (cadr input)) make-sum)
                    ((eq? '* (cadr input)) make-product)
                    (else (error "unknown infix operator:" input)))
                   (infixtree->expr (car input))
                   (infix-tree->expr (caddr input)))
                  (error "not a length 3 list" input)))))

  ;;SIMPLIFY

(define (simplify expr)
  (cond ((sum? expr) (simplify-sum expr))
        ((product? expr) (simplify-prod expr))
        (else expr)))

(define (simplify-sum sum)
  (let ((ad (simplify (addend sum)))
        (au (simplify (augend sum))))
    (cond ((and (number? ad) (number? au))
           (+ ad au))
          ((and (number? ad) (zero? ad)) au)
          ((and (number? au) (zero? au)) ad)
          (else (make-sum ad au)))))

             ;THE SOLUTION TO THE EXERCISE
(define (simplify-prod prod)
  (let ((plier (simplify (multiplier prod)))
        (plicand (simplify (multiplicand prod))))
    (cond ((and (number? plier) (number? plicand))
           (* plier plicand))
          ((or (and (number? plier) (zero? plier))
               (and (number? plicand) (zero? plicand)))
           0)
          ((and (number? plier) (= 1 plier)) plicand)
          ((and (number? plicand) (= 1 plicand)) plier)
          (else (make-product plier plicand)))))          


  ;; DERIVATIVE

(define (deriv expr var)
  (cond ((number-expr? expr) 0)
        ((sum? expr)
	 (make-sum
	  (deriv (addend expr) var)
	  (deriv (augend expr) var)))
	((product? expr)
	 (let ((plier (multiplier expr))
	       (plicand (multiplicand expr)))
	   (make-sum
	    (make-product (deriv plier var) plicand)
	    (make-product (deriv plicand var) plier))))
        ((variable? expr)
	 (if (eq? (variable-name expr) (variable-name var)) 1 0))
        (else (error "Bad expression" expr))))


               ;; SIMPLE EXPRESSION IMPLEMENTATION: OPERATION SYMBOLS AS TAGS

 ;;SUMS
(define (make-sum e1 e2)
  (attach-tag sum-tag e1 e2))

(define (addend sum) (car (detach-tag sum)))
(define (augend sum) (cadr (detach-tag sum)))
(define (sum? expr)
  (and (pair? expr) (eq? (tag-of expr) sum-tag)))

 ;;PRODUCTS
(define (make-product e1 e2)
  (attach-tag prod-tag e1 e2))

(define (multiplier prod) (car (detach-tag prod)))
(define (multiplicand prod) (cadr (detach-tag prod)))
(define (product? expr)
  (and (pair? expr) (eq? (tag-of expr) prod-tag)))

 ;;VARIABLES IMPLEMENTED AS SYMBOLS
; Variable = Symbol
(define variable? symbol?)
(define (variable-name var) var)
(define (make-variable var) var)

 ;;NUMBER EXPRESSIONS: USE SCHEME NUMBERS
;Number-expression = Number 
(define number-expr? number?)

 ;;VAR-VALS ENVIRONMENTS IMPLEMENTED AS SYMBOL-NUMBER ASSOCIATION LISTS

(define (make-initial-env) nil)

(define (extended-env var n env)  ;ADD BINDING (VAR n)
  (cons (list var val) env))

(define (lookup var env) (assq var env))


  ;;ABSTRACT TAGGED DATA

(define (attach-tag tag . args) (cons tag args))
(define tag-of car)
(define detach-tag cdr)
(define sum-tag 'sum)
(define prod-tag 'prod)


;; EXPRESSION IMPLEMENTATION 2: AS RECORDS (A-LISTS)

  ;;IMPLEMENTATION 2A: WITH A 'PRINTABLE-INFIX LIST' FIELD.  
(define (expr->infix-tree expr)         ;JUST EXTRACT CONTENTS OF 'printable-infix' FIELD
  (cond ((number-expr? expr) expr)
        ((variable? expr) (variable-name expr))
        ((or (sum? expr) (product? expr))
         (field-contents 'printable-infix  (fields expr)))
        (else (error "Bad expression" expr))))

  ;;SUMS
(define (make-sum expr1 expr2)
  (let ((printable-infix
         (list
          (expr->infix-tree expr1)
          '+
          (expr->infix-tree expr2))))
    (attach-tag
     sum-tag
     (attach-tag 'addend expr1)
     (attach-tag 'augend expr2)
     (attach-tag 'printable-infix printable-infix))))

(define (addend sum) (field-contents 'addend (fields sum)))
(define (augend sum) (field-contents 'augend (fields sum)))


  ;;PRODUCTS
(define (make-product expr1 expr2)
  (let ((printable-infix
         (list
          (expr->infix-tree expr1)
          '*
          (expr->infix-tree expr2))))
    (attach-tag
     prod-tag
     (attach-tag 'multiplier expr1)
     (attach-tag 'multiplicand expr2)
     (attach-tag 'printable-infix printable-infix))))

(define (multiplier prod) (field-contents 'multiplier (fields prod)))
(define (multiplicand prod) (field-contents 'multiplicand (fields prod)))


  ;;VARIABLES ARE TAGGED TOO
(define (make-variable name)
  (attach-tag
   var-tag
   (attach-tag 'name name)))

(define (variable-name var)
 (field-contents 'name (fields var)))

(define var-tag 'var)
(define (variable? expr)
  (and (pair? expr) (eq? (tag-of expr) var-tag)))



  ;;FIELDS
(define fields detach-tag)
(define (field-contents tag fields)
  (let ((field (assq tag fields)))
    (if field
        (cadr field)
        (error "no field" tag fields))))


  ;;IMPLEMENTATION 2B: WITH AN 'EVALUATION-PROCEDURE' AS WELL

   ;;eval-proc: Vvenv -> Scheme-number
   ;;eval-proc is equivalent to (curry eval-arith) but faster:
(define (eval-arith expr env)
  ((eval-proc expr) env))

(define (eval-proc expr)                ;JUST EXTRACT CONTENTS OF 'EVAL-PROC FIELD
  (cond ((number-expr? expr) (lambda (env) expr))
        ((variable? expr)
         (lambda (env) (lookup expr env)))
        ((or (sum? expr) (product? expr))
         (field-contents 'eval-proc (fields expr)))
        (else (error "Bad expression" expr))))

(define (make-sum expr1 expr2)
  (let ((sum-proc
         (lambda (env)
           (+ ((eval-proc expr1) env)    ;COULD ALSO (SIMPLIFY EXPR1)
              ((eval-proc expr2) env)))) ;COULD ALSO (SIMPLIFY EXPR2)
        (printable-infix                ;SAME AS IN IMPLEMENTATION 2A
         (list
          (expr->infix-tree expr1)
          '+
          (expr->infix-tree expr2))))
    (attach-tag
     sum-tag
     (attach-tag 'eval-proc sum-proc)
     (attach-tag 'addend expr1)
     (attach-tag 'augend expr2)
     (attach-tag 'printable-infix printable-infix))))

(define (make-product expr1 expr2)
  (let ((prod-proc
         (lambda (env)
           (* ((eval-proc expr1) env)
              ((eval-proc expr2) env))))
        (printable-infix                ;SAME AS IN IMPLEMENTATION 2A
         (list
          (expr->infix-tree expr1)
          '*
          (expr->infix-tree expr2))))
    (attach-tag
     prod-tag
     (attach-tag 'eval-proc prod-proc)
     (attach-tag 'multiplicand expr2)
     (attach-tag 'multiplier expr1)
     (attach-tag 'printable-infix printable-infix))))


;TESTS

(define (varx) (make-variable 'x))
(define (vary) (make-variable 'y))
(define (varz) (make-variable 'z))

(define (test-expr)
  (make-product
   (make-sum 3 (make-product (varx) 9))
   (make-sum  (vary) (varz))))

;(expr->infix-tree (test-expr))
;(expr->prefix-tree (test-expr))
;(expr->infix-string (test-expr))

;(infix-tree->expr '((3 + (z * 9)) * (y + z)))

;(expr->prefix-tree (infix-tree->expr '((3 + (z * 9)) * (y + z))))

(define (env-1)
  (extended-env
   (varx) 6
   (extended-env
    (vary) 19
    (extended-env
     (varz) 20
     (make-initial-env)))))

(define (env-2)              ;RESULT IS EQUAL? TO (ENV-1)
  (make-env
    '((x 6) (y 19) (z 20))))

;(eval-arith (test-expr) (env-1))

(define (test-expr2)
 (infix-tree->expr '((3 + ((z * 9) * 0)) * (y + z))))

;(expr->prefix-tree (simplify (test-expr2)))

;(eval-arith (test-expr2) (env-1))

;(eval-arith (simplify (test-expr2)) (env-1))

;(expr->infix-tree (test-expr))
;(expr->infix-tree (deriv (test-expr) (vary)))
;(expr->infix-tree (simplify (deriv (test-expr) (vary))))
;(expr->infix-tree (deriv (test-expr) (varx)))
;(expr->infix-tree (simplify (deriv (test-expr) (varx))))

;(expr->infix-tree (test-expr2))
;(expr->infix-tree (simplify (test-expr2)))
;(expr->infix-tree (deriv (test-expr2) (vary)))
;(expr->infix-tree (simplify (deriv (test-expr2) (vary))))
;(expr->infix-tree (deriv (test-expr2) (varx)))
;(expr->infix-tree (simplify (deriv (test-expr2) (varx))))



(define (accumulate op init ls)
  (if (null? ls)
      init
      (op (car ls) (accumulate op init (cdr ls)))))

(define (make-env name-val-pairs)
  (accumulate (lambda (name-val vvenv-so-far)
                (extended-env
                 (make-variable (car name-val)) ;THE NAME
                 (cadr name-val)                ;THE VALUE
                 vvenv-so-far))
              (make-initial-env)
              name-val-pairs))