;;; COM3351 Section 2        Solution to Problem Set 3, Part B

;;; tree-equal method

;;; Auxiliary function to display mismatched nodes in trees
;;;  {keeps the code that does the actual work, easy to read}

(defun describe-mismatch (template comparand)
  (if (or (null template) (null comparand)) ;at most one is nil
    (cond 
      (template 
        (format t " The node ~%~%") (send template ':pp)
        (format t "DOES NOT MATCH ~%~% nil ~%~%"))
      (comparand
	(format t " nil DOES NOT MATCH ~%~%") (send comparand ':pp)
	(format "~%~%")))
   ;else
    (progn
      (format t "The node ~%~%")
      (send template ':pp)
      (format t "DOES NOT MATCH ~%~%")
      (send comparand ':pp)
      (format t "~%~%")))
 nil
)

;;; Methods which actually perform the comparison.
;;; We assume that comparand is a flavor instance and that tree
;;; has been constructed in type-checking mode.

(defmethod (repetition :tree-equal) (comparand)
  (if (and (equal (send-self ':type)
	     (send comparand ':type))
             ; what if one child is longer than the other ?
           (equal (send-self ':length) (send comparand ':length)))
         (apply 'and
	     (loop for element-of-self in child and
		   for  element-of-comparand in (send comparand ':child)
		   collect (send element-of-self
   		         ':tree-equal element-of-comparand)))
   ;else       
    (describe-mismatch self comparand)))
    

(defmethod (construction :tree-equal) (comparand)
  (if (equal (send-self ':type)
	     (send comparand ':type))
      (apply 'and
	     (loop for rhs-ref in (send-self ':rhs)
		   collect (let (
	 (self-element 
	   (send self (concat ":" rhs-ref)))
	 (comparand-element
	   (send comparand (concat ":" rhs-ref))))
	      (if (and self-element
		       comparand-element)
		  (send self-element
			':tree-equal comparand-element)
               ;else
		  (if (and (null self-element) (null comparand-element))
                    t 
                    (describe-mismatch self-element 
				       comparand-element))))))
   ;else
      (describe-mismatch self comparand)))

(defmethod (terminal :tree-equal) (comparand)
  (if (equal (send-self ':type)
	     (send comparand ':type))
      (if (equal val (send comparand ':val))
	  t
	  (describe-mismatch self comparand))))