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.
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.
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.
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/>.
20 * The authors reserve the right to distribute this or future versions of
21 * Coccinelle under other licenses.
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.
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.
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.
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/>.
44 * The authors reserve the right to distribute this or future versions of
45 * Coccinelle under other licenses.
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
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. *)
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. *)
62 module Ast
= Ast_cocci
63 module V
= Visitor_ast
65 (* --------------------------------------------------------------------- *)
68 Open
of Ast.anything
* int * int * int * int
69 | Closed
of (Ast.anything
* int * int * int * int) list
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)]
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
97 let get_real_start = function
98 Open
(_
,line,_
,_
,_
) -> line
99 | _
-> failwith
"not possible"
101 let get_real_finish = function
102 Open
(_
,_
,line,_
,_
) -> line
103 | _
-> failwith
"not possible"
105 let get_start = function
106 Open
(_
,_
,_
,line,_
) -> line
107 | _
-> failwith
"not possible"
109 let get_finish = function
110 Open
(_
,_
,_
,_
,line) -> line
111 | _
-> failwith
"not possible"
113 let get_option fn
= function
117 (* --------------------------------------------------------------------- *)
118 (* --------------------------------------------------------------------- *)
119 (* Step 1: coalesce + terms, record starting and ending line numbers *)
122 let rec loop = function
124 | Open
(x
,start
,finish
,lstart
,lfinish
)::rest
->
125 (x
,start
,finish
,lstart
,lfinish
)::(loop rest
)
126 | (Closed l
)::rest
-> l
@ (loop rest
) in
129 let test term subterms
=
130 if List.for_all
(function Open
(_
,_
,_
,_
,_
) -> true | _
-> false) subterms
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
]
138 (* --------------------------------------------------------------------- *)
141 let dots recursor k dotlist
= [close (k dotlist
)]
143 (* --------------------------------------------------------------------- *)
146 let ident recursor k i
= test (Ast.IdentTag i
) (k i
)
148 (* --------------------------------------------------------------------- *)
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
)
160 (* --------------------------------------------------------------------- *)
163 and fullType recursor k ft
= test (Ast.FullTypeTag ft
) (k ft
)
165 and typeC recursor k t
= k t
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. *)
172 let declaration recursor k d
= test (Ast.DeclarationTag d
) (k d
)
174 (* --------------------------------------------------------------------- *)
177 let parameterTypeDef recursor k
= function
178 Ast.Pdots
(_
) -> [Closed
[]]
179 | Ast.Pcircles
(_
) -> [Closed
[]]
180 | p
-> test (Ast.ParameterTypeDefTag p
) (k p
)
182 (* --------------------------------------------------------------------- *)
185 let rec rule_elem recursor k re
= test (Ast.Rule_elemTag re
) (k re
)
187 let rec statement recursor k
= function
188 Ast.Disj
(stmt_dots_list
) ->
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
)
197 let rec meta recursor k m
= test (Ast.MetaTag m
) (k m
)
199 let top_level recursor k
= function
200 Ast.FILEINFO
(_
,_
) -> [Closed
[]]
201 | Ast.ERRORWORDS
(exps
) -> [Closed
[]]
202 | t
-> test (Ast.Code t
) (k t
)
204 let anything recursor k a
= failwith
"not called"
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
217 let rule code
= List.concat
(List.map
collect_tokens code
)
219 (* --------------------------------------------------------------------- *)
220 (* --------------------------------------------------------------------- *)
221 (* Step 2: find neighbors *)
223 let rec find_neighbors = function
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
)
232 ((((x1
,real_start1
,real_finish1
,start1
,finish1
)::
233 (x2
,real_start2
,real_finish2
,start2
,finish2
)::rest_inner
)::
236 else if finish1
+ 1 = start2
238 (([(x1
,real_start1
,real_finish1
,start1
,finish1
)]::
239 ((x2
,real_start2
,real_finish2
,start2
,finish2
)::rest_inner
)::
242 else [[(x1
,real_start1
,real_finish1
,start1
,finish1
)]]::rest
243 | _
-> [[[(x1
,real_start1
,real_finish1
,start1
,finish1
)]]])
244 (* rest must be [] *)
246 (* --------------------------------------------------------------------- *)
247 (* --------------------------------------------------------------------- *)
251 match close (rule ast
) with
252 Closed l
-> find_neighbors l
253 | _
-> failwith
"impossible"