X-Git-Url: https://git.hcoop.net/bpt/coccinelle.git/blobdiff_plain/aa7214425d48f1e44bdb723016058f518f8ee133..8f657093d128c6436330659d273c2762ac9cbf79:/parsing_cocci/get_constants2.ml diff --git a/parsing_cocci/get_constants2.ml b/parsing_cocci/get_constants2.ml index 90a0aa3..53e2aa3 100644 --- a/parsing_cocci/get_constants2.ml +++ b/parsing_cocci/get_constants2.ml @@ -1,5 +1,7 @@ (* - * Copyright 2005-2010, Ecole des Mines de Nantes, University of Copenhagen + * Copyright 2010, INRIA, University of Copenhagen + * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix + * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * @@ -37,6 +39,11 @@ module TC = Type_cocci constants. *) +(* This doesn't do the . -> trick of get_constants for record fields, as + that does not fit well with the recursive structure. It was not clear + that that was completely safe either, although eg putting a newline + after the . or -> is probably unusual. *) + (* ----------------------------------------------------------------------- *) (* This phase collects everything. One can then filter out what it not wanted *) @@ -47,6 +54,52 @@ wanted *) type combine = And of combine list | Or of combine list | Elem of string | False | True +(* glimpse often fails on large queries. We can safely remove arguments of +&& as long as we don't remove all of them (note that there is no negation). +This tries just removing one of them and then orders the results by +increasing number of ors (ors are long, increasing the chance of failure, +and are less restrictive, possibly increasing the chance of irrelevant +code. *) +let reduce_glimpse x = + let rec loop x k q = + match x with + Elem _ -> q() + | And [x] -> loop x (function changed_l -> k (And [changed_l])) q + | And l -> + kloop l + (function changed_l -> k (And changed_l)) + (function _ -> + let rec rloop l k = + match l with + [] -> q() + | x::xs -> + (k xs) :: + rloop xs (function changed_xs -> k (x :: changed_xs)) in + rloop l (function changed_l -> k (And changed_l))) + | Or l -> kloop l (function changed_l -> k (Or changed_l)) q + | _ -> failwith "not possible" + and kloop l k q = + match l with + [] -> q() + | x::xs -> + loop x + (function changed_x -> k (changed_x::xs)) + (function _ -> + kloop xs + (function changed_xs -> k (x :: changed_xs)) + q) in + let rec count_ors = function + Elem _ -> 0 + | And l -> List.fold_left (+) 0 (List.map count_ors l) + | Or l -> + ((List.length l) - 1) + + (List.fold_left (+) 0 (List.map count_ors l)) + | _ -> failwith "not possible" in + let res = loop x (function x -> x) (function _ -> []) in + let res = List.map (function x -> (count_ors x,x)) res in + let res = List.sort compare res in + List.map (function (_,x) -> x) res + let interpret_glimpse strict x = let rec loop = function Elem x -> x @@ -54,7 +107,10 @@ let interpret_glimpse strict x = | Or [x] -> loop x | And l -> Printf.sprintf "{%s}" (String.concat ";" (List.map loop l)) | Or l -> Printf.sprintf "{%s}" (String.concat "," (List.map loop l)) - | True -> "True" + | True -> + if strict + then failwith "True should not be in the final result" + else "True" | False -> if strict then failwith "False should not be in the final result. Perhaps your rule doesn't contain any +/-/* code" @@ -63,7 +119,28 @@ let interpret_glimpse strict x = True -> None | False when strict -> failwith "False should not be in the final result. Perhaps your rule doesn't contain any +/-/* code" - | _ -> Some [(loop x)] + | _ -> + Some (if strict then List.map loop (x::reduce_glimpse x) else [loop x]) + +(* grep only does or *) +let interpret_grep strict x = + let rec loop = function + Elem x -> [x] + | And l -> List.concat (List.map loop l) + | Or l -> List.concat (List.map loop l) + | True -> + if strict + then failwith "True should not be in the final result" + else ["True"] + | False -> + if strict + then failwith "False should not be in the final result. Perhaps your rule doesn't contain any +/-/* code" + else ["False"] in + match x with + True -> None + | False when strict -> + failwith "False should not be in the final result. Perhaps your rule doesn't contain any +/-/* code" + | _ -> Some (loop x) let interpret_google strict x = (* convert to dnf *) @@ -92,14 +169,8 @@ let interpret_google strict x = failwith "False should not be in the final result. Perhaps your rule doesn't contain any +/-/* code" | _ -> Some (dnf x) -let interpret strict x = - match !Flag.scanner with - Flag.Glimpse -> interpret_glimpse strict x - | Flag.Google _ -> interpret_google strict x - | _ -> failwith "not possible" - let combine2c x = - match interpret false x with + match interpret_glimpse false x with None -> "None" | Some x -> String.concat " || " x @@ -198,9 +269,10 @@ let do_get_constants constants keywords env neg_pos = else (try List.assoc nm1 env with Not_found -> False) in let minherited name = inherited (Ast.unwrap_mcode name) in let mcode _ x = - match Ast.get_pos_var x with - Ast.MetaPos(name,constraints,_,keep,inh) -> minherited name - | _ -> option_default in + List.fold_left bind option_default + (List.map + (function Ast.MetaPos(name,constraints,_,keep,inh) -> minherited name) + (Ast.get_pos_var x)) in (* if one branch gives no information, then we have to take anything *) let disj_union_all = List.fold_left build_or False in @@ -214,6 +286,7 @@ let do_get_constants constants keywords env neg_pos = | nm -> constants nm) | Ast.MetaId(name,_,_,_) | Ast.MetaFunc(name,_,_,_) | Ast.MetaLocalFunc(name,_,_,_) -> bind (k i) (minherited name) + | Ast.DisjId(ids) -> disj_union_all (List.map r.V.combiner_ident ids) | _ -> k i in let rec type_collect res = function @@ -222,8 +295,8 @@ let do_get_constants constants keywords env neg_pos = | TC.MetaType(tyname,_,_) -> inherited tyname | TC.TypeName(s) -> constants s - | TC.EnumName(false,s) -> constants s - | TC.StructUnionName(_,false,s) -> constants s + | TC.EnumName(TC.Name s) -> constants s + | TC.StructUnionName(_,TC.Name s) -> constants s | ty -> res in (* no point to do anything special for records because glimpse is @@ -244,13 +317,13 @@ let do_get_constants constants keywords env neg_pos = bind (k e) (bind (minherited name) types) | Ast.MetaErr(name,_,_,_) | Ast.MetaExpr(name,_,_,_,_,_) -> bind (k e) (minherited name) - | Ast.MetaExprList(name,None,_,_) -> minherited name - | Ast.MetaExprList(name,Some (lenname,_,_),_,_) -> + | Ast.MetaExprList(name,Ast.MetaListLen (lenname,_,_),_,_) -> bind (k e) (bind (minherited name) (minherited lenname)) + | Ast.MetaExprList(name,_,_,_) -> minherited name | Ast.SizeOfExpr(sizeof,exp) -> bind (keywords "sizeof") (k e) | Ast.SizeOfType(sizeof,lp,ty,rp) -> bind (keywords "sizeof") (k e) - | Ast.NestExpr(expr_dots,wc,false) -> option_default - | Ast.NestExpr(expr_dots,wc,true) -> + | Ast.NestExpr(starter,expr_dots,ender,wc,false) -> option_default + | Ast.NestExpr(starter,expr_dots,ender,wc,true) -> r.V.combiner_expression_dots expr_dots | Ast.DisjExpr(exps) -> disj_union_all (List.map r.V.combiner_expression exps) @@ -272,7 +345,10 @@ let do_get_constants constants keywords env neg_pos = | Ast.IntType -> keywords "int " | Ast.DoubleType -> keywords "double " | Ast.FloatType -> keywords "float " - | Ast.LongType | Ast.LongLongType -> keywords "long " in + | Ast.LongType | Ast.LongLongType -> keywords "long " + | Ast.SizeType -> keywords "size_t " + | Ast.SSizeType -> keywords "ssize_t " + | Ast.PtrDiffType -> keywords "ptrdiff_t " in let typeC r k ty = match Ast.unwrap ty with @@ -283,7 +359,11 @@ let do_get_constants constants keywords env neg_pos = let declaration r k d = match Ast.unwrap d with - Ast.DisjDecl(decls) -> + Ast.MetaDecl(name,_,_) | Ast.MetaField(name,_,_) -> + bind (k d) (minherited name) + | Ast.MetaFieldList(name,Ast.MetaListLen(lenname,_,_),_,_) -> + bind (minherited name) (bind (minherited lenname) (k d)) + | Ast.DisjDecl(decls) -> disj_union_all (List.map r.V.combiner_declaration decls) | Ast.OptDecl(decl) -> option_default | Ast.Ddots(dots,whencode) -> option_default @@ -298,9 +378,9 @@ let do_get_constants constants keywords env neg_pos = match Ast.unwrap p with Ast.OptParam(param) -> option_default | Ast.MetaParam(name,_,_) -> bind (k p) (minherited name) - | Ast.MetaParamList(name,None,_,_) -> bind (k p) (minherited name) - | Ast.MetaParamList(name,Some(lenname,_,_),_,_) -> + | Ast.MetaParamList(name,Ast.MetaListLen(lenname,_,_),_,_) -> bind (minherited name) (bind (minherited lenname) (k p)) + | Ast.MetaParamList(name,_,_,_) -> bind (k p) (minherited name) | _ -> k p in let rule_elem r k re = @@ -347,8 +427,8 @@ let do_get_constants constants keywords env neg_pos = match Ast.unwrap s with Ast.Disj(stmt_dots) -> disj_union_all (List.map r.V.combiner_statement_dots stmt_dots) - | Ast.Nest(stmt_dots,whn,false,_,_) -> option_default - | Ast.Nest(stmt_dots,whn,true,_,_) -> + | Ast.Nest(starter,stmt_dots,ender,whn,false,_,_) -> option_default + | Ast.Nest(starter,stmt_dots,ender,whn,true,_,_) -> r.V.combiner_statement_dots stmt_dots | Ast.OptStm(s) -> option_default | Ast.Dots(d,whn,_,_) | Ast.Circles(d,whn,_,_) | Ast.Stars(d,whn,_,_) -> @@ -357,7 +437,7 @@ let do_get_constants constants keywords env neg_pos = V.combiner bind option_default mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode - donothing donothing donothing donothing + donothing donothing donothing donothing donothing ident expression fullType typeC initialiser parameter declaration rule_elem statement donothing donothing donothing @@ -390,7 +470,7 @@ let get_all_constants minus_only = V.combiner bind option_default other mcode other other other other other other other other other other - donothing donothing donothing donothing + donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing @@ -400,16 +480,15 @@ let get_plus_constants = let donothing r k e = k e in let bind = Common.union_set in let option_default = [] in - let mcode r mc = - let mcodekind = Ast.get_mcodekind mc in - let recurse l = - List.fold_left - (List.fold_left - (function prev -> - function cur -> - bind ((get_all_constants false).V.combiner_anything cur) prev)) - [] l in - match mcodekind with + + let recurse l = + List.fold_left + (List.fold_left + (function prev -> + function cur -> + bind ((get_all_constants false).V.combiner_anything cur) prev)) + [] l in + let process_mcodekind = function Ast.MINUS(_,_,_,anythings) -> recurse anythings | Ast.CONTEXT(_,Ast.BEFORE(a,_)) -> recurse a | Ast.CONTEXT(_,Ast.AFTER(a,_)) -> recurse a @@ -417,11 +496,27 @@ let get_plus_constants = Common.union_set (recurse a1) (recurse a2) | _ -> [] in + let mcode r mc = process_mcodekind (Ast.get_mcodekind mc) in + let end_info (_,_,_,mc) = process_mcodekind mc in + + let rule_elem r k e = + match Ast.unwrap e with + Ast.FunHeader(bef,_,_,_,_,_,_) + | Ast.Decl(bef,_,_) -> bind (process_mcodekind bef) (k e) + | _ -> k e in + + let statement r k e = + match Ast.unwrap e with + Ast.IfThen(_,_,ei) | Ast.IfThenElse(_,_,_,_,ei) + | Ast.While(_,_,ei) | Ast.For(_,_,ei) + | Ast.Iterator(_,_,ei) -> bind (k e) (end_info ei) + | _ -> k e in + V.combiner bind option_default mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode - donothing donothing donothing donothing - donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing + donothing donothing donothing donothing donothing donothing donothing + rule_elem statement donothing donothing donothing (* ------------------------------------------------------------------------ *) @@ -444,16 +539,38 @@ let all_context = let donothing recursor k e = k e in - let mcode r e = - match Ast.get_mcodekind e with + let process_mcodekind = function Ast.CONTEXT(_,Ast.NOTHING) -> true | _ -> false in + let mcode r e = process_mcodekind (Ast.get_mcodekind e) in + + let end_info (_,_,_,mc) = process_mcodekind mc in + + let initialiser r k e = + match Ast.unwrap e with + Ast.StrInitList(all_minus,_,_,_,_) -> + not all_minus && k e + | _ -> k e in + + let rule_elem r k e = + match Ast.unwrap e with + Ast.FunHeader(bef,_,_,_,_,_,_) + | Ast.Decl(bef,_,_) -> bind (process_mcodekind bef) (k e) + | _ -> k e in + + let statement r k e = + match Ast.unwrap e with + Ast.IfThen(_,_,ei) | Ast.IfThenElse(_,_,_,_,ei) + | Ast.While(_,_,ei) | Ast.For(_,_,ei) + | Ast.Iterator(_,_,ei) -> bind (k e) (end_info ei) + | _ -> k e in + V.combiner bind option_default mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode - donothing donothing donothing donothing - donothing donothing donothing donothing donothing donothing - donothing donothing donothing donothing donothing donothing + donothing donothing donothing donothing donothing + donothing donothing donothing donothing initialiser donothing + donothing rule_elem statement donothing donothing donothing (* ------------------------------------------------------------------------ *) @@ -491,46 +608,59 @@ let rule_fn tls in_plus env neg_pos = | x -> (build_or x rest_info, new_plusses)) (False,in_plus) (List.combine tls neg_pos) -let get_constants rules neg_pos_vars = - match !Flag.scanner with - Flag.NoScanner -> None - | Flag.Glimpse | Flag.Google _ -> - let (info,_,_,_) = - List.fold_left - (function (rest_info,in_plus,env,locals(*dom of env*)) -> - function - (Ast.ScriptRule (_,deps,mv,_),_) -> - let extra_deps = - List.fold_left - (function prev -> - function (_,(rule,_)) -> - if rule = "virtual" - then prev - else Ast.AndDep (Ast.Dep rule,prev)) - deps mv in - (match dependencies env extra_deps with - False -> (rest_info, in_plus, env, locals) - | dependencies -> - (build_or dependencies rest_info, in_plus, env, locals)) - | (Ast.InitialScriptRule (_,deps,_),_) - | (Ast.FinalScriptRule (_,deps,_),_) -> +let run rules neg_pos_vars = + let (info,_,_,_) = + List.fold_left + (function (rest_info,in_plus,env,locals(*dom of env*)) -> + function + (Ast.ScriptRule (nm,_,deps,mv,_,_),_) -> + let extra_deps = + List.fold_left + (function prev -> + function (_,(rule,_),_) -> + if rule = "virtual" + then prev + else Ast.AndDep (Ast.Dep rule,prev)) + deps mv in + (match dependencies env extra_deps with + False -> (rest_info, in_plus, (nm,True)::env, nm::locals) + | dependencies -> + (build_or dependencies rest_info, in_plus, env, locals)) + | (Ast.InitialScriptRule (_,_,deps,_),_) + | (Ast.FinalScriptRule (_,_,deps,_),_) -> (* initialize and finalize dependencies are irrelevant to get_constants *) - (rest_info, in_plus, env, locals) - | (Ast.CocciRule (nm,(dep,_,_),cur,_,_),neg_pos_vars) -> - let (cur_info,cur_plus) = - rule_fn cur in_plus ((nm,True)::env) - neg_pos_vars in + (rest_info, in_plus, env, locals) + | (Ast.CocciRule (nm,(dep,_,_),cur,_,_),neg_pos_vars) -> + let (cur_info,cur_plus) = + rule_fn cur in_plus ((nm,True)::env) + neg_pos_vars in + (match dependencies env dep with + False -> (rest_info,cur_plus,env,locals) + | dependencies -> if List.for_all all_context.V.combiner_top_level cur then (rest_info,cur_plus,(nm,cur_info)::env,nm::locals) else (* no constants if dependent on another rule; then we need to find the constants of that rule *) - match dependencies env dep with - False -> (rest_info,cur_plus,env,locals) - | dependencies -> - (build_or (build_and dependencies cur_info) rest_info, - cur_plus,env,locals)) - (False,[],[],[]) - (List.combine (rules : Ast.rule list) neg_pos_vars) in - interpret true info + (build_or (build_and dependencies cur_info) rest_info, + cur_plus,env,locals))) + (False,[],[],[]) + (List.combine (rules : Ast.rule list) neg_pos_vars) in + info + +let get_constants rules neg_pos_vars = + match !Flag.scanner with + Flag.NoScanner -> (None,None,None) + | Flag.Grep -> + let res = run rules neg_pos_vars in + (interpret_grep true res,None,None) + | Flag.Glimpse -> + let res = run rules neg_pos_vars in + (interpret_grep true res,interpret_glimpse true res,None) + | Flag.Google _ -> + let res = run rules neg_pos_vars in + (interpret_grep true res,interpret_google true res,None) + | Flag.IdUtils -> + let res = run rules neg_pos_vars in + (interpret_grep true res,None,Some res)