let get_option f = function
Some x -> let (n,e) = f x in (n,Some e)
| None -> (option_default,None) in
+ let do_disj starter lst mids ender processor rebuilder =
+ let (starter_n,starter) = string_mcode starter in
+ let (lst_n,lst) = map_split processor lst in
+ let (mids_n,mids) = map_split string_mcode mids in
+ let (ender_n,ender) = string_mcode ender in
+ (multibind
+ [starter_n;List.hd lst_n;
+ multibind (List.map2 bind mids_n (List.tl lst_n));ender_n],
+ rebuilder starter lst mids ender) in
let rec expression_dots d =
let k d =
rewrap d
(match Ast0.unwrap i with
Ast0.Id(name) ->
let (n,name) = string_mcode name in (n,Ast0.Id(name))
- | Ast0.MetaId(name,constraints,pure) ->
+ | Ast0.MetaId(name,constraints,seed,pure) ->
let (n,name) = meta_mcode name in
- (n,Ast0.MetaId(name,constraints,pure))
+ (n,Ast0.MetaId(name,constraints,seed,pure))
| Ast0.MetaFunc(name,constraints,pure) ->
let (n,name) = meta_mcode name in
(n,Ast0.MetaFunc(name,constraints,pure))
| Ast0.MetaLocalFunc(name,constraints,pure) ->
let (n,name) = meta_mcode name in
(n,Ast0.MetaLocalFunc(name,constraints,pure))
+ | Ast0.DisjId(starter,id_list,mids,ender) ->
+ do_disj starter id_list mids ender ident
+ (fun starter id_list mids ender ->
+ Ast0.DisjId(starter,id_list,mids,ender))
| Ast0.OptIdent(id) ->
let (n,id) = ident id in (n,Ast0.OptIdent(id))
| Ast0.UniqueIdent(id) ->
| Ast0.TypeExp(ty) ->
let (ty_n,ty) = typeC ty in
(ty_n,Ast0.TypeExp(ty))
+ | Ast0.Constructor(lp,ty,rp,init) ->
+ let (lp_n,lp) = string_mcode lp in
+ let (ty_n,ty) = typeC ty in
+ let (rp_n,rp) = string_mcode rp in
+ let (init_n,init) = initialiser init in
+ (multibind [lp_n;ty_n;rp_n;init_n], Ast0.Constructor(lp,ty,rp,init))
| Ast0.MetaErr(name,constraints,pure) ->
let (name_n,name) = meta_mcode name in
(name_n,Ast0.MetaErr(name,constraints,pure))
| Ast0.EComma(cm) ->
let (cm_n,cm) = string_mcode cm in (cm_n,Ast0.EComma(cm))
| Ast0.DisjExpr(starter,expr_list,mids,ender) ->
- let (starter_n,starter) = string_mcode starter in
- let (expr_list_n,expr_list) = map_split expression expr_list in
- let (mids_n,mids) = map_split string_mcode mids in
- let (ender_n,ender) = string_mcode ender in
- (multibind
- [starter_n;List.hd expr_list_n;
- multibind (List.map2 bind mids_n (List.tl expr_list_n));
- ender_n],
- Ast0.DisjExpr(starter,expr_list,mids,ender))
+ do_disj starter expr_list mids ender expression
+ (fun starter expr_list mids ender ->
+ Ast0.DisjExpr(starter,expr_list,mids,ender))
| Ast0.NestExpr(starter,expr_dots,ender,whencode,multi) ->
let (starter_n,starter) = string_mcode starter in
let (expr_dots_n,expr_dots) = expression_dots expr_dots in
| Ast0.Array(ty,lb,size,rb) -> array_type (ty,lb,size,rb) []
| Ast0.EnumName(kind,name) ->
let (kind_n,kind) = string_mcode kind in
- let (name_n,name) = ident name in
+ let (name_n,name) = get_option ident name in
(bind kind_n name_n, Ast0.EnumName(kind,name))
+ | Ast0.EnumDef(ty,lb,ids,rb) ->
+ let (ty_n,ty) = typeC ty in
+ let (lb_n,lb) = string_mcode lb in
+ let (ids_n,ids) = expression_dots ids in
+ let (rb_n,rb) = string_mcode rb in
+ (multibind [ty_n;lb_n;ids_n;rb_n], Ast0.EnumDef(ty,lb,ids,rb))
| Ast0.StructUnionName(kind,name) ->
let (kind_n,kind) = struct_mcode kind in
let (name_n,name) = get_option ident name in
let (name_n,name) = meta_mcode name in
(name_n,Ast0.MetaType(name,pure))
| Ast0.DisjType(starter,types,mids,ender) ->
- let (starter_n,starter) = string_mcode starter in
- let (types_n,types) = map_split typeC types in
- let (mids_n,mids) = map_split string_mcode mids in
- let (ender_n,ender) = string_mcode ender in
- (multibind
- [starter_n;List.hd types_n;
- multibind (List.map2 bind mids_n (List.tl types_n));
- ender_n],
- Ast0.DisjType(starter,types,mids,ender))
+ do_disj starter types mids ender typeC
+ (fun starter types mids ender ->
+ Ast0.DisjType(starter,types,mids,ender))
| Ast0.OptType(ty) ->
let (ty_n,ty) = typeC ty in (ty_n, Ast0.OptType(ty))
| Ast0.UniqueType(ty) ->
let k d =
rewrap d
(match Ast0.unwrap d with
- Ast0.Init(stg,ty,id,eq,ini,sem) ->
+ Ast0.MetaDecl(name,pure) ->
+ let (n,name) = meta_mcode name in
+ (n,Ast0.MetaDecl(name,pure))
+ | Ast0.MetaField(name,pure) ->
+ let (n,name) = meta_mcode name in
+ (n,Ast0.MetaField(name,pure))
+ | Ast0.MetaFieldList(name,lenname,pure) ->
+ let (n,name) = meta_mcode name in
+ (n,Ast0.MetaFieldList(name,lenname,pure))
+ | Ast0.Init(stg,ty,id,eq,ini,sem) ->
let (stg_n,stg) = get_option storage_mcode stg in
let ((ty_id_n,ty),id) = named_type ty id in
let (eq_n,eq) = string_mcode eq in
let (sem_n,sem) = string_mcode sem in
(multibind [stg_n;ty_n;id_n;sem_n], Ast0.Typedef(stg,ty,id,sem))
| Ast0.DisjDecl(starter,decls,mids,ender) ->
- let (starter_n,starter) = string_mcode starter in
- let (decls_n,decls) = map_split declaration decls in
- let (mids_n,mids) = map_split string_mcode mids in
- let (ender_n,ender) = string_mcode ender in
- (multibind
- [starter_n;List.hd decls_n;
- multibind (List.map2 bind mids_n (List.tl decls_n));
- ender_n],
- Ast0.DisjDecl(starter,decls,mids,ender))
+ do_disj starter decls mids ender declaration
+ (fun starter decls mids ender ->
+ Ast0.DisjDecl(starter,decls,mids,ender))
| Ast0.Ddots(dots,whencode) ->
let (dots_n,dots) = string_mcode dots in
let (whencode_n,whencode) = get_option declaration whencode in
Ast0.MetaInit(name,pure) ->
let (name_n,name) = meta_mcode name in
(name_n,Ast0.MetaInit(name,pure))
+ | Ast0.MetaInitList(name,lenname,pure) ->
+ let (name_n,name) = meta_mcode name in
+ (name_n,Ast0.MetaInitList(name,lenname,pure))
| Ast0.InitExpr(exp) ->
let (exp_n,exp) = expression exp in
(exp_n,Ast0.InitExpr(exp))
- | Ast0.InitList(lb,initlist,rb) ->
+ | Ast0.InitList(lb,initlist,rb,ordered) ->
let (lb_n,lb) = string_mcode lb in
let (initlist_n,initlist) = initialiser_list initlist in
let (rb_n,rb) = string_mcode rb in
- (multibind [lb_n;initlist_n;rb_n], Ast0.InitList(lb,initlist,rb))
+ (multibind [lb_n;initlist_n;rb_n],
+ Ast0.InitList(lb,initlist,rb,ordered))
| Ast0.InitGccExt(designators,eq,ini) ->
let (dn,designators) = map_split_bind designator designators in
let (eq_n,eq) = string_mcode eq in
(multibind [lbrace_n;body_n;rbrace_n],
Ast0.Seq(lbrace,body,rbrace))
| Ast0.ExprStatement(exp,sem) ->
- let (exp_n,exp) = expression exp in
+ let (exp_n,exp) = get_option expression exp in
let (sem_n,sem) = string_mcode sem in
(bind exp_n sem_n, Ast0.ExprStatement(exp,sem))
| Ast0.IfThen(iff,lp,exp,rp,branch1,aft) ->
let (name_n,name) = meta_mcode name in
(name_n,Ast0.MetaStmtList(name,pure))
| Ast0.Disj(starter,statement_dots_list,mids,ender) ->
- let (starter_n,starter) = string_mcode starter in
- let (s_n,statement_dots_list) =
- map_split statement_dots statement_dots_list in
- let (mids_n,mids) = map_split string_mcode mids in
- let (ender_n,ender) = string_mcode ender in
- (multibind
- [starter_n;List.hd s_n;
- multibind (List.map2 bind mids_n (List.tl s_n));
- ender_n],
- Ast0.Disj(starter,statement_dots_list,mids,ender))
+ do_disj starter statement_dots_list mids ender statement_dots
+ (fun starter statement_dots_list mids ender ->
+ Ast0.Disj(starter,statement_dots_list,mids,ender))
| Ast0.Nest(starter,stmt_dots,ender,whn,multi) ->
let (starter_n,starter) = string_mcode starter in
let (stmt_dots_n,stmt_dots) = statement_dots stmt_dots in
let (inc_n,inc) = string_mcode inc in
let (name_n,name) = inc_mcode name in
(bind inc_n name_n, Ast0.Include(inc,name))
+ | Ast0.Undef(def,id) ->
+ let (def_n,def) = string_mcode def in
+ let (id_n,id) = ident id in
+ (multibind [def_n;id_n],Ast0.Undef(def,id))
| Ast0.Define(def,id,params,body) ->
let (def_n,def) = string_mcode def in
let (id_n,id) = ident id in
(multibind [case_n;exp_n;colon_n;code_n],
Ast0.Case(case,exp,colon,code))
| Ast0.DisjCase(starter,case_lines,mids,ender) ->
- let (starter_n,starter) = string_mcode starter in
- let (case_lines_n,case_lines) = map_split case_line case_lines in
- let (mids_n,mids) = map_split string_mcode mids in
- let (ender_n,ender) = string_mcode ender in
- (multibind
- [starter_n;List.hd case_lines_n;
- multibind (List.map2 bind mids_n (List.tl case_lines_n));
- ender_n],
- Ast0.DisjCase(starter,case_lines,mids,ender))
+ do_disj starter case_lines mids ender case_line
+ (fun starter case_lines mids ender ->
+ Ast0.DisjCase(starter,case_lines,mids,ender))
| Ast0.OptCase(case) ->
let (n,case) = case_line case in (n,Ast0.OptCase(case))) in
casefn all_functions k c
let (old_file_n,old_file) = string_mcode old_file in
let (new_file_n,new_file) = string_mcode new_file in
(bind old_file_n new_file_n,Ast0.FILEINFO(old_file,new_file))
- | Ast0.DECL(statement_dots) ->
+ | Ast0.NONDECL(statement_dots) ->
let (n,statement_dots) = statement statement_dots in
- (n,Ast0.DECL(statement_dots))
+ (n,Ast0.NONDECL(statement_dots))
| Ast0.CODE(stmt_dots) ->
let (stmt_dots_n,stmt_dots) = statement_dots stmt_dots in
(stmt_dots_n, Ast0.CODE(stmt_dots))
+ | Ast0.TOPCODE(stmt_dots) ->
+ let (stmt_dots_n,stmt_dots) = statement_dots stmt_dots in
+ (stmt_dots_n, Ast0.TOPCODE(stmt_dots))
| Ast0.ERRORWORDS(exps) ->
let (n,exps) = map_split_bind expression exps in
(n, Ast0.ERRORWORDS(exps))
HCoop / bpt / coccinelle.git / blobdiff