(*
- * Copyright 2010, INRIA, 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
Ast0.MINUS(r) -> let (plusses,_) = !r in plusses = Ast.NOREPLACEMENT
| _ -> false in
- (* special case for disj *)
+ (* special case for disj and asExpr etc *)
let ident r k e =
match Ast0.unwrap e with
Ast0.DisjId(starter,id_list,mids,ender) ->
match Ast0.unwrap e with
Ast0.DisjExpr(starter,expr_list,mids,ender) ->
List.for_all r.VT0.combiner_rec_expression expr_list
+ | Ast0.AsExpr(exp,asexp) -> k exp
| _ -> k e in
let declaration r k e =
match Ast0.unwrap e with
Ast0.DisjDecl(starter,decls,mids,ender) ->
List.for_all r.VT0.combiner_rec_declaration decls
+ | Ast0.AsDecl(decl,asdecl) -> k decl
| _ -> k e in
let typeC r k e =
match Ast0.unwrap e with
Ast0.DisjType(starter,decls,mids,ender) ->
List.for_all r.VT0.combiner_rec_typeC decls
+ | Ast0.AsType(ty,asty) -> k ty
+ | _ -> k e in
+
+ let initialiser r k e =
+ match Ast0.unwrap e with
+ Ast0.AsInit(init,asinit) -> k init
| _ -> k e in
let statement r k e =
match Ast0.unwrap e with
Ast0.Disj(starter,statement_dots_list,mids,ender) ->
List.for_all r.VT0.combiner_rec_statement_dots statement_dots_list
+ | Ast0.AsStmt(stmt,asstmt) -> k stmt
| _ -> k e in
let case_line r k e =
mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
mcode mcode
donothing donothing donothing donothing donothing donothing
- ident expression typeC donothing donothing declaration
+ ident expression typeC initialiser donothing declaration
statement case_line donothing
(* --------------------------------------------------------------------- *)
let mcode (term,_,info,mcodekind,pos,adj) =
let pos =
- List.map
- (function Ast0.MetaPos(pos,constraints,per) ->
- Ast.MetaPos(pos_mcode pos,constraints,per,unitary,false))
- !pos in
- (term,convert_info info,convert_mcodekind adj mcodekind,pos)
+ List.fold_left
+ (function prev ->
+ function
+ Ast0.MetaPosTag(Ast0.MetaPos(pos,constraints,per)) ->
+ (Ast.MetaPos(pos_mcode pos,constraints,per,unitary,false))::prev
+ | _ -> prev)
+ [] !pos in
+ (term,convert_info info,convert_mcodekind adj mcodekind,List.rev pos)
(* --------------------------------------------------------------------- *)
(* Dots *)
(* commas in dotted lists, here due to polymorphism restrictions *)
-let add_comma is_comma make_comma itemlist =
+let add_comma is_comma is_dots make_comma itemlist =
match Ast0.unwrap itemlist with
Ast0.DOTS(x) ->
(match List.rev x with
[] -> itemlist
+(* Not sure if comma is needed if the list is just ...; leave it there for
+now. See list_matcher in cocci_vs_c.ml in first try_matches case. *)
+(* | [e] when is_dots e -> itemlist*)
| e::es ->
if is_comma e
then itemlist
let add_exp_comma =
add_comma
(function x -> match Ast0.unwrap x with Ast0.EComma _ -> true | _ -> false)
+ (function x -> match Ast0.unwrap x with Ast0.Edots _ -> true | _ -> false)
(function x -> Ast0.EComma x)
and add_init_comma =
add_comma
(function x -> match Ast0.unwrap x with Ast0.IComma _ -> true | _ -> false)
+ (function x -> match Ast0.unwrap x with Ast0.Idots _ -> true | _ -> false)
(function x -> Ast0.IComma x)
(* --------------------------------------------------------------------- *)
Ast.FunCall(fn,lp,args,rp)
| Ast0.Assignment(left,op,right,simple) ->
Ast.Assignment(expression left,mcode op,expression right,simple)
+ | Ast0.Sequence(left,op,right) ->
+ Ast.Sequence(expression left,mcode op,expression right)
| Ast0.CondExpr(exp1,why,exp2,colon,exp3) ->
let exp1 = expression exp1 in
let why = mcode why in
| Ast0.RecordPtAccess(exp,ar,field) ->
Ast.RecordPtAccess(expression exp,mcode ar,ident field)
| Ast0.Cast(lp,ty,rp,exp) ->
- Ast.Cast(mcode lp,typeC ty,mcode rp,expression exp)
+ let allminus = check_allminus.VT0.combiner_rec_expression e in
+ Ast.Cast(mcode lp,typeC allminus ty,mcode rp,expression exp)
| Ast0.SizeOfExpr(szf,exp) ->
Ast.SizeOfExpr(mcode szf,expression exp)
| Ast0.SizeOfType(szf,lp,ty,rp) ->
- Ast.SizeOfType(mcode szf, mcode lp,typeC ty,mcode rp)
- | Ast0.TypeExp(ty) -> Ast.TypeExp(typeC ty)
+ let allminus = check_allminus.VT0.combiner_rec_expression e in
+ Ast.SizeOfType(mcode szf, mcode lp,typeC allminus ty,mcode rp)
+ | Ast0.TypeExp(ty) ->
+ let allminus = check_allminus.VT0.combiner_rec_expression e in
+ Ast.TypeExp(typeC allminus ty)
| Ast0.Constructor(lp,ty,rp,init) ->
- Ast.Constructor(mcode lp,typeC ty,mcode rp,initialiser init)
+ let allminus = check_allminus.VT0.combiner_rec_expression e in
+ Ast.Constructor(mcode lp,typeC allminus ty,mcode rp,initialiser init)
| Ast0.MetaErr(name,cstrts,_) ->
Ast.MetaErr(mcode name,constraints cstrts,unitary,false)
| Ast0.MetaExpr(name,cstrts,ty,form,_) ->
Ast.MetaExpr(mcode name,constraints cstrts,unitary,ty,form,false)
| Ast0.MetaExprList(name,lenname,_) ->
Ast.MetaExprList(mcode name,do_lenname lenname,unitary,false)
+ | Ast0.AsExpr(expr,asexpr) ->
+ Ast.AsExpr(expression expr,expression asexpr)
| Ast0.EComma(cm) -> Ast.EComma(mcode cm)
| Ast0.DisjExpr(_,exps,_,_) ->
Ast.DisjExpr(List.map expression exps)
and rewrap_iso t t1 = rewrap t (do_isos (Ast0.get_iso t)) t1
-and typeC t =
+and typeC allminus t =
rewrap t (do_isos (Ast0.get_iso t))
(match Ast0.unwrap t with
Ast0.ConstVol(cv,ty) ->
List.map
(function ty ->
Ast.Type
- (Some (mcode cv),rewrap_iso ty (base_typeC ty)))
+ (allminus, Some (mcode cv),
+ rewrap_iso ty (base_typeC allminus ty)))
(collect_disjs ty) in
(* one could worry that isos are lost because we flatten the
disjunctions. but there should not be isos on the disjunctions
| Ast0.Array(_,_,_,_) | Ast0.EnumName(_,_) | Ast0.StructUnionName(_,_)
| Ast0.StructUnionDef(_,_,_,_) | Ast0.EnumDef(_,_,_,_)
| Ast0.TypeName(_) | Ast0.MetaType(_,_) ->
- Ast.Type(None,rewrap t no_isos (base_typeC t))
- | Ast0.DisjType(_,types,_,_) -> Ast.DisjType(List.map typeC types)
- | Ast0.OptType(ty) -> Ast.OptType(typeC ty)
- | Ast0.UniqueType(ty) -> Ast.UniqueType(typeC ty))
-
-and base_typeC t =
+ Ast.Type(allminus,None,rewrap t no_isos (base_typeC allminus t))
+ | Ast0.DisjType(_,types,_,_) ->
+ Ast.DisjType(List.map (typeC allminus) types)
+ | Ast0.AsType(ty,asty) ->
+ Ast.AsType(typeC allminus ty,typeC allminus asty)
+ | Ast0.OptType(ty) -> Ast.OptType(typeC allminus ty)
+ | Ast0.UniqueType(ty) -> Ast.UniqueType(typeC allminus ty))
+
+and base_typeC allminus t =
match Ast0.unwrap t with
Ast0.BaseType(ty,strings) -> Ast.BaseType(ty,List.map mcode strings)
| Ast0.Signed(sgn,ty) ->
- Ast.SignedT(mcode sgn,
- get_option (function x -> rewrap_iso x (base_typeC x)) ty)
- | Ast0.Pointer(ty,star) -> Ast.Pointer(typeC ty,mcode star)
+ Ast.SignedT
+ (mcode sgn,
+ get_option (function x -> rewrap_iso x (base_typeC allminus x)) ty)
+ | Ast0.Pointer(ty,star) -> Ast.Pointer(typeC allminus ty,mcode star)
| Ast0.FunctionPointer(ty,lp1,star,rp1,lp2,params,rp2) ->
Ast.FunctionPointer
- (typeC ty,mcode lp1,mcode star,mcode rp1,
+ (typeC allminus ty,mcode lp1,mcode star,mcode rp1,
mcode lp2,parameter_list params,mcode rp2)
| Ast0.FunctionType(ret,lp,params,rp) ->
let allminus = check_allminus.VT0.combiner_rec_typeC t in
Ast.FunctionType
- (allminus,get_option typeC ret,mcode lp,
+ (allminus,get_option (typeC allminus) ret,mcode lp,
parameter_list params,mcode rp)
| Ast0.Array(ty,lb,size,rb) ->
- Ast.Array(typeC ty,mcode lb,get_option expression size,mcode rb)
+ Ast.Array(typeC allminus ty,mcode lb,get_option expression size,
+ mcode rb)
| Ast0.EnumName(kind,name) ->
Ast.EnumName(mcode kind,get_option ident name)
| Ast0.EnumDef(ty,lb,ids,rb) ->
let ids = add_exp_comma ids in
- Ast.EnumDef(typeC ty,mcode lb,dots expression ids,mcode rb)
+ Ast.EnumDef(typeC allminus ty,mcode lb,dots expression ids,mcode rb)
| Ast0.StructUnionName(kind,name) ->
Ast.StructUnionName(mcode kind,get_option ident name)
| Ast0.StructUnionDef(ty,lb,decls,rb) ->
- Ast.StructUnionDef(typeC ty,mcode lb,
+ Ast.StructUnionDef(typeC allminus ty,mcode lb,
dots declaration decls,
mcode rb)
| Ast0.TypeName(name) -> Ast.TypeName(mcode name)
| Ast0.MetaField(name,_) -> Ast.MetaField(mcode name,unitary,false)
| Ast0.MetaFieldList(name,lenname,_) ->
Ast.MetaFieldList(mcode name,do_lenname lenname,unitary,false)
+ | Ast0.AsDecl(decl,asdecl) ->
+ Ast.AsDecl(declaration decl,declaration asdecl)
| Ast0.Init(stg,ty,id,eq,ini,sem) ->
+ let allminus = check_allminus.VT0.combiner_rec_declaration d in
let stg = get_option mcode stg in
- let ty = typeC ty in
+ let ty = typeC allminus ty in
let id = ident id in
let eq = mcode eq in
let ini = initialiser ini in
Ast.UnInit(get_option mcode stg,
rewrap ty (do_isos (Ast0.get_iso ty))
(Ast.Type
- (None,
+ (allminus,None,
rewrap ty no_isos
(Ast.FunctionType
- (allminus,get_option typeC tyx,mcode lp1,
+ (allminus,get_option (typeC allminus) tyx,
+ mcode lp1,
parameter_list params,mcode rp1)))),
ident id,mcode sem)
- | _ -> Ast.UnInit(get_option mcode stg,typeC ty,ident id,mcode sem))
+ | _ ->
+ let allminus = check_allminus.VT0.combiner_rec_declaration d in
+ Ast.UnInit(get_option mcode stg,typeC allminus ty,ident id,
+ mcode sem))
| Ast0.MacroDecl(name,lp,args,rp,sem) ->
let name = ident name in
let lp = mcode lp in
let rp = mcode rp in
let sem = mcode sem in
Ast.MacroDecl(name,lp,args,rp,sem)
- | Ast0.TyDecl(ty,sem) -> Ast.TyDecl(typeC ty,mcode sem)
+ | Ast0.MacroDeclInit(name,lp,args,rp,eq,ini,sem) ->
+ let name = ident name in
+ let lp = mcode lp in
+ let args = dots expression args in
+ let rp = mcode rp in
+ let eq = mcode eq in
+ let ini = initialiser ini in
+ let sem = mcode sem in
+ Ast.MacroDeclInit(name,lp,args,rp,eq,ini,sem)
+ | Ast0.TyDecl(ty,sem) ->
+ let allminus = check_allminus.VT0.combiner_rec_declaration d in
+ Ast.TyDecl(typeC allminus ty,mcode sem)
| Ast0.Typedef(stg,ty,id,sem) ->
- let id = typeC id in
+ let allminus = check_allminus.VT0.combiner_rec_declaration d in
+ let id = typeC allminus id in
(match Ast.unwrap id with
- Ast.Type(None,id) -> (* only MetaType or Id *)
- Ast.Typedef(mcode stg,typeC ty,id,mcode sem)
+ Ast.Type(_,None,id) -> (* only MetaType or Id *)
+ Ast.Typedef(mcode stg,typeC allminus ty,id,mcode sem)
| _ -> failwith "bad typedef")
| Ast0.DisjDecl(_,decls,_,_) -> Ast.DisjDecl(List.map declaration decls)
| Ast0.Ddots(dots,whencode) ->
Ast0.MetaInit(name,_) -> Ast.MetaInit(mcode name,unitary,false)
| Ast0.MetaInitList(name,lenname,_) ->
Ast.MetaInitList(mcode name,do_lenname lenname,unitary,false)
+ | Ast0.AsInit(init,asinit) ->
+ Ast.AsInit(initialiser init,initialiser asinit)
| Ast0.InitExpr(exp) -> Ast.InitExpr(expression exp)
| Ast0.InitList(lb,initlist,rb,true) ->
let initlist = add_init_comma initlist in
and parameterTypeDef p =
rewrap p no_isos
(match Ast0.unwrap p with
- Ast0.VoidParam(ty) -> Ast.VoidParam(typeC ty)
- | Ast0.Param(ty,id) -> Ast.Param(typeC ty,get_option ident id)
+ Ast0.VoidParam(ty) -> Ast.VoidParam(typeC false ty)
+ | Ast0.Param(ty,id) ->
+ let allminus = check_allminus.VT0.combiner_rec_parameter p in
+ Ast.Param(typeC allminus ty,get_option ident id)
| Ast0.MetaParam(name,_) ->
Ast.MetaParam(mcode name,unitary,false)
| Ast0.MetaParamList(name,lenname,_) ->
| Ast0.MetaStmtList(name,_) ->
Ast.Atomic(rewrap_rule_elem s
(Ast.MetaStmtList(mcode name,unitary,false)))
+ | Ast0.AsStmt(stmt,asstmt) ->
+ Ast.AsStmt(statement seqible stmt,statement seqible asstmt)
| Ast0.TopExp(exp) ->
Ast.Atomic(rewrap_rule_elem s (Ast.TopExp(expression exp)))
| Ast0.Exp(exp) ->
| Ast0.TopInit(init) ->
Ast.Atomic(rewrap_rule_elem s (Ast.TopInit(initialiser init)))
| Ast0.Ty(ty) ->
- Ast.Atomic(rewrap_rule_elem s (Ast.Ty(typeC ty)))
+ let allminus = check_allminus.VT0.combiner_rec_statement s in
+ Ast.Atomic(rewrap_rule_elem s (Ast.Ty(typeC allminus ty)))
| Ast0.Disj(_,rule_elem_dots_list,_,_) ->
Ast.Disj(List.map (function x -> statement_dots seqible x)
rule_elem_dots_list)
and fninfo = function
Ast0.FStorage(stg) -> Ast.FStorage(mcode stg)
- | Ast0.FType(ty) -> Ast.FType(typeC ty)
+ | Ast0.FType(ty) -> Ast.FType(typeC false ty)
| Ast0.FInline(inline) -> Ast.FInline(mcode inline)
| Ast0.FAttr(attr) -> Ast.FAttr(mcode attr)
| Ast0.ExprTag(d) -> Ast.ExpressionTag(expression d)
| Ast0.ArgExprTag(d) | Ast0.TestExprTag(d) ->
failwith "only in isos, not converted to ast"
- | Ast0.TypeCTag(d) -> Ast.FullTypeTag(typeC d)
+ | Ast0.TypeCTag(d) -> Ast.FullTypeTag(typeC false d)
| Ast0.ParamTag(d) -> Ast.ParamTag(parameterTypeDef d)
| Ast0.InitTag(d) -> Ast.InitTag(initialiser d)
| Ast0.DeclTag(d) -> Ast.DeclarationTag(declaration d)
| Ast0.IsoWhenTTag(_) -> failwith "not possible"
| Ast0.IsoWhenFTag(_) -> failwith "not possible"
| Ast0.MetaPosTag _ -> failwith "not possible"
+ | Ast0.HiddenVarTag _ -> failwith "not possible"
(* --------------------------------------------------------------------- *)
(* Function declaration *)
HCoop / bpt / coccinelle.git / blobdiff