(*
+ * 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.
module V0 = Visitor_ast0
module VT0 = Visitor_ast0_types
-type id = Id of string | Meta of (string * string)
+type id = Id of string | Meta of Ast.meta_name
let rec get_name name =
match Ast0.unwrap name with
- Ast0.Id(nm) -> Id(Ast0.unwrap_mcode nm)
- | Ast0.MetaId(nm,_,_) | Ast0.MetaFunc(nm,_,_)
- | Ast0.MetaLocalFunc(nm,_,_) -> Meta(Ast0.unwrap_mcode nm)
- | Ast0.OptIdent(id) | Ast0.UniqueIdent(id) ->
- get_name id
+ Ast0.Id(nm) -> [Id(Ast0.unwrap_mcode nm)]
+ | Ast0.MetaId(nm,_,_,_) | Ast0.MetaFunc(nm,_,_)
+ | Ast0.MetaLocalFunc(nm,_,_) -> [Meta(Ast0.unwrap_mcode nm)]
+ | Ast0.DisjId(_,id_list,_,_) -> List.concat (List.map get_name id_list)
+ | Ast0.OptIdent(id) | Ast0.UniqueIdent(id) ->
+ get_name id
(* --------------------------------------------------------------------- *)
(* collect all of the functions *)
match
List.filter (function Ast0.FType(_) -> true | _ -> false)
fninfo with [Ast0.FType(t)] -> Some t | _ -> None in
- [(get_name name,stm,
- Ast0.copywrap stm
- (Ast0.Decl((Ast0.default_info(),Ast0.context_befaft()),
- Ast0.copywrap stm
- (Ast0.UnInit
- (stg,
- Ast0.copywrap stm
- (Ast0.FunctionType(ty,lp,params,rp)),
- name,brace_to_semi lbrace)))))]
+ List.map
+ (function nm ->
+ (nm,stm,
+ Ast0.copywrap stm
+ (Ast0.Decl((Ast0.default_info(),Ast0.context_befaft()),
+ Ast0.copywrap stm
+ (Ast0.UnInit
+ (stg,
+ Ast0.copywrap stm
+ (Ast0.FunctionType(ty,lp,params,rp)),
+ name,brace_to_semi lbrace))))))
+ (get_name name)
| _ -> []
let collect_functions stmt_dots =
List.concat (List.map collect_function (Ast0.undots stmt_dots))
+let drop_positions =
+ let mcode (term,arity,info,mc,_,adj) =
+ (term,arity,info,mc,ref [],adj) in
+ let donothing r k e = k e in
+ let res =
+ V0.flat_rebuilder
+ mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
+ donothing donothing donothing donothing donothing donothing
+ donothing donothing donothing donothing donothing donothing donothing
+ donothing donothing in
+ res.VT0.rebuilder_rec_statement
+
let get_all_functions rule =
let res =
match Ast0.unwrap rule with
- Ast0.DECL(stmt) -> collect_function stmt
+ Ast0.NONDECL(stmt) -> collect_function stmt
| Ast0.CODE(rule_elem_dots) -> collect_functions rule_elem_dots
| _ -> [] in
List.map
(function (nm,def,vl) ->
(nm,
- (def,(Iso_pattern.rebuild_mcode None).VT0.rebuilder_rec_statement vl)))
+ (def,
+ drop_positions
+ ((Iso_pattern.rebuild_mcode None).VT0.rebuilder_rec_statement vl))))
res
(* --------------------------------------------------------------------- *)
Ast0.mcodekind = ref (Ast0.PLUS Ast.ONE)} in
let mcode (mc,_,_,_,_,_) =
(mc,Ast0.NONE,Ast0.default_info(),Ast0.PLUS Ast.ONE,
- ref Ast0.NoMetaPos,-1) in
+ ref [],-1) in
(* need a case for everything that has an unvisited component and can be in
- a function prototype *)
+ a function prototype. Also get rid of constraints because pcre
+ constraints cannot be compared. *)
let ident r k e =
donothing r k
(Ast0.rewrap e
(match Ast0.unwrap e with
- Ast0.MetaId(nm,constraints,pure) ->
- Ast0.MetaId(nm,constraints,Ast0.Pure)
+ Ast0.MetaId(nm,constraints,seed,pure) ->
+ Ast0.MetaId(nm,Ast.IdNoConstraint,seed,Ast0.Pure)
| Ast0.MetaFunc(nm,constraints,pure) ->
- Ast0.MetaFunc(nm,constraints,Ast0.Pure)
+ Ast0.MetaFunc(nm,Ast.IdNoConstraint,Ast0.Pure)
| Ast0.MetaLocalFunc(nm,constraints,pure) ->
- Ast0.MetaLocalFunc(nm,constraints,Ast0.Pure)
+ Ast0.MetaLocalFunc(nm,Ast.IdNoConstraint,Ast0.Pure)
| e -> e)) in
let typeC r k e =
Ast0.Param(ty,Some id) when all ->
(match Ast0.unwrap id with
Ast0.MetaId
- (((_,name),arity,info,mcodekind,pos,adj),constraints,pure) ->
+ (((_,name),arity,info,mcodekind,pos,adj),constraints,seed,pure) ->
let nm = ("__no_name__",new_name name) in
let new_id =
Ast0.rewrap id
(Ast0.MetaId
- ((nm,arity,info,mcodekind,pos,adj),constraints,Ast0.Pure)) in
+ ((nm,arity,info,mcodekind,pos,adj),constraints,seed,
+ Ast0.Pure)) in
([Ast.MetaIdDecl(Ast.NONE,nm)],
Ast0.rewrap param (Ast0.Param(ty,Some new_id)))
| _ -> ([],param))
let new_id =
Ast0.rewrap param
(Ast0.MetaParamList(Ast0.rewrap_mcode d nm,
- Some (Ast0.rewrap_mcode d nml),
+ Ast0.MetaListLen (Ast0.rewrap_mcode d nml),
Ast0.Pure)) in
- ([Ast.MetaParamListDecl(Ast.NONE,nm,Some nml);Ast.MetaListlenDecl(nml)],
+ ([Ast.MetaParamListDecl(Ast.NONE,nm,Ast.MetaLen nml);
+ Ast.MetaListlenDecl(nml)],
new_id)
| Ast0.OptParam(p) ->
let (metavars,p) = rename_param old_name all p in
Ast0.get_mcode_mcodekind lp in
let pdots =
("...",Ast0.NONE,info,mcodekind,
- ref Ast0.NoMetaPos,-1) in
+ ref [],-1) in
Ast0.DOTS
([Ast0.rewrap params
(Ast0.Pdots(pdots))])),
| _ -> dec)
| _ -> dec
+let mkcode proto =
+ Ast0.copywrap proto (Ast0.CODE(Ast0.copywrap proto (Ast0.DOTS [proto])))
+
let merge mproto pproto =
- let mproto =
- Compute_lines.compute_lines true
- [Ast0.copywrap mproto (Ast0.DECL mproto)] in
- let pproto =
- Compute_lines.compute_lines true
- [Ast0.copywrap pproto (Ast0.DECL pproto)] in
+ let mproto = Compute_lines.compute_lines true [mkcode mproto] in
+ let pproto = Compute_lines.compute_lines true [mkcode pproto] in
let (m,p) = List.split(Context_neg.context_neg mproto pproto) in
Insert_plus.insert_plus m p true (* no isos for protos *);
(* convert to ast so that the + code will fall down to the tokens
- and off the artificially added Ast0.DECL *)
+ and off the artificially added Ast0.CODE *)
let mproto = Ast0toast.ast0toast_toplevel (List.hd mproto) in
(* clean up the wrapping added above *)
match Ast.unwrap mproto with
- Ast.DECL mproto -> mproto
+ Ast.CODE mproto -> List.hd (Ast.undots mproto)
| _ -> failwith "not possible"
let make_rule rule_name = function
List.map
(function x ->
match Ast0.unwrap x with
- Ast0.DECL(stmt) ->
+ Ast0.NONDECL(stmt) ->
(match Ast0.unwrap stmt with
Ast0.FunDecl(_,fninfo,name,lp,params,rp,lbrace,body,rbrace) ->
- (try Ast0.rewrap x (Ast0.DECL(List.assoc name table))
+ (try Ast0.rewrap x (Ast0.NONDECL(List.assoc name table))
with Not_found -> x)
| _ -> x)
| Ast0.CODE(rule_elem_dots) ->
| (a,b,c,d)::rest ->
let (ax,bx,cx,dx) = split4 rest in (a::ax,b::bx,c::cx,d::dx)
+let mk_ast_code proto =
+ Ast.rewrap proto (Ast.CODE(Ast.rewrap proto (Ast.DOTS [proto])))
+
let process rule_name rule_metavars dropped_isos minus plus ruletype =
let minus_functions = List.concat (List.map get_all_functions minus) in
match minus_functions with
Ast.CocciRule
("proto for "^rule_name,
(Ast.Dep rule_name,dropped_isos,Ast.Forall),
- [Ast.rewrap x (Ast.DECL x)],
+ [mk_ast_code x],
[false],ruletype)))
| x::_ ->
let drules =
Ast.CocciRule
("proto for "^rule_name,
(Ast.Dep rule_name,dropped_isos,Ast.Forall),
- [Ast.rewrap x (Ast.DECL (Ast.rewrap x (Ast.Disj drules)))],
+ [mk_ast_code (Ast.rewrap x (Ast.Disj drules))],
[false],ruletype) in
((mdef_metavars,minus),Some(metavars,res))