module D = Data
module PC = Parser_cocci_menhir
module V0 = Visitor_ast0
+module VT0 = Visitor_ast0_types
module Ast = Ast_cocci
module Ast0 = Ast0_cocci
let pr = Printf.sprintf
| PC.Tconst(clt) -> "const"^(line_type2c clt)
| PC.Tvolatile(clt) -> "volatile"^(line_type2c clt)
- | PC.TPragma(s) -> s
+ | PC.TPragma(s,_) -> s
| PC.TIncludeL(s,clt) -> (pr "#include \"%s\"" s)^(line_type2c clt)
| PC.TIncludeNL(s,clt) -> (pr "#include <%s>" s)^(line_type2c clt)
| PC.TDefine(clt,_) -> "#define"^(line_type2c clt)
- | PC.TDefineParam(clt,_,_) -> "#define_param"^(line_type2c clt)
+ | PC.TDefineParam(clt,_,_,_) -> "#define_param"^(line_type2c clt)
| PC.TMinusFile(s,clt) -> (pr "--- %s" s)^(line_type2c clt)
| PC.TPlusFile(s,clt) -> (pr "+++ %s" s)^(line_type2c clt)
| PC.TArob -> "@"
| PC.TPArob -> "P@"
| PC.TScript -> "script"
+ | PC.TInitialize -> "initialize"
+ | PC.TFinalize -> "finalize"
| PC.TWhen(clt) -> "WHEN"^(line_type2c clt)
| PC.TWhenTrue(clt) -> "WHEN TRUE"^(line_type2c clt)
type plus = PLUS | NOTPLUS | SKIP
-let plus_attachable (tok,_) =
+let plus_attachable only_plus (tok,_) =
match tok with
PC.Tchar(clt) | PC.Tshort(clt) | PC.Tint(clt) | PC.Tdouble(clt)
| PC.Tfloat(clt) | PC.Tlong(clt) | PC.Tvoid(clt) | PC.Tstruct(clt)
| PC.Textern(clt) | PC.Tconst(clt) | PC.Tvolatile(clt)
| PC.TIncludeL(_,clt) | PC.TIncludeNL(_,clt) | PC.TDefine(clt,_)
- | PC.TDefineParam(clt,_,_) | PC.TMinusFile(_,clt) | PC.TPlusFile(_,clt)
+ | PC.TDefineParam(clt,_,_,_) | PC.TMinusFile(_,clt) | PC.TPlusFile(_,clt)
| PC.TInc(clt) | PC.TDec(clt)
| PC.TEq(clt) | PC.TAssign(_,clt) | PC.TDot(clt) | PC.TComma(clt)
| PC.TPtVirg(clt) ->
- if line_type clt = D.PLUS then PLUS else NOTPLUS
+ if line_type clt = D.PLUS
+ then PLUS
+ else if only_plus then NOTPLUS
+ else if line_type clt = D.CONTEXT then PLUS else NOTPLUS
| PC.TOPar0(clt) | PC.TMid0(clt) | PC.TCPar0(clt)
| PC.TOEllipsis(clt) | PC.TCEllipsis(clt)
| PC.Textern(clt) | PC.Tconst(clt) | PC.Tvolatile(clt)
| PC.TIncludeL(_,clt) | PC.TIncludeNL(_,clt) | PC.TDefine(clt,_)
- | PC.TDefineParam(clt,_,_) | PC.TMinusFile(_,clt) | PC.TPlusFile(_,clt)
+ | PC.TDefineParam(clt,_,_,_) | PC.TMinusFile(_,clt) | PC.TPlusFile(_,clt)
| PC.TInc(clt) | PC.TDec(clt)
| PC.TIncludeL(s,_) -> (PC.TIncludeL(s,clt),x)
| PC.TIncludeNL(s,_) -> (PC.TIncludeNL(s,clt),x)
| PC.TDefine(_,a) -> (PC.TDefine(clt,a),x)
- | PC.TDefineParam(_,a,b) -> (PC.TDefineParam(clt,a,b),x)
+ | PC.TDefineParam(_,a,b,c) -> (PC.TDefineParam(clt,a,b,c),x)
| PC.TMinusFile(s,_) -> (PC.TMinusFile(s,clt),x)
| PC.TPlusFile(s,_) -> (PC.TPlusFile(s,clt),x)
| PC.Tinline(clt) | PC.Ttypedef(clt) | PC.Tattr(_,clt)
| PC.Tconst(clt) | PC.Tvolatile(clt) -> split t clt
- | PC.TPragma(s) -> ([],[t]) (* only allowed in + *)
+ | PC.TPragma(s,_) -> ([],[t]) (* only allowed in + *)
| PC.TPlusFile(s,clt) | PC.TMinusFile(s,clt)
| PC.TIncludeL(s,clt) | PC.TIncludeNL(s,clt) ->
split t clt
- | PC.TDefine(clt,_) | PC.TDefineParam(clt,_,_) -> split t clt
+ | PC.TDefine(clt,_) | PC.TDefineParam(clt,_,_,_) -> split t clt
| PC.TIf(clt) | PC.TElse(clt) | PC.TWhile(clt) | PC.TFor(clt) | PC.TDo(clt)
| PC.TSwitch(clt) | PC.TCase(clt) | PC.TDefault(clt)
| PC.TMetaStm(_,_,clt) | PC.TMetaStmList(_,_,clt) | PC.TMetaErr(_,_,_,clt)
| PC.TMetaFunc(_,_,_,clt) | PC.TMetaLocalFunc(_,_,_,clt)
| PC.TMetaDeclarer(_,_,_,clt) | PC.TMetaIterator(_,_,_,clt) -> split t clt
- | PC.TMPtVirg | PC.TArob | PC.TArobArob | PC.TScript -> ([t],[t])
+ | PC.TMPtVirg | PC.TArob | PC.TArobArob | PC.TScript
+ | PC.TInitialize | PC.TFinalize -> ([t],[t])
| PC.TPArob | PC.TMetaPos(_,_,_,_) -> ([t],[])
| PC.TFunDecl(clt)
| PC.TPtrOp(clt)
- | PC.TDefine(clt,_) | PC.TDefineParam(clt,_,_)
+ | PC.TDefine(clt,_) | PC.TDefineParam(clt,_,_,_)
| PC.TIncludeL(_,clt) | PC.TIncludeNL(_,clt)
| PC.TEq(clt) | PC.TAssign(_,clt) | PC.TDot(clt) | PC.TComma(clt)
| (((PC.TWhen(clt),q) as x)::xs) ->
x::(find_line_end true (token2line x) clt q xs)
| (((PC.TDefine(clt,_),q) as x)::xs)
- | (((PC.TDefineParam(clt,_,_),q) as x)::xs) ->
+ | (((PC.TDefineParam(clt,_,_,_),q) as x)::xs) ->
x::(find_line_end false (token2line x) clt q xs)
| x::xs -> x::(insert_line_end xs)
| _ -> tokens
(* ----------------------------------------------------------------------- *)
-(* process pragmas: they can only be used in + code, and adjacent to
-another + token. They are concatenated to the string representation of
-that other token. *)
+(* Integrate pragmas into some adjacent token. + tokens are preferred. Dots
+are not allowed. *)
let rec collect_all_pragmas collected = function
- (PC.TPragma(s),_)::rest -> collect_all_pragmas (s::collected) rest
+ (PC.TPragma(s,(_,line,logical_line,offset,col,_,_,pos)),_)::rest ->
+ let i =
+ { Ast0.line_start = line; Ast0.line_end = line;
+ Ast0.logical_start = logical_line; Ast0.logical_end = logical_line;
+ Ast0.column = col; Ast0.offset = offset; } in
+ collect_all_pragmas ((s,i)::collected) rest
| l -> (List.rev collected,l)
-let rec collect_up_to_pragmas skipped = function
- [] -> None (* didn't reach a pragma, so nothing to do *)
- | ((PC.TPragma(s),_) as t)::rest ->
- let (pragmas,rest) = collect_all_pragmas [] (t::rest) in
- Some (List.rev skipped,pragmas,rest)
+let rec collect_pass = function
+ [] -> ([],[])
| x::xs ->
- match plus_attachable x with
- PLUS -> None
- | NOTPLUS -> None
- | SKIP -> collect_up_to_pragmas (x::skipped) xs
-
-let rec collect_up_to_plus skipped = function
- [] -> failwith "nothing to attach a pragma to (empty)"
- | x::xs ->
- match plus_attachable x with
- PLUS -> (List.rev skipped,x,xs)
- | NOTPLUS -> failwith "nothing to attach a pragma to"
- | SKIP -> collect_up_to_plus (x::skipped) xs
-
-let rec process_pragmas = function
- [] -> []
- | ((PC.TPragma(s),_)::_) as l ->
+ match plus_attachable false x with
+ SKIP ->
+ let (pass,rest) = collect_pass xs in
+ (x::pass,rest)
+ | _ -> ([],x::xs)
+
+let plus_attach strict = function
+ None -> NOTPLUS
+ | Some x -> plus_attachable strict x
+
+let add_bef = function Some x -> [x] | None -> []
+
+(*skips should be things like line end
+skips is things before pragmas that can't be attached to, pass is things
+after. pass is used immediately. skips accumulates. *)
+let rec process_pragmas bef skips = function
+ [] -> add_bef bef @ List.rev skips
+ | ((PC.TPragma(s,i),_)::_) as l ->
let (pragmas,rest) = collect_all_pragmas [] l in
- let (skipped,aft,rest) = collect_up_to_plus [] rest in
- let (a,b,c,d,e,strbef,straft,pos) = get_clt aft in
- skipped@
- (process_pragmas ((update_clt aft (a,b,c,d,e,pragmas,straft,pos))::rest))
- | bef::xs ->
- (match plus_attachable bef with
- PLUS ->
- (match collect_up_to_pragmas [] xs with
- Some(skipped,pragmas,rest) ->
+ let (pass,rest0) = collect_pass rest in
+ let (next,rest) =
+ match rest0 with [] -> (None,[]) | next::rest -> (Some next,rest) in
+ (match (bef,plus_attach true bef,next,plus_attach true next) with
+ (Some bef,PLUS,_,_) ->
+ let (a,b,c,d,e,strbef,straft,pos) = get_clt bef in
+ (update_clt bef (a,b,c,d,e,strbef,pragmas,pos))::List.rev skips@
+ pass@process_pragmas None [] rest0
+ | (_,_,Some next,PLUS) ->
+ let (a,b,c,d,e,strbef,straft,pos) = get_clt next in
+ (add_bef bef) @ List.rev skips @ pass @
+ (process_pragmas
+ (Some (update_clt next (a,b,c,d,e,pragmas,straft,pos)))
+ [] rest)
+ | _ ->
+ (match (bef,plus_attach false bef,next,plus_attach false next) with
+ (Some bef,PLUS,_,_) ->
let (a,b,c,d,e,strbef,straft,pos) = get_clt bef in
- (update_clt bef (a,b,c,d,e,strbef,pragmas,pos))::
- skipped@(process_pragmas rest)
- | None -> bef::(process_pragmas xs))
- | _ -> bef::(process_pragmas xs))
+ (update_clt bef (a,b,c,d,e,strbef,pragmas,pos))::List.rev skips@
+ pass@process_pragmas None [] rest0
+ | (_,_,Some next,PLUS) ->
+ let (a,b,c,d,e,strbef,straft,pos) = get_clt next in
+ (add_bef bef) @ List.rev skips @ pass @
+ (process_pragmas
+ (Some (update_clt next (a,b,c,d,e,pragmas,straft,pos)))
+ [] rest)
+ | _ -> failwith "nothing to attach pragma to"))
+ | x::xs ->
+ (match plus_attachable false x with
+ SKIP -> process_pragmas bef (x::skips) xs
+ | _ -> (add_bef bef) @ List.rev skips @ (process_pragmas (Some x) [] xs))
(* ----------------------------------------------------------------------- *)
(* Drop ... ... . This is only allowed in + code, and arises when there is
let bind x y = x or y in
let option_default = false in
let fn =
- V0.combiner bind option_default
+ V0.flat_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 in
- List.exists fn.V0.combiner_top_level rule
+ List.exists fn.VT0.combiner_rec_top_level rule
let drop_last extra l = List.rev(extra@(List.tl(List.rev l)))
| Ast.GeneratedRulename (nm,a,b,c,d,e) ->
Ast.GeneratedRulename (check_name nm,a,b,c,d,e)
| Ast.ScriptRulename(s,deps) -> Ast.ScriptRulename(s,deps)
+ | Ast.InitialScriptRulename(s) -> Ast.InitialScriptRulename(s)
+ | Ast.FinalScriptRulename(s) -> Ast.FinalScriptRulename(s)
else
Ast.CocciRulename(Some(mknm()),Ast.NoDep,[],[],Ast.Undetermined,false) in
Data.in_rule_name := false;
*)
let plus_tokens =
- process_pragmas
+ process_pragmas None []
(fix (function x -> drop_double_dots (drop_empty_or x))
(drop_when plus_tokens)) in
(*
if !Flag.sgrep_mode2
then (* not actually used for anything, except context_neg *)
List.map
- (Iso_pattern.rebuild_mcode None).V0.rebuilder_top_level
+ (Iso_pattern.rebuild_mcode None).VT0.rebuilder_rec_top_level
minus_res
else
if is_expression
| _ -> failwith "Malformed script rule" in
(more,Ast0.ScriptRule(language, deps, metavars, data),[],tokens) in
+ let parse_if_script_rule k language =
+ let get_tokens = tokens_script_all table file false lexbuf in
+
+ (* script code *)
+ let (more, tokens) = get_tokens [PC.TArobArob; PC.TArob] in
+ let data =
+ match List.hd tokens with
+ (PC.TScriptData(s),_) -> s
+ | (PC.TArobArob,_) | (PC.TArob,_) -> ""
+ | _ -> failwith "Malformed script rule" in
+ (more,k (language, data),[],tokens) in
+
+ let parse_iscript_rule =
+ parse_if_script_rule
+ (function (language,data) ->
+ Ast0.InitialScriptRule(language,data)) in
+
+ let parse_fscript_rule =
+ parse_if_script_rule
+ (function (language,data) ->
+ Ast0.FinalScriptRule(language,data)) in
+
let parse_rule old_metas starts_with_name =
let rulename =
get_rule_name PC.rule_name starts_with_name get_tokens file
parse_cocci_rule Ast.Generated old_metas (s,a,b,c,d,e) in
Data.in_generating := false;
res
- | Ast.ScriptRulename (l,deps) -> parse_script_rule l old_metas deps
+ | Ast.ScriptRulename(l,deps) -> parse_script_rule l old_metas deps
+ | Ast.InitialScriptRulename(l) -> parse_iscript_rule l
+ | Ast.FinalScriptRulename(l) -> parse_fscript_rule l
| _ -> failwith "Malformed rule name"
in
List.map
(function
Ast0.ScriptRule (a,b,c,d) -> [([],Ast.ScriptRule (a,b,c,d))]
+ | Ast0.InitialScriptRule (a,b) -> [([],Ast.InitialScriptRule (a,b))]
+ | Ast0.FinalScriptRule (a,b) -> [([],Ast.FinalScriptRule (a,b))]
| Ast0.CocciRule
((minus, metavarsm,
(iso, dropiso, dependencies, rule_name, exists)),
let ((metavars,minus),function_prototypes) =
Function_prototypes.process
rule_name metavars dropped_isos minus plus ruletype in
+ let plus = Adjust_pragmas.process plus in
(* warning! context_neg side-effects its arguments *)
let (m,p) = List.split (Context_neg.context_neg minus plus) in
Type_infer.type_infer p;
some restrictions on the -+ code *)
([],_) | (_,Ast.Generated) -> ([],minus)
| _ -> Iso_pattern.apply_isos chosen_isos minus rule_name in
+ (* after iso, because iso can intro ... *)
+ let minus = Adjacency.compute_adjacency minus in
let minus = Comm_assoc.comm_assoc minus rule_name dropiso in
let minus =
if !Flag.sgrep_mode2 then minus