;6.001 March 9, 2000                    Recitation Notes by Prof. Albert R. Meyer

           ;ARITHMETIC EXPRESSIONS IMPLEMENTED AS MUTABLE RECORDS

;   (make-sum expr1 expr2)
;   (make-product expr1 expr2)
;   (make-variable name)
;   (sum? expr)
;   (product? expr)
;   (variable? expr)
;   (define number-expr? number?)


  ;;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)))
                   (infix-tree->expr (car input))
                   (infix-tree->expr (caddr input)))
                  (error "not a length 3 list" input)))))


 ;;OUTPUT

(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))))


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


(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))))

  ;;EXAMPLE:
;(expr->infix-string (infix-tree->expr '((3 + (z * 9)) * (y + z))))
;;Value: "((3+(z*9))*(y+z))"



;EXPRESSIONS IMPLEMENTED AS ABSTRACT RECORDS:

;A RECORD has a TAG and a set of FIELDS

 ;; ABSTRACT RECORD PRODCEDURES:
;(make-record tag f1 f2 ...)
;(record? thing)
;(record-tag record)
;(has-field? tag record)
;(field-content tag record)


;A FIELD has a UNIQUE TAG and some VALUE which is celled its CONTENT

;; ABSTRACT FIELD PRODCEDURES:
;(make-field 'field98 "a string value")
;(field? thing)
;(field-tag field)
;(field-value field)


 ;;EXPRESSION IMPLEMENTATION

 ;;SUMS

(define (make-sum expr1 expr2)
  (make-record
   sum-tag
   (make-field 'addend expr1)
   (make-field 'augend expr2)))

(define (addend sum) (field-content 'addend sum))
(define (augend sum) (field-content 'augend sum))
(define (sum? expr)
  (and (record? expr) (eq? (record-tag expr) sum-tag)))
(define sum-tag 'sum)


 ;;PRODUCTS

(define (make-product expr1 expr2)
  (make-record
   prod-tag
   (make-field 'multiplier expr1)
   (make-field 'multiplicand expr2)))


(define (multiplier prod) (field-content 'multiplier prod))
(define (multiplicand prod) (field-content 'multiplicand prod))
(define (product? expr)
  (and (record? expr) (eq? (record-tag expr) prod-tag)))
(define prod-tag 'prod)


  ;;VARIABLES ARE TAGGED TOO

(define (make-variable name)
  (make-record
   var-tag
   (make-field 'name name)))

(define (variable.name var)
 (field-content 'name var))
(define (variable? expr)
  (and (record? expr) (eq? (record-tag expr) var-tag)))
(define var-tag 'var)


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



  ;;RECORDS IMPLEMENTED AS TAGGED LIST OF FIELDS


(define (make-record tag . fields) (cons tag fields))
(define (record? thing)
  (and (pair? thing)
       (list? thing)
       (symbol? (car thing))
       (for-all? (cdr thing) field?)))  ;unique-tag check is skipped

(define (fields record) (cdr record))
(define (record-tag record) (car record))
(define (has-field? tag record)
  (pair? (member tag (map field-tag (fields record)))))


;;FIELDS

(define (make-field tag value)
  (list tag value))
(define (field-tag field) (car field))
(define (field-value field) (cadr field))
(define (field? thing)
  (and (pair? thing)
       (symbol? (car thing))
       (pair? (cdr thing))
       (null? (cddr thing))))
(define (field-content tag record)
  (field-value (get-field tag (fields record))))

(define (set-field-value! field val)
  (set-car! (cdr field val)))

(define (get-field tag fields)		;FIELDS MUST HAVE A "TAG" FIELD
  (let ((field (first fields)))
    (if (eq? tag (field-tag field))
	field
	(get-field tag (cdr fields)))))

(define (set-field! tag record val)
  (if (has-field? tag record)
      (set-field-value! (get-field tag record) val)
      (create-field! tag record val)))  

(define (create-field! tag record val)
  (set-cdr!
   record
   (cons (make-field tag val) (cdr record))))




;; PROCEDURES TO MEMOIZE EXPRESSION FIELDS

(define (expr->infix-tree expr)
  (cond ((number-expr? expr) expr)
        ((variable? expr) (variable.name expr))
        ((or (sum? expr) (product? expr))
	 (if (has-field? 'printable-infix expr)
	     (field-content 'printable-infix  expr)
	     (let ((infix-tree
		    (if (sum? expr)
			(let ((addend-tree (expr->infix-tree (addend expr)))
			      (augend-tree (expr->infix-tree (augend expr))))
			  (list addend-tree '+ augend-tree))
			(let ((plier-tree (expr->infix-tree (multiplier expr)))
			      (plicand-tree (expr->infix-tree (multiplicand expr))))
			  (list plier-tree '* plicand-tree)))))
	       (begin			;NOT REQUIRED, BUT CLEARER
		 (set-field!		;WILL CREATE THE FIELD IF NEED BE
		  'printable-infix
		  expr
		  infix-tree)
		 infix-tree))))
	(else (error "Bad expression" expr))))



;TESTS


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

(pp expr1)
(prod
 (multiplier
  (sum (addend 3)
       (augend (prod (multiplier (var (name z))) (multiplicand 9)))))
 (multiplicand
  (sum (addend (var (name y))) (augend (var (name z))))))
;Value: #[unspecified-return-value]

(expr->prefix-tree expr1)
;Value: (* (+ 3 (* z 9)) (+ y z))

(pp expr1)    ;NO CHANGE
(prod
 (multiplier
  (sum (addend 3)
       (augend (prod (multiplier (var (name z))) (multiplicand 9)))))
 (multiplicand
  (sum (addend (var (name y))) (augend (var (name z))))))
;Value: #[unspecified-return-value]


(expr->infix-string expr1)
;Value: "((3+(z*9))*(y+z))"

(pp expr1)    ;STILL NO CHANGE
(prod
 (multiplier
  (sum (addend 3)
       (augend (prod (multiplier (var (name z))) (multiplicand 9)))))
 (multiplicand
  (sum (addend (var (name y))) (augend (var (name z))))))
;Value: #[unspecified-return-value]


(expr->infix-tree expr1)   ;;THE MEMOIZING PROCEDURE!
;Value: ((3 + (z * 9)) * (y + z))

(pp expr1)
(prod               ;NEW PRINTABLE-INFIX FIELDS (LOTS)
 (printable-infix ((3 + (z * 9)) * (y + z)))
 (multiplier
  (sum
   (printable-infix (3 + (z * 9)))
   (addend 3)
   (augend
    (prod (printable-infix (z * 9))
          (multiplier (var (name z)))
          (multiplicand 9)))))
 (multiplicand
  (sum (printable-infix (y + z))
       (addend (var (name y)))
       (augend (var (name z))))))
;Value: #[unspecified-return-value]

(expr->infix-tree expr1)  ;;MEMOIZING AGAIN
;Value: (* (+ 3 (* z 9)) (+ y z))  ;STILL WORKS


(define expr2 (make-product (make-variable 'a) expr1))  ;MIXED PRINTABLE-INFIX FIELDS

(pp expr2)
(prod
 (multiplier (var (name a)))       ;NO PRINTABLE-INFIX FIELD HERE
 (multiplicand
  (prod
   (printable-infix ((3 + (z * 9)) * (y + z)))
   (multiplier
    (sum
     (printable-infix (3 + (z * 9)))
     (addend 3)
     (augend
      (prod (printable-infix (z * 9))
            (multiplier (var (name z)))
            (multiplicand 9)))))
   (multiplicand
    (sum (printable-infix (y + z))
         (addend (var (name y)))
         (augend (var (name z))))))))
;Value: #[unspecified-return-value]

(expr->infix-tree expr2) ;THE MEMOIZING PROCEDURE
;Value: (a * ((3 + (z * 9)) * (y + z)))

(pp expr2)
(prod
 (printable-infix (a * ((3 + (z * 9)) * (y + z))))
 (multiplier (var (name a)))
 (multiplicand
  (prod
   (printable-infix ((3 + (z * 9)) * (y + z)))
   (multiplier
    (sum
     (printable-infix (3 + (z * 9)))
     (addend 3)
     (augend
      (prod (printable-infix (z * 9))
            (multiplier (var (name z)))
            (multiplicand 9)))))
   (multiplicand
    (sum (printable-infix (y + z))
         (addend (var (name y)))
         (augend (var (name z))))))))
;Value: #[unspecified-return-value]


(expr->infix-tree expr2)  ;THE MEMOIZED ONE STILL WORKS!
;Value: (a * ((3 + (z * 9)) * (y + z)))