- Try to do better pretty printing when array elements are individually

[bpt/coccinelle.git] / commons / common.ml

diff --git a/commons/common.ml b/commons/common.ml
index aa4d6e2..34d602b 100644 (file)
--- a/commons/common.ml
+++ b/commons/common.ml
@@ -309,6 +309,7 @@ let reset_pr_indent () =
  * this file.
  *)
 
+(* don't the code below, use the Dumper module in ocamlextra instead.
 (* start of dumper.ml *)
 
 (* Dump an OCaml value into a printable string.
@@ -397,6 +398,7 @@ let rec dump r =
 let dump v = dump (repr v)
 
 (* end of dumper.ml *)
+*)
 
 (*
 let (dump : 'a -> string) = fun x ->
@@ -405,7 +407,7 @@ let (dump : 'a -> string) = fun x ->
 
 
 (* ---------------------------------------------------------------------- *)
-let pr2_gen x = pr2 (dump x)
+let pr2_gen x = pr2 (Dumper.dump x)
 
 
 
@@ -759,7 +761,7 @@ let _ex1 = example (enum 1 4 = [1;2;3;4])
 let assert_equal a b =
   if not (a = b)
   then failwith ("assert_equal: those 2 values are not equal:\n\t" ^
-                 (dump a) ^ "\n\t" ^ (dump b) ^ "\n")
+                 (Dumper.dump a) ^ "\n\t" ^ (Dumper.dump b) ^ "\n")
 
 let (example2: string -> bool -> unit) = fun s b ->
   try assert b with x -> failwith s
@@ -1155,10 +1157,10 @@ let macro_expand s =
   let c = open_out "/tmp/ttttt.ml" in
   begin
     output_string c s; close_out c;
-    command2 ("ocamlc -c -pp 'camlp4o pa_extend.cmo q_MLast.cmo -impl' " ^
-             "-I +camlp4 -impl macro.ml4");
-    command2 "camlp4o ./macro.cmo pr_o.cmo /tmp/ttttt.ml";
-    command2 "rm -f /tmp/ttttt.ml";
+    command2 (Commands.ocamlc_cmd ^ " -c -pp '" ^ Commands.camlp4o_cmd ^" pa_extend.cmo q_MLast.cmo -impl' " ^
+             "-I +" ^ Commands.camlp4_cmd ^ " -impl macro.ml4");
+    command2 (Commands.camlp4o_cmd ^" ./macro.cmo pr_o.cmo /tmp/ttttt.ml");
+    Unix.unlink "/tmp/ttttt.ml";
   end
 
 (*
@@ -1386,7 +1388,7 @@ let release_file_lock filename =
 (*****************************************************************************)
 
 exception Todo
-exception Impossible
+exception Impossible of int
 exception Here
 exception ReturnExn
 
@@ -1397,7 +1399,7 @@ exception WrongFormat of string
 (* old: let _TODO () = failwith "TODO",  now via fix_caml with raise Todo *)
 
 let internal_error s = failwith ("internal error: "^s)
-let error_cant_have x = internal_error ("cant have this case: " ^(dump x))
+let error_cant_have x = internal_error ("cant have this case: " ^(Dumper.dump x))
 let myassert cond = if cond then () else failwith "assert error"
 
 
@@ -1414,7 +1416,7 @@ let myassert cond = if cond then () else failwith "assert error"
  * In fact dont have to name it, use +> (fun v -> ...)  so when want
  * erase debug just have to erase one line.
  *)
-let warning s v = (pr2 ("Warning: " ^ s ^ "; value = " ^ (dump v)); v)
+let warning s v = (pr2 ("Warning: " ^ s ^ "; value = " ^ (Dumper.dump v)); v)
 
 
 
@@ -1651,7 +1653,7 @@ let arg_parse2 l msg short_usage_fun =
       short_usage_fun();
       raise (UnixExit (2))
   | Arg.Help msg -> (* printf "%s" msg; exit 0; *)
-      raise Impossible  (* -help is specified in speclist *)
+      raise (Impossible 1)  (* -help is specified in speclist *)
   )
 
 
@@ -2675,7 +2677,7 @@ let int_to_month i =
   | 11 -> "November"
   | 12 -> "December"
 *)
-  | _ -> raise Impossible
+  | _ -> raise (Impossible 2)
 
 
 let month_info = [
@@ -3371,9 +3373,13 @@ let cache_computation_robust2
 
   if Sys.file_exists dependencies_cache &&
      get_value dependencies_cache =*= dependencies
-  then get_value file_cache
+  then
+    (*begin
+    pr2 ("cache computation reuse " ^ file);*)
+    get_value file_cache
+    (*end*)
   else begin
-    pr2 ("cache computation recompute " ^ file);
+    (*pr2 ("cache computation recompute " ^ file);*)
     let res = f () in
     write_value dependencies dependencies_cache;
     write_value res file_cache;
@@ -3552,6 +3558,7 @@ let timeout_function timeoutval = fun f ->
   with Timeout ->
     begin
       log "timeout (we abort)";
+      (*pr2 (List.hd(cmd_to_list "free -m | grep Mem"));*)
       raise Timeout;
     end
   | e ->
@@ -3576,6 +3583,11 @@ let timeout_function_opt timeoutvalopt f =
   | Some x -> timeout_function x f
 
 
+(* removes only if the file does not exists *)
+let remove_file path =
+  if Sys.file_exists path
+  then Sys.remove path
+  else ()
 
 (* creation of tmp files, a la gcc *)
 
@@ -3594,7 +3606,7 @@ let erase_temp_files () =
   if not !save_tmp_files then begin
     !_temp_files_created +> List.iter (fun s ->
       (* pr2 ("erasing: " ^ s); *)
-      command2 ("rm -f " ^ s)
+      remove_file s
     );
     _temp_files_created := []
   end
@@ -3603,7 +3615,7 @@ let erase_this_temp_file f =
   if not !save_tmp_files then begin
     _temp_files_created :=
       List.filter (function x -> not (x =$= f)) !_temp_files_created;
-    command2 ("rm -f " ^ f)
+    remove_file f
   end
 
 
@@ -4693,7 +4705,7 @@ let assoc_option  k l =
 let assoc_with_err_msg k l =
   try List.assoc k l
   with Not_found ->
-    pr2 (spf "pb assoc_with_err_msg: %s" (dump k));
+    pr2 (spf "pb assoc_with_err_msg: %s" (Dumper.dump k));
     raise Not_found
 
 (*****************************************************************************)
@@ -5358,7 +5370,7 @@ let (diff: (int -> int -> diff -> unit)-> (string list * string list) -> unit)=
       | ("|" | "/" | "\\" ) ->
           f !a !b BnotinA; f !a !b AnotinB; incr a; incr b;
       | "<" -> f !a !b AnotinB; incr a;
-      | _ -> raise Impossible
+      | _ -> raise (Impossible 3)
     )
 (*
 let _ =
@@ -5386,7 +5398,7 @@ let (diff2: (int -> int -> diff -> unit) -> (string * string) -> unit) =
       | ">" -> f !a !b BnotinA; incr b;
       | "|" -> f !a !b BnotinA; f !a !b AnotinB; incr a; incr b;
       | "<" -> f !a !b AnotinB; incr a;
-      | _ -> raise Impossible
+      | _ -> raise (Impossible 4)
     )
 
 
@@ -5544,7 +5556,7 @@ let full_charpos_to_pos a =
   profile_code "Common.full_charpos_to_pos" (fun () -> full_charpos_to_pos2 a)
 
 let test_charpos file =
-  full_charpos_to_pos file +> dump +> pr2
+  full_charpos_to_pos file +> Dumper.dump +> pr2
 
 
 
@@ -5674,7 +5686,11 @@ type score_list = (string (* usually a filename *) * score_result) list
 
 let empty_score () = (Hashtbl.create 101 : score)
 
+let save_score score path =
+  write_value score path
 
+let load_score path () =
+  read_value path
 
 let regression_testing_vs newscore bestscore =
 
@@ -5691,7 +5707,7 @@ let regression_testing_vs newscore bestscore =
         optionise (fun () -> Hashtbl.find newscore res),
         optionise (fun () -> Hashtbl.find bestscore res)
       with
-      | None, None -> raise Impossible
+      | None, None -> raise (Impossible 5)
       | Some x, None ->
           Printf.printf "new test file appeared: %s\n" res;
           Hashtbl.add newbestscore res x;