* http://helm.cs.unibo.it/
*)
-let debug_print = prerr_endline
+let debug = false
+let debug_print s = if debug then prerr_endline (Lazy.force s)
open Printf
(** {2 Parsing context management} *)
let pop ctxt =
-(* debug_print "pop";*)
+(* debug_print (lazy "pop");*)
match ctxt.stack with
| hd :: tl -> (ctxt.stack <- tl)
| _ -> assert false
let push ctxt v =
-(* debug_print "push";*)
+(* debug_print (lazy "push");*)
ctxt.stack <- v :: ctxt.stack
let set_top ctxt v =
-(* debug_print "set_top";*)
+(* debug_print (lazy "set_top");*)
match ctxt.stack with
| _ :: tl -> (ctxt.stack <- v :: tl)
| _ -> assert false
* each callback needs to be instantiated to a parsing context *)
let start_element ctxt tag attrs =
-(* debug_print (sprintf "<%s%s>" tag (match attrs with | [] -> "" | _ -> " " ^ String.concat " " (List.map (fun (a,v) -> sprintf "%s=\"%s\"" a v) attrs)));*)
+(* debug_print (lazy (sprintf "<%s%s>" tag (match attrs with | [] -> "" | _ -> " " ^ String.concat " " (List.map (fun (a,v) -> sprintf "%s=\"%s\"" a v) attrs))));*)
push ctxt (Tag (tag, attrs))
let end_element ctxt tag =
-(* debug_print (sprintf "</%s>" tag);*)
-(* debug_print (string_of_stack ctxt);*)
+(* debug_print (lazy (sprintf "</%s>" tag));*)
+(* debug_print (lazy (string_of_stack ctxt));*)
let attribute_error () = attribute_error ctxt tag in
let parse_error = parse_error ctxt in
let sort_of_string = sort_of_string ctxt in
* leak when used in conjunction with such structures *)
raise exn);
ctxt.xml_parser <- None; (* ZACK: same comment as above *)
-(* debug_print (string_of_stack stack);*)
+(* debug_print (lazy (string_of_stack stack));*)
(* assert (List.length ctxt.stack = 1) *)
List.hd ctxt.stack
with