(* A report generator for the GimML profiler.
   Copyright (C) 1992-1995 Jean Goubault and Bull S.A.
   All rights reserved.

   Redistribution and use in source and binary forms are permitted provided
   that: (1) source distributions retain this entire copyright notice and
   comment, and (2) distributions including binaries display the following
   acknowledgement:  ``This product includes software developed by Jean
   Goubault as a contributor of Bull S.A.'' in the
   documentation or other materials provided with the distribution and in
   all advertising materials mentioning features or use of this software.
   Neither the name of Bull S.A. or of its corporate affiliates,
   nor the names of its contributors may be used to endorse or promote
   products derived from this software without specific prior written permission.
   THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR IMPLIED
   WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
   MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
*)

local
    (*$P-*) (* disable profiling when analyzing profiles... *)

    fun merge less =
	let fun merge ([],l2) = l2
	      | merge (l1,[]) = l1
	      | merge (l1 as x1::l'1,l2 as x2::l'2) =
		if less(x1,x2)
		    then x1::merge(l'1,l2)
		else x2::merge(l1,l'2)
	in
	    merge
	end

    fun sort less = (* (''a * ''a -> bool) -> (''a -m> 'b) -> ''a list *)
	let val merge = merge less
	    fun sort {} = []
	      | sort {x => _} = [x]
	      | sort vars =
		let val (vars1,vars2) = split vars
	    in
		merge (sort vars1,sort vars2)
	    end
	in
	    sort
	end

    fun prof1 profiles outstream =
	let val l = sort (fn (|[ncalls = n1, proper = |[time = (t1,_),...]|, ...]|,
			      |[ncalls = n2, proper = |[time = (t2,_),...]|, ...]|) =>
			  t1 #> t2 orelse
			  (t1=t2 andalso n1>n2)) profiles

	    val put = #put outstream
	    val flush = #flush outstream
	    val p = print outstream

	    fun spaces n =
		let val r = ref n
		in
		    while !r>0
			do (dec r; put " ")
		end

	    fun putmax n str =
		if size str<n
		    then (put str; spaces (n-size str))
		else (put (substr (str, 0, n-3));
		      put "...")

	    fun putnmax n k =
		let val s as |[convert,...]| = outstring ""
		    val str = (print s (pack (k:int));
			       convert ())
		in
		    spaces (n-size str);
		    put str
		end
	    fun putmmax n k =
		let val s as |[convert,...]| = outstring ""
		    val str = (print s (pack (k:int));
			       convert ())
		in
		    put str;
		    spaces (n-size str)
		end
	    fun putfmax n f =
		let val s as |[convert,...]| = outstring ""
		    val str = (print s (pack (f:num));
			       convert ())
		in
		    spaces (n-size str);
		    put str
		end
	    fun putgmax n f =
		let val s as |[convert,...]| = outstring ""
		    val str = (print s (pack (f:num));
			       convert ())
		in
		    put str;
		    spaces (n-size str)
		end

	    fun putzone (_,file,pos1 as (l1,c1),pos2 as (l2,c2)) =
		(put ";";
		 put file;
		 (*put ", line";
		 (if l1<> l2 then put "s" else ());*)
		 put " ";
		 p (pack (l1:int));
		 (if c1<>0 then (put "("; p (pack (c1:int)); put ")") else ());
		 (if pos1<>pos2
		      then (put "-";
			    p (pack (l2:int));
			    if c2<>0 then (put "("; p (pack (c2:int)); put ")") else ())
		  else ()))
		
	    val savenumformat = !numformat
	in
	    numformat := "%.2f";
	    put "Function                 #Calls  Time(proper/total) GC Time    #GC calls\n\
	        \------------------------------------------------------------------------\n";
	    iterate
	    (putmax 20 func;
	     putnmax 10 ncalls;
	     put " ";
	     putfmax 8 (#1 (#time proper) #/ 1`s);
	     put "/";
	     putgmax 8 (#1 (#time total) #/ 1`s);
	     put "  ";
	     putfmax 6 (#1 (#gctime proper) #/ 1`s);
	     put "/";
	     putgmax 6 (#1 (#gctime total) #/ 1`s);
	     put " ";
	     putnmax 4 (#ngcs proper);
	     put "/";
	     putmmax 4 (#ngcs total);
	     put " ";
	     putzone location;
	     put "\n"
	     )
	     | |[location as (func,...),ncalls,proper,total]| in list l
	    end;
	    flush ();
	    numformat := savenumformat
	end
in
    fun prof outstream = prof1 (report_profiles ()) outstream
    fun fprof filename = let val f = outfile filename
			 in
			     prof f;
			     #close f ()
			 end
end
