(*
-* 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 <http://www.gnu.org/licenses/>.
-*
-* 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 <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. *)
let fail w str =
failwith
- (Printf.sprintf "cocci line %d: %s" ((Ast0.get_info w).Ast0.line_start)
+ (Printf.sprintf "cocci line %d: %s"
+ ((Ast0.get_info w).Ast0.pos_info.Ast0.line_start)
str)
let make_opt_unique optfn uniquefn info tgt arity term =
(* --------------------------------------------------------------------- *)
(* Mcode *)
-let mcode2line (_,_,info,_,_) = info.Ast0.line_start
-let mcode2arity (_,arity,_,_,_) = arity
+let mcode2line (_,_,info,_,_,_) = info.Ast0.pos_info.Ast0.line_start
+let mcode2arity (_,arity,_,_,_,_) = arity
let mcode x = x (* nothing to do ... *)
(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 =
[mcode2arity name] in
let name = mcode name in
make_id i tgt arity (Ast0.Id(name))
- | Ast0.MetaId(name,constraints,pure) ->
+ | 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,pure))
+ 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.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 dots = mcode dots in
let whencode = get_option (expression Ast0.NONE) whencode in
make_exp expr tgt arity (Ast0.Estars(dots,whencode))
+ (* why does optexp exist???? *)
| Ast0.OptExp(_) | Ast0.UniqueExp(_) ->
failwith "unexpected code"
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)
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]) @
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
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 rp = mcode rp in
let body = statement arity body in
make_rule_elem stm tgt arity (Ast0.Iterator(nm,lp,args,rp,body,aft))
- | Ast0.Switch(switch,lp,exp,rp,lb,cases,rb) ->
+ | Ast0.Switch(switch,lp,exp,rp,lb,decls,cases,rb) ->
let arity =
stm_same (mcode2line switch)
(List.map mcode2arity [switch;lp;rp;lb;rb]) in
let exp = expression arity exp in
let rp = mcode rp in
let lb = mcode lb in
+ let decls = dots (statement arity) decls in
let cases = dots (case_line arity) cases in
let rb = mcode rb in
make_rule_elem stm tgt arity
- (Ast0.Switch(switch,lp,exp,rp,lb,cases,rb))
+ (Ast0.Switch(switch,lp,exp,rp,lb,decls,cases,rb))
| Ast0.Break(br,sem) ->
let arity = stm_same (mcode2line br) (List.map mcode2arity [br;sem]) in
let br = mcode br in
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 colon = mcode colon in
let code = dots (statement arity) code in
make_case_line c tgt arity (Ast0.Case(case,exp,colon,code))
+ | Ast0.DisjCase(starter,case_lines,mids,ender) ->
+ let case_lines = List.map (case_line tgt) case_lines in
+ (match List.rev case_lines with
+ _::xs ->
+ if anyopt xs (function Ast0.OptCase(_) -> true | _ -> false)
+ then fail c "opt only allowed in the last disjunct"
+ | _ -> ());
+ Ast0.rewrap c (Ast0.DisjCase(starter,case_lines,mids,ender))
| Ast0.OptCase(_) -> failwith "unexpected OptCase"
(* --------------------------------------------------------------------- *)
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