Commit | Line | Data |
---|---|---|
9bc82bae C |
1 | (* |
2 | * Copyright 2010, INRIA, University of Copenhagen | |
3 | * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix | |
4 | * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen | |
5 | * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix | |
6 | * This file is part of Coccinelle. | |
7 | * | |
8 | * Coccinelle is free software: you can redistribute it and/or modify | |
9 | * it under the terms of the GNU General Public License as published by | |
10 | * the Free Software Foundation, according to version 2 of the License. | |
11 | * | |
12 | * Coccinelle is distributed in the hope that it will be useful, | |
13 | * but WITHOUT ANY WARRANTY; without even the implied warranty of | |
14 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
15 | * GNU General Public License for more details. | |
16 | * | |
17 | * You should have received a copy of the GNU General Public License | |
18 | * along with Coccinelle. If not, see <http://www.gnu.org/licenses/>. | |
19 | * | |
20 | * The authors reserve the right to distribute this or future versions of | |
21 | * Coccinelle under other licenses. | |
22 | *) | |
23 | ||
24 | ||
c491d8ee C |
25 | (* |
26 | * Copyright 2010, INRIA, University of Copenhagen | |
27 | * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix | |
28 | * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen | |
29 | * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix | |
30 | * This file is part of Coccinelle. | |
31 | * | |
32 | * Coccinelle is free software: you can redistribute it and/or modify | |
33 | * it under the terms of the GNU General Public License as published by | |
34 | * the Free Software Foundation, according to version 2 of the License. | |
35 | * | |
36 | * Coccinelle is distributed in the hope that it will be useful, | |
37 | * but WITHOUT ANY WARRANTY; without even the implied warranty of | |
38 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
39 | * GNU General Public License for more details. | |
40 | * | |
41 | * You should have received a copy of the GNU General Public License | |
42 | * along with Coccinelle. If not, see <http://www.gnu.org/licenses/>. | |
43 | * | |
44 | * The authors reserve the right to distribute this or future versions of | |
45 | * Coccinelle under other licenses. | |
46 | *) | |
47 | ||
48 | ||
34e49164 C |
49 | (* The plus fragments are converted to a list of lists of lists. |
50 | Innermost list: Elements have type anything. For any pair of successive | |
51 | elements, n and n+1, the ending line of n is the same as the starting line | |
52 | of n+1. | |
53 | Middle lists: For any pair of successive elements, n and n+1, the ending | |
54 | line of n is one less than the starting line of n+1. | |
55 | Outer list: For any pair of successive elements, n and n+1, the ending | |
56 | line of n is more than one less than the starting line of n+1. *) | |
57 | ||
58 | (* For nests and disjs, we are relying on the fact that <... ...> ( | ) | |
59 | must appear on lines by themselves, meaning that the various + fragments | |
60 | can't be contiguous to each other or to unrelated things. *) | |
61 | ||
62 | module Ast = Ast_cocci | |
63 | module V = Visitor_ast | |
64 | ||
65 | (* --------------------------------------------------------------------- *) | |
66 | ||
67 | type res = | |
68 | Open of Ast.anything * int * int * int * int | |
69 | | Closed of (Ast.anything * int * int * int * int) list | |
70 | ||
71 | let mcode fn = function | |
72 | (term, Ast.PLUS(info)) -> | |
73 | let line = info.Ast.line in | |
74 | let lline = info.Ast.logical_line in | |
75 | [Open (fn term,line,line,lline,lline)] | |
76 | | _ -> [Closed []] | |
77 | ||
78 | let mk_fullType x = Ast.FullTypeTag x | |
79 | let mk_baseType x = Ast.BaseTypeTag x | |
80 | let mk_structUnion x = Ast.StructUnionTag x | |
81 | let mk_sign x = Ast.SignTag x | |
82 | let mk_ident x = Ast.IdentTag x | |
83 | let mk_expression x = Ast.ExpressionTag x | |
84 | let mk_constant x = Ast.ConstantTag x | |
85 | let mk_unaryOp x = Ast.UnaryOpTag x | |
86 | let mk_assignOp x = Ast.AssignOpTag x | |
87 | let mk_fixOp x = Ast.FixOpTag x | |
88 | let mk_binaryOp x = Ast.BinaryOpTag x | |
89 | let mk_arithOp x = Ast.ArithOpTag x | |
90 | let mk_logicalOp x = Ast.LogicalOpTag x | |
91 | let mk_declaration x = Ast.DeclarationTag x | |
92 | let mk_storage x = Ast.StorageTag x | |
93 | let mk_rule_elem x = Ast.Rule_elemTag x | |
94 | let mk_const_vol x = Ast.ConstVolTag x | |
95 | let mk_token x = Ast.Token x | |
96 | ||
97 | let get_real_start = function | |
98 | Open (_,line,_,_,_) -> line | |
99 | | _ -> failwith "not possible" | |
100 | ||
101 | let get_real_finish = function | |
102 | Open (_,_,line,_,_) -> line | |
103 | | _ -> failwith "not possible" | |
104 | ||
105 | let get_start = function | |
106 | Open (_,_,_,line,_) -> line | |
107 | | _ -> failwith "not possible" | |
108 | ||
109 | let get_finish = function | |
110 | Open (_,_,_,_,line) -> line | |
111 | | _ -> failwith "not possible" | |
112 | ||
113 | let get_option fn = function | |
114 | None -> [] | |
115 | | Some x -> [fn x] | |
116 | ||
117 | (* --------------------------------------------------------------------- *) | |
118 | (* --------------------------------------------------------------------- *) | |
119 | (* Step 1: coalesce + terms, record starting and ending line numbers *) | |
120 | ||
121 | let rec close l = | |
122 | let rec loop = function | |
123 | [] -> [] | |
124 | | Open(x,start,finish,lstart,lfinish)::rest -> | |
125 | (x,start,finish,lstart,lfinish)::(loop rest) | |
126 | | (Closed l)::rest -> l @ (loop rest) in | |
127 | Closed (loop l) | |
128 | ||
129 | let test term subterms = | |
130 | if List.for_all (function Open(_,_,_,_,_) -> true | _ -> false) subterms | |
131 | then [Open(term, | |
132 | get_real_start (List.hd subterms), | |
133 | get_real_finish (List.hd (List.rev subterms)), | |
134 | get_start (List.hd subterms), | |
135 | get_finish (List.hd (List.rev subterms)))] | |
136 | else [close subterms] | |
137 | ||
138 | (* --------------------------------------------------------------------- *) | |
139 | (* Dots *) | |
140 | ||
141 | let dots recursor k dotlist = [close (k dotlist)] | |
142 | ||
143 | (* --------------------------------------------------------------------- *) | |
144 | (* Identifier *) | |
145 | ||
146 | let ident recursor k i = test (Ast.IdentTag i) (k i) | |
147 | ||
148 | (* --------------------------------------------------------------------- *) | |
149 | (* Expression *) | |
150 | ||
151 | let expression recursor k = function | |
152 | Ast.DisjExpr(exps) -> | |
153 | [close (List.concat(List.map recursor.V.combiner_expression exps))] | |
154 | | Ast.Edots(_,_) -> [Closed []] (* must be context *) | |
155 | | Ast.Ecircles(_,_) -> [Closed []] (* must be context *) | |
156 | | Ast.Estars(_,_) -> [Closed []] (* must be context *) | |
157 | | Ast.OptExp(_) | Ast.UniqueExp(_) | Ast.MultiExp(_) -> failwith "impossible" | |
158 | | e -> test (Ast.ExpressionTag e) (k e) | |
159 | ||
160 | (* --------------------------------------------------------------------- *) | |
161 | (* Types *) | |
162 | ||
163 | and fullType recursor k ft = test (Ast.FullTypeTag ft) (k ft) | |
164 | ||
165 | and typeC recursor k t = k t | |
166 | ||
167 | (* --------------------------------------------------------------------- *) | |
168 | (* Variable declaration *) | |
169 | (* Even if the Cocci program specifies a list of declarations, they are | |
170 | split out into multiple declarations of a single variable each. *) | |
171 | ||
172 | let declaration recursor k d = test (Ast.DeclarationTag d) (k d) | |
173 | ||
174 | (* --------------------------------------------------------------------- *) | |
175 | (* Parameter *) | |
176 | ||
177 | let parameterTypeDef recursor k = function | |
178 | Ast.Pdots(_) -> [Closed []] | |
179 | | Ast.Pcircles(_) -> [Closed []] | |
180 | | p -> test (Ast.ParameterTypeDefTag p) (k p) | |
181 | ||
182 | (* --------------------------------------------------------------------- *) | |
183 | (* Top-level code *) | |
184 | ||
185 | let rec rule_elem recursor k re = test (Ast.Rule_elemTag re) (k re) | |
186 | ||
187 | let rec statement recursor k = function | |
188 | Ast.Disj(stmt_dots_list) -> | |
189 | [close | |
190 | (List.concat | |
191 | (List.map recursor.V.combiner_statement_dots stmt_dots_list))] | |
192 | | Ast.Dots(_,_,_) -> [Closed []] | |
193 | | Ast.Circles(_,_,_) -> [Closed []] | |
194 | | Ast.Stars(_,_,_) -> [Closed []] | |
195 | | s -> test (Ast.StatementTag s) (k s) | |
196 | ||
197 | let rec meta recursor k m = test (Ast.MetaTag m) (k m) | |
198 | ||
199 | let top_level recursor k = function | |
200 | Ast.FILEINFO(_,_) -> [Closed []] | |
201 | | Ast.ERRORWORDS(exps) -> [Closed []] | |
202 | | t -> test (Ast.Code t) (k t) | |
203 | ||
204 | let anything recursor k a = failwith "not called" | |
205 | ||
206 | let collect_tokens = | |
207 | let recursor = | |
208 | V.combiner (@) [] | |
209 | (mcode mk_token) (mcode mk_constant) (mcode mk_assignOp) (mcode mk_fixOp) | |
210 | (mcode mk_unaryOp) (mcode mk_binaryOp) (mcode mk_const_vol) | |
211 | (mcode mk_baseType) (mcode mk_sign) (mcode mk_structUnion) | |
212 | (mcode mk_storage) dots dots dots | |
213 | ident expression fullType typeC parameterTypeDef declaration | |
214 | rule_elem statement meta top_level anything in | |
215 | recursor.V.combiner_top_level | |
216 | ||
217 | let rule code = List.concat(List.map collect_tokens code) | |
218 | ||
219 | (* --------------------------------------------------------------------- *) | |
220 | (* --------------------------------------------------------------------- *) | |
221 | (* Step 2: find neighbors *) | |
222 | ||
223 | let rec find_neighbors = function | |
224 | [] -> [] | |
225 | | (x1,real_start1,real_finish1,start1,finish1)::rest -> | |
226 | (match find_neighbors rest with | |
227 | ((((x2,real_start2,real_finish2,start2,finish2):: | |
228 | rest_inner)::rest_middle)::rest_outer) | |
229 | as rest -> | |
230 | if finish1 = start2 | |
faf9a90c | 231 | then |
34e49164 C |
232 | ((((x1,real_start1,real_finish1,start1,finish1):: |
233 | (x2,real_start2,real_finish2,start2,finish2)::rest_inner):: | |
234 | rest_middle):: | |
235 | rest_outer) | |
236 | else if finish1 + 1 = start2 | |
237 | then | |
238 | (([(x1,real_start1,real_finish1,start1,finish1)]:: | |
239 | ((x2,real_start2,real_finish2,start2,finish2)::rest_inner):: | |
240 | rest_middle):: | |
241 | rest_outer) | |
242 | else [[(x1,real_start1,real_finish1,start1,finish1)]]::rest | |
243 | | _ -> [[[(x1,real_start1,real_finish1,start1,finish1)]]]) | |
244 | (* rest must be [] *) | |
faf9a90c | 245 | |
34e49164 C |
246 | (* --------------------------------------------------------------------- *) |
247 | (* --------------------------------------------------------------------- *) | |
248 | (* Entry point *) | |
249 | ||
250 | let plus ast = | |
251 | match close (rule ast) with | |
252 | Closed l -> find_neighbors l | |
253 | | _ -> failwith "impossible" |