← Back to branch summary

~ubuntu-branches/ubuntu/karmic/coccinelle/karmic

« back to all changes in this revision

Viewing changes to commons/common.ml

  • Committer: Bazaar Package Importer
  • Author(s): Євгеній Мещеряков
  • Date: 2009-05-11 15:32:24 UTC
  • mfrom: (1.1.3 upstream)
  • Revision ID: james.westby@ubuntu.com-20090511153224-1odv41d4dkr3y80v
Tags: 0.1.8.deb-2
Use common install Makefile target for both native and bytecode
build. This hopefully fixes FTBFS on bytecode archs 

Show diffs side-by-side

added added

removed removed

Lines of Context:
commons/common.ml
237
237
  flush stdout
238
238
 
239
239
 
 
240
 
 
241
 
 
242
 
 
243
 
 
244
let _chan_pr2 = ref (None: out_channel option)
 
245
 
 
246
let out_chan_pr2 ?(newline=true) s = 
 
247
  match !_chan_pr2 with
 
248
  | None -> ()
 
249
  | Some chan -> 
 
250
      output_string chan (s ^ (if newline then "\n" else "")); 
 
251
      flush chan
 
252
 
 
253
 
240
254
let pr2 s = 
241
255
  prerr_string !_prefix_pr;
242
256
  do_n !_tab_level_print (fun () -> prerr_string " ");
243
257
  prerr_string s;
244
258
  prerr_string "\n"; 
245
 
  flush stderr
 
259
  flush stderr;
 
260
  out_chan_pr2 s;
 
261
  ()
246
262
 
247
263
let pr2_no_nl s = 
248
264
  prerr_string !_prefix_pr;
249
265
  do_n !_tab_level_print (fun () -> prerr_string " ");
250
266
  prerr_string s;
251
 
  flush stderr
 
267
  flush stderr;
 
268
  out_chan_pr2 ~newline:false s;
 
269
  ()
 
270
 
252
271
 
253
272
let pr_xxxxxxxxxxxxxxxxx () = 
254
273
  pr "-----------------------------------------------------------------------"
385
404
 
386
405
let _already_printed = Hashtbl.create 101
387
406
let disable_pr2_once = ref false 
388
 
let pr2_once s = 
 
407
 
 
408
let xxx_once f s = 
389
409
  if !disable_pr2_once then pr2 s
390
410
  else 
391
411
    if not (Hashtbl.mem _already_printed s)
392
412
    then begin
393
413
      Hashtbl.add _already_printed s true;
394
 
      pr2 ("(ONCE) " ^ s);
 
414
      f ("(ONCE) " ^ s);
395
415
    end
396
416
 
 
417
let pr2_once s = xxx_once pr2 s
 
418
 
 
419
(* ---------------------------------------------------------------------- *)
 
420
let mk_pr2_wrappers aref = 
 
421
  let fpr2 s = 
 
422
    if !aref
 
423
    then pr2 s
 
424
    else 
 
425
      (* just to the log file *)
 
426
      out_chan_pr2 s
 
427
  in
 
428
  let fpr2_once s = 
 
429
    if !aref
 
430
    then pr2_once s
 
431
    else 
 
432
      xxx_once out_chan_pr2 s
 
433
  in
 
434
  fpr2, fpr2_once
 
435
 
397
436
 
398
437
(* ---------------------------------------------------------------------- *)
399
438
(* could also be in File section *)
433
472
  | Some infile -> redirect_stdin infile f
434
473
 
435
474
 
 
475
(* cf end 
 
476
let with_pr2_to_string f = 
 
477
*)
 
478
  
436
479
 
437
480
(* ---------------------------------------------------------------------- *)
438
481
 
1050
1093
 
1051
1094
let pp s = Format.print_string s
1052
1095
 
1053
 
 
1054
 
 
1055
 
(* julia: convert something printed using format to print into a string *)
1056
 
let format_to_string f =
1057
 
  let o = open_out "/tmp/out" in
1058
 
  Format.set_formatter_out_channel o;
1059
 
  let _ = f() in
1060
 
  Format.print_flush();
1061
 
  Format.set_formatter_out_channel stdout;
1062
 
  close_out o;
1063
 
  let i = open_in "/tmp/out" in
1064
 
  let lines = ref [] in
1065
 
  let rec loop _ =
1066
 
    let cur = input_line i in
1067
 
    lines := cur :: !lines;
1068
 
    loop() in
1069
 
  (try loop() with End_of_file -> ());
1070
 
  close_in i;
1071
 
  String.concat "\n" (List.rev !lines)
1072
 
 
1073
 
 
1074
 
 
1075
1096
let mk_str_func_of_assoc_conv xs = 
1076
1097
  let swap (x,y) = (y,x) in
1077
1098
 
1083
1104
    List.assoc a xs
1084
1105
  )
1085
1106
 
 
1107
 
 
1108
 
 
1109
(* julia: convert something printed using format to print into a string *)
 
1110
(* now at bottom of file
 
1111
let format_to_string f =
 
1112
 ...
 
1113
*)
 
1114
 
 
1115
 
 
1116
 
1086
1117
(*****************************************************************************)
1087
1118
(* Macro *)
1088
1119
(*****************************************************************************)
1213
1244
  reference := old;
1214
1245
  res
1215
1246
 
 
1247
let save_excursion_and_disable reference f = 
 
1248
  save_excursion reference (fun () -> 
 
1249
    reference := false;
 
1250
    f ()
 
1251
  )
 
1252
 
 
1253
let save_excursion_and_enable reference f = 
 
1254
  save_excursion reference (fun () -> 
 
1255
    reference := true;
 
1256
    f ()
 
1257
  )
1216
1258
 
1217
1259
 
1218
1260
let memoized h k f = 
1401
1443
  Gc.set {(Gc.get ()) with Gc.stack_limit = 100 * 1024 * 1024}
1402
1444
 
1403
1445
 
 
1446
 
 
1447
 
1404
1448
(* if process a big set of files then dont want get overflow in the middle
1405
1449
 * so for this we are ready to spend some extra time at the beginning that
1406
1450
 * could save far more later.
3300
3344
    then 
3301
3345
      cmd_to_list 
3302
3346
        ("find " ^ x  ^
3303
 
         " -noleaf -type f | grep -v /.hg/ |grep -v /CVS/ | grep -v /.git/"
 
3347
         " -noleaf -type f | grep -v /.hg/ |grep -v /CVS/ | grep -v /.git/ |grep -v /_darcs/"
3304
3348
        )
3305
3349
        +> List.filter (fun s -> s =~ regex)
3306
3350
    else [x]
5347
5391
 
5348
5392
 
5349
5393
 
5350
 
let (full_charpos_to_pos2: filename -> (int * int) array ) = fun filename ->
5351
 
 
5352
 
    let arr = Array.create (filesize filename + 2) (0,0) in
 
5394
let full_charpos_to_pos2 = fun filename ->
 
5395
 
 
5396
  let size = (filesize filename + 2) in
 
5397
 
 
5398
    let arr = Array.create size  (0,0) in
5353
5399
 
5354
5400
    let chan = open_in filename in
5355
5401
 
5394
5440
    column = snd (table.(x.charpos));
5395
5441
  }
5396
5442
 
 
5443
 
 
5444
 
 
5445
let full_charpos_to_pos_large2 = fun filename ->
 
5446
 
 
5447
  let size = (filesize filename + 2) in
 
5448
 
 
5449
    (* old: let arr = Array.create size  (0,0) in *)
 
5450
    let arr1 = Bigarray.Array1.create 
 
5451
      Bigarray.int Bigarray.c_layout size in
 
5452
    let arr2 = Bigarray.Array1.create 
 
5453
      Bigarray.int Bigarray.c_layout size in
 
5454
    Bigarray.Array1.fill arr1 0;
 
5455
    Bigarray.Array1.fill arr2 0;
 
5456
 
 
5457
    let chan = open_in filename in
 
5458
 
 
5459
    let charpos   = ref 0 in
 
5460
    let line  = ref 0 in
 
5461
 
 
5462
    let rec full_charpos_to_pos_aux () =
 
5463
     try
 
5464
       let s = (input_line chan) in
 
5465
       incr line;
 
5466
 
 
5467
       (* '... +1 do'  cos input_line dont return the trailing \n *)
 
5468
       for i = 0 to (slength s - 1) + 1 do 
 
5469
         (* old: arr.(!charpos + i) <- (!line, i); *)
 
5470
         arr1.{!charpos + i} <- (!line);
 
5471
         arr2.{!charpos + i} <- i;
 
5472
       done;
 
5473
       charpos := !charpos + slength s + 1;
 
5474
       full_charpos_to_pos_aux();
 
5475
       
 
5476
     with End_of_file -> 
 
5477
       for i = !charpos to (* old: Array.length arr *) 
 
5478
         Bigarray.Array1.dim arr1 - 1 do
 
5479
         (* old: arr.(i) <- (!line, 0); *)
 
5480
         arr1.{i} <- !line;
 
5481
         arr2.{i} <- 0;
 
5482
       done;
 
5483
       ();
 
5484
    in 
 
5485
    begin 
 
5486
      full_charpos_to_pos_aux ();
 
5487
      close_in chan;
 
5488
      (fun i -> arr1.{i}, arr2.{i})
 
5489
    end
 
5490
let full_charpos_to_pos_large a =
 
5491
  profile_code "Common.full_charpos_to_pos_large" 
 
5492
    (fun () -> full_charpos_to_pos_large2 a)
 
5493
 
 
5494
 
 
5495
let complete_parse_info_large filename table x = 
 
5496
  { x with 
 
5497
    file = filename;
 
5498
    line   = fst (table (x.charpos));
 
5499
    column = snd (table (x.charpos));
 
5500
  }
 
5501
 
5397
5502
(*---------------------------------------------------------------------------*)
5398
5503
(* Decalage is here to handle stuff such as cpp which include file and who 
5399
5504
 * can make shift.
5896
6001
  | _ -> failwith "md5sum_of_string wrong output"
5897
6002
 
5898
6003
 
 
6004
 
 
6005
let with_pr2_to_string f = 
 
6006
  let file = new_temp_file "pr2" "out" in
 
6007
  redirect_stdout_stderr file f;
 
6008
  cat file
 
6009
 
 
6010
(* julia: convert something printed using format to print into a string *)
 
6011
let format_to_string f =
 
6012
  let (nm,o) = Filename.open_temp_file "format_to_s" ".out" in
 
6013
  Format.set_formatter_out_channel o;
 
6014
  let _ = f() in
 
6015
  Format.print_newline();
 
6016
  Format.print_flush();
 
6017
  Format.set_formatter_out_channel stdout;
 
6018
  close_out o;
 
6019
  let i = open_in nm in
 
6020
  let lines = ref [] in
 
6021
  let rec loop _ =
 
6022
    let cur = input_line i in
 
6023
    lines := cur :: !lines;
 
6024
    loop() in
 
6025
  (try loop() with End_of_file -> ());
 
6026
  close_in i;
 
6027
  command2 ("rm -f " ^ nm);
 
6028
  String.concat "\n" (List.rev !lines)
 
6029
 
 
6030
 
 
6031
 
5899
6032
(*****************************************************************************)
5900
6033
(* Misc/test *)
5901
6034
(*****************************************************************************)