| 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" |