(in-package "KPML")

;;; File: example-running.lisp
;;; original version: KPML 0.8: Apr95
;;;
;;; File extracts all the functions for running examples from their
;;; diverse original Penman homes and  includes KPML updates for increased
;;; functionality of the example runner.
;;;
;;; ----------------------------------------------------------------------
;;; Normally output from the example runner will go to a file,
;;; although this can also be standard-output. Three levels of
;;; output production are provided in KPML 0.8 (actually in versions
;;; after 0.8.14):
;;; i:   strings only
;;; ii:  strings+input SPL
;;; iii: strings+full example record structures
;;; 
;;; The latter is very verbose, but is necessary for the more advanced
;;; example comparison functionalities.
;;;
;;; Example runner and example runner comparisons
;;; ---------------------------------------------
;;;
;;;*** Saying in addition to expressing added in this and related
;;;    functions below... (John:IPSI:March 94)
;;;
;;; Furthermore, if there is no logical form, then it will attempt to
;;; run from the example record, and vice versa. 
;;;
;;; Patches
;;; -------
;;;
;;; Folds in the suitably updated version of the patches 0.7.36 and 
;;; 0.8.14.
;;;
;;; 2.1 old conditionalization for symbolics removed.
;;;     some of the example utilities for comparing generated with target
;;;     improved, integrated, and moved to examples.lisp
;;;
;;;     uses the parameterizable *failure-string* instead of a null
;;;     string when failing
;;; 3.2.17 (for Serge)
;;;            make the following note the maximum constituency 
;;;            complexity reached. Add the global defvar into the 
;;;            same file.
;;; 3.2.50 make sure that this say function just cannot break, even due
;;;            to extreme Lisp errors somewhere in the middle of
;;;            generation, as this can wreck an automatic batch of
;;;            example set regression checks.    
;;; ----------------------------------------------------------------------

(defvar *MAX-COMPLEXITY-REACHED* 0)
(defvar *SERIOUS-FAILURE-COUNT* 0)
(defvar *SERIOUS-FAILURES* nil)

(defvar *EXAMPLE-RUNNING-OPTIONS* '(:low :medium :high :complete))
(defvar *EXAMPLE-RUNNING-DETAIL-LEVEL* :low)
(defvar *FAILED-EXAMPLES* nil)
(defvar *EXAMPLE-RUNNER-STREAM* nil 
  "example runner stream during example runs")
(defvar *ML-GENERATION-MODE* :monolingual)

;;; ----------------------------------------------------------------------
;;; 1.0.23
;;; Additions for checking the success of example sets. Various modes
;;; of comparing the generated strings with targets, and with previous
;;; generated strings. 
;;; 
;;; Note that these (as of 2.1) are still only partially integrated with the 
;;; kinds of checks offered by the Example Manager.
;;; ----------------------------------------------------------------------

(defvar *example-running-comparison* :target)  ;; or :generated
(defvar *example-check-results* nil)
(defvar *example-checking* nil)                 
(defvar *generated-results-table* (make-hash-table :size 200))

;;; ----------------------------------------------------------------------
;;; The following function is main function for running sets of
;;; examples. The behavior of the keywords is as follows. 
;;; When the data-file-stream is given, it is used as the
;;; output of the example running. If the data-file-name is
;;; given, this is used as the destination of the output.
;;;
;;; 2.0.21
;;; extension of example runner to give mismatches between 
;;; generated and target forms also. Note that this uses the
;;; same mechanism as provided by the example manager 
;;; mismatch tool. It should also therefore be integrated with
;;; the various options that check structure and string with
;;; the previously generated results. This has not yet been
;;; done.
;;;
;;; 4.0 It is really nice to have an overview of what worked
;;;     and what did not, so this information is now passed back
;;;     to any caller who wishes to do something with it...
;;; ----------------------------------------------------------------------

(defun EXAMPLE-RUNNER (given-example-list 
		       &key 
		       (data-file-stream nil)
		       (data-file-name "example-runner")
		       (say-p t)
		       (sort-examples T)
		       (message-stream *trace-output*)
		       (check *example-checking*)
		       (compare *example-running-comparison*)
		       (closeness *example-check-exactness*))
  "Runs all the examples in example-list optionally dumping the text, function structure and selection expressions to a file"
  (let ((inquiry-mode *general-inquiry-mode*)
;;; KPML 0.7.36-- and all references to generated-string below.
	(example-list (if sort-examples
			  (sort (copy-list given-example-list) 
				;; 2.0.25
				#'numbered-name-lessp)
			given-example-list))
	(final-string *failure-string*)    ;; 2.1
	(l (length given-example-list))
	(*example-checking* check)
	(*example-running-comparison* compare)
	(*example-check-exactness* closeness)
	(*demo-mode* *demo-mode*))
    
    (setf *failed-examples* nil
	  *example-check-results* nil
	  *example-checking* check)
    
    (setf example-list (example-runner-language-selection example-list))
    (preserve-previous-generated-results example-list)
    (do-all-kpml-initializations)  ;; 4.0 added
    (unwind-protect
	(block 
	 nil
	 (setq example-runner-flag t)
	 (unless (streamp data-file-stream)
		 (setq data-file-stream 
		       (open (merge-pathnames 
			      (pathname (string data-file-name))
			      (user-homedir-pathname))
			     :direction :output
			     :if-exists :new-version)))
	 (format data-file-stream "~%(in-package \"KPML\")")
	 (setf *example-runner-stream* data-file-stream)
	 (example-runner-header-info *example-runner-stream* example-list)
	 (unless (eq message-stream *example-runner-stream*)
		 (example-runner-header-info message-stream example-list))
	 
	 (when (eq *example-running-detail-level* :complete)
	   (setf *demo-mode* T))
	 (loop for example in example-list
	     for n upfrom 1 
	     do
	       (cond 
		((example-p example)
		 (format message-stream "~%;;; ~A (~A of ~A)"
			 (embed-in-line-of-chars
			  (format nil "EXAMPLE ~a"  example))  n l)
		 (setf final-string *failure-string*)
		 (catch 'erunner 
		   (setf final-string (example-runner-say say-p example)))
		 (report-eg-runner-result 
		  data-file-stream final-string example))
		(t
		 (format  
		  message-stream 
		  "~%;;; ~A"
		  (embed-in-line-of-chars
		   (format nil
			   "EXAMPLE ~a is not the name of a loaded example"  
			   example))))))
	 
	 (format message-stream "~%;;; ~A" (embed-in-line-of-chars ""))

	 ;; 2.0.21 all these reports should be combined one day...
         ;; 2.1    put the failure summaries in the tmp file also...
	 (report-example-runner-failures message-stream)
         (report-example-runner-failures data-file-stream)
	 (report-example-mismatches example-list message-stream)
         (report-example-mismatches example-list data-file-stream)

	 (report-example-check-results message-stream)
	 (when data-file-stream
	   (format message-stream 
		   "~2%;;; The data file for this set of examples is: ~a"
		   (namestring (truename data-file-stream ))))
	 (if *monitor-feature-use*
	     (format 
	      message-stream 
	      "~%;;; In this example run, a total of ~A features were used."
	      (length *cumulative-features-used*)))
	 (format message-stream "~2%;;; Example runner done."))
      (block nil
	(when data-file-stream
	  (close data-file-stream))
	(setq example-runner-flag nil))
      (set-inquiry-mode nil inquiry-mode)
      (setf *general-inquiry-mode* inquiry-mode)
      (setf *demo-mode* nil))
      ;; 4.0 ... a start...
      (values l *failed-examples*)))


(defun EXAMPLE-RUNNER-HEADER-INFO (stream exs)
  (format  stream 
	   "~%;;; Summary of a run of the example runner on ~a" (time-stamp))
  (if (or (eq *ml-generation-mode* :multilingual)
	  (eq *ml-generation-mode* :contrastive))
      (loop for curlan in (if *languages-in-focus* *languages-in-focus*
			    all_languages)
	    when (disable-system)
	    do
	    (format stream 
		    "~%;;; Note that the following systems were disabled!! ~%~A for language: ~A"
		       (disable-system) curlan))
    (when (disable-system)
	  (format data-file-stream 
		  "~%;;; Note that the following systems were disabled!! ~%~A"
		  (disable-system))))
  (format stream 
	  "~%;;;        ~A examples selected." (length exs))
  (format stream 
	  "~%;;;        Report detail level: ~A." *example-running-detail-level*) ;; 4.0
  )

  ;; ----------------------------------------------------------------------
  ;; The following provides a say that never breaks, regardless of
  ;; what sort of nonsense it is given. This is only to be used during
  ;; processes and batch runs where individual examples failing is
  ;; a bad idea.
  ;; ----------------------------------------------------------------------

(defmacro HARD-SAY (example)
  `(unwind-protect
       (multiple-value-bind
	(value error)
	(ignore-errors
	 (say ,example))
	(progn
	  (if error
	      (progn
		(setf *serious-failure-count* (1+ *serious-failure-count*))
		(push ,example *serious-failures*)
		*failure-string*)
	    value)))))

(defun EXAMPLE-RUNNER-SAY (say-p example)
  (let ((generated-result
	 (cond 
	  (say-p
	   (cond ((fetch-example-info example 'logicalform)
		  (unless (or 
			   (eq *example-running-detail-level* :low)
			   (eq *example-running-detail-level* :complete))
		    (format *example-runner-stream*
			    "~%;;; Generating from logical form / spl:~%")
		    (let ((*standard-output* *example-runner-stream*))
		      (pprint-spl-logical-form
		       (fetch-example-info example 'logicalform)))
		    (format *example-runner-stream* "~2%"))
		  (set-inquiry-mode-implemented)
		  (hard-say example))              	     ;; 3.2.50
		 (t
		  (format 
		   *example-runner-stream*
		   "~%;;; Generating from example record, although logical form requested")
		  (set-inquiry-mode-deimplemented)
		  (hard-say example))))              	     ;; 3.2.50
	  (t
	   (format *example-runner-stream* 
		   "~%;;; Generating from example record")
	   (set-inquiry-mode-deimplemented)
	   (hard-say example)))))              	             ;; 3.2.50
    (when constituent-index                                  ;; 4.0 can blow if first example fails!
      (setf *max-complexity-reached*                         ;; 3.2.17 added.
	    (max constituent-index *max-complexity-reached*)))
    generated-result))

  ;; 3.2.11
  ;; The use of pprint in Lispworks given an error with non-Latin
  ;; characters that go beyond base strings... This is quite unfortunate.
  ;; pprint replaced by print here until a better solution appears,
  ;; otherwise the example runner can just break...

(defun REPORT-EG-RUNNER-RESULT (data-file-stream final-string example)
  (when (eq *example-running-detail-level* :complete)
    (print-full-example-record example data-file-stream)
    (return-from report-eg-runner-result nil))
  (check-example example final-string)                    ;; 1.0.23
  (cond ((not (generation-completed-p final-string))      ;; 2.1
	 (push example *failed-examples*)
	 (when data-file-stream
	   (format data-file-stream
		   "~%(~a :failed)~2%" example)))
	(data-file-stream
	 (format data-file-stream "~%(~a " example)
	 (case *example-running-detail-level*
	       (:low
		(print final-string data-file-stream)) ;; 3.2.11
	       (:medium
		(print final-string data-file-stream)) ;; 3.2.11
	       (:high
		(print final-string data-file-stream)  ;; 3.2.11
		(format data-file-stream "~%(~%")
		(print-orderings data-file-stream)     ;; 3.2.11
		(format data-file-stream "~%)~%")
		(print (fetch-example-info example 'selectionexpressions)
		       data-file-stream)))
	 (format data-file-stream "~%)~%"))))

(defun EXAMPLE-RUNNER-TO-FILE 
  (example-list output-file-name &key (data-file-name nil)(say-p t))
  (unwind-protect
      (block nil
	     (progn
	       
	       (do-all-kpml-initializations) ;; 3.2.30 
	                                     ;; + 4.0 moved so that the output
	                                     ;;       does not appear in file!
	       (with-open-file 
		(*standard-output*
		 (merge-pathnames (pathname (string output-file-name))
				  (user-homedir-pathname))
		 :direction :output
		 :if-exists :new-version)
		
		(setf *serious-failure-count* 0         ;; 3.2.50
		      *serious-failures* nil)
	      
		(example-runner example-list data-file-name :say-p say-p)))
	     )))
	  
;;; ----------------------------------------------------------------------
;;; (Take from patch: 0.7.36)
;;; Following function is called in ml-window-ops to get the window
;;; interface switched off during example running (since you can't use
;;; it then anyway!)  Puts *all* output to files, including warnings,
;;; etc. This adds another mode to example-running:
;;; ----------------------------------------------------------------------

(defvar *EXAMPLE-RUNNING-WARNINGS-AND-ALL* NIL)

;;; ----------------------------------------------------------------------
;;; Standard break function during example running.
;;; Stream name is used special...
;;; ----------------------------------------------------------------------

(defun USER-REQUEST-DURING-EXAMPLE-RUNNING (strings-to-print)
  (format *example-runner-stream* "~%**** BREAK CONDITION!!!! ")
  (format *example-runner-stream* "~% ~{ ~A ~%~} " 
	  (if (listp strings-to-print)
	      strings-to-print
	    (list strings-to-print)))
  (format *example-runner-stream* "~% ... resuming.")
  (throw 'erunner nil))

;;; ----------------------------------------------------------------------
;;; Following function depending on the global setting, either restricts
;;; the examples to be generated to those valid for the current language
;;; or does all of them. If there is no language conditionalization,
;;; returns the entire list.
;;; ----------------------------------------------------------------------

(defvar *restrict-example-running-by-language* T)

(defun EXAMPLE-RUNNER-LANGUAGE-SELECTION (example-list)
  (remove-duplicates
   (typecase example-list
     (cons
      (if (consp (first example-list))
	  (if *restrict-example-running-by-language*
	      (loop for eg in example-list
		  when (member curlan (cdr eg))
		  collect (first eg))
	    (mapcar #'first example-list))
	example-list))
     (symbol
      (list example-list)))))

;;; ----------------------------------------------------------------------
;;; Following addition does the work of checking the newly generated
;;; string with what had happened before...
;;; 1.0.23
;;; 2.1     changed to use the general matching predicate defined in
;;;         examples.lisp, thus making all matching subject to the same
;;;         flags and options.
;;; ----------------------------------------------------------------------

(defun CHECK-EXAMPLE (example final-string)                    
  (when *example-checking*
    (let* ((new-comparison-string final-string)
	   (old-comparison-string
	    (case *example-running-comparison*
	      (:target (fetch-example-info example 'targetform))
	      (:generated (gethash example *generated-results-table*)))))
      (when (generation-mismatch-p new-comparison-string old-comparison-string)
	(push (list example new-comparison-string old-comparison-string)
	      *example-check-results*)))))

(defun PRESERVE-PREVIOUS-GENERATED-RESULTS (examples)
  (when *example-checking*
    (clrhash *generated-results-table*)
    (loop for ex in examples
	do (setf (gethash ex *generated-results-table*)
	     (fetch-example-info ex 'generatedform)))))

(defun REPORT-EXAMPLE-CHECK-RESULTS (message-stream)
  (cond ((and *example-checking* *example-check-results*)
	 (format message-stream
	  "~%;;; Following examples did not generate the same as previously,")
	 (format message-stream "~2%")
	 (format message-stream
		 "~% ;;; with ~S matching with ~S."
		 *example-check-exactness* *example-running-comparison*)
	 (format message-stream
		 "~{~{~%;;;   Example ~A: ~
                      ~%;;;        new: ~A~
                      ~%;;;        old: ~A~}~}"
		 (reverse *example-check-results*)))
	(*example-checking*
	 (format message-stream
		 "~%;;; No differences found with previous ~S" 
		 *example-running-comparison*))))

;;; ----------------------------------------------------------------------

(defvar *FAILURE-STRING* "...failed to generate...")

(defun REPORT-EXAMPLE-RUNNER-FAILURES (stream)
  (loop for e in *failed-examples*
      do (setf (fetch-example-info e 'generatedform) *failure-string*))
  (format stream "~%;;; Following ~A examples failed: ~A" 
	  (length *failed-examples*)
	  *failed-examples*))
   
(defun REPORT-EXAMPLE-MISMATCHES (example-list stream)
  (multiple-value-bind 
      (count mismatches)
      (loop for e in example-list
	  when (generation-mismatch-p
		(fetch-example-info e 'targetform)
		(fetch-example-info e 'generatedform))
	  collect e into mismatches
	  and count e into count
	  finally (return (values count mismatches)))
    (format 
     stream 
     "~%;;; Following ~A examples generated differently from their targets: ~A"
     count mismatches)
    ;; 2.1
    (report-example-mismatch-flag-status stream)
    ))

;;; ----------------------------------------------------------------------
;;; 2.1 Note
;;;  functions for checking mismatch between generated and target moved
;;;  to objects/examples.lisp
;;; ----------------------------------------------------------------------

;;; ----------------------------------------------------------------------
;;; pretty printing...
;;; ----------------------------------------------------------------------

(defvar *BACKGROUND-LINE-CHAR* #\*)
(defvar *BACKGROUND-LINE-LENGTH* 55)

(defun EMBED-IN-LINE-OF-CHARS 
    (symbol-or-string &key (length *background-line-length*)(indent 3))
  (let ((string (string symbol-or-string)))
    (concatenate 'string 
      (coerce 
       (loop for i from 0 to indent collect *background-line-char*) 'string)
      "  "
      string 
      "  " 
      (coerce
       (loop for i from (length string) to length 
	   collect *background-line-char*)
       'string))))




;;; =========================================================================
;;; From here on needs checking/updating!!! Is completely undebugged.
;;; ======================================================================

(defun report-examples (example-list)
  "Prints to a lisp listener a summary of feature, system, chooser and operator usage for a list of examples."
;  (analyze-choosers t)
;  (analyze-choosers)
  (when (atom example-list) (setq example-list (list example-list)))
  (let ((features-chosen nil)(selection-expressions nil)(systems-used nil)(choosers-used nil)
	(operators-used nil)(use-trivial-default-code nil) (use-no-operator-code nil)(counter 0)(loaded-operator nil))
    
    (dolist (example-name example-list)
      (setq selection-expressions 
	(fetch-example-info example-name 'selectionexpressions))
      (dolist (x selection-expressions)
	(setq features-chosen (append  (cdr x) features-chosen)))
      (setq features-chosen (sort (copy-list (remove-duplicates features-chosen)) #'string-lessp )))
  
    (dolist (x (list-systems))
      (setq counter 0)
      (block is-system-used
	(dolist (y (fetch-output-features x))
	    (when (member y features-chosen)
	      (incf counter)
	      (push x systems-used)
	      (return-from is-system-used)))))
    (setq  systems-used (sort (copy-list (remove-duplicates  systems-used)) #'string-lessp))
    
    (dolist (x systems-used )
      (push (fetch-system-chooser x) choosers-used))
    (setq choosers-used (sort (copy-list (remove-duplicates choosers-used)) #'string-lessp))
    
    (dolist (x choosers-used)
      (dolist (y (fetch-chooser-db-elt 'asks x))
	(push (car y) operators-used))
      (dolist (y (fetch-chooser-db-elt 'identifies x))
	(push (caadr y) operators-used)))
    (setq operators-used (sort (copy-list (remove-duplicates operators-used)) #'string-lessp))
    
    (dolist (x operators-used)
      (cond((setq loaded-operator (gethash x quiry-operators))
	    (when (equal (fetch-inquiry-info  loaded-operator 'operatorcode)
			 'trivialdefaultcode)
		  (push x use-trivial-default-code))
	    (unless (fetch-inquiry-info loaded-operator 'operatorcode)
	      (push x use-no-operator-code )))
	   (t(warning x " is not a loaded operator."))))
    (setq use-trivial-default-code (sort (copy-list (remove-duplicates use-trivial-default-code)) #'string-lessp))
    (setq use-no-operator-code (sort (copy-list(remove-duplicates use-no-operator-code )) #'string-lessp))
    (values features-chosen systems-used
	    choosers-used operators-used use-trivial-default-code use-no-operator-code )))


      
(defun report-examples-print (example-list)
  (multiple-value-bind (features-chosen systems-used
			choosers-used operators-used use-trivial-default-code use-no-operator-code)
      (report-examples example-list)
    (format t "~2%Report for example(s): ~a" example-list)
    
    (format t "~%Total features used:")
    (pprint features-chosen)
    
    (format t "~%Total systems used:")
    (pprint   systems-used)
    
    (format t "~%Total choosers used:")
    (pprint  choosers-used)
    
    (format t "~%Total operators in used choosers:")
    (pprint  operators-used)
    
    (format t "~%Total operators in used choosers using trivial default code:")
    (pprint use-trivial-default-code ) 
    
    (format t "~%Total operators in used choosers with no operator code:")
    (pprint use-no-operator-code )))



(defun compare-example-runner-summaries (file1-name file2-name)
  "Compares the data files writen by example runner"
  (let* ((file1-table (make-hash-table))
	(file2-table (make-hash-table))
	(file1-pathname (merge-pathnames (pathname (string file1-name ))
					 (user-homedir-pathname)))
	(file2-pathname (merge-pathnames (pathname (string file2-name ))
					 (user-homedir-pathname)))
	(file1-namestring (namestring (truename file1-pathname)))
	(file2-namestring (namestring (truename file2-pathname)))
	(form nil)
	
	(file1-list nil)
	(file2-list nil))
    (format t "~2%Summary of Example Runner Runs.~%")
    (with-open-file (file1-stream file1-pathname 
				  :direction :input)
      (loop
	 (setq form (read file1-stream nil nil))
	 (unless form (return (values)))
	 (when (gethash (car form) file1-table)
	   (format t "~%Duplicate example name ~a in file ~a." (car form) file1-namestring)
	   (format t "~%Will use latest example."))
	 (setf (gethash (car form) file1-table) (cdr form))))
    
    (with-open-file (file2-stream file2-pathname 
				  :direction :input)
      (loop
	 (setq form (read file2-stream nil nil))
	 (unless form (return (values)))
	 (when (gethash (car form) file2-table)
	   (format t "~%Duplicate example name ~a in file ~a." (car form) file2-namestring)
	   (format t "~%Will use latest example."))
	 (setf (gethash (car form) file2-table) (cdr form))))

    (setq file1-list (hashtable-to-list file1-table))
    (setq file2-list (hashtable-to-list file2-table))
    (format t "~2%File ~a contains ~a examples." file1-namestring (length file1-list))
    (format t "~%File ~a contains ~a examples.~%" file2-namestring (length file2-list))
    (let ((extra1 (set-difference file1-list file2-list))
	  (extra2 (set-difference file2-list file1-list)))
      (when extra1
	(format t "~%The example(s) ~a appear in file ~a but not in file ~a." extra1 file1-namestring file2-namestring))
      (when extra2
	(format t "~%The example(s) ~a appear in file ~a but not in file ~a." extra2 file2-namestring file1-namestring)))
    
    (let ((all-examples (union file1-list file2-list)))
      (dolist (x all-examples)
	(let ((val1 (gethash x file1-table))
	      (val2 (gethash x file2-table)))
	  (when (and val1 val2 )
	    (cond((equal (length (car val1)) (length (car val2)))
		  (check-for-text-difference
		    (car val1)(car val2) file1-namestring file2-namestring x)
		  (check-for-function-structure-difference
		    (car val1) (car val2) file1-namestring file2-namestring x)
		  (check-for-selection-expression-difference
		    (second val1) (second val2) file1-namestring file2-namestring x)
		  )
		 (t
		  (format t "~2%**** Difference Found In Number Of Final Orderings****")
		  (format t "~%Example ~a in file ~a has ~a final ordering(s)."
			  x file1-namestring (length (car val1)))
		  (format t "~%Example ~a in file ~a has ~a final ordering(s)."
			  x file2-namestring (length (car val2)))))))))
    (format t "~2%End of Summary.")))

(defun check-for-text-difference (final-orderings-1 final-orderings-2 file1-namestring file2-namestring example-name)
  "checks for differences in text"
  (do ((an-ordering-1 final-orderings-1 (cdr final-orderings-1 ))
       (an-ordering-2 final-orderings-2 (cdr final-orderings-2 )))
      ((or (not an-ordering-1 )(not an-ordering-2)) t)
    (let ((text1 (cdar an-ordering-1 ))
	  (text2 (cdar an-ordering-2)))
      (unless (equal text1 text2)
	(format t "~2%**** Difference Found In Text****")
	(format t "~%Example ~a in file ~a"  example-name file1-namestring )
	(pprint text1)
	(format t "~%Example ~a in file ~a"  example-name file2-namestring )
	(pprint text2)))))
(defun check-for-function-structure-difference
       (final-orderings-1 final-orderings-2 file1-namestring file2-namestring example-name)
  "checks for differences in function structure."
  (do ((an-ordering-1 final-orderings-1 (cdr final-orderings-1 ))
       (an-ordering-2 final-orderings-2 (cdr final-orderings-2 )))
      ((or (not an-ordering-1 )(not an-ordering-2)) t)
    (let ((function-structure-1 (caar an-ordering-1 ))
	  (function-structure-2 (caar an-ordering-2)))
      (unless (equal function-structure-1 function-structure-2 )
	(format t "~2%**** Difference Found In Function Structure****")
	(format t "~%Example ~a in file ~a"  example-name file1-namestring )
	(pprint function-structure-1 )
	(format t "~%Example ~a in file ~a"  example-name file2-namestring )
	(pprint function-structure-2 )))))

#|(defun check-for-selection-expression-difference
       (expression-1 expression-2 file1-namestring file2-namestring example-name)
  "checks for differences in the selection expressions."
  (cond ((equal (length expression-1)(length expression-2))
	 (do ((tail-1 expression-1 (cdr tail-1))
	      (tail-2 expression-2 (cdr tail-2))
	      (count 1 (+ 1 count)))
	     ((or (not tail-1)(not tail-2)) t)
	   (let* ((exp-1 (car tail-1))
		  (exp-2 (car tail-2))
		  (index (mismatch exp-1 exp-2)))
	     (when index
	       (format t "~2%**** Difference Found In Selection Expression****")
	       (format t "~%The selection expressions for rank ~a differ." count)
	       (format t "~%The tail of the expression for example ~a in file ~a is:" example-name file1-namestring)
	       (pprint (subseq exp-1 index))
	       (format t "~%The tail of the expression for example ~a in file ~a is:" example-name file2-namestring)
	       (pprint (subseq exp-2 index))))))
	(t
	 (format t "~2%**** Difference Found In Length Of Selection Expressions****")
	 (format t "The selection expression for example ~a in file ~a has length ~a."
		 example-name file1-namestring (length expression-1))
	 (format t "The selection expression for example ~a in file ~a has length ~a."
		 example-name file2-namestring (length expression-2)))))
|#
;;; 

(defun check-for-selection-expression-difference
       (expression-1 expression-2 file1-namestring file2-namestring example-name)
  "checks for differences in the selection expressions."
  (cond ((equal (length expression-1)(length expression-2))
	 (do ((tail-1 expression-1 (cdr tail-1))
	      (tail-2 expression-2 (cdr tail-2))
	      (count 1 (+ 1 count)))
	     ((or (not tail-1)(not tail-2)) t)
	   (let* ((exp-1 (car tail-1))
		  (exp-2 (car tail-2))
		  (in-1-not-in-2 (set-difference exp-1 exp-2))
		  (in-2-not-in-1 (set-difference exp-2 exp-1)))
	       (when (or in-1-not-in-2 in-2-not-in-1)
		 (format t "~2%**** Difference Found In Selection Expression****")
		 (when in-1-not-in-2 
		   (format t "~%For rank ~a, file ~a contains the selections ~a that are not found in file ~a."
			   count file1-namestring in-1-not-in-2 file2-namestring))
		 (when in-2-not-in-1 
		   (format t "~%For rank ~a, file ~a contains the selections ~a that are not found in file ~a."
			   count file2-namestring in-2-not-in-1 file1-namestring))))))
	(t
	 (format t "~2%**** Difference Found In number of ranks.")
	 (format t "~%The selection expression for example ~a in file ~a has ~a ranks."
		 example-name file1-namestring (length expression-1))
	 (format t "~%The selection expression for example ~a in file ~a has ~a ranks."
		 example-name file2-namestring (length expression-2)))))


