[bpt/coccinelle.git] / tools / bridge.ml

(*
 * Copyright 2012, INRIA
 * Julia Lawall, Gilles Muller
 * Copyright 2010-2011, INRIA, University of Copenhagen
 * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix
 * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen
 * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix
 * This file is part of Coccinelle.
 *
 * Coccinelle is free software: you can redistribute it and/or modify
 * it under the terms of the GNU General Public License as published by
 * the Free Software Foundation, according to version 2 of the License.
 *
 * Coccinelle is distributed in the hope that it will be useful,
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 * GNU General Public License for more details.
 *
 * You should have received a copy of the GNU General Public License
 * along with Coccinelle.  If not, see <http://www.gnu.org/licenses/>.
 *
 * The authors reserve the right to distribute this or future versions of
 * Coccinelle under other licenses.
 *)


# 0 "./bridge.ml"
let drop_spaces s =
  String.concat "" (Str.split (Str.regexp "[ ]+") s)

let parse_line fp l n =
  if List.mem l fp
  then None
  else
    if Str.string_match (Str.regexp "#") l 0
    then None (* comment line *)
    else
      let top_split = Str.split (Str.regexp ":") l in
      match top_split with
	cocci::first::others ->
	  let rec loop tag = function
	      [x] ->
		let x =
		  String.concat "\\ " (Str.split (Str.regexp "[ ]+") x) in
		[(tag,x)]
	    | first::rest ->
		let splitted = Str.split (Str.regexp "[ ]+") first in
		(match List.rev splitted with
		  new_tag::info ->
		    let rest = loop new_tag rest in
		    (tag,String.concat "\\ " (List.rev info))::rest
		|	_ -> failwith "bad element")
	    | _ -> failwith "no data" in
	  Some (cocci,loop (drop_spaces first) others)
      | _ -> failwith (Printf.sprintf "bad line: %s" l)

let collect_lines fp i =
  let lines = ref [] in
  let ln = ref 0 in
  let rec loop _ =
    ln := !ln + 1;
    (match parse_line fp (input_line i) !ln with
      Some l ->
	if List.mem l !lines
	then ()
	else lines := l::!lines
    | None -> ());
    loop() in
  try loop() with End_of_file -> !lines

(* --------------------------------------------------------------------- *)

let process_fp fl =
  let i = open_in fl in
  let lines = ref ([] : string list) in
  let rec loop _ =
    let l = input_line i in
    (if not(Str.string_match (Str.regexp "#") l 0)
    then lines := l :: !lines);
    loop() in
  (try loop() with End_of_file -> ());
  close_in i;
  !lines

(* --------------------------------------------------------------------- *)
(* same info, different categories *)

let discard_ambiguous lines =
  let rec loop = function
      [] -> []
    | (cocci,tags)::rest ->
	let (same,others) =
	  List.partition
	    (function (cocci2,tags2) -> tags = tags2 && not(cocci = cocci2))
	    rest in
	match same with
	  [] -> (cocci,tags)::loop rest
	| _ ->
	    Printf.printf "ignoring ambiguity:\n";
	    List.iter
	      (function (cocci,tags) ->
		Printf.printf "%s: %s\n" cocci
		  (String.concat ", "
		     (List.map
			(function (tag,tagval) ->
			  Printf.sprintf "%s: %s" tag tagval)
			tags)))
	      ((cocci,tags)::same);
	    loop others in
  loop lines

(* --------------------------------------------------------------------- *)
(* only actually collects the rightmost element into ors *)

let split_or (cocci,line) =
  let rev = List.rev line in
  (cocci,List.rev(List.tl rev), List.hd rev)

let collect_ors fp lines =
  let rec loop = function
      [] -> failwith "no lines"
    | [line] ->
	let (c,k,v) = split_or line in
	((c,k,[v]),[])
    | line::xs ->
	let (c,k,v) = split_or line in
	let ((c1,k1,v1),rest) = loop xs in
	if c = c1 && k = k1 && not (k = [])
	then
	  if List.mem v v1
	  then ((c1,k1,v1),rest)
	  else ((c1,k1,v::v1),rest)
	else ((c,k,[v]),((c1,k1,v1)::rest)) in
  let ((c,k,v),rest) = loop lines in
  let res = (c,k,v)::rest in
  List.fold_left
    (function prev ->
      function (c,k,v) ->
	match v with
	  [] -> failwith "not possible"
	| [x] -> (c,k@v) :: prev
	| (tag,_)::_ ->
	    (*let vs =
	      Printf.sprintf "%s:(%s)" tag
		(String.concat "|"
		   (List.sort compare
		      (List.map (function (_,vl) -> vl) v))) in
	    let attempt =
	      Printf.sprintf "%s: %s %s" c
		(String.concat " " (List.map (function (k,v) -> k^":"^v) k))
		vs in*)
	    if true (*List.mem attempt fp*)
	    then
	      let vs =
		Printf.sprintf "\\\\\\\\\\(%s\\\\\\\\\\)"
		  (String.concat "\\\\\\\\\\|"
		     (List.sort compare
			(List.map (function (_,vl) -> vl) v))) in
	      (c,k@[(tag,vs)]) :: prev
	    else (List.map (function vi -> (c,k@[vi])) v) @ prev)
    [] res

(* --------------------------------------------------------------------- *)

let command s =
  let _ = Sys.command s in
  ()

let created = ref ([] : (string * (string list ref * out_channel)) list)

let mktag n = Printf.sprintf "x%d" n

let created_files = ref ([] : (string * int ref) list)

let process_line env (cocci,tags) =
  let files = List.filter (function (c,f) -> c = cocci) env in
  List.iter
    (function (_,cocci_file) ->
      let resdir = Filename.chop_extension cocci_file in
      (if not(Sys.file_exists cocci_file)
      then failwith "no cocci file");
      let (n,o) =
	try List.assoc resdir !created
	with Not_found ->
	  begin
	    if Sys.file_exists resdir
	    then
	      command
		(Printf.sprintf
		   "test %s -nt %s && /bin/rm -r -f %s && mkdir %s"
		   cocci_file resdir resdir resdir)
	    else command (Printf.sprintf "mkdir %s" resdir);
	    let files = Printf.sprintf "%s/files" resdir in
	    let o = open_out files in
	    Printf.fprintf o "all: real_all\n\n";
	    let cell = ((ref []),o) in
	    created := (resdir,cell) :: !created;
	    cell
	  end in
      let temp_file = Filename.temp_file cocci ".cocci" in
      command (Printf.sprintf "cp %s %s" cocci_file temp_file);
      let first_tag_val =
	match tags with
	  [] -> failwith "no tags"
	| (_,first_tag_val)::_ ->
	    let cell =
	      try List.assoc first_tag_val !created_files
	      with Not_found ->
		let c = ref (-1) in
		created_files := (first_tag_val,c)::!created_files;
		c in
	    cell := !cell + 1;
	    if !cell = 0
	    then first_tag_val
	    else Printf.sprintf "%s%d" first_tag_val !cell in
      List.iter
	(function (tag,tagval) ->
	  command
	    (Printf.sprintf "sed s+%s+%s+ %s > %s_out; cp %s_out %s"
	       tag tagval temp_file temp_file temp_file temp_file))
	tags;
      command
	(Printf.sprintf "mv %s %s/%s.cocci" temp_file resdir first_tag_val);
      Printf.fprintf o "%s.out:\n\tmono_spatch_linux %s.cocci ${ARGS}\n\n"
	first_tag_val first_tag_val;
      n := (first_tag_val^".out") :: !n)
    files

(* --------------------------------------------------------------------- *)

let rec mkenv = function
    [] -> []
  | [_] -> failwith "required arguments: file (category x cocci file)*"
  | category::cocci::rest ->
      if Filename.check_suffix cocci ".cocci"
      then (category,cocci)::mkenv rest
      else failwith "required arguments: file (category x cocci file)*"

let rec upto = function
    0 -> []
  | n -> (mktag (n-1)) :: (upto (n-1))

let _ =
  let (no_ors,args) =
    List.partition (function "-no_ors" -> true | _ -> false)
      (Array.to_list Sys.argv) in
  let (file,fp,env) =
    match List.tl args with
      file::env ->
	let rec loop prev = function
	    [] ->
	      if prev = ""
	      then ([],[])
	      else ([prev],[])
	  | x::xs ->
	      try
		let _ = Str.search_forward (Str.regexp ".cocci") x 0 in
		if prev = ""
		then ([],x::xs)
		else ([],prev::x::xs)
	      with Not_found ->
		let (fp,env) = loop x xs in
		if prev = ""
		then (fp,env)
		else (prev::fp,env) in
	let (fp,env) = loop "" env in
	(file,fp,mkenv env)
    | _ -> failwith "one argument expected" in
  let fp = List.fold_left (@) [] (List.map process_fp fp) in
  let i = open_in file in
  let lines = collect_lines fp i in
  let lines = if no_ors = [] then collect_ors fp lines else lines in
  close_in i;
  let lines = discard_ambiguous lines in
  List.iter (process_line env) lines;
  List.iter
    (function (resdir,(n,o)) ->
      Printf.fprintf o "real_all: %s\n"
	(String.concat " " (List.rev !n));
      Printf.fprintf o "\tcat %s > completed\n"
	(String.concat " " (List.rev !n));
      close_out o)
    !created
Commit	Line	Data
f537ebc4	1	(*
17ba0788 C	2	* Copyright 2012, INRIA
	3	* Julia Lawall, Gilles Muller
	4	* Copyright 2010-2011, INRIA, University of Copenhagen
f537ebc4 C	5	* Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix
	6	* Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen
	7	* Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix
	8	* This file is part of Coccinelle.
	9	*
	10	* Coccinelle is free software: you can redistribute it and/or modify
	11	* it under the terms of the GNU General Public License as published by
	12	* the Free Software Foundation, according to version 2 of the License.
	13	*
	14	* Coccinelle is distributed in the hope that it will be useful,
	15	* but WITHOUT ANY WARRANTY; without even the implied warranty of
	16	* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
	17	* GNU General Public License for more details.
	18	*
	19	* You should have received a copy of the GNU General Public License
	20	* along with Coccinelle. If not, see <http://www.gnu.org/licenses/>.
	21	*
	22	* The authors reserve the right to distribute this or future versions of
	23	* Coccinelle under other licenses.
	24	*)
	25
	26
feec80c3	27	# 0 "./bridge.ml"
34e49164 C	28	let drop_spaces s =
	29	String.concat "" (Str.split (Str.regexp "[ ]+") s)
	30
	31	let parse_line fp l n =
	32	if List.mem l fp
	33	then None
	34	else
	35	if Str.string_match (Str.regexp "#") l 0
	36	then None (* comment line *)
	37	else
	38	let top_split = Str.split (Str.regexp ":") l in
	39	match top_split with
	40	cocci::first::others ->
	41	let rec loop tag = function
	42	[x] ->
	43	let x =
	44	String.concat "\\ " (Str.split (Str.regexp "[ ]+") x) in
	45	[(tag,x)]
	46	\| first::rest ->
	47	let splitted = Str.split (Str.regexp "[ ]+") first in
	48	(match List.rev splitted with
	49	new_tag::info ->
	50	let rest = loop new_tag rest in
413ffc02	51	(tag,String.concat "\\ " (List.rev info))::rest
34e49164 C	52	\| _ -> failwith "bad element")
	53	\| _ -> failwith "no data" in
	54	Some (cocci,loop (drop_spaces first) others)
	55	\| _ -> failwith (Printf.sprintf "bad line: %s" l)
ae4735db	56
34e49164 C	57	let collect_lines fp i =
	58	let lines = ref [] in
	59	let ln = ref 0 in
	60	let rec loop _ =
	61	ln := !ln + 1;
	62	(match parse_line fp (input_line i) !ln with
	63	Some l ->
	64	if List.mem l !lines
	65	then ()
	66	else lines := l::!lines
	67	\| None -> ());
	68	loop() in
	69	try loop() with End_of_file -> !lines
	70
	71	(* --------------------------------------------------------------------- *)
	72
	73	let process_fp fl =
	74	let i = open_in fl in
	75	let lines = ref ([] : string list) in
	76	let rec loop _ =
	77	let l = input_line i in
	78	(if not(Str.string_match (Str.regexp "#") l 0)
	79	then lines := l :: !lines);
	80	loop() in
	81	(try loop() with End_of_file -> ());
	82	close_in i;
	83	!lines
	84
	85	(* --------------------------------------------------------------------- *)
9f8e26f4	86	(* same info, different categories *)
34e49164 C	87
	88	let discard_ambiguous lines =
	89	let rec loop = function
	90	[] -> []
	91	\| (cocci,tags)::rest ->
	92	let (same,others) =
	93	List.partition
	94	(function (cocci2,tags2) -> tags = tags2 && not(cocci = cocci2))
	95	rest in
	96	match same with
	97	[] -> (cocci,tags)::loop rest
	98	\| _ ->
	99	Printf.printf "ignoring ambiguity:\n";
	100	List.iter
	101	(function (cocci,tags) ->
	102	Printf.printf "%s: %s\n" cocci
	103	(String.concat ", "
	104	(List.map
	105	(function (tag,tagval) ->
	106	Printf.sprintf "%s: %s" tag tagval)
	107	tags)))
	108	((cocci,tags)::same);
	109	loop others in
	110	loop lines
	111
	112	(* --------------------------------------------------------------------- *)
	113	(* only actually collects the rightmost element into ors *)
	114
	115	let split_or (cocci,line) =
	116	let rev = List.rev line in
	117	(cocci,List.rev(List.tl rev), List.hd rev)
	118
	119	let collect_ors fp lines =
	120	let rec loop = function
	121	[] -> failwith "no lines"
	122	\| [line] ->
	123	let (c,k,v) = split_or line in
	124	((c,k,[v]),[])
	125	\| line::xs ->
	126	let (c,k,v) = split_or line in
	127	let ((c1,k1,v1),rest) = loop xs in
978fd7e5	128	if c = c1 && k = k1 && not (k = [])
34e49164 C	129	then
	130	if List.mem v v1
	131	then ((c1,k1,v1),rest)
	132	else ((c1,k1,v::v1),rest)
	133	else ((c,k,[v]),((c1,k1,v1)::rest)) in
	134	let ((c,k,v),rest) = loop lines in
	135	let res = (c,k,v)::rest in
	136	List.fold_left
	137	(function prev ->
	138	function (c,k,v) ->
	139	match v with
	140	[] -> failwith "not possible"
	141	\| [x] -> (c,k@v) :: prev
	142	\| (tag,_)::_ ->
91eba41f	143	(*let vs =
34e49164 C	144	Printf.sprintf "%s:(%s)" tag
	145	(String.concat "\|"
	146	(List.sort compare
	147	(List.map (function (_,vl) -> vl) v))) in
	148	let attempt =
	149	Printf.sprintf "%s: %s %s" c
	150	(String.concat " " (List.map (function (k,v) -> k^":"^v) k))
91eba41f C	151	vs in*)
91eba41f C	152	if true (List.mem attempt fp)
34e49164 C	153	then
	154	let vs =
	155	Printf.sprintf "\\\\\\\\\\(%s\\\\\\\\\\)"
	156	(String.concat "\\\\\\\\\\\|"
	157	(List.sort compare
	158	(List.map (function (_,vl) -> vl) v))) in
	159	(c,k@[(tag,vs)]) :: prev
	160	else (List.map (function vi -> (c,k@[vi])) v) @ prev)
	161	[] res
	162
	163	(* --------------------------------------------------------------------- *)
	164
	165	let command s =
	166	let _ = Sys.command s in
	167	()
	168
785a3008	169	let created = ref ([] : (string * (string list ref * out_channel)) list)
34e49164 C	170
	171	let mktag n = Printf.sprintf "x%d" n
	172
	173	let created_files = ref ([] : (string * int ref) list)
	174
	175	let process_line env (cocci,tags) =
	176	let files = List.filter (function (c,f) -> c = cocci) env in
	177	List.iter
	178	(function (_,cocci_file) ->
	179	let resdir = Filename.chop_extension cocci_file in
	180	(if not(Sys.file_exists cocci_file)
	181	then failwith "no cocci file");
	182	let (n,o) =
	183	try List.assoc resdir !created
	184	with Not_found ->
	185	begin
785a3008 C	186	if Sys.file_exists resdir
	187	then
	188	command
	189	(Printf.sprintf
	190	"test %s -nt %s && /bin/rm -r -f %s && mkdir %s"
	191	cocci_file resdir resdir resdir)
	192	else command (Printf.sprintf "mkdir %s" resdir);
34e49164 C	193	let files = Printf.sprintf "%s/files" resdir in
	194	let o = open_out files in
	195	Printf.fprintf o "all: real_all\n\n";
785a3008	196	let cell = ((ref []),o) in
34e49164 C	197	created := (resdir,cell) :: !created;
	198	cell
	199	end in
	200	let temp_file = Filename.temp_file cocci ".cocci" in
	201	command (Printf.sprintf "cp %s %s" cocci_file temp_file);
	202	let first_tag_val =
	203	match tags with
	204	[] -> failwith "no tags"
	205	\| (_,first_tag_val)::_ ->
	206	let cell =
	207	try List.assoc first_tag_val !created_files
	208	with Not_found ->
	209	let c = ref (-1) in
	210	created_files := (first_tag_val,c)::!created_files;
	211	c in
	212	cell := !cell + 1;
	213	if !cell = 0
	214	then first_tag_val
	215	else Printf.sprintf "%s%d" first_tag_val !cell in
	216	List.iter
	217	(function (tag,tagval) ->
	218	command
b23ff9c7	219	(Printf.sprintf "sed s+%s+%s+ %s > %s_out; cp %s_out %s"
34e49164 C	220	tag tagval temp_file temp_file temp_file temp_file))
	221	tags;
	222	command
	223	(Printf.sprintf "mv %s %s/%s.cocci" temp_file resdir first_tag_val);
785a3008 C	224	Printf.fprintf o "%s.out:\n\tmono_spatch_linux %s.cocci ${ARGS}\n\n"
	225	first_tag_val first_tag_val;
	226	n := (first_tag_val^".out") :: !n)
34e49164	227	files
ae4735db	228
34e49164	229	(* --------------------------------------------------------------------- *)
ae4735db	230
34e49164 C	231	let rec mkenv = function
	232	[] -> []
	233	\| [_] -> failwith "required arguments: file (category x cocci file)*"
	234	\| category::cocci::rest ->
	235	if Filename.check_suffix cocci ".cocci"
	236	then (category,cocci)::mkenv rest
	237	else failwith "required arguments: file (category x cocci file)*"
	238
	239	let rec upto = function
	240	0 -> []
	241	\| n -> (mktag (n-1)) :: (upto (n-1))
ae4735db	242
34e49164	243	let _ =
9f8e26f4 C	244	let (no_ors,args) =
	245	List.partition (function "-no_ors" -> true \| _ -> false)
	246	(Array.to_list Sys.argv) in
34e49164	247	let (file,fp,env) =
9f8e26f4	248	match List.tl args with
34e49164 C	249	file::env ->
	250	let rec loop prev = function
	251	[] ->
	252	if prev = ""
	253	then ([],[])
	254	else ([prev],[])
	255	\| x::xs ->
	256	try
	257	let _ = Str.search_forward (Str.regexp ".cocci") x 0 in
	258	if prev = ""
	259	then ([],x::xs)
	260	else ([],prev::x::xs)
	261	with Not_found ->
	262	let (fp,env) = loop x xs in
	263	if prev = ""
	264	then (fp,env)
	265	else (prev::fp,env) in
	266	let (fp,env) = loop "" env in
	267	(file,fp,mkenv env)
	268	\| _ -> failwith "one argument expected" in
	269	let fp = List.fold_left (@) [] (List.map process_fp fp) in
	270	let i = open_in file in
	271	let lines = collect_lines fp i in
9f8e26f4	272	let lines = if no_ors = [] then collect_ors fp lines else lines in
34e49164 C	273	close_in i;
	274	let lines = discard_ambiguous lines in
	275	List.iter (process_line env) lines;
	276	List.iter
	277	(function (resdir,(n,o)) ->
	278	Printf.fprintf o "real_all: %s\n"
785a3008 C	279	(String.concat " " (List.rev !n));
	280	Printf.fprintf o "\tcat %s > completed\n"
	281	(String.concat " " (List.rev !n));
34e49164 C	282	close_out o)
34e49164 C	283	!created