
;
;	Debugging tools for rule handler
;
;
;	Test case processor
;
;	test tools
;
;	decl  --  declare and print declaration
;
(defun decl (item)
    (remprop (car item) 'vtype)		; cleanup
    (remprop (car item) 'dtype)		; cleanup
    (patom (car item)) (patom ":  ") (patom (cadr item)) (terpri)
    (vardecl (car item) (cadr item)))
;
;	testcase  --  set and save test case
;
(defun testcase (name result form)
    (set name form)			; save under specified name
    (setq testlist (append1 testlist (list name result form))) ; add to test list
	)
;
;	runtests  --  run all test cases
;
(defun runtests nil
    (simpinit)				; reinitialize
    (begin-decl)			; begin junit
    (mapcar 'decl testdecls)		; do all declarations
    (terpri)
    (mapcar 'dolemma testrules)		; do all rules
    (terpri)
    (mapcar 'runtest testlist) 		; try all tests
    (terpri)
    (end-decl) t)			; done
	
;
	 runonetest   --   run one test case , with full reinitialization
;
(defun runonetest (testid)
	(setq testcase (find-if (lambda (x) (eq (car x) testid)) testlist))
	(cond ((null testcase) (break "Test ID not in test list.")))
    (simpinit)				; reinitialize
    (begin-decl)			; begin junit
    (mapcar 'decl testdecls)		; do all declarations
    (terpri)
    (mapcar 'dolemma testrules)		; do all rules
    (terpri)
    (runtest testcase)
    (terpri)
    (end-decl) t)			; done
;
;	runtest  --  run a test case
;
(defun runtest (l)
    (prog (name expected form result)
	(setq name (car l))		; get test name
	(setq expected (cadr l))	; get expected result
	(setq form (caddr l))		; get test case itself.
	(patom "Test case ") (patom name) (patom ": expect ") 
	(patom (cond (expected "true.") (t "false.")))
	(terpri)
	(pform form)			; print form begin simplified
	(setq result (prove form))	; do the test
	(patom result)
	(cond ((not (equal expected result)) ; if fail
	       (patom " -- TEST CASE DID NOT PRODUCE EXPECTED RESULT") (terpri)
	       (break "Test failed."))
	      (t (patom " -- OK") (terpri)))
	(terpri)
	nil))
;
;	Dumping and tracing tools
;
;	dumpanything
;
(defun dumpanything (xx)
    (cond	
		((isenode xx) (patom (dumpenodeexpr xx)))
		((functionp xx) (patom (getfunctionname xx)))
		((atomp xx) (patom xx))
		((consp xx) (patom "(")
		   ;;;(mapcar 'dumpanything xx) ; ***DOES NOT WORK ON A NON-LIST CONS***
			(dumplist xx)
		   (patom ")"))
		(t (patom xx)))
		(patom " ")
		nil)

;
;	dumplist -- also does a single cons
;
(defun dumplist (lst) 
	(cond 	((null lst) (patom "nil"))
				((consp lst) 
					(dumpanything (car lst))
					(cond 	((consp (cdr lst)) (dumplist (cdr lst)))
								((null (cdr lst))) ;	 Nothing to do if null list end
								(t (patom ". ") (dumpanything (cdr lst)))))
				(t (dumpanything(lst)))))
				
;
;	getfunctionname -- there should be some easier way to do this.
;
(defun getfunctionname (fn) 
	(setq s (write-to-string fn))
	(concatenate 'string (subseq s 0 (search "(" s)) ">"))

;
	 dumpbind1   --   dump one pattern - var to expr - var binding
;
(defun dumpbind1 (bind)
	(patom "        ")
	(print (car bind))			; pattern var
	(patom "  <==>  ")			; marker
	(patom (dumpenodeexpr (cdr bind)))	; expression
	(terpri))
;
;	dumpbinds  --  dump all bindings for rule being applied
;
(defun dumpbinds (binds)
	(cond ((null binds) nil)		; if done, exit
	      (t (dumpbind1 (car binds))	; dump binding
		 (dumpbinds (cdr binds)))))	; recurse for rest
;
;	dumpelist  --  dump mixed list of enodes and atoms
;
(defun dumpelist (elist)
	(cond ((atomp elist) (patom elist))
	      ((isenode elist) (patom (dumpenodeexpr elist)))
	      (t	(patom "(")
			(mapc 'dumpelist elist)
			(patom ")")))
	(patom " ")
	nil)
;
	 Trace aids . These are implementation - specific to GNU Common LISP .
;
	 Trace is not standardized in Common LISP .
;
;
;	dumpapplyrule  --  dump bindings
;
(defun dumpapplyrule nil
	(patom "applyrule: ") 
(  ( arg 3 ) )
  CL
	(terpri)
( dumpbinds ( arg 2 ) )
  CL
	(terpri)
	)
;
;	Demon dumping
;
(defun dumpfiredemon nil
    (patom "Firing demon ")
(  ( arg 1 ) )
  CL
    (terpri))
	
(defun dumppfire nil
    (patom "Pfire: ")
    (terpri)
    (patom "    Function: ");
(  ( arg 1 ) )
  CL
    (terpri)
    (patom "    Node: ")
(  ( dumpenodeexpr ( arg 2 ) ) )
  CL
    (terpri)
    (patom "    Bindings: ")
    (terpri)
( dumpbinds ( arg 3 ) )
  CL
    (terpri))
;
;	dumppropagate
;
(defun dumppropagate nil
    (patom "Propagate: ")
( dumpelist ( arg 1 ) )
  CL
    (terpri))
;
;	dumpemerge
;
(defun dumpemerge nil
    (patom "emerge: ")
( cond ( ( eq (  ( arg 1 ) ) ( eroot ( arg 2 ) ) ) (  " ( ALREADY EQUAL ) " ) ) )
	(cond ((eq (eroot (nth 0 EXT:*TRACE-ARGS*)) (eroot (nth 1 EXT:*TRACE-ARGS*))) (patom " (ALREADY EQUAL)")))
    (terpri)
    (patom "    ")
(  ( dumpenodeexpr ( arg 1 ) ) )
  CL
    (terpri)
    (patom "    ")
(  ( dumpenodeexpr ( arg 2 ) ) )
  CL
    (terpri)
    nil
	)
;
;	dumppushcontext
;
(defun dumppushcontext nil (patom "pushcontext") (terpri))
(defun dumppopcontext nil (patom "popcontext") (terpri))
;
	 dumpchangedatatype
;
(defun dumpchangedatatype nil
 	(patom "changedatatype: ")
(  ( dumpenodeexpr ( arg 1 ) ) )
  CL
	(patom " <== ")
(  ( arg 3 ) )
	(patom (nth 2 EXT:*TRACE-ARGS*))
	(terpri)
( and ( edatatype (  ( arg 1 ) ) ) ( not ( equal ( arg 3 )
		  ( commontype ( edatatype (  ( arg 1 ) ) ) ( arg 3 ) ) ) )
	(and (edatatype (eroot (nth 0 EXT:*TRACE-ARGS*))) (not (equal (nth 2 EXT:*TRACE-ARGS*)
			 (commontype (edatatype (eroot (nth 0 EXT:*TRACE-ARGS*))) (nth 2 EXT:*TRACE-ARGS*))))
	     (break "Less-restrictive changedatatype"))
	nil
	)
;
;	dumpemerget
;
(defun dumpemerget nil
    (prog nil
( and ( equal ( arg 2 ) ( arg 3 ) ) ( return ) )
  CL
	(patom "emerget: ")
  (  ( dumpenodeexpr ( arg 1 ) ) )
  CL
	(patom " <== ")
(  ( arg 2 ) )
  CL
	(patom "    ")
  (  ( arg 3 ) )
  CL
	(terpri)
	))
;
	 dumppropagaterule
;
(defun dumppropagaterule nil
    (patom "propagaterule: ")
(  ( arg 1 ) )
  CL
    (terpri))
;
;	dumpseteheight
;
(defun dumpseteheight nil
  (prog nil
  ( and ( equal (  ( arg 1 ) ) ( arg 2 ) ) ( return nil ) ) ; no dump if no change
    (and (equal (eheight (nth 0 EXT:*TRACE-ARGS*)) (nth 1 EXT:*TRACE-ARGS*)) (return nil)) ; no dump if no change
	(patom "seteheight: ")
  (  ( dumpenodeexpr ( arg 1 ) ) )
  CL
    (patom "     ")
  (  ( arg 2 ) )
  CL
	(patom "  (was ")
  (  (  ( arg 1 ) ) )
  CL
    (patom ")") (terpri)))
;
;	dumpqueuetypewait
;
(defun dumpqueuetypewait nil
	(patom "queuetypewait: ")
  (  ( dumpenodeexpr ( arg 1 ) ) )
  CL
	(patom " ")
  (  ( arg 2 ) )
  CL
	(patom " ")
  (  ( arg 3 ) )
  CL
	(terpri)
	)
;
;	dumpsimpinit  --  place to reset trace counters
;
(defun dumpsimpinit nil
   (setq casedepth 0)
	)
;
;	dumpsimpsave  --  entering a new case
;
(defun dumpsimpsave nil
   (patom "simpsave: ")
   (setq casedepth (add1 casedepth))
   (printdepth casedepth) (terpri))
(defun dumpsimprestore nil
   (patom "simprest: ")
   (setq casedepth (- casedepth 1))
   (printdepth casedepth) (terpri))
(defun printdepth (n)
   (cond ((> n 0)
	(patom "| ") (printdepth (- n 1)))))
;
;	dumpsubprovercall
;
(defun dumpsubprovercall nil
   (patom "subprovercall: ")
  (  ( arg 2 ) )
   (patom (nth 1 EXT:*TRACE-ARGS*))
   (patom "  ")
  (  ( arg 3 ) )
   (patom (nth 2 EXT:*TRACE-ARGS*))
   (patom "  #")
  (  (  ( arg 1 ) ) )
   (patom (enumber (nth 0 EXT:*TRACE-ARGS*)))
   (patom ": ")
  (  ( dumpenodeexpr ( arg 1 ) ) )
   (patom (dumpenodeexpr (nth 0 EXT:*TRACE-ARGS*)))
   (terpri))
;
;	dumpnew-eassertz
;
;	Shows all terms going into Z box
;
(defun dumpnew-iassertz nil
	(patom "new-iassertz: ")
  ( mapcar ' dumpzterm ( arg 1 ) )
	(mapcar 'dumpzterm (nth 0 EXT:*TRACE-ARGS*))
	(terpri))
	
(defun dumpnew-eassertz nil
	(patom "new-eassertz: ")
  ( mapcar ' dumpzterm ( arg 1 ) )
	(mapcar 'dumpzterm (nth 0 EXT:*TRACE-ARGS*))
	(terpri))
	
(defun dumpzterm (x)
       (patom (caar x))		; constant multiplier
       (patom " * ")		; indicate multiplication
       (patom (dumpenodeexpr (cadr x)))	; term
       (terpri)
       (patom "              ")
	)
;
;	dumppropeq   --   terms coming out of Z box
;	
(defun dumppropeq nil
	(patom "propeq: ")
  (  ( dumpenodeexpr ( arg 1 ) ) )
	(patom (dumpenodeexpr (nth 0 EXT:*TRACE-ARGS*)))
	(patom "   ")
  (  ( dumpenodeexpr ( arg 2 ) ) )
	(patom (dumpenodeexpr (nth 1 EXT:*TRACE-ARGS*)))
	(terpri))
;
;	dumpenodeexpr  --  dump enode expression without looking
;			   at root information.
;
(defun dumpenodeexpr (node)
	(cond
		((isenode node) (dumpenodeexpr (esuccessors node)))
		((atomp node) node)
		(t (concat "(" (concatlist (mapcar 'dumpenodeexpr node)) ")"))))
(defun concatlist (lst)
     (cond ((null lst) nil)
	   ((null (cdr lst)) (car lst))
	   (t (concat (car lst) " " (concatlist (cdr lst))))))
;
;	tracetellz
;
(defun dumptellz nil
    (patom "tellz: ")
  (  ( dumpenodeexpr ( arg 2 ) ) )
  CL

    (terpri))
;
;	traceprepattern  --  dump pattern before and after processing
;
;
(defun dumpprepattern nil
    (setq prepatterndepth (+ 1 prepatterndepth))
    (cond ((equal prepatterndepth 1)
    	(patom "prepattern: ")
  (  ( dumpenodeexpr ( car fargs ) ) )
    	(patom (dumpenodeexpr (nth 0 EXT:*TRACE-ARGS*)))
    	(terpri))
	(t nil)))
	
(defun dumpexitprepattern nil
    (setq prepatterndepth (- prepatterndepth 1))
    (cond ((equal prepatterndepth 0)
    	(patom "Exiting prepattern: ")
  (  ( dumpenodeexpr fresult ) )
    	(patom (dumpenodeexpr EXT:*TRACE-VALUES*))
     	(terpri))
	(t nil)))
	
(defun dumpstartpattern nil 
	;(pattern matchlist node)
	(patom "Startpattern: ") (terpri)
	(patom "  Pattern: ") (dumpanything (nth 0 EXT:*TRACE-ARGS*)) (terpri)
	(patom "  Matchlist: ") (dumpanything (nth 1 EXT:*TRACE-ARGS*)) (terpri)
	(patom "  Node: ") (dumpanything (nth 2 EXT:*TRACE-ARGS*)) (terpri))
	
;
;	These turn on tracing of the indicated function
;
(defun tracestartpattern nil (trace (startpattern :pre (dumpstartpattern))))
(defun tracefiredemon nil (trace (firedemon :pre (dumpfiredemon))))
(defun tracepfire nil (trace (pfire :pre (dumppfire))))
(defun traceapplyrule nil (trace (applyrule :pre (dumpapplyrule))))
(defun tracecontext nil (trace (pushcontext :pre (dumppushcontext)))
			(trace (popcontext :post (dumppopcontext))))
(defun tracepropagate nil (trace (propagate :pre (dumppropagate))))
(defun traceemerge nil (trace (emerge :pre (dumpemerge))))
(defun tracechangedatatype nil (trace (changedatatype :pre (dumpchangedatatype))))
(defun traceemerget nil (trace (emerget :pre (dumpemerget))))
(defun tracepropagaterule nil (trace (propagaterule :pre (dumppropagaterule))))
(defun traceseteheight nil (trace (seteheight :pre (dumpseteheight))))
(defun tracequeuetypewait nil (trace (queuetypewait :pre (dumpqueuetypewait))))
(defun tracesubprovercall nil (trace (subprovercall :pre (dumpsubprovercall))))
(defun tracenew-iassertz nil (trace (new-iassertz :pre (dumpnew-iassertz))))
(defun tracenew-eassertz nil (trace (new-eassertz :pre (dumpnew-eassertz))))
(defun tracepropeq nil (trace (propeq :pre (dumppropeq))))
(defun tracetellz nil (trace (tellz :pre (dumptellz))))
(defun traceze nil (tracenew-iassertz) (tracenew-eassertz) 
			(tracetellz) (tracepropeq))
(defun traceprepattern nil (setq prepatterndepth 0)
			(trace (prepattern 
			:pre (dumpprepattern)
			:post (dumpexitprepattern))))
(defun tracecasing nil 
	(trace (simpsave :pre (dumpsimpsave)))
	(trace (simprestore :pre (dumpsimprestore)))
	(trace (simpinit :pre (dumpsimpinit))))
(setq prinlevel 5 prinlength 5)		; avoid runaway printing


	Debugging tools for rule handler


	Test case processor

	test tools

	decl  --  declare and print declaration

 cleanup
 cleanup

	testcase  --  set and save test case

 save under specified name
 add to test list

	runtests  --  run all test cases

 reinitialize
 begin junit
 do all declarations
 do all rules
 try all tests
 done


 reinitialize
 begin junit
 do all declarations
 do all rules
 done

	runtest  --  run a test case

 get test name
 get expected result
 get test case itself.
 print form begin simplified
 do the test
 if fail

	Dumping and tracing tools

	dumpanything

(mapcar 'dumpanything xx) ; ***DOES NOT WORK ON A NON-LIST CONS***

	dumplist -- also does a single cons

	 Nothing to do if null list end

	getfunctionname -- there should be some easier way to do this.



 pattern var
 marker
 expression

	dumpbinds  --  dump all bindings for rule being applied

 if done, exit
 dump binding
 recurse for rest

	dumpelist  --  dump mixed list of enodes and atoms





	dumpapplyrule  --  dump bindings


	Demon dumping



	dumppropagate


	dumpemerge


	dumppushcontext




	dumpemerget




	dumpseteheight

 no dump if no change
 no dump if no change

	dumpqueuetypewait


	dumpsimpinit  --  place to reset trace counters


	dumpsimpsave  --  entering a new case


	dumpsubprovercall


	dumpnew-eassertz

	Shows all terms going into Z box

 constant multiplier
 indicate multiplication
 term

	dumppropeq   --   terms coming out of Z box
	

	dumpenodeexpr  --  dump enode expression without looking
			   at root information.


	tracetellz


	traceprepattern  --  dump pattern before and after processing


(pattern matchlist node)

	These turn on tracing of the indicated function

 avoid runaway printing

(defun decl (item)
    (patom (car item)) (patom ":  ") (patom (cadr item)) (terpri)
    (vardecl (car item) (cadr item)))
(defun testcase (name result form)
	)
(defun runtests nil
    (terpri)
    (terpri)
    (terpri)
	
	 runonetest   --   run one test case , with full reinitialization
(defun runonetest (testid)
	(setq testcase (find-if (lambda (x) (eq (car x) testid)) testlist))
	(cond ((null testcase) (break "Test ID not in test list.")))
    (terpri)
    (terpri)
    (runtest testcase)
    (terpri)
(defun runtest (l)
    (prog (name expected form result)
	(patom "Test case ") (patom name) (patom ": expect ") 
	(patom (cond (expected "true.") (t "false.")))
	(terpri)
	(patom result)
	       (patom " -- TEST CASE DID NOT PRODUCE EXPECTED RESULT") (terpri)
	       (break "Test failed."))
	      (t (patom " -- OK") (terpri)))
	(terpri)
	nil))
(defun dumpanything (xx)
    (cond	
		((isenode xx) (patom (dumpenodeexpr xx)))
		((functionp xx) (patom (getfunctionname xx)))
		((atomp xx) (patom xx))
		((consp xx) (patom "(")
			(dumplist xx)
		   (patom ")"))
		(t (patom xx)))
		(patom " ")
		nil)

(defun dumplist (lst) 
	(cond 	((null lst) (patom "nil"))
				((consp lst) 
					(dumpanything (car lst))
					(cond 	((consp (cdr lst)) (dumplist (cdr lst)))
								(t (patom ". ") (dumpanything (cdr lst)))))
				(t (dumpanything(lst)))))
				
(defun getfunctionname (fn) 
	(setq s (write-to-string fn))
	(concatenate 'string (subseq s 0 (search "(" s)) ">"))

	 dumpbind1   --   dump one pattern - var to expr - var binding
(defun dumpbind1 (bind)
	(patom "        ")
	(terpri))
(defun dumpbinds (binds)
(defun dumpelist (elist)
	(cond ((atomp elist) (patom elist))
	      ((isenode elist) (patom (dumpenodeexpr elist)))
	      (t	(patom "(")
			(mapc 'dumpelist elist)
			(patom ")")))
	(patom " ")
	nil)
	 Trace aids . These are implementation - specific to GNU Common LISP .
	 Trace is not standardized in Common LISP .
(defun dumpapplyrule nil
	(patom "applyrule: ") 
(  ( arg 3 ) )
  CL
	(terpri)
( dumpbinds ( arg 2 ) )
  CL
	(terpri)
	)
(defun dumpfiredemon nil
    (patom "Firing demon ")
(  ( arg 1 ) )
  CL
    (terpri))
	
(defun dumppfire nil
    (patom "Pfire: ")
    (terpri)
(  ( arg 1 ) )
  CL
    (terpri)
    (patom "    Node: ")
(  ( dumpenodeexpr ( arg 2 ) ) )
  CL
    (terpri)
    (patom "    Bindings: ")
    (terpri)
( dumpbinds ( arg 3 ) )
  CL
    (terpri))
(defun dumppropagate nil
    (patom "Propagate: ")
( dumpelist ( arg 1 ) )
  CL
    (terpri))
(defun dumpemerge nil
    (patom "emerge: ")
( cond ( ( eq (  ( arg 1 ) ) ( eroot ( arg 2 ) ) ) (  " ( ALREADY EQUAL ) " ) ) )
	(cond ((eq (eroot (nth 0 EXT:*TRACE-ARGS*)) (eroot (nth 1 EXT:*TRACE-ARGS*))) (patom " (ALREADY EQUAL)")))
    (terpri)
    (patom "    ")
(  ( dumpenodeexpr ( arg 1 ) ) )
  CL
    (terpri)
    (patom "    ")
(  ( dumpenodeexpr ( arg 2 ) ) )
  CL
    (terpri)
    nil
	)
(defun dumppushcontext nil (patom "pushcontext") (terpri))
(defun dumppopcontext nil (patom "popcontext") (terpri))
	 dumpchangedatatype
(defun dumpchangedatatype nil
 	(patom "changedatatype: ")
(  ( dumpenodeexpr ( arg 1 ) ) )
  CL
	(patom " <== ")
(  ( arg 3 ) )
	(patom (nth 2 EXT:*TRACE-ARGS*))
	(terpri)
( and ( edatatype (  ( arg 1 ) ) ) ( not ( equal ( arg 3 )
		  ( commontype ( edatatype (  ( arg 1 ) ) ) ( arg 3 ) ) ) )
	(and (edatatype (eroot (nth 0 EXT:*TRACE-ARGS*))) (not (equal (nth 2 EXT:*TRACE-ARGS*)
			 (commontype (edatatype (eroot (nth 0 EXT:*TRACE-ARGS*))) (nth 2 EXT:*TRACE-ARGS*))))
	     (break "Less-restrictive changedatatype"))
	nil
	)
(defun dumpemerget nil
    (prog nil
( and ( equal ( arg 2 ) ( arg 3 ) ) ( return ) )
  CL
	(patom "emerget: ")
  (  ( dumpenodeexpr ( arg 1 ) ) )
  CL
	(patom " <== ")
(  ( arg 2 ) )
  CL
	(patom "    ")
  (  ( arg 3 ) )
  CL
	(terpri)
	))
	 dumppropagaterule
(defun dumppropagaterule nil
    (patom "propagaterule: ")
(  ( arg 1 ) )
  CL
    (terpri))
(defun dumpseteheight nil
  (prog nil
	(patom "seteheight: ")
  (  ( dumpenodeexpr ( arg 1 ) ) )
  CL
    (patom "     ")
  (  ( arg 2 ) )
  CL
	(patom "  (was ")
  (  (  ( arg 1 ) ) )
  CL
    (patom ")") (terpri)))
(defun dumpqueuetypewait nil
	(patom "queuetypewait: ")
  (  ( dumpenodeexpr ( arg 1 ) ) )
  CL
	(patom " ")
  (  ( arg 2 ) )
  CL
	(patom " ")
  (  ( arg 3 ) )
  CL
	(terpri)
	)
(defun dumpsimpinit nil
   (setq casedepth 0)
	)
(defun dumpsimpsave nil
   (patom "simpsave: ")
   (setq casedepth (add1 casedepth))
   (printdepth casedepth) (terpri))
(defun dumpsimprestore nil
   (patom "simprest: ")
   (setq casedepth (- casedepth 1))
   (printdepth casedepth) (terpri))
(defun printdepth (n)
   (cond ((> n 0)
	(patom "| ") (printdepth (- n 1)))))
(defun dumpsubprovercall nil
   (patom "subprovercall: ")
  (  ( arg 2 ) )
   (patom (nth 1 EXT:*TRACE-ARGS*))
   (patom "  ")
  (  ( arg 3 ) )
   (patom (nth 2 EXT:*TRACE-ARGS*))
   (patom "  #")
  (  (  ( arg 1 ) ) )
   (patom (enumber (nth 0 EXT:*TRACE-ARGS*)))
   (patom ": ")
  (  ( dumpenodeexpr ( arg 1 ) ) )
   (patom (dumpenodeexpr (nth 0 EXT:*TRACE-ARGS*)))
   (terpri))
(defun dumpnew-iassertz nil
	(patom "new-iassertz: ")
  ( mapcar ' dumpzterm ( arg 1 ) )
	(mapcar 'dumpzterm (nth 0 EXT:*TRACE-ARGS*))
	(terpri))
	
(defun dumpnew-eassertz nil
	(patom "new-eassertz: ")
  ( mapcar ' dumpzterm ( arg 1 ) )
	(mapcar 'dumpzterm (nth 0 EXT:*TRACE-ARGS*))
	(terpri))
	
(defun dumpzterm (x)
       (terpri)
       (patom "              ")
	)
(defun dumppropeq nil
	(patom "propeq: ")
  (  ( dumpenodeexpr ( arg 1 ) ) )
	(patom (dumpenodeexpr (nth 0 EXT:*TRACE-ARGS*)))
	(patom "   ")
  (  ( dumpenodeexpr ( arg 2 ) ) )
	(patom (dumpenodeexpr (nth 1 EXT:*TRACE-ARGS*)))
	(terpri))
(defun dumpenodeexpr (node)
	(cond
		((isenode node) (dumpenodeexpr (esuccessors node)))
		((atomp node) node)
		(t (concat "(" (concatlist (mapcar 'dumpenodeexpr node)) ")"))))
(defun concatlist (lst)
     (cond ((null lst) nil)
	   ((null (cdr lst)) (car lst))
	   (t (concat (car lst) " " (concatlist (cdr lst))))))
(defun dumptellz nil
    (patom "tellz: ")
  (  ( dumpenodeexpr ( arg 2 ) ) )
  CL

    (terpri))
(defun dumpprepattern nil
    (setq prepatterndepth (+ 1 prepatterndepth))
    (cond ((equal prepatterndepth 1)
    	(patom "prepattern: ")
  (  ( dumpenodeexpr ( car fargs ) ) )
    	(patom (dumpenodeexpr (nth 0 EXT:*TRACE-ARGS*)))
    	(terpri))
	(t nil)))
	
(defun dumpexitprepattern nil
    (setq prepatterndepth (- prepatterndepth 1))
    (cond ((equal prepatterndepth 0)
    	(patom "Exiting prepattern: ")
  (  ( dumpenodeexpr fresult ) )
    	(patom (dumpenodeexpr EXT:*TRACE-VALUES*))
     	(terpri))
	(t nil)))
	
(defun dumpstartpattern nil 
	(patom "Startpattern: ") (terpri)
	(patom "  Pattern: ") (dumpanything (nth 0 EXT:*TRACE-ARGS*)) (terpri)
	(patom "  Matchlist: ") (dumpanything (nth 1 EXT:*TRACE-ARGS*)) (terpri)
	(patom "  Node: ") (dumpanything (nth 2 EXT:*TRACE-ARGS*)) (terpri))
	
(defun tracestartpattern nil (trace (startpattern :pre (dumpstartpattern))))
(defun tracefiredemon nil (trace (firedemon :pre (dumpfiredemon))))
(defun tracepfire nil (trace (pfire :pre (dumppfire))))
(defun traceapplyrule nil (trace (applyrule :pre (dumpapplyrule))))
(defun tracecontext nil (trace (pushcontext :pre (dumppushcontext)))
			(trace (popcontext :post (dumppopcontext))))
(defun tracepropagate nil (trace (propagate :pre (dumppropagate))))
(defun traceemerge nil (trace (emerge :pre (dumpemerge))))
(defun tracechangedatatype nil (trace (changedatatype :pre (dumpchangedatatype))))
(defun traceemerget nil (trace (emerget :pre (dumpemerget))))
(defun tracepropagaterule nil (trace (propagaterule :pre (dumppropagaterule))))
(defun traceseteheight nil (trace (seteheight :pre (dumpseteheight))))
(defun tracequeuetypewait nil (trace (queuetypewait :pre (dumpqueuetypewait))))
(defun tracesubprovercall nil (trace (subprovercall :pre (dumpsubprovercall))))
(defun tracenew-iassertz nil (trace (new-iassertz :pre (dumpnew-iassertz))))
(defun tracenew-eassertz nil (trace (new-eassertz :pre (dumpnew-eassertz))))
(defun tracepropeq nil (trace (propeq :pre (dumppropeq))))
(defun tracetellz nil (trace (tellz :pre (dumptellz))))
(defun traceze nil (tracenew-iassertz) (tracenew-eassertz) 
			(tracetellz) (tracepropeq))
(defun traceprepattern nil (setq prepatterndepth 0)
			(trace (prepattern 
			:pre (dumpprepattern)
			:post (dumpexitprepattern))))
(defun tracecasing nil 
	(trace (simpsave :pre (dumpsimpsave)))
	(trace (simprestore :pre (dumpsimprestore)))
	(trace (simpinit :pre (dumpsimpinit))))
