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

(*
 * 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.
 *)


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