2 * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen
3 * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller
4 * This file is part of Coccinelle.
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.
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.
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/>.
18 * The authors reserve the right to distribute this or future versions of
19 * Coccinelle under other licenses.
23 (* two goals: first drop from the environments things that are not used,
24 and second prompt for the names of fresh variables that are used *)
26 (* have to add in the whole inherited env because inherited variables are
27 not returned by get_fvs. It would be better if that were the case, but
28 since at the moment I think we can only inherit one value per variable,
29 perhaps it doesn't matter - these bindings will always be the same no matter
30 how we reached a particular match *)
32 module Ast
= Ast_cocci
34 let extra_counter = ref 0
36 let ctr = !extra_counter in
37 extra_counter := !extra_counter + 1;
38 "__extra_counter__"^
(string_of_int
ctr)
41 let ctr = !extra_counter in
42 extra_counter := !extra_counter + 1;
43 seed^
(string_of_int
ctr)
47 let s = read_line
() in
48 match Parse_c.tokens_of_string
s with
49 [Parser_c.TIdent _
; Parser_c.EOF _
] -> s
50 | [Parser_c.EOF _
] -> get_extra()
51 | _
-> failwith
("wrong fresh id: " ^
s)
52 with End_of_file
-> get_extra()
54 let get_vars = function
55 Lib_engine.Match
(re
) -> (Ast.get_fvs re
, Ast.get_fresh re
)
58 let string2val str
= Lib_engine.NormalMetaVal
(Ast_c.MetaIdVal
(str
))
60 (* ----------------------------------------------------------------------- *)
61 (* Get values for fresh variables *)
63 let process_tree inherited_env l
=
64 let (all_fresh
,local_freshs
,new_triples
) =
66 (function (all_fresh
,local_freshs
,new_triples
) ->
67 function (node
,env
,pred
) ->
68 let (other
,fresh
) = get_vars pred
in
69 let env = List.filter
(function (x
,_
) -> List.mem x other
) env in
70 (Common.union_set fresh all_fresh
,
72 (node
,env@inherited_env
,pred
)::new_triples
))
74 let local_freshs = List.rev
local_freshs in
75 let new_triples = List.rev
new_triples in
79 ((r
,n
) as fresh
,None
) ->
80 Printf.printf
"%s: name for %s: " r n
; (* not debugging code!!! *)
82 (fresh
,string2val(read_fresh_id()))
83 | ((r
,n
) as fresh
,Some seed
) ->
84 (fresh
,string2val(get_seeded seed
)))
89 (function freshs_node_env_preds
->
90 function (fresh
,_
) as elem
->
92 (function (freshs
,((node
,env,pred
) as cur
)) ->
94 let _ = List.assoc fresh freshs
in
95 (freshs
,(node
,elem
::env,pred
))
96 with Not_found
-> (freshs
,cur
))
97 freshs_node_env_preds
)
98 (List.combine
local_freshs new_triples)
100 (List.rev res
, fresh_env)
102 (* ----------------------------------------------------------------------- *)
103 (* Create the environment to be used afterwards *)
105 let collect_used_after used_after envs
=
106 List.map
(List.filter
(function (v
,vl
) -> List.mem v used_after
)) envs
108 (* ----------------------------------------------------------------------- *)
109 (* distinguish between distinct witness trees, each gets an index n *)
111 let numberify trees
=
113 Common.fold_left_with_index
114 (function acc
-> function xs
-> function n
->
115 (List.map
(function x
-> (n
,x
)) xs
) @ acc
)
120 let (same
,diff
) = List.partition
(function (ns
,xs
) -> x
= xs
) res
in
122 [(ns
,xs
)] -> (n
::ns
,xs
)::diff
126 (* ----------------------------------------------------------------------- *)
129 let process used_after inherited_env l
=
130 let (trees, fresh_envs
) =
131 List.split
(List.map
(process_tree inherited_env
) l
) in
132 let trees = numberify trees in
133 (trees, collect_used_after used_after fresh_envs
)