parsing_cocci/plus.ml

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