;;;; Functions to put simple expressions in normal form.
;;;;
;;;; File:         normal-x.lsp
;;;; Author:       CS 51 (Bob Walton)
;;;; Version:      1

;; simple-expression ::= variable
;;		       | (+ simple-expression
;;                          simple-expression)
;; variable ::= symbol
;;
;;
;; v, v1, v2 are variables (symbols),
;; e, e1, e2, e3 are simple expressions
;;
;;
;; v1 << v2 iff v1 is lexically less than v2
;;
;;
;; ((e1 + e2) + e3) ===> (e1 + (e2 + e3))
;; (v2 + v1) ===> (v1 + v2) if v1 << v2
;; (v2 + (v1 + e3)) ===> (v1 + (v2 + e3)) if v1 << v2

;; Functions to make code more readable
;;
(defun op (e) (car e))	    ; (op '(x y z)) ===> 'x
(defun arg1 (e) (cadr e))   ; (arg1 '(x y z)) ===> 'y
(defun arg2 (e) (caddr e))  ; (arg2 '(x y z)) ===> 'z
;;
(defun is+exp (e) (and (consp e) (eql '+ (op e))))
(defun isvar (e) (symbolp e))
(defun << (v1 v2) (string-lessp v1 v2))

;; Function to find normal form of a simple expression.
;; First effort: just do it.
;;
(defun normal-1 (e)

  (cond
   ;; Base case:
   ;;
   ((isvar e)		; v ===> v
    e)

   ;; Be sure arguments are already normal:
   ;;
   ((or (not (equal (arg1 e) (normal-1 (arg1 e))))
	(not (equal (arg2 e) (normal-1 (arg2 e)))))
    (normal-1 `(,(op e) ,(normal-1 (arg1 e))
		        ,(normal-1 (arg2 e)))))

   ;; Associate to the right:
   ;;
   ((and (is+exp e)		; (+ (+ e1 e2) e3) ===>
	 (is+exp (arg1 e)))	;   (+ e1 (+ e2 e3)) 
    (normal-1 `(+ ,(arg1 (arg1 e))
		  (+ ,(arg2 (arg1 e)) ,(arg2 e)))))

   ;; Sort variables:
   ;;
   							
   ((and (is+exp e)		; (+ v2 v1) ===>
	 (isvar (arg1 e))	;   (+ v1 v2)
	 (isvar (arg2 e))	;   if v1 << v2
	 (<< (arg2 e) (arg1 e)))
    (normal-1 `(+ ,(arg2 e) ,(arg1 e))))

   ((and (is+exp e)		; (+ v2 (+ v1 e3)) ===>
	 (is+exp (arg2 e))	;   (+ v1 (+ v2 e3))
	 (isvar (arg1 e))	;   if v1 << v2
	 (isvar (arg1 (arg2 e)))
	 (<< (arg1 (arg2 e)) (arg1 e)))
    (normal-1 `(+ ,(arg1 (arg2 e))
		  (+ ,(arg1 e) ,(arg2 (arg2 e))))))

   ;; Input expression is already normal.
   ;;
   (t
    e)))

;; Instrumentation helper functions


;; Variables to gather statistics on calls to normal.
;;
(defvar *did-rewrite* 0) ; Number of rewrites done.
(defvar *did-nothing* 0) ; Number of times no rewrite
			 ; was found.
(defvar *trace* nil)     ; True to print trace,
			 ; false not to.

;; Functions to gather statistics and output trace.

;; Call when rewriting an original expression to a new
;; rewritten expression.
;;
(defun rr (original-expression rewritten-expression)
  (setf *did-rewrite* (+ *did-rewrite* 1))
  (cond (*trace*
	 (fresh-line)
	 (princ `(,original-expression =>
	             ,rewritten-expression))
	 (fresh-line))))

;; Call when no applicable rewrite rule found.
;;
(defun no-rr ()
  (setf *did-nothing* (+ *did-nothing* 1)))

;; Call (RR-TIME (NORMAL-... ...)) to test a
;; version of the normal rewriter.
;;
(defmacro rr-time (expression)
  `(let ((result nil))
    (setf *did-nothing* 0)
    (setf *did-rewrite* 0)
    (setf result (time ,expression))
    (fresh-line)
    (terpri)
    (princ '|Number of Rewrites: |)
    (princ *did-rewrite*)
    (terpri)
    (princ
     '|Number of failures to find any rewrite: |)
    (princ *did-nothing*)
    (terpri)
    (terpri)
    result))

;; Function to find normal form of a simple expression.
;;
;; Normal-1 plus instrumentation.
;;
(defun normal-2 (e)

  (cond
   ;; Base case:
   ;;
   ((isvar e)		; v ===> v
    (no-rr)
    e)

   ;; Be sure arguments are already normal:
   ;;
   ((or (not (equal (arg1 e) (normal-2 (arg1 e))))
	(not (equal (arg2 e) (normal-2 (arg2 e)))))
    (normal-2 `(,(op e) ,(normal-2 (arg1 e))
		        ,(normal-2 (arg2 e)))))

   ;; Associate to the right:
   ;;
   ((and (is+exp e)		; (+ (+ e1 e2) e3) ===>
	 (is+exp (arg1 e)))	;   (+ e1 (+ e2 e3)) 
    (rr e `(+ ,(arg1 (arg1 e))
	      (+ ,(arg2 (arg1 e)) ,(arg2 e))))
    (normal-2 `(+ ,(arg1 (arg1 e))
		  (+ ,(arg2 (arg1 e)) ,(arg2 e)))))

   ;; Sort variables:
   ;;
   							
   ((and (is+exp e)		; (+ v2 v1) ===>
	 (isvar (arg1 e))	;   (+ v1 v2)
	 (isvar (arg2 e))	;   if v1 << v2
	 (<< (arg2 e) (arg1 e)))
    (rr e `(+ ,(arg2 e) ,(arg1 e)))
    (normal-2 `(+ ,(arg2 e) ,(arg1 e))))

   ((and (is+exp e)		; (+ v2 (+ v1 e3)) ===>
	 (is+exp (arg2 e))	;   (+ v1 (+ v2 e3))
	 (isvar (arg1 e))	;   if v1 << v2
	 (isvar (arg1 (arg2 e)))
	 (<< (arg1 (arg2 e)) (arg1 e)))
    (rr e `(+ ,(arg1 (arg2 e))
	      (+ ,(arg1 e) ,(arg2 (arg2 e)))))
    (normal-2 `(+ ,(arg1 (arg2 e))
		  (+ ,(arg1 e) ,(arg2 (arg2 e))))))

   ;; Input expression is already normal.
   ;;
   (t
    (no-rr)
    e)))

;; Function to find normal form of a simple expression.
;;
;; This version is efficient because it does not
;; unnecessarily check subexpressions to see if they
;; are normal.  It uses a helper function, apply-rules,
;; that takes as input an expression of the form
;; (+ e1 e2) where e1 and e2 are already known to be
;; normal.
;;
(defun normal-3 (e)

  (cond
   ;; Base case:
   ;;
   ((isvar e)		; v ===> v
    (no-rr)
    e)

   ;; Apply rules to operator with normal arguments.
   ;;
   (t
    (apply-rules-3
     `(,(op e)
	,(normal-3 (arg1 e))
	,(normal-3 (arg2 e)))))))

;; Apply rules assuming expression has form (+ e1 e2)
;; where e1 and e2 are normal.
;;
(defun apply-rules-3 (e)
  (cond

   ;; Associate to the right:
   ;;
   ((and (is+exp e)		; (+ (+ e1 e2) e3) ===>
	 (is+exp (arg1 e)))	;   (+ e1 (+ e2 e3)) 
    (rr e `(+ ,(arg1 (arg1 e))
	      (+ ,(arg2 (arg1 e)) ,(arg2 e))))
    (apply-rules-3
     `(+ ,(arg1 (arg1 e))
	 ,(apply-rules-3
	   `(+ ,(arg2 (arg1 e)) ,(arg2 e))))))

   ;; Sort variables:
   ;;
   							
   ((and (is+exp e)		; (+ v2 v1) ===>
	 (isvar (arg1 e))	;   (+ v1 v2)
	 (isvar (arg2 e))	;   if v1 << v2
	 (<< (arg2 e) (arg1 e)))
    (rr e `(+ ,(arg2 e) ,(arg1 e)))
    (apply-rules-3 `(+ ,(arg2 e) ,(arg1 e))))

   ((and (is+exp e)		; (+ v2 (+ v1 e3)) ===>
	 (is+exp (arg2 e))	;   (+ v1 (+ v2 e3))
	 (isvar (arg1 e))	;   if v1 << v2
	 (isvar (arg1 (arg2 e)))
	 (<< (arg1 (arg2 e)) (arg1 e)))
    (rr e `(+ ,(arg1 (arg2 e))
	      (+ ,(arg1 e) ,(arg2 (arg2 e)))))
    (apply-rules-3
     `(+ ,(arg1 (arg2 e))
	 ,(apply-rules-3
	   `(+ ,(arg1 e) ,(arg2 (arg2 e)))))))

   ;; Input expression is already normal.
   ;;
   (t
    (no-rr)
    e)))