(*
- * Copyright 2005-2010, Ecole des Mines de Nantes, University of Copenhagen
+ * Copyright 2012, INRIA
+ * Julia Lawall, Gilles Muller
+ * Copyright 2010-2011, 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.
*
*)
+# 0 "./compute_lines.ml"
+(*
+ * Copyright 2012, INRIA
+ * Julia Lawall, Gilles Muller
+ * Copyright 2010-2011, 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 <http://www.gnu.org/licenses/>.
+ *
+ * The authors reserve the right to distribute this or future versions of
+ * Coccinelle under other licenses.
+ *)
+
+
+# 0 "./compute_lines.ml"
(* Computes starting and ending logical lines for statements and
expressions. every node gets an index as well. *)
(* --------------------------------------------------------------------- *)
(* 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
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 *)
- Ast0.strings_before = []; Ast0.strings_after = [] } in
+ Ast0.strings_before = []; Ast0.strings_after = [];
+ Ast0.isSymbolIdent = false; } in
{x with Ast0.node = e; Ast0.info = info}
(* This looks like it is there to allow distribution of plus code
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 *)
- Ast0.strings_before = []; Ast0.strings_after = [] } in
+ Ast0.strings_before = []; Ast0.strings_after = [];
+ Ast0.isSymbolIdent = false; } in
{x with Ast0.node = e; Ast0.info = info}
(* --------------------------------------------------------------------- *)
{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 =
{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 =
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
| (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
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.OptIdent(id) ->
- let id = ident id in mkres i (Ast0.OptIdent(id)) id id
- | Ast0.UniqueIdent(id) ->
- let id = ident id in mkres i (Ast0.UniqueIdent(id)) id id
+ 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,r) = full_ident id in mkidres i (Ast0.OptIdent(id)) id id r
+ | Ast0.UniqueIdent(id) ->
+ let (id,r) = full_ident id in mkidres i (Ast0.UniqueIdent(id)) id id r
+ | Ast0.AsIdent _ -> failwith "not possible"
+and ident i = let (id,_) = full_ident i in id
(* --------------------------------------------------------------------- *)
(* Expression *)
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.Sequence(left,op,right) ->
+ let left = expression left in
+ let op = normal_mcode op in
+ let right = expression right in
+ mkres e (Ast0.Sequence(left,op,right)) 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.Constructor(lp,ty,rp,init) ->
+ let lp = normal_mcode lp in
+ let init = initialiser init in
+ let rp = normal_mcode rp in
+ mkres e (Ast0.Constructor(lp,typeC ty,rp,init)) (promote_mcode lp) init
+ | 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))
| Ast0.UniqueExp(exp) ->
let exp = expression exp in
mkres e (Ast0.UniqueExp(exp)) exp exp
+ | Ast0.AsExpr _ -> failwith "not possible"
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) ->
let ty = typeC ty in mkres t (Ast0.UniqueType(ty)) ty ty
+ | Ast0.AsType _ -> failwith "not possible"
(* --------------------------------------------------------------------- *)
(* Variable declaration *)
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.MacroDeclInit(name,lp,args,rp,eq,ini,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 eq = normal_mcode eq in
+ let ini = initialiser ini in
+ let sem = normal_mcode sem in
+ mkres d (Ast0.MacroDeclInit(name,lp,args,rp,eq,ini,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
| Ast0.UniqueDecl(decl) ->
let decl = declaration decl in
mkres d (Ast0.UniqueDecl(declaration decl)) decl decl
+ | Ast0.AsDecl _ -> failwith "not possible"
(* --------------------------------------------------------------------- *)
(* Initializer *)
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
| Ast0.UniqueIni(ini) ->
let ini = initialiser ini in
mkres i (Ast0.UniqueIni(ini)) ini ini
+ | Ast0.AsInit _ -> failwith "not possible"
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
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) ->
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 res = define_param dp in
mkres p (Ast0.UniqueDParam(res)) res res
-let define_parameters x =
+let define_parameters x id =
match Ast0.unwrap x with
- Ast0.NoParams -> x (* no info, should be ignored *)
+ 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
+ (mkres x (Ast0.DParams(lp,dp,rp)) l r, r)
(* --------------------------------------------------------------------- *)
(* Top-level code *)
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
(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,
(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
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
| 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) ->
(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
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 params = define_parameters params 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) ->
- let stm = statement stm in mkres s (Ast0.UniqueStm(stm)) stm stm in
+ let stm = statement stm in mkres s (Ast0.UniqueStm(stm)) stm stm
+ | Ast0.AsStmt _ -> failwith "not possible" in
Ast0.set_dots_bef_aft res
(match Ast0.get_dots_bef_aft res with
Ast0.NoDots -> Ast0.NoDots
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
let top_level t =
match Ast0.unwrap t with
Ast0.FILEINFO(old_file,new_file) -> t
- | Ast0.DECL(stmt) ->
- let stmt = statement stmt in mkres t (Ast0.DECL(stmt)) stmt stmt
+ | Ast0.NONDECL(stmt) ->
+ let stmt = statement stmt in mkres t (Ast0.NONDECL(stmt)) stmt stmt
| Ast0.CODE(rule_elem_dots) ->
let rule_elem_dots = dots is_stm_dots None statement rule_elem_dots in
mkres t (Ast0.CODE(rule_elem_dots)) rule_elem_dots rule_elem_dots
| Ast0.ERRORWORDS(exps) -> t
- | Ast0.OTHER(_) -> failwith "eliminated by top_level"
+ | Ast0.OTHER(_) | Ast0.TOPCODE(_) -> failwith "eliminated by top_level"
(* --------------------------------------------------------------------- *)
(* 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