(******************************************************************************)
(*  SXSI : XPath evaluator                                                    *)
(*  Kim Nguyen (Kim.Nguyen@nicta.com.au)                                      *)
(*  Copyright NICTA 2008                                                      *)
(*  Distributed under the terms of the LGPL (see LICENCE)                     *)
(******************************************************************************)

let globals = Hashtbl.create 107
let cpt = ref 0

let register v str = 
  let _cpt = !cpt in
  let f = (* This function must not take v as argument, otherwise
	     v won't be garbage collected *)
    fun _ -> Hashtbl.remove globals _cpt
  in
    Hashtbl.add globals _cpt str;
    incr cpt;
    Gc.finalise f v
;;
    
let schedule_stats =
  let first = ref true in
    function () -> if !first
    then
      let show_leaked_values () = 
	Printf.eprintf "Memory debugging requested :\n%!";
	Printf.eprintf "Triggering major collection :%!";
	Gc.full_major();
	Printf.eprintf " ok\n%!";
	Printf.eprintf "Triggering memory compaction :%!";
	Gc.compact();
	Printf.eprintf " ok\n%!";
	let i = Hashtbl.length globals in
	  Printf.eprintf "%i object%s leaked\n%!" i (if i < 2 then "" else "s");
	  Hashtbl.iter (fun key msg ->
			  Printf.printf "Value %i, registered at %s has not been collected\n" key msg) globals
      in at_exit show_leaked_values; first := false
    else ()