parsing_cocci/plus.ml

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