+(*
+ * 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.
+ *)
+
+
(* Arities matter for the minus slice, but not for the plus slice. *)
(* ? only allowed on rule_elems, and on subterms if the context is ? also. *)
(function x -> Ast0.OptIdent x)
(function x -> Ast0.UniqueIdent x)
-let ident opt_allowed tgt i =
+let rec ident opt_allowed tgt i =
match Ast0.unwrap i with
- Ast0.Id(name) ->
- let arity =
- all_same opt_allowed tgt (mcode2line name)
- [mcode2arity name] in
- let name = mcode name in
- make_id i tgt arity (Ast0.Id(name))
- | Ast0.MetaId(name,constraints,pure) ->
- let arity =
- all_same opt_allowed tgt (mcode2line name)
- [mcode2arity name] in
- let name = mcode name in
- make_id i tgt arity (Ast0.MetaId(name,constraints,pure))
- | Ast0.MetaFunc(name,constraints,pure) ->
- let arity =
- all_same opt_allowed tgt (mcode2line name)
- [mcode2arity name] in
- let name = mcode name in
- make_id i tgt arity (Ast0.MetaFunc(name,constraints,pure))
- | Ast0.MetaLocalFunc(name,constraints,pure) ->
- let arity =
- all_same opt_allowed tgt (mcode2line name)
- [mcode2arity name] in
- let name = mcode name in
- make_id i tgt arity (Ast0.MetaLocalFunc(name,constraints,pure))
- | Ast0.OptIdent(_) | Ast0.UniqueIdent(_) ->
- failwith "unexpected code"
-
+ Ast0.Id(name) ->
+ let arity =
+ all_same opt_allowed tgt (mcode2line name)
+ [mcode2arity name] in
+ let name = mcode name in
+ make_id i tgt arity (Ast0.Id(name))
+ | Ast0.MetaId(name,constraints,seed,pure) ->
+ let arity =
+ all_same opt_allowed tgt (mcode2line name)
+ [mcode2arity name] in
+ let name = mcode name in
+ make_id i tgt arity (Ast0.MetaId(name,constraints,seed,pure))
+ | Ast0.MetaFunc(name,constraints,pure) ->
+ let arity =
+ all_same opt_allowed tgt (mcode2line name)
+ [mcode2arity name] in
+ let name = mcode name in
+ make_id i tgt arity (Ast0.MetaFunc(name,constraints,pure))
+ | Ast0.MetaLocalFunc(name,constraints,pure) ->
+ let arity =
+ all_same opt_allowed tgt (mcode2line name)
+ [mcode2arity name] in
+ let name = mcode name in
+ make_id i tgt arity (Ast0.MetaLocalFunc(name,constraints,pure))
+ | Ast0.DisjId(starter,id_list,mids,ender) ->
+ let id_list = List.map (ident opt_allowed tgt) id_list in
+ (match List.rev id_list with
+ _::xs ->
+ if anyopt xs (function Ast0.OptIdent(_) -> true | _ -> false)
+ then fail i "opt only allowed in the last disjunct"
+ | _ -> ());
+ Ast0.rewrap i (Ast0.DisjId(starter,id_list,mids,ender))
+ | Ast0.OptIdent(_) | Ast0.UniqueIdent(_) ->
+ failwith "unexpected code"
+
(* --------------------------------------------------------------------- *)
(* Expression *)
-
+
let make_exp =
make_opt_unique
(function x -> Ast0.OptExp x)
let op = mcode op in
let right = expression arity right in
make_exp expr tgt arity (Ast0.Assignment(left,op,right,simple))
+ | Ast0.Sequence(left,op,right) ->
+ let arity = exp_same (mcode2line op) [mcode2arity op] in
+ let left = expression arity left in
+ let op = mcode op in
+ let right = expression arity right in
+ make_exp expr tgt arity (Ast0.Sequence(left,op,right))
| Ast0.CondExpr(exp1,why,exp2,colon,exp3) ->
let arity =
exp_same (mcode2line why) [mcode2arity why; mcode2arity colon] in
let dots = mcode dots in
let whencode = get_option (expression Ast0.NONE) whencode in
make_exp expr tgt arity (Ast0.Estars(dots,whencode))
+ | Ast0.Constructor(lp,ty,rp,init) ->
+ let arity = exp_same (mcode2line lp) [mcode2arity lp;mcode2arity rp] in
+ let lp = mcode lp in
+ let ty = typeC arity ty in
+ let rp = mcode rp in
+ let init = initialiser arity init in
+ make_exp expr tgt arity (Ast0.Constructor(lp,ty,rp,init))
(* why does optexp exist???? *)
- | Ast0.OptExp(_) | Ast0.UniqueExp(_) ->
+ | Ast0.OptExp(_) | Ast0.UniqueExp(_) | Ast0.AsExpr _ ->
failwith "unexpected code"
and expression tgt exp = top_expression false tgt exp
let arity =
all_same opt_allowed tgt (mcode2line kind) [mcode2arity kind] in
let kind = mcode kind in
- let name = ident false arity name in
+ let name = get_option (ident false arity) name in
make_typeC typ tgt arity (Ast0.EnumName(kind,name))
+ | Ast0.EnumDef(ty,lb,decls,rb) ->
+ let arity =
+ all_same opt_allowed tgt (mcode2line lb)
+ (List.map mcode2arity [lb;rb]) in
+ let ty = typeC arity ty in
+ let lb = mcode lb in
+ let ids = dots (expression tgt) decls in
+ let rb = mcode rb in
+ make_typeC typ tgt arity (Ast0.EnumDef(ty,lb,ids,rb))
| Ast0.StructUnionName(kind,name) ->
let arity =
all_same opt_allowed tgt (mcode2line kind)
| _ -> ());
let res = Ast0.DisjType(starter,types,mids,ender) in
Ast0.rewrap typ res
- | Ast0.OptType(_) | Ast0.UniqueType(_) ->
+ | Ast0.OptType(_) | Ast0.UniqueType(_) | Ast0.AsType _ ->
failwith "unexpected code"
and typeC tgt ty = top_typeC tgt false ty
and declaration tgt decl =
match Ast0.unwrap decl with
- Ast0.Init(stg,ty,id,eq,exp,sem) ->
+ Ast0.MetaDecl(name,pure) ->
+ let arity = all_same true tgt (mcode2line name) [mcode2arity name] in
+ let name = mcode name in
+ make_decl decl tgt arity (Ast0.MetaDecl(name,pure))
+ | Ast0.MetaField(name,pure) ->
+ let arity = all_same true tgt (mcode2line name) [mcode2arity name] in
+ let name = mcode name in
+ make_decl decl tgt arity (Ast0.MetaField(name,pure))
+ | Ast0.MetaFieldList(name,lenname,pure) ->
+ let arity = all_same true tgt (mcode2line name) [mcode2arity name] in
+ let name = mcode name in
+ make_decl decl tgt arity (Ast0.MetaFieldList(name,lenname,pure))
+ | Ast0.Init(stg,ty,id,eq,exp,sem) ->
let arity =
all_same true tgt (mcode2line eq)
((match stg with None -> [] | Some x -> [mcode2arity x]) @
make_decl decl tgt arity (Ast0.UnInit(stg,ty,id,sem))
| Ast0.MacroDecl(name,lp,args,rp,sem) ->
let arity =
- all_same true tgt (mcode2line lp) (List.map mcode2arity [lp;rp;sem]) in
+ all_same true tgt (mcode2line lp)
+ (List.map mcode2arity [lp;rp;sem]) in
let name = ident false arity name in
let lp = mcode lp in
let args = dots (expression arity) args in
let rp = mcode rp in
let sem = mcode sem in
make_decl decl tgt arity (Ast0.MacroDecl(name,lp,args,rp,sem))
+ | Ast0.MacroDeclInit(name,lp,args,rp,eq,ini,sem) ->
+ let arity =
+ all_same true tgt (mcode2line lp)
+ (List.map mcode2arity [lp;rp;eq;sem]) in
+ let name = ident false arity name in
+ let lp = mcode lp in
+ let args = dots (expression arity) args in
+ let rp = mcode rp in
+ let ini = initialiser arity ini in
+ let sem = mcode sem in
+ make_decl decl tgt arity
+ (Ast0.MacroDeclInit(name,lp,args,rp,eq,ini,sem))
| Ast0.TyDecl(ty,sem) ->
let arity =
all_same true tgt (mcode2line sem) [mcode2arity sem] in
let dots = mcode dots in
let whencode = get_option (declaration Ast0.NONE) whencode in
make_decl decl tgt arity (Ast0.Ddots(dots,whencode))
- | Ast0.OptDecl(_) | Ast0.UniqueDecl(_) ->
+ | Ast0.OptDecl(_) | Ast0.UniqueDecl(_) | Ast0.AsDecl _ ->
failwith "unexpected code"
(* --------------------------------------------------------------------- *)
let arity = init_same (mcode2line name) [mcode2arity name] in
let name = mcode name in
make_init i tgt arity (Ast0.MetaInit(name,pure))
+ | Ast0.MetaInitList(name,lenname,pure) ->
+ let arity = init_same (mcode2line name) [mcode2arity name] in
+ let name = mcode name in
+ make_init i tgt arity (Ast0.MetaInitList(name,lenname,pure))
| Ast0.InitExpr(exp) ->
Ast0.rewrap i (Ast0.InitExpr(expression tgt exp))
- | Ast0.InitList(lb,initlist,rb) ->
+ | Ast0.InitList(lb,initlist,rb,ordered) ->
let arity = init_same (mcode2line lb) [mcode2arity lb; mcode2arity rb] in
let lb = mcode lb in
let initlist = dots (initialiser arity) initlist in
let rb = mcode rb in
- make_init i tgt arity (Ast0.InitList(lb,initlist,rb))
+ make_init i tgt arity (Ast0.InitList(lb,initlist,rb,ordered))
| Ast0.InitGccExt(designators,eq,ini) ->
let arity = init_same (mcode2line eq) [mcode2arity eq] in
let designators = List.map (designator arity) designators in
let dots = mcode dots in
let whencode = get_option (initialiser Ast0.NONE) whencode in
make_init i tgt arity (Ast0.Idots(dots,whencode))
- | Ast0.OptIni(_) | Ast0.UniqueIni(_) ->
+ | Ast0.OptIni(_) | Ast0.UniqueIni(_) | Ast0.AsInit _ ->
failwith "unexpected code"
and designator tgt d =
make_rule_elem stm tgt arity (Ast0.Seq(lbrace,body,rbrace))
| Ast0.ExprStatement(exp,sem) ->
let arity = stm_same (mcode2line sem) [mcode2arity sem] in
- let exp = expression arity exp in
+ let exp = get_option (expression arity) exp in
let sem = mcode sem in
make_rule_elem stm tgt arity (Ast0.ExprStatement(exp,sem))
| Ast0.IfThen(iff,lp,exp,rp,branch,aft) ->
let arity =
stm_same (mcode2line goto) (List.map mcode2arity [goto;sem]) in
let goto = mcode goto in
- let l = ident false tgt l in
+ let l = ident false arity l in
let sem = mcode sem in
make_rule_elem stm tgt arity (Ast0.Goto(goto,l,sem))
| Ast0.Return(ret,sem) ->
let inc = mcode inc in
let s = mcode s in
make_rule_elem stm tgt arity (Ast0.Include(inc,s))
+ | Ast0.Undef(def,id) ->
+ let arity = all_same true tgt (mcode2line def) [mcode2arity def] in
+ let def = mcode def in
+ let id = ident false arity id in
+ make_rule_elem stm tgt arity (Ast0.Undef(def,id))
| Ast0.Define(def,id,params,body) ->
let arity = all_same true tgt (mcode2line def) [mcode2arity def] in
let def = mcode def in
let params = define_parameters arity params in
let body = dots (statement arity) body in
make_rule_elem stm tgt arity (Ast0.Define(def,id,params,body))
- | Ast0.OptStm(_) | Ast0.UniqueStm(_) ->
+ | Ast0.OptStm(_) | Ast0.UniqueStm(_) | Ast0.AsStmt _ ->
failwith "unexpected code"
and define_parameters tgt params =
if mcode2arity old_file = Ast0.NONE && mcode2arity new_file = Ast0.NONE
then Ast0.FILEINFO(mcode old_file,mcode new_file)
else fail t "unexpected arity for file info"
- | Ast0.DECL(stmt) ->
- Ast0.DECL(statement tgt stmt)
+ | Ast0.NONDECL(stmt) ->
+ Ast0.NONDECL(statement tgt stmt)
| Ast0.CODE(rule_elem_dots) ->
Ast0.CODE(concat_dots (statement tgt) rule_elem_dots)
+ | Ast0.TOPCODE(rule_elem_dots) -> fail t "eliminated by top_level"
| Ast0.ERRORWORDS(exps) ->
Ast0.ERRORWORDS(List.map (top_expression false Ast0.NONE) exps)
| Ast0.OTHER(_) -> fail t "eliminated by top_level")
HCoop / bpt / coccinelle.git / blobdiff