ocaml 3.09 transition

[helm.git] / helm / ocaml / hbugs / broker.ml

diff --git a/helm/ocaml/hbugs/broker.ml b/helm/ocaml/hbugs/broker.ml
index b86c08b9bd6d7df10aba7dc7939e87de00de2688..6b62af94660b40cb06f436918e0194a34a56d89b 100644 (file)
--- a/helm/ocaml/hbugs/broker.ml
+++ b/helm/ocaml/hbugs/broker.ml
@@ -30,7 +30,7 @@ open Hbugs_types;;
 open Printf;;
 
 let debug = true ;;
-let debug_print s = if debug then prerr_endline s ;;
+let debug_print s = if debug then prerr_endline (Lazy.force s) ;;
 
 let daemon_name = "H-Bugs Broker" ;;
 let default_port = 49081 ;;
@@ -66,13 +66,13 @@ let do_critical =
   let mutex = Mutex.create () in
   fun action ->
     try
-(*       debug_print "Acquiring lock ..."; *)
+(*       debug_print (lazy "Acquiring lock ..."); *)
       Mutex.lock mutex;
-(*       debug_print "Lock Acquired!"; *)
+(*       debug_print (lazy "Lock Acquired!"); *)
       let res = Lazy.force action in
-(*       debug_print "Releaseing lock ..."; *)
+(*       debug_print (lazy "Releaseing lock ..."); *)
       Mutex.unlock mutex;
-(*       debug_print "Lock released!"; *)
+(*       debug_print (lazy "Lock released!"); *)
       res
     with e -> Mutex.unlock mutex; raise e
 ;;
@@ -232,7 +232,7 @@ let handle_msg outchan msg =
     ))
 
   | msg ->  (* unexpected message *)
-      debug_print "Unknown message!";
+      debug_print (lazy "Unknown message!");
       Hbugs_messages.respond_exc
         "unexpected_msg" (Hbugs_messages.string_of_msg msg) outchan)
 in
@@ -241,7 +241,7 @@ let handle_msg outchan =
   if debug then
     (fun msg -> (* filter handle_msg through a function which dumps input
                 messages *)
-      debug_print (Hbugs_messages.string_of_msg msg);
+      debug_print (lazy (Hbugs_messages.string_of_msg msg));
       handle_msg outchan msg)
   else
     handle_msg outchan
@@ -251,8 +251,8 @@ in
   (* thread action *)
 let callback (req: Http_types.request) outchan =
   try
-    debug_print ("Connection from " ^ req#clientAddr);
-    debug_print ("Received request: " ^ req#path);
+    debug_print (lazy ("Connection from " ^ req#clientAddr));
+    debug_print (lazy ("Received request: " ^ req#path));
     (match req#path with
       (* TODO write help message *)
     | "/help" -> return_xml_msg "<help> not yet written </help>" outchan
@@ -265,7 +265,7 @@ let callback (req: Http_types.request) outchan =
         else
           Http_daemon.respond_error ~code:400 outchan
     | _ -> Http_daemon.respond_error ~code:400 outchan);
-    debug_print "Done!\n"
+    debug_print (lazy "Done!\n")
   with
   | Http_types.Param_not_found attr_name ->
       Hbugs_messages.respond_exc "missing_parameter" attr_name outchan