X-Git-Url: http://git.hcoop.net/bpt/coccinelle.git/blobdiff_plain/fc1ad9719a3a6317b3a4749dac68e7272a3617db..8babbc8f18fe06ec20e19630a1ec09e759c380e1:/parsing_cocci/compute_lines.ml diff --git a/parsing_cocci/compute_lines.ml b/parsing_cocci/compute_lines.ml index e7cf519..6c2c566 100644 --- a/parsing_cocci/compute_lines.ml +++ b/parsing_cocci/compute_lines.ml @@ -1,23 +1,25 @@ (* -* Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen -* Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller -* This file is part of Coccinelle. -* -* Coccinelle is free software: you can redistribute it and/or modify -* it under the terms of the GNU General Public License as published by -* the Free Software Foundation, according to version 2 of the License. -* -* Coccinelle is distributed in the hope that it will be useful, -* but WITHOUT ANY WARRANTY; without even the implied warranty of -* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -* GNU General Public License for more details. -* -* You should have received a copy of the GNU General Public License -* along with Coccinelle. If not, see . -* -* The authors reserve the right to distribute this or future versions of -* Coccinelle under other licenses. -*) + * 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. + * + * Coccinelle is free software: you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation, according to version 2 of the License. + * + * Coccinelle is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with Coccinelle. If not, see . + * + * The authors reserve the right to distribute this or future versions of + * Coccinelle under other licenses. + *) (* Computes starting and ending logical lines for statements and @@ -29,6 +31,12 @@ module Ast = Ast_cocci (* --------------------------------------------------------------------- *) (* Result *) +(* This is a horrible hack. We need to have a special treatment for the code +inside a nest, and this is to avoid threading that information around +everywhere *) +let in_nest_count = ref 0 +let check_attachable v = if !in_nest_count > 0 then false else v + let mkres x e left right = let lstart = Ast0.get_info left in let lend = Ast0.get_info right in @@ -41,8 +49,9 @@ let mkres x e left right = Ast0.offset = lstart.Ast0.pos_info.Ast0.offset;} in let info = { Ast0.pos_info = pos_info; - Ast0.attachable_start = lstart.Ast0.attachable_start; - Ast0.attachable_end = lend.Ast0.attachable_end; + (* not clear that the next two lines serve any purpose *) + Ast0.attachable_start = check_attachable lstart.Ast0.attachable_start; + Ast0.attachable_end = check_attachable lend.Ast0.attachable_end; Ast0.mcode_start = lstart.Ast0.mcode_start; Ast0.mcode_end = lend.Ast0.mcode_end; (* only for tokens, not inherited upwards *) @@ -71,8 +80,10 @@ let mkmultires x e left right (astart,start_mcodes) (aend,end_mcodes) = Ast0.offset = lstart.Ast0.pos_info.Ast0.offset; } in let info = { Ast0.pos_info = pos_info; - Ast0.attachable_start = if !inherit_attachable then astart else false; - Ast0.attachable_end = if !inherit_attachable then aend else false; + Ast0.attachable_start = + check_attachable (if !inherit_attachable then astart else false); + Ast0.attachable_end = + check_attachable (if !inherit_attachable then aend else false); Ast0.mcode_start = start_mcodes; Ast0.mcode_end = end_mcodes; (* only for tokens, not inherited upwards *) @@ -96,7 +107,7 @@ let promote_mcode (_,_,info,mcodekind,_,_) = {(Ast0.wrap ()) with Ast0.info = new_info; Ast0.mcodekind = ref mcodekind} let promote_mcode_plus_one (_,_,info,mcodekind,_,_) = - let new_pos_info = + let new_pos_info = {info.Ast0.pos_info with Ast0.line_start = info.Ast0.pos_info.Ast0.line_start + 1; Ast0.logical_start = info.Ast0.pos_info.Ast0.logical_start + 1; @@ -118,7 +129,8 @@ let promote_to_statement stm mcodekind = {info with Ast0.pos_info = new_pos_info; Ast0.mcode_start = [mcodekind]; Ast0.mcode_end = [mcodekind]; - Ast0.attachable_start = true; Ast0.attachable_end = true} in + Ast0.attachable_start = check_attachable true; + Ast0.attachable_end = check_attachable true} in {(Ast0.wrap ()) with Ast0.info = new_info; Ast0.mcodekind = ref mcodekind} let promote_to_statement_start stm mcodekind = @@ -131,13 +143,26 @@ let promote_to_statement_start stm mcodekind = {info with Ast0.pos_info = new_pos_info; Ast0.mcode_start = [mcodekind]; Ast0.mcode_end = [mcodekind]; - Ast0.attachable_start = true; Ast0.attachable_end = true} in + Ast0.attachable_start = check_attachable true; + Ast0.attachable_end = check_attachable true} in {(Ast0.wrap ()) with Ast0.info = new_info; Ast0.mcodekind = ref mcodekind} (* mcode is good by default *) let bad_mcode (t,a,info,mcodekind,pos,adj) = let new_info = - {info with Ast0.attachable_start = false; Ast0.attachable_end = false} in + {info with + Ast0.attachable_start = check_attachable false; + Ast0.attachable_end = check_attachable false} in + (t,a,new_info,mcodekind,pos,adj) + +let normal_mcode (t,a,info,mcodekind,pos,adj) = + let new_info = + if !in_nest_count > 0 + then + {info with + Ast0.attachable_start = check_attachable false; + Ast0.attachable_end = check_attachable false} + else info in (t,a,new_info,mcodekind,pos,adj) let get_all_start_info l = @@ -174,11 +199,11 @@ let dot_list is_dots fn = function let last = List.hd backward in let first_info = { (Ast0.get_info first) with - Ast0.attachable_start = first_attachable; + Ast0.attachable_start = check_attachable first_attachable; Ast0.mcode_start = first_mcode } in let last_info = { (Ast0.get_info last) with - Ast0.attachable_end = last_attachable; + Ast0.attachable_end = check_attachable last_attachable; Ast0.mcode_end = last_mcode } in let first = Ast0.set_info first first_info in let last = Ast0.set_info last last_info in @@ -191,7 +216,9 @@ let dots is_dots prev fn d = | (None,Ast0.DOTS([])) -> Ast0.set_info d {(Ast0.get_info d) - with Ast0.attachable_start = false; Ast0.attachable_end = false} + with + Ast0.attachable_start = check_attachable false; + Ast0.attachable_end = check_attachable false} | (_,Ast0.DOTS(x)) -> let (l,lstart,lend) = dot_list is_dots fn x in mkres d (Ast0.DOTS l) lstart lend @@ -202,20 +229,53 @@ let dots is_dots prev fn d = let (l,lstart,lend) = dot_list is_dots fn x in mkres d (Ast0.STARS l) lstart lend +(* --------------------------------------------------------------------- *) +(* Disjunctions *) + +let do_disj e starter xs mids ender processor rebuilder = + let starter = bad_mcode starter in + let xs = List.map processor xs in + let mids = List.map bad_mcode mids in + let ender = bad_mcode ender in + mkmultires e (rebuilder starter xs mids ender) + (promote_mcode starter) (promote_mcode ender) + (get_all_start_info xs) (get_all_end_info xs) + (* --------------------------------------------------------------------- *) (* Identifier *) -let rec ident i = +(* for #define name, with no value, to compute right side *) +let mkidres a b c d r = (mkres a b c d,r) + +let rec full_ident i = match Ast0.unwrap i with - Ast0.Id(name) as ui -> - let name = promote_mcode name in mkres i ui name name - | Ast0.MetaId(name,_,_) - | Ast0.MetaFunc(name,_,_) | Ast0.MetaLocalFunc(name,_,_) as ui -> - let name = promote_mcode name in mkres i ui name name + Ast0.Id(nm) -> + let nm = normal_mcode nm in + let name = promote_mcode nm in + mkidres i (Ast0.Id(nm)) name name (Some name) + | Ast0.MetaId(nm,a,b,c) -> + let nm = normal_mcode nm in + let name = promote_mcode nm in + mkidres i (Ast0.MetaId(nm,a,b,c)) name name (Some name) + | Ast0.MetaFunc(nm,a,b) -> + let nm = normal_mcode nm in + let name = promote_mcode nm in + mkidres i (Ast0.MetaFunc(nm,a,b)) name name (Some name) + | Ast0.MetaLocalFunc(nm,a,b) -> + let nm = normal_mcode nm in + let name = promote_mcode nm in + mkidres i (Ast0.MetaLocalFunc(nm,a,b)) name name (Some name) + | Ast0.DisjId(starter,ids,mids,ender) -> + let res = + do_disj i starter ids mids ender ident + (fun starter ids mids ender -> + Ast0.DisjId(starter,ids,mids,ender)) in + (res,None) | Ast0.OptIdent(id) -> - let id = ident id in mkres i (Ast0.OptIdent(id)) id id + let (id,r) = full_ident id in mkidres i (Ast0.OptIdent(id)) id id r | Ast0.UniqueIdent(id) -> - let id = ident id in mkres i (Ast0.UniqueIdent(id)) id id + let (id,r) = full_ident id in mkidres i (Ast0.UniqueIdent(id)) id id r +and ident i = let (id,_) = full_ident i in id (* --------------------------------------------------------------------- *) (* Expression *) @@ -230,82 +290,120 @@ let rec expression e = Ast0.Ident(id) -> let id = ident id in mkres e (Ast0.Ident(id)) id id - | Ast0.Constant(const) as ue -> + | Ast0.Constant(const) -> + let const = normal_mcode const in let ln = promote_mcode const in - mkres e ue ln ln + mkres e (Ast0.Constant(const)) ln ln | Ast0.FunCall(fn,lp,args,rp) -> let fn = expression fn in + let lp = normal_mcode lp in + let rp = normal_mcode rp in let args = dots is_exp_dots (Some(promote_mcode lp)) expression args in mkres e (Ast0.FunCall(fn,lp,args,rp)) fn (promote_mcode rp) | Ast0.Assignment(left,op,right,simple) -> let left = expression left in + let op = normal_mcode op in let right = expression right in mkres e (Ast0.Assignment(left,op,right,simple)) left right | Ast0.CondExpr(exp1,why,exp2,colon,exp3) -> let exp1 = expression exp1 in + let why = normal_mcode why in let exp2 = get_option expression exp2 in + let colon = normal_mcode colon in let exp3 = expression exp3 in mkres e (Ast0.CondExpr(exp1,why,exp2,colon,exp3)) exp1 exp3 | Ast0.Postfix(exp,op) -> let exp = expression exp in + let op = normal_mcode op in mkres e (Ast0.Postfix(exp,op)) exp (promote_mcode op) | Ast0.Infix(exp,op) -> let exp = expression exp in + let op = normal_mcode op in mkres e (Ast0.Infix(exp,op)) (promote_mcode op) exp | Ast0.Unary(exp,op) -> let exp = expression exp in + let op = normal_mcode op in mkres e (Ast0.Unary(exp,op)) (promote_mcode op) exp | Ast0.Binary(left,op,right) -> let left = expression left in + let op = normal_mcode op in let right = expression right in mkres e (Ast0.Binary(left,op,right)) left right | Ast0.Nested(left,op,right) -> let left = expression left in + let op = normal_mcode op in let right = expression right in mkres e (Ast0.Nested(left,op,right)) left right | Ast0.Paren(lp,exp,rp) -> + let lp = normal_mcode lp in + let rp = normal_mcode rp in mkres e (Ast0.Paren(lp,expression exp,rp)) (promote_mcode lp) (promote_mcode rp) | Ast0.ArrayAccess(exp1,lb,exp2,rb) -> let exp1 = expression exp1 in + let lb = normal_mcode lb in let exp2 = expression exp2 in + let rb = normal_mcode rb in mkres e (Ast0.ArrayAccess(exp1,lb,exp2,rb)) exp1 (promote_mcode rb) | Ast0.RecordAccess(exp,pt,field) -> let exp = expression exp in + let pt = normal_mcode pt in let field = ident field in mkres e (Ast0.RecordAccess(exp,pt,field)) exp field | Ast0.RecordPtAccess(exp,ar,field) -> let exp = expression exp in + let ar = normal_mcode ar in let field = ident field in mkres e (Ast0.RecordPtAccess(exp,ar,field)) exp field | Ast0.Cast(lp,ty,rp,exp) -> + let lp = normal_mcode lp in let exp = expression exp in + let rp = normal_mcode rp in mkres e (Ast0.Cast(lp,typeC ty,rp,exp)) (promote_mcode lp) exp | Ast0.SizeOfExpr(szf,exp) -> + let szf = normal_mcode szf in let exp = expression exp in mkres e (Ast0.SizeOfExpr(szf,exp)) (promote_mcode szf) exp | Ast0.SizeOfType(szf,lp,ty,rp) -> + let szf = normal_mcode szf in + let lp = normal_mcode lp in + let rp = normal_mcode rp in mkres e (Ast0.SizeOfType(szf,lp,typeC ty,rp)) (promote_mcode szf) (promote_mcode rp) | Ast0.TypeExp(ty) -> let ty = typeC ty in mkres e (Ast0.TypeExp(ty)) ty ty - | Ast0.MetaErr(name,_,_) | Ast0.MetaExpr(name,_,_,_,_) - | Ast0.MetaExprList(name,_,_) as ue -> - let ln = promote_mcode name in mkres e ue ln ln + | Ast0.MetaErr(name,a,b) -> + let name = normal_mcode name in + let ln = promote_mcode name in + mkres e (Ast0.MetaErr(name,a,b)) ln ln + | Ast0.MetaExpr(name,a,b,c,d) -> + let name = normal_mcode name in + let ln = promote_mcode name in + mkres e (Ast0.MetaExpr(name,a,b,c,d)) ln ln + | Ast0.MetaExprList(name,a,b) -> + let name = normal_mcode name in + let ln = promote_mcode name in + mkres e (Ast0.MetaExprList(name,a,b)) ln ln | Ast0.EComma(cm) -> (*let cm = bad_mcode cm in*) (* why was this bad??? *) + let cm = normal_mcode cm in let ln = promote_mcode cm in mkres e (Ast0.EComma(cm)) ln ln | Ast0.DisjExpr(starter,exps,mids,ender) -> - let starter = bad_mcode starter in - let exps = List.map expression exps in - let mids = List.map bad_mcode mids in - let ender = bad_mcode ender in - mkmultires e (Ast0.DisjExpr(starter,exps,mids,ender)) - (promote_mcode starter) (promote_mcode ender) - (get_all_start_info exps) (get_all_end_info exps) + do_disj e starter exps mids ender expression + (fun starter exps mids ender -> Ast0.DisjExpr(starter,exps,mids,ender)) | Ast0.NestExpr(starter,exp_dots,ender,whencode,multi) -> - let exp_dots = dots is_exp_dots None expression exp_dots in + (* See explanation on Nest *) + let wrapper f = + match Ast0.get_mcode_mcodekind starter with + Ast0.MINUS _ -> + in_nest_count := !in_nest_count + 1; + let res = f() in + in_nest_count := !in_nest_count - 1; + res + | _ -> f() in + let exp_dots = + wrapper (function _ -> dots is_exp_dots None expression exp_dots) in let starter = bad_mcode starter in let ender = bad_mcode ender in mkres e (Ast0.NestExpr(starter,exp_dots,ender,whencode,multi)) @@ -337,64 +435,96 @@ and expression_dots x = dots is_exp_dots None expression x and typeC t = match Ast0.unwrap t with Ast0.ConstVol(cv,ty) -> + let cv = normal_mcode cv in let ty = typeC ty in mkres t (Ast0.ConstVol(cv,ty)) (promote_mcode cv) ty - | Ast0.BaseType(ty,strings) as ut -> + | Ast0.BaseType(ty,strings) -> + let strings = List.map normal_mcode strings in let first = List.hd strings in let last = List.hd (List.rev strings) in - mkres t ut (promote_mcode first) (promote_mcode last) - | Ast0.Signed(sgn,None) as ut -> - mkres t ut (promote_mcode sgn) (promote_mcode sgn) + mkres t (Ast0.BaseType(ty,strings)) + (promote_mcode first) (promote_mcode last) + | Ast0.Signed(sgn,None) -> + let sgn = normal_mcode sgn in + mkres t (Ast0.Signed(sgn,None)) (promote_mcode sgn) (promote_mcode sgn) | Ast0.Signed(sgn,Some ty) -> + let sgn = normal_mcode sgn in let ty = typeC ty in mkres t (Ast0.Signed(sgn,Some ty)) (promote_mcode sgn) ty | Ast0.Pointer(ty,star) -> let ty = typeC ty in + let star = normal_mcode star in mkres t (Ast0.Pointer(ty,star)) ty (promote_mcode star) | Ast0.FunctionPointer(ty,lp1,star,rp1,lp2,params,rp2) -> let ty = typeC ty in + let lp1 = normal_mcode lp1 in + let star = normal_mcode star in + let rp1 = normal_mcode rp1 in + let lp2 = normal_mcode lp2 in let params = parameter_list (Some(promote_mcode lp2)) params in + let rp2 = normal_mcode rp2 in mkres t (Ast0.FunctionPointer(ty,lp1,star,rp1,lp2,params,rp2)) ty (promote_mcode rp2) | Ast0.FunctionType(Some ty,lp1,params,rp1) -> let ty = typeC ty in + let lp1 = normal_mcode lp1 in let params = parameter_list (Some(promote_mcode lp1)) params in + let rp1 = normal_mcode rp1 in let res = Ast0.FunctionType(Some ty,lp1,params,rp1) in mkres t res ty (promote_mcode rp1) | Ast0.FunctionType(None,lp1,params,rp1) -> + let lp1 = normal_mcode lp1 in let params = parameter_list (Some(promote_mcode lp1)) params in + let rp1 = normal_mcode rp1 in let res = Ast0.FunctionType(None,lp1,params,rp1) in mkres t res (promote_mcode lp1) (promote_mcode rp1) | Ast0.Array(ty,lb,size,rb) -> let ty = typeC ty in + let lb = normal_mcode lb in + let rb = normal_mcode rb in mkres t (Ast0.Array(ty,lb,get_option expression size,rb)) ty (promote_mcode rb) - | Ast0.EnumName(kind,name) -> + | Ast0.EnumName(kind,Some name) -> + let kind = normal_mcode kind in let name = ident name in - mkres t (Ast0.EnumName(kind,name)) (promote_mcode kind) name + mkres t (Ast0.EnumName(kind,Some name)) (promote_mcode kind) name + | Ast0.EnumName(kind,None) -> + let kind = normal_mcode kind in + let mc = promote_mcode kind in + mkres t (Ast0.EnumName(kind,None)) mc mc + | Ast0.EnumDef(ty,lb,ids,rb) -> + let ty = typeC ty in + let lb = normal_mcode lb in + let ids = dots is_exp_dots (Some(promote_mcode lb)) expression ids in + let rb = normal_mcode rb in + mkres t (Ast0.EnumDef(ty,lb,ids,rb)) ty (promote_mcode rb) | Ast0.StructUnionName(kind,Some name) -> + let kind = normal_mcode kind in let name = ident name in mkres t (Ast0.StructUnionName(kind,Some name)) (promote_mcode kind) name | Ast0.StructUnionName(kind,None) -> + let kind = normal_mcode kind in let mc = promote_mcode kind in mkres t (Ast0.StructUnionName(kind,None)) mc mc | Ast0.StructUnionDef(ty,lb,decls,rb) -> let ty = typeC ty in + let lb = normal_mcode lb in let decls = dots is_decl_dots (Some(promote_mcode lb)) declaration decls in + let rb = normal_mcode rb in mkres t (Ast0.StructUnionDef(ty,lb,decls,rb)) ty (promote_mcode rb) - | Ast0.TypeName(name) as ut -> - let ln = promote_mcode name in mkres t ut ln ln - | Ast0.MetaType(name,_) as ut -> - let ln = promote_mcode name in mkres t ut ln ln + | Ast0.TypeName(name) -> + let name = normal_mcode name in + let ln = promote_mcode name in + mkres t (Ast0.TypeName(name)) ln ln + | Ast0.MetaType(name,a) -> + let name = normal_mcode name in + let ln = promote_mcode name in + mkres t (Ast0.MetaType(name,a)) ln ln | Ast0.DisjType(starter,types,mids,ender) -> - let starter = bad_mcode starter in - let types = List.map typeC types in - let mids = List.map bad_mcode mids in - let ender = bad_mcode ender in - mkmultires t (Ast0.DisjType(starter,types,mids,ender)) - (promote_mcode starter) (promote_mcode ender) - (get_all_start_info types) (get_all_end_info types) + do_disj t starter types mids ender typeC + (fun starter types mids ender -> + Ast0.DisjType(starter,types,mids,ender)) | Ast0.OptType(ty) -> let ty = typeC ty in mkres t (Ast0.OptType(ty)) ty ty | Ast0.UniqueType(ty) -> @@ -412,45 +542,64 @@ and is_decl_dots s = and declaration d = match Ast0.unwrap d with - Ast0.Init(stg,ty,id,eq,exp,sem) -> + Ast0.MetaDecl(name,a) -> + let name = normal_mcode name in + let ln = promote_mcode name in + mkres d (Ast0.MetaDecl(name,a)) ln ln + | Ast0.MetaField(name,a) -> + let name = normal_mcode name in + let ln = promote_mcode name in + mkres d (Ast0.MetaField(name,a)) ln ln + | Ast0.MetaFieldList(name,a,b) -> + let name = normal_mcode name in + let ln = promote_mcode name in + mkres d (Ast0.MetaFieldList(name,a,b)) ln ln + | Ast0.Init(stg,ty,id,eq,exp,sem) -> let ty = typeC ty in let id = ident id in + let eq = normal_mcode eq in let exp = initialiser exp in + let sem = normal_mcode sem in (match stg with None -> mkres d (Ast0.Init(stg,ty,id,eq,exp,sem)) ty (promote_mcode sem) | Some x -> + let stg = Some (normal_mcode x) in mkres d (Ast0.Init(stg,ty,id,eq,exp,sem)) (promote_mcode x) (promote_mcode sem)) | Ast0.UnInit(stg,ty,id,sem) -> let ty = typeC ty in let id = ident id in + let sem = normal_mcode sem in (match stg with None -> mkres d (Ast0.UnInit(stg,ty,id,sem)) ty (promote_mcode sem) | Some x -> + let stg = Some (normal_mcode x) in mkres d (Ast0.UnInit(stg,ty,id,sem)) (promote_mcode x) (promote_mcode sem)) | Ast0.MacroDecl(name,lp,args,rp,sem) -> let name = ident name in + let lp = normal_mcode lp in let args = dots is_exp_dots (Some(promote_mcode lp)) expression args in + let rp = normal_mcode rp in + let sem = normal_mcode sem in mkres d (Ast0.MacroDecl(name,lp,args,rp,sem)) name (promote_mcode sem) | Ast0.TyDecl(ty,sem) -> let ty = typeC ty in + let sem = normal_mcode sem in mkres d (Ast0.TyDecl(ty,sem)) ty (promote_mcode sem) | Ast0.Typedef(stg,ty,id,sem) -> + let stg = normal_mcode stg in let ty = typeC ty in let id = typeC id in + let sem = normal_mcode sem in mkres d (Ast0.Typedef(stg,ty,id,sem)) (promote_mcode stg) (promote_mcode sem) | Ast0.DisjDecl(starter,decls,mids,ender) -> - let starter = bad_mcode starter in - let decls = List.map declaration decls in - let mids = List.map bad_mcode mids in - let ender = bad_mcode ender in - mkmultires d (Ast0.DisjDecl(starter,decls,mids,ender)) - (promote_mcode starter) (promote_mcode ender) - (get_all_start_info decls) (get_all_end_info decls) + do_disj d starter decls mids ender declaration + (fun starter decls mids ender -> + Ast0.DisjDecl(starter,decls,mids,ender)) | Ast0.Ddots(dots,whencode) -> let dots = bad_mcode dots in let ln = promote_mcode dots in @@ -472,28 +621,40 @@ and is_init_dots i = and initialiser i = match Ast0.unwrap i with - Ast0.MetaInit(name,_) as ut -> - let ln = promote_mcode name in mkres i ut ln ln + Ast0.MetaInit(name,a) -> + let name = normal_mcode name in + let ln = promote_mcode name in + mkres i (Ast0.MetaInit(name,a)) ln ln + | Ast0.MetaInitList(name,a,b) -> + let name = normal_mcode name in + let ln = promote_mcode name in + mkres i (Ast0.MetaInitList(name,a,b)) ln ln | Ast0.InitExpr(exp) -> let exp = expression exp in mkres i (Ast0.InitExpr(exp)) exp exp - | Ast0.InitList(lb,initlist,rb) -> + | Ast0.InitList(lb,initlist,rb,ordered) -> + let lb = normal_mcode lb in let initlist = dots is_init_dots (Some(promote_mcode lb)) initialiser initlist in - mkres i (Ast0.InitList(lb,initlist,rb)) + let rb = normal_mcode rb in + mkres i (Ast0.InitList(lb,initlist,rb,ordered)) (promote_mcode lb) (promote_mcode rb) | Ast0.InitGccExt(designators,eq,ini) -> let (delims,designators) = (* non empty due to parsing *) List.split (List.map designator designators) in + let eq = normal_mcode eq in let ini = initialiser ini in mkres i (Ast0.InitGccExt(designators,eq,ini)) (promote_mcode (List.hd delims)) ini | Ast0.InitGccName(name,eq,ini) -> let name = ident name in + let eq = normal_mcode eq in let ini = initialiser ini in mkres i (Ast0.InitGccName(name,eq,ini)) name ini - | Ast0.IComma(cm) as up -> - let ln = promote_mcode cm in mkres i up ln ln + | Ast0.IComma(cm) -> + let cm = normal_mcode cm in + let ln = promote_mcode cm in + mkres i (Ast0.IComma(cm)) ln ln | Ast0.Idots(dots,whencode) -> let dots = bad_mcode dots in let ln = promote_mcode dots in @@ -507,10 +668,16 @@ and initialiser i = and designator = function Ast0.DesignatorField(dot,id) -> + let dot = normal_mcode dot in (dot,Ast0.DesignatorField(dot,ident id)) | Ast0.DesignatorIndex(lb,exp,rb) -> + let lb = normal_mcode lb in + let rb = normal_mcode rb in (lb,Ast0.DesignatorIndex(lb,expression exp,rb)) | Ast0.DesignatorRange(lb,min,dots,max,rb) -> + let lb = normal_mcode lb in + let dots = normal_mcode dots in + let rb = normal_mcode rb in (lb,Ast0.DesignatorRange(lb,expression min,dots,expression max,rb)) and initialiser_list prev = dots is_init_dots prev initialiser @@ -535,12 +702,17 @@ and parameterTypeDef p = let ty = typeC ty in mkres p (Ast0.Param(ty,Some id)) ty id | Ast0.Param(ty,None) -> let ty = typeC ty in mkres p (Ast0.Param(ty,None)) ty ty - | Ast0.MetaParam(name,_) as up -> - let ln = promote_mcode name in mkres p up ln ln - | Ast0.MetaParamList(name,_,_) as up -> - let ln = promote_mcode name in mkres p up ln ln + | Ast0.MetaParam(name,a) -> + let name = normal_mcode name in + let ln = promote_mcode name in + mkres p (Ast0.MetaParam(name,a)) ln ln + | Ast0.MetaParamList(name,a,b) -> + let name = normal_mcode name in + let ln = promote_mcode name in + mkres p (Ast0.MetaParamList(name,a,b)) ln ln | Ast0.PComma(cm) -> (*let cm = bad_mcode cm in*) (* why was this bad??? *) + let cm = normal_mcode cm in let ln = promote_mcode cm in mkres p (Ast0.PComma(cm)) ln ln | Ast0.Pdots(dots) -> @@ -563,6 +735,48 @@ and parameter_list prev = dots is_param_dots prev parameterTypeDef (* for export *) let parameter_dots x = dots is_param_dots None parameterTypeDef x +(* --------------------------------------------------------------------- *) + +let is_define_param_dots s = + match Ast0.unwrap s with + Ast0.DPdots(_) | Ast0.DPcircles(_) -> true + | _ -> false + +let rec define_param p = + match Ast0.unwrap p with + Ast0.DParam(id) -> + let id = ident id in mkres p (Ast0.DParam(id)) id id + | Ast0.DPComma(cm) -> + (*let cm = bad_mcode cm in*) (* why was this bad??? *) + let cm = normal_mcode cm in + let ln = promote_mcode cm in + mkres p (Ast0.DPComma(cm)) ln ln + | Ast0.DPdots(dots) -> + let dots = bad_mcode dots in + let ln = promote_mcode dots in + mkres p (Ast0.DPdots(dots)) ln ln + | Ast0.DPcircles(dots) -> + let dots = bad_mcode dots in + let ln = promote_mcode dots in + mkres p (Ast0.DPcircles(dots)) ln ln + | Ast0.OptDParam(dp) -> + let res = define_param dp in + mkres p (Ast0.OptDParam(res)) res res + | Ast0.UniqueDParam(dp) -> + let res = define_param dp in + mkres p (Ast0.UniqueDParam(res)) res res + +let define_parameters x id = + match Ast0.unwrap x with + Ast0.NoParams -> (x,id) (* no info, should be ignored *) + | Ast0.DParams(lp,dp,rp) -> + let lp = normal_mcode lp in + let dp = dots is_define_param_dots None define_param dp in + let rp = normal_mcode rp in + let l = promote_mcode lp in + let r = promote_mcode rp in + (mkres x (Ast0.DParams(lp,dp,rp)) l r, r) + (* --------------------------------------------------------------------- *) (* Top-level code *) @@ -579,22 +793,36 @@ let rec statement s = let left = promote_to_statement_start decl bef in mkres s (Ast0.Decl((Ast0.get_info left,bef),decl)) decl decl | Ast0.Seq(lbrace,body,rbrace) -> + let lbrace = normal_mcode lbrace in let body = dots is_stm_dots (Some(promote_mcode lbrace)) statement body in + let rbrace = normal_mcode rbrace in mkres s (Ast0.Seq(lbrace,body,rbrace)) (promote_mcode lbrace) (promote_mcode rbrace) - | Ast0.ExprStatement(exp,sem) -> + | Ast0.ExprStatement(Some exp,sem) -> let exp = expression exp in - mkres s (Ast0.ExprStatement(exp,sem)) exp (promote_mcode sem) + let sem = normal_mcode sem in + mkres s (Ast0.ExprStatement(Some exp,sem)) exp (promote_mcode sem) + | Ast0.ExprStatement(None,sem) -> + let sem = normal_mcode sem in + let promoted_sem = promote_mcode sem in + mkres s (Ast0.ExprStatement(None,sem)) promoted_sem promoted_sem | Ast0.IfThen(iff,lp,exp,rp,branch,(_,aft)) -> + let iff = normal_mcode iff in + let lp = normal_mcode lp in let exp = expression exp in + let rp = normal_mcode rp in let branch = statement branch in let right = promote_to_statement branch aft in mkres s (Ast0.IfThen(iff,lp,exp,rp,branch,(Ast0.get_info right,aft))) (promote_mcode iff) right | Ast0.IfThenElse(iff,lp,exp,rp,branch1,els,branch2,(_,aft)) -> + let iff = normal_mcode iff in + let lp = normal_mcode lp in let exp = expression exp in + let rp = normal_mcode rp in let branch1 = statement branch1 in + let els = normal_mcode els in let branch2 = statement branch2 in let right = promote_to_statement branch2 aft in mkres s @@ -602,20 +830,32 @@ let rec statement s = (Ast0.get_info right,aft))) (promote_mcode iff) right | Ast0.While(wh,lp,exp,rp,body,(_,aft)) -> + let wh = normal_mcode wh in + let lp = normal_mcode lp in let exp = expression exp in + let rp = normal_mcode rp in let body = statement body in let right = promote_to_statement body aft in mkres s (Ast0.While(wh,lp,exp,rp,body,(Ast0.get_info right,aft))) (promote_mcode wh) right | Ast0.Do(d,body,wh,lp,exp,rp,sem) -> + let d = normal_mcode d in let body = statement body in + let wh = normal_mcode wh in + let lp = normal_mcode lp in let exp = expression exp in + let rp = normal_mcode rp in mkres s (Ast0.Do(d,body,wh,lp,exp,rp,sem)) (promote_mcode d) (promote_mcode sem) | Ast0.For(fr,lp,exp1,sem1,exp2,sem2,exp3,rp,body,(_,aft)) -> + let fr = normal_mcode fr in + let lp = normal_mcode lp in let exp1 = get_option expression exp1 in + let sem1 = normal_mcode sem1 in let exp2 = get_option expression exp2 in + let sem2 = normal_mcode sem2 in let exp3 = get_option expression exp3 in + let rp = normal_mcode rp in let body = statement body in let right = promote_to_statement body aft in mkres s (Ast0.For(fr,lp,exp1,sem1,exp2,sem2,exp3,rp,body, @@ -623,13 +863,19 @@ let rec statement s = (promote_mcode fr) right | Ast0.Iterator(nm,lp,args,rp,body,(_,aft)) -> let nm = ident nm in + let lp = normal_mcode lp in let args = dots is_exp_dots (Some(promote_mcode lp)) expression args in + let rp = normal_mcode rp in let body = statement body in let right = promote_to_statement body aft in mkres s (Ast0.Iterator(nm,lp,args,rp,body,(Ast0.get_info right,aft))) nm right | Ast0.Switch(switch,lp,exp,rp,lb,decls,cases,rb) -> + let switch = normal_mcode switch in + let lp = normal_mcode lp in let exp = expression exp in + let rp = normal_mcode rp in + let lb = normal_mcode lb in let decls = dots is_stm_dots (Some(promote_mcode lb)) statement decls in @@ -640,29 +886,45 @@ let rec statement s = else None (* not sure this is right, but not sure the case can arise either *)) case_line cases in + let rb = normal_mcode rb in mkres s (Ast0.Switch(switch,lp,exp,rp,lb,decls,cases,rb)) (promote_mcode switch) (promote_mcode rb) - | Ast0.Break(br,sem) as us -> - mkres s us (promote_mcode br) (promote_mcode sem) - | Ast0.Continue(cont,sem) as us -> - mkres s us (promote_mcode cont) (promote_mcode sem) + | Ast0.Break(br,sem) -> + let br = normal_mcode br in + let sem = normal_mcode sem in + mkres s (Ast0.Break(br,sem)) (promote_mcode br) (promote_mcode sem) + | Ast0.Continue(cont,sem) -> + let cont = normal_mcode cont in + let sem = normal_mcode sem in + mkres s (Ast0.Continue(cont,sem)) + (promote_mcode cont) (promote_mcode sem) | Ast0.Label(l,dd) -> let l = ident l in + let dd = normal_mcode dd in mkres s (Ast0.Label(l,dd)) l (promote_mcode dd) | Ast0.Goto(goto,id,sem) -> + let goto = normal_mcode goto in let id = ident id in + let sem = normal_mcode sem in mkres s (Ast0.Goto(goto,id,sem)) (promote_mcode goto) (promote_mcode sem) - | Ast0.Return(ret,sem) as us -> - mkres s us (promote_mcode ret) (promote_mcode sem) + | Ast0.Return(ret,sem) -> + let ret = normal_mcode ret in + let sem = normal_mcode sem in + mkres s (Ast0.Return(ret,sem)) (promote_mcode ret) (promote_mcode sem) | Ast0.ReturnExpr(ret,exp,sem) -> + let ret = normal_mcode ret in let exp = expression exp in + let sem = normal_mcode sem in mkres s (Ast0.ReturnExpr(ret,exp,sem)) (promote_mcode ret) (promote_mcode sem) - | Ast0.MetaStmt(name,_) - | Ast0.MetaStmtList(name,_) as us -> - let ln = promote_mcode name in mkres s us ln ln + | Ast0.MetaStmt(name,a) -> + let ln = promote_mcode name in + mkres s (Ast0.MetaStmt(name,a)) ln ln + | Ast0.MetaStmtList(name,a) -> + let ln = promote_mcode name in + mkres s (Ast0.MetaStmtList(name,a)) ln ln | Ast0.Exp(exp) -> let exp = expression exp in mkres s (Ast0.Exp(exp)) exp exp @@ -692,7 +954,27 @@ let rec statement s = | Ast0.Nest(starter,rule_elem_dots,ender,whencode,multi) -> let starter = bad_mcode starter in let ender = bad_mcode ender in - let rule_elem_dots = dots is_stm_dots None statement rule_elem_dots in + let wrapper f = + match Ast0.get_mcode_mcodekind starter with + Ast0.MINUS _ -> + (* if minus, then all nest code has to be minus. This is + checked at the token level, in parse_cocci.ml. All nest code + is also unattachable. We strip the minus annotations from + the nest code because in the CTL another metavariable will + take care of removing all the code matched by the nest. + Without stripping the minus annotations, we would get a + double transformation. Perhaps there is a more elegant + way to do this in the CTL, but it is not easy, because of + the interaction with the whencode and the implementation of + plus *) + in_nest_count := !in_nest_count + 1; + let res = f() in + in_nest_count := !in_nest_count - 1; + res + | _ -> f() in + let rule_elem_dots = + wrapper + (function _ -> dots is_stm_dots None statement rule_elem_dots) in mkres s (Ast0.Nest(starter,rule_elem_dots,ender,whencode,multi)) (promote_mcode starter) (promote_mcode ender) | Ast0.Dots(dots,whencode) -> @@ -713,9 +995,13 @@ let rec statement s = (function Ast0.FType(ty) -> Ast0.FType(typeC ty) | x -> x) fninfo in let name = ident name in + let lp = normal_mcode lp in let params = parameter_list (Some(promote_mcode lp)) params in + let rp = normal_mcode rp in + let lbrace = normal_mcode lbrace in let body = dots is_stm_dots (Some(promote_mcode lbrace)) statement body in + let rbrace = normal_mcode rbrace in let left = (* cases on what is leftmost *) match fninfo with @@ -750,11 +1036,22 @@ let rec statement s = mkres s res (promote_mcode attr) (promote_mcode rbrace)) | Ast0.Include(inc,stm) -> + let inc = normal_mcode inc in + let stm = normal_mcode stm in mkres s (Ast0.Include(inc,stm)) (promote_mcode inc) (promote_mcode stm) - | Ast0.Define(def,id,params,body) -> + | Ast0.Undef(def,id) -> + let def = normal_mcode def in let id = ident id in - let body = dots is_stm_dots None statement body in - mkres s (Ast0.Define(def,id,params,body)) (promote_mcode def) body + mkres s (Ast0.Undef(def,id)) (promote_mcode def) id + | Ast0.Define(def,id,params,body) -> + let def = normal_mcode def in + let (id,right) = full_ident id in + (match right with + None -> failwith "no disj id for #define" + | Some right -> + let (params,prev) = define_parameters params right in + let body = dots is_stm_dots (Some prev) statement body in + mkres s (Ast0.Define(def,id,params,body)) (promote_mcode def) body) | Ast0.OptStm(stm) -> let stm = statement stm in mkres s (Ast0.OptStm(stm)) stm stm | Ast0.UniqueStm(stm) -> @@ -770,20 +1067,20 @@ let rec statement s = and case_line c = match Ast0.unwrap c with Ast0.Default(def,colon,code) -> + let def = normal_mcode def in + let colon = normal_mcode colon in let code = dots is_stm_dots (Some(promote_mcode colon)) statement code in mkres c (Ast0.Default(def,colon,code)) (promote_mcode def) code | Ast0.Case(case,exp,colon,code) -> + let case = normal_mcode case in let exp = expression exp in + let colon = normal_mcode colon in let code = dots is_stm_dots (Some(promote_mcode colon)) statement code in mkres c (Ast0.Case(case,exp,colon,code)) (promote_mcode case) code | Ast0.DisjCase(starter,case_lines,mids,ender) -> - let starter = bad_mcode starter in - let case_lines = List.map case_line case_lines in - let mids = List.map bad_mcode mids in - let ender = bad_mcode ender in - mkmultires c (Ast0.DisjCase(starter,case_lines,mids,ender)) - (promote_mcode starter) (promote_mcode ender) - (get_all_start_info case_lines) (get_all_end_info case_lines) + do_disj c starter case_lines mids ender case_line + (fun starter case_lines mids ender -> + Ast0.DisjCase(starter,case_lines,mids,ender)) | Ast0.OptCase(case) -> let case = case_line case in mkres c (Ast0.OptCase(case)) case case @@ -807,14 +1104,17 @@ let top_level t = (* Entry points *) let compute_lines attachable_or x = + in_nest_count := 0; inherit_attachable := attachable_or; List.map top_level x let compute_statement_lines attachable_or x = + in_nest_count := 0; inherit_attachable := attachable_or; statement x let compute_statement_dots_lines attachable_or x = + in_nest_count := 0; inherit_attachable := attachable_or; statement_dots x