-(*
-* Copyright 2005-2008, 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.
-*)
-
-
(* 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. *)
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 ... *)
let 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,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"
(* --------------------------------------------------------------------- *)
(* Expression *)
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 cv = mcode cv in
let ty = typeC arity ty in
make_typeC typ tgt arity (Ast0.ConstVol(cv,ty))
- | Ast0.BaseType(ty,Some sign) ->
+ | Ast0.BaseType(ty,strings) ->
let arity =
- all_same opt_allowed tgt (mcode2line ty)
- [mcode2arity ty; mcode2arity sign] in
- let ty = mcode ty in
- let sign = mcode sign in
- make_typeC typ tgt arity (Ast0.BaseType(ty,Some sign))
- | Ast0.BaseType(ty,None) ->
- let arity =
- all_same opt_allowed tgt (mcode2line ty) [mcode2arity ty] in
- let ty = mcode ty in
- make_typeC typ tgt arity (Ast0.BaseType(ty,None))
- | Ast0.ImplicitInt(sign) ->
+ all_same opt_allowed tgt (mcode2line (List.hd strings))
+ (List.map mcode2arity strings) in
+ let strings = List.map mcode strings in
+ make_typeC typ tgt arity (Ast0.BaseType(ty,strings))
+ | Ast0.Signed(sign,ty) ->
let arity =
all_same opt_allowed tgt (mcode2line sign) [mcode2arity sign] in
let sign = mcode sign in
- make_typeC typ tgt arity (Ast0.ImplicitInt(sign))
+ let ty = get_option (typeC arity) ty in
+ make_typeC typ tgt arity (Ast0.Signed(sign,ty))
| Ast0.Pointer(ty,star) ->
let arity =
all_same opt_allowed tgt (mcode2line star) [mcode2arity star] in
let size = get_option (expression arity) size in
let rb = mcode rb in
make_typeC typ tgt arity (Ast0.Array(ty,lb,size,rb))
+ | Ast0.EnumName(kind,name) ->
+ let arity =
+ all_same opt_allowed tgt (mcode2line kind) [mcode2arity kind] in
+ let kind = mcode kind in
+ let name = ident false arity name in
+ make_typeC typ tgt arity (Ast0.EnumName(kind,name))
| 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.Init(stg,ty,id,eq,exp,sem) ->
let arity =
all_same true tgt (mcode2line eq)
((match stg with None -> [] | Some x -> [mcode2arity x]) @
and initialiser tgt i =
let init_same = all_same true tgt in
match Ast0.unwrap i with
- Ast0.InitExpr(exp) ->
+ Ast0.MetaInit(name,pure) ->
+ let arity = init_same (mcode2line name) [mcode2arity name] in
+ let name = mcode name in
+ make_init i tgt arity (Ast0.MetaInit(name,pure))
+ | Ast0.InitExpr(exp) ->
Ast0.rewrap i (Ast0.InitExpr(expression tgt exp))
| Ast0.InitList(lb,initlist,rb) ->
let arity = init_same (mcode2line lb) [mcode2arity lb; mcode2arity rb] in
let initlist = dots (initialiser arity) initlist in
let rb = mcode rb in
make_init i tgt arity (Ast0.InitList(lb,initlist,rb))
- | Ast0.InitGccDotName(dot,name,eq,ini) ->
- let arity =
- init_same (mcode2line dot) [mcode2arity dot; mcode2arity eq] in
- let dot = mcode dot in
- let name = ident true arity name in
+ | Ast0.InitGccExt(designators,eq,ini) ->
+ let arity = init_same (mcode2line eq) [mcode2arity eq] in
+ let designators = List.map (designator arity) designators in
let eq = mcode eq in
let ini = initialiser arity ini in
- make_init i tgt arity (Ast0.InitGccDotName(dot,name,eq,ini))
+ make_init i tgt arity (Ast0.InitGccExt(designators,eq,ini))
| Ast0.InitGccName(name,eq,ini) ->
let arity = init_same (mcode2line eq) [mcode2arity eq] in
let name = ident true arity name in
let eq = mcode eq in
let ini = initialiser arity ini in
make_init i tgt arity (Ast0.InitGccName(name,eq,ini))
- | Ast0.InitGccIndex(lb,exp,rb,eq,ini) ->
- let arity =
- init_same (mcode2line lb)
- [mcode2arity lb; mcode2arity rb; mcode2arity eq] in
- let lb = mcode lb in
- let exp = expression arity exp in
- let rb = mcode rb in
- let eq = mcode eq in
- let ini = initialiser arity ini in
- make_init i tgt arity (Ast0.InitGccIndex(lb,exp,rb,eq,ini))
- | Ast0.InitGccRange(lb,exp1,dots,exp2,rb,eq,ini) ->
- let arity =
- init_same (mcode2line lb)
- [mcode2arity lb; mcode2arity dots; mcode2arity rb; mcode2arity eq] in
- let lb = mcode lb in
- let exp1 = expression arity exp1 in
- let dots = mcode dots in
- let exp2 = expression arity exp2 in
- let rb = mcode rb in
- let eq = mcode eq in
- let ini = initialiser arity ini in
- make_init i tgt arity
- (Ast0.InitGccRange(lb,exp1,dots,exp2,rb,eq,ini))
| Ast0.IComma(cm) ->
let arity = init_same (mcode2line cm) [mcode2arity cm] in
let cm = mcode cm in
| Ast0.OptIni(_) | Ast0.UniqueIni(_) ->
failwith "unexpected code"
+and designator tgt d =
+ let dsame = all_same false tgt in
+ match d with
+ Ast0.DesignatorField(dot,id) ->
+ let arity = dsame (mcode2line dot) [mcode2arity dot] in
+ let dot = mcode dot in
+ let id = ident false arity id in
+ Ast0.DesignatorField(dot,id)
+ | Ast0.DesignatorIndex(lb,exp,rb) ->
+ let arity = dsame (mcode2line lb) [mcode2arity lb;mcode2arity rb] in
+ let lb = mcode lb in
+ let exp = top_expression false arity exp in
+ let rb = mcode rb in
+ Ast0.DesignatorIndex(lb,exp,rb)
+ | Ast0.DesignatorRange(lb,min,dots,max,rb) ->
+ let arity =
+ dsame (mcode2line lb)
+ [mcode2arity lb;mcode2arity dots;mcode2arity rb] in
+ let lb = mcode lb in
+ let min = top_expression false arity min in
+ let dots = mcode dots in
+ let max = top_expression false arity max in
+ let rb = mcode rb in
+ Ast0.DesignatorRange(lb,min,dots,max,rb)
+
(* --------------------------------------------------------------------- *)
(* Parameter *)
| Ast0.Param(ty,Some id) ->
let ty = top_typeC tgt true ty in
let id = ident true tgt id in
- Ast0.rewrap param
+ Ast0.rewrap param
(match (Ast0.unwrap ty,Ast0.unwrap id) with
(Ast0.OptType(ty),Ast0.OptIdent(id)) ->
Ast0.OptParam(Ast0.rewrap param (Ast0.Param(ty,Some id)))
| _ -> Ast0.Param(ty,Some id))
| Ast0.Param(ty,None) ->
let ty = top_typeC tgt true ty in
- Ast0.rewrap param
+ Ast0.rewrap param
(match Ast0.unwrap ty with
Ast0.OptType(ty) ->
Ast0.OptParam(Ast0.rewrap param (Ast0.Param(ty,None)))
match Ast0.unwrap stm with
Ast0.Decl(bef,decl) ->
let new_decl = declaration tgt decl in
- Ast0.rewrap stm
+ Ast0.rewrap stm
(match Ast0.unwrap new_decl with
Ast0.OptDecl(decl) ->
Ast0.OptStm(Ast0.rewrap stm (Ast0.Decl(bef,decl)))
| Ast0.UniqueDecl(decl) ->
Ast0.UniqueStm(Ast0.rewrap stm (Ast0.Decl(bef,decl)))
| _ -> Ast0.Decl(bef,new_decl))
- | Ast0.Seq(lbrace,body,rbrace) ->
+ | Ast0.Seq(lbrace,body,rbrace) ->
let arity =
stm_same (mcode2line lbrace)
[mcode2arity lbrace; mcode2arity rbrace] in
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) ->
make_rule_elem stm tgt arity (Ast0.MetaStmtList(name,pure))
| Ast0.Exp(exp) ->
let new_exp = top_expression true tgt exp in
- Ast0.rewrap stm
+ Ast0.rewrap stm
(match Ast0.unwrap new_exp with
Ast0.OptExp(exp) ->
Ast0.OptStm(Ast0.rewrap stm (Ast0.Exp(exp)))
| _ -> Ast0.Exp(new_exp))
| Ast0.TopExp(exp) ->
let new_exp = top_expression true tgt exp in
- Ast0.rewrap stm
+ Ast0.rewrap stm
(match Ast0.unwrap new_exp with
Ast0.OptExp(exp) ->
Ast0.OptStm(Ast0.rewrap stm (Ast0.TopExp(exp)))
| _ -> Ast0.TopExp(new_exp))
| Ast0.Ty(ty) ->
let new_ty = typeC tgt ty in (* opt makes no sense alone at top level *)
- Ast0.rewrap stm
+ Ast0.rewrap stm
(match Ast0.unwrap new_ty with
Ast0.OptType(ty) ->
Ast0.OptStm(Ast0.rewrap stm (Ast0.Ty(ty)))
| Ast0.UniqueType(ty) ->
Ast0.UniqueStm(Ast0.rewrap stm (Ast0.Ty(ty)))
| _ -> Ast0.Ty(new_ty))
+ | Ast0.TopInit(init) ->
+ let new_init = initialiser tgt init in
+ Ast0.rewrap stm
+ (match Ast0.unwrap new_init with
+ Ast0.OptIni(init) ->
+ Ast0.OptStm(Ast0.rewrap stm (Ast0.TopInit(init)))
+ | Ast0.UniqueIni(init) ->
+ Ast0.UniqueStm(Ast0.rewrap stm (Ast0.TopInit(init)))
+ | _ -> Ast0.TopInit(new_init))
| Ast0.Disj(starter,rule_elem_dots_list,mids,ender) ->
let stms =
List.map (function x -> concat_dots (statement tgt) x)
concat_dots (statement Ast0.NONE) rule_elem_dots in
let whn =
List.map
- (whencode (concat_dots (statement Ast0.NONE)) (statement Ast0.NONE))
+ (whencode (concat_dots (statement Ast0.NONE)) (statement Ast0.NONE)
+ (expression Ast0.NONE))
whn in
Ast0.rewrap stm
(Ast0.Nest(starter,new_rule_elem_dots,ender,whn,multi))
let dots = mcode dots in
let whn =
List.map
- (whencode (concat_dots (statement Ast0.NONE)) (statement Ast0.NONE))
+ (whencode (concat_dots (statement Ast0.NONE)) (statement Ast0.NONE)
+ (expression Ast0.NONE))
whn in
make_rule_elem stm tgt arity (Ast0.Dots(dots,whn))
| Ast0.Circles(dots,whn) ->
let dots = mcode dots in
let whn =
List.map
- (whencode (concat_dots (statement Ast0.NONE)) (statement Ast0.NONE))
+ (whencode (concat_dots (statement Ast0.NONE)) (statement Ast0.NONE)
+ (expression Ast0.NONE))
whn in
make_rule_elem stm tgt arity (Ast0.Circles(dots,whn))
| Ast0.Stars(dots,whn) ->
let dots = mcode dots in
let whn =
List.map
- (whencode (concat_dots (statement Ast0.NONE)) (statement Ast0.NONE))
+ (whencode (concat_dots (statement Ast0.NONE)) (statement Ast0.NONE)
+ (expression Ast0.NONE))
whn in
make_rule_elem stm tgt arity (Ast0.Stars(dots,whn))
| Ast0.FunDecl(bef,fi,name,lp,params,rp,lbrace,body,rbrace) ->
let rbrace = mcode rbrace in
make_rule_elem stm tgt arity
(Ast0.FunDecl(bef,fi,name,lp,params,rp,lbrace,body,rbrace))
- | Ast0.Include(inc,s) ->
+ | Ast0.Include(inc,s) ->
let arity =
all_same true tgt (mcode2line inc) [mcode2arity inc; mcode2arity s] in
let inc = mcode inc in
| Ast0.FAttr(attr) -> [mcode2arity attr])
fninfo)
-and whencode notfn alwaysfn = function
+and whencode notfn alwaysfn expression = function
Ast0.WhenNot a -> Ast0.WhenNot (notfn a)
| Ast0.WhenAlways a -> Ast0.WhenAlways (alwaysfn a)
| Ast0.WhenModifier(x) -> Ast0.WhenModifier(x)
+ | Ast0.WhenNotTrue a -> Ast0.WhenNotTrue (expression a)
+ | Ast0.WhenNotFalse a -> Ast0.WhenNotFalse (expression a)
and make_case_line =
make_opt_unique
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"
(* --------------------------------------------------------------------- *)
let top_level tgt t =
Ast0.rewrap t
(match Ast0.unwrap t with
- Ast0.FILEINFO(old_file,new_file) ->
+ Ast0.FILEINFO(old_file,new_file) ->
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"
HCoop / bpt / coccinelle.git / blobdiff