parsing_cocci/plus.ml

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