;; Fill this function in with code to call your parser
;; e.g. jparse path #'my-grammar
(defun test-mj-parse (path)
  (parse-java path))


(defun run-tests (example-dir &optional (stderr t))
  "Compare your parser to simple-parse for all Appel's programs."
  (let ((codes '("BinarySearch.java"
                 "BinaryTree.java"
                 "BubbleSort.java"
                 "Factorial.java"
                 "LinearSearch.java"
                 "LinkedList.java"
                 "QuickSort.java"
                 "TreeVisitor.java")))
    (format stderr "~%Comparing output on all Appel's example files")
    (dolist (code codes)
      (format stderr "~%~%==== ~A ====" code)
      (let ((path (concatenate 'string example-dir code)))
        (check-ast path (test-mj-parse path))))))


(defun check-ast (fname ast &optional (stderr t))
  "Compare your AST to the output of simple-parse"
  (setf *ast-location* nil)
  (compare-ast (parse-java fname) ast stderr)
  nil)


(defun compare-ast (ast1 ast2 &optional (stderr t))
  "Compare two MiniJava ASTs"

  (let ((l1 (and (listp ast1) (length ast1)))
        (l2 (and (listp ast2) (length ast2))))
    (cond

      ((not (eq l1 l2))
       (format stderr "~%~%-- Mismatched AST lengths around ~A --" 
               *ast-location*)
       (if l1 
           (format stderr "~%Expected: (~A ...): ~A items" (car ast1) l1)
           (format stderr "~%Expected:  ~A" ast1))
       (if l2
           (format stderr "~%Saw:      (~A ...): ~A items" (car ast2) l2)
           (format stderr "~%Saw:       ~A" ast2)))

      ((and l1 (eq (car ast1) 'id))
       (unless (and (eq l1 3)
                    (eq (first ast2) 'id)
                    (eq (second ast1) (second ast2)))
         (format stderr "~%~%-- Mismatched identifiers around ~A --" 
                 *ast-location*)
         (pprint ast1 stderr)
         (pprint ast2 stderr))
       (setf *ast-location* (third ast1)))

      (l1
       (mapcar #'(lambda (a1 a2) (compare-ast a1 a2 stderr))
               ast1 ast2))

      (t
       (unless (equal ast1 ast2)
         (format stderr "~%~%-- Mismatched atoms around ~A --" *ast-location*)
         (pprint ast1 stderr)
         (pprint ast2 stderr)))))

  nil)