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.
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 (* The plus fragments are converted to a list of lists of lists.
24 Innermost list: Elements have type anything. For any pair of successive
25 elements, n and n+1, the ending line of n is the same as the starting line
27 Middle lists: For any pair of successive elements, n and n+1, the ending
28 line of n is one less than the starting line of n+1.
29 Outer list: For any pair of successive elements, n and n+1, the ending
30 line of n is more than one less than the starting line of n+1. *)
32 (* For nests and disjs, we are relying on the fact that <... ...> ( | )
33 must appear on lines by themselves, meaning that the various + fragments
34 can't be contiguous to each other or to unrelated things. *)
36 module Ast
= Ast_cocci
37 module V
= Visitor_ast
39 (* --------------------------------------------------------------------- *)
42 Open
of Ast.anything
* int * int * int * int
43 | Closed
of (Ast.anything
* int * int * int * int) list
45 let mcode fn
= function
46 (term
, Ast.PLUS
(info
)) ->
47 let line = info
.Ast.line in
48 let lline = info
.Ast.logical_line
in
49 [Open
(fn term
,line,line,lline,lline)]
52 let mk_fullType x
= Ast.FullTypeTag x
53 let mk_baseType x
= Ast.BaseTypeTag x
54 let mk_structUnion x
= Ast.StructUnionTag x
55 let mk_sign x
= Ast.SignTag x
56 let mk_ident x
= Ast.IdentTag x
57 let mk_expression x
= Ast.ExpressionTag x
58 let mk_constant x
= Ast.ConstantTag x
59 let mk_unaryOp x
= Ast.UnaryOpTag x
60 let mk_assignOp x
= Ast.AssignOpTag x
61 let mk_fixOp x
= Ast.FixOpTag x
62 let mk_binaryOp x
= Ast.BinaryOpTag x
63 let mk_arithOp x
= Ast.ArithOpTag x
64 let mk_logicalOp x
= Ast.LogicalOpTag x
65 let mk_declaration x
= Ast.DeclarationTag x
66 let mk_storage x
= Ast.StorageTag x
67 let mk_rule_elem x
= Ast.Rule_elemTag x
68 let mk_const_vol x
= Ast.ConstVolTag x
69 let mk_token x
= Ast.Token x
71 let get_real_start = function
72 Open
(_
,line,_
,_
,_
) -> line
73 | _
-> failwith
"not possible"
75 let get_real_finish = function
76 Open
(_
,_
,line,_
,_
) -> line
77 | _
-> failwith
"not possible"
79 let get_start = function
80 Open
(_
,_
,_
,line,_
) -> line
81 | _
-> failwith
"not possible"
83 let get_finish = function
84 Open
(_
,_
,_
,_
,line) -> line
85 | _
-> failwith
"not possible"
87 let get_option fn
= function
91 (* --------------------------------------------------------------------- *)
92 (* --------------------------------------------------------------------- *)
93 (* Step 1: coalesce + terms, record starting and ending line numbers *)
96 let rec loop = function
98 | Open
(x
,start
,finish
,lstart
,lfinish
)::rest
->
99 (x
,start
,finish
,lstart
,lfinish
)::(loop rest
)
100 | (Closed l
)::rest
-> l
@ (loop rest
) in
103 let test term subterms
=
104 if List.for_all
(function Open
(_
,_
,_
,_
,_
) -> true | _
-> false) subterms
106 get_real_start (List.hd subterms
),
107 get_real_finish (List.hd
(List.rev subterms
)),
108 get_start (List.hd subterms
),
109 get_finish (List.hd
(List.rev subterms
)))]
110 else [close subterms
]
112 (* --------------------------------------------------------------------- *)
115 let dots recursor k dotlist
= [close (k dotlist
)]
117 (* --------------------------------------------------------------------- *)
120 let ident recursor k i
= test (Ast.IdentTag i
) (k i
)
122 (* --------------------------------------------------------------------- *)
125 let expression recursor k
= function
126 Ast.DisjExpr
(exps
) ->
127 [close (List.concat
(List.map recursor
.V.combiner_expression exps
))]
128 | Ast.Edots
(_
,_
) -> [Closed
[]] (* must be context *)
129 | Ast.Ecircles
(_
,_
) -> [Closed
[]] (* must be context *)
130 | Ast.Estars
(_
,_
) -> [Closed
[]] (* must be context *)
131 | Ast.OptExp
(_
) | Ast.UniqueExp
(_
) | Ast.MultiExp
(_
) -> failwith
"impossible"
132 | e
-> test (Ast.ExpressionTag e
) (k e
)
134 (* --------------------------------------------------------------------- *)
137 and fullType recursor k ft
= test (Ast.FullTypeTag ft
) (k ft
)
139 and typeC recursor k t
= k t
141 (* --------------------------------------------------------------------- *)
142 (* Variable declaration *)
143 (* Even if the Cocci program specifies a list of declarations, they are
144 split out into multiple declarations of a single variable each. *)
146 let declaration recursor k d
= test (Ast.DeclarationTag d
) (k d
)
148 (* --------------------------------------------------------------------- *)
151 let parameterTypeDef recursor k
= function
152 Ast.Pdots
(_
) -> [Closed
[]]
153 | Ast.Pcircles
(_
) -> [Closed
[]]
154 | p
-> test (Ast.ParameterTypeDefTag p
) (k p
)
156 (* --------------------------------------------------------------------- *)
159 let rec rule_elem recursor k re
= test (Ast.Rule_elemTag re
) (k re
)
161 let rec statement recursor k
= function
162 Ast.Disj
(stmt_dots_list
) ->
165 (List.map recursor
.V.combiner_statement_dots stmt_dots_list
))]
166 | Ast.Dots
(_
,_
,_
) -> [Closed
[]]
167 | Ast.Circles
(_
,_
,_
) -> [Closed
[]]
168 | Ast.Stars
(_
,_
,_
) -> [Closed
[]]
169 | s
-> test (Ast.StatementTag s
) (k s
)
171 let rec meta recursor k m
= test (Ast.MetaTag m
) (k m
)
173 let top_level recursor k
= function
174 Ast.FILEINFO
(_
,_
) -> [Closed
[]]
175 | Ast.ERRORWORDS
(exps
) -> [Closed
[]]
176 | t
-> test (Ast.Code t
) (k t
)
178 let anything recursor k a
= failwith
"not called"
183 (mcode mk_token) (mcode mk_constant) (mcode mk_assignOp) (mcode mk_fixOp)
184 (mcode mk_unaryOp) (mcode mk_binaryOp) (mcode mk_const_vol)
185 (mcode mk_baseType) (mcode mk_sign) (mcode mk_structUnion)
186 (mcode mk_storage) dots dots dots
187 ident expression fullType typeC
parameterTypeDef declaration
188 rule_elem statement meta top_level anything in
189 recursor.V.combiner_top_level
191 let rule code
= List.concat
(List.map
collect_tokens code
)
193 (* --------------------------------------------------------------------- *)
194 (* --------------------------------------------------------------------- *)
195 (* Step 2: find neighbors *)
197 let rec find_neighbors = function
199 | (x1
,real_start1
,real_finish1
,start1
,finish1
)::rest
->
200 (match find_neighbors rest
with
201 ((((x2
,real_start2
,real_finish2
,start2
,finish2
)::
202 rest_inner
)::rest_middle
)::rest_outer
)
206 ((((x1
,real_start1
,real_finish1
,start1
,finish1
)::
207 (x2
,real_start2
,real_finish2
,start2
,finish2
)::rest_inner
)::
210 else if finish1
+ 1 = start2
212 (([(x1
,real_start1
,real_finish1
,start1
,finish1
)]::
213 ((x2
,real_start2
,real_finish2
,start2
,finish2
)::rest_inner
)::
216 else [[(x1
,real_start1
,real_finish1
,start1
,finish1
)]]::rest
217 | _
-> [[[(x1
,real_start1
,real_finish1
,start1
,finish1
)]]])
218 (* rest must be [] *)
220 (* --------------------------------------------------------------------- *)
221 (* --------------------------------------------------------------------- *)
225 match close (rule ast
) with
226 Closed l
-> find_neighbors l
227 | _
-> failwith
"impossible"