(*
-* 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.
-*)
+ * 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.
+ *)
(* exports everything, used only by parser_cocci_menhir.mly *)
type idinfo = Ast.meta_name * Data.iconstraints * Ast0.pure * Data.clt
type expinfo = Ast.meta_name * Data.econstraints * Ast0.pure * Data.clt
type tyinfo = Ast.meta_name * Ast0.typeC list * Ast0.pure * Data.clt
-type list_info = Ast.meta_name * Ast.meta_name option * Ast0.pure * Data.clt
-type typed_info =
+type list_info = Ast.meta_name * Ast.list_len * Ast0.pure * Data.clt
+type typed_expinfo =
Ast.meta_name * Data.econstraints * Ast0.pure *
Type_cocci.typeC list option * Data.clt
type pos_info = Ast.meta_name * Data.pconstraints * Ast.meta_collect * Data.clt
-
let get_option fn = function
None -> None
| Some x -> Some (fn x)
let make_info line logical_line offset col strbef straft =
- { Ast0.line_start = line; Ast0.line_end = line;
- Ast0.logical_start = logical_line; Ast0.logical_end = logical_line;
+ let new_pos_info =
+ {Ast0.line_start = line; Ast0.line_end = line;
+ Ast0.logical_start = logical_line; Ast0.logical_end = logical_line;
+ Ast0.column = col; Ast0.offset = offset; } in
+ { Ast0.pos_info = new_pos_info;
Ast0.attachable_start = true; Ast0.attachable_end = true;
Ast0.mcode_start = []; Ast0.mcode_end = [];
- Ast0.column = col; Ast0.offset = offset;
Ast0.strings_before = strbef; Ast0.strings_after = straft; }
let clt2info (_,line,logical_line,offset,col,strbef,straft,pos) =
let drop_aft (arity,line,lline,offset,col,strbef,straft,pos) =
(arity,line,lline,offset,col,strbef,[],pos)
+let drop_pos (arity,line,lline,offset,col,strbef,straft,pos) =
+ (arity,line,lline,offset,col,strbef,straft,Ast0.NoMetaPos)
+
let clt2mcode str = function
(Data.MINUS,line,lline,offset,col,strbef,straft,pos) ->
(str,Ast0.NONE,make_info line lline offset col strbef straft,
- Ast0.MINUS(ref([],Ast0.default_token_info)),ref pos)
+ Ast0.MINUS(ref([],Ast0.default_token_info)),ref pos,-1)
| (Data.OPTMINUS,line,lline,offset,col,strbef,straft,pos) ->
(str,Ast0.OPT,make_info line lline offset col strbef straft,
- Ast0.MINUS(ref([],Ast0.default_token_info)),ref pos)
+ Ast0.MINUS(ref([],Ast0.default_token_info)),ref pos,-1)
| (Data.UNIQUEMINUS,line,lline,offset,col,strbef,straft,pos) ->
(str,Ast0.UNIQUE,make_info line lline offset col strbef straft,
- Ast0.MINUS(ref([],Ast0.default_token_info)),ref pos)
+ Ast0.MINUS(ref([],Ast0.default_token_info)),ref pos,-1)
| (Data.PLUS,line,lline,offset,col,strbef,straft,pos) ->
- (str,Ast0.NONE,make_info line lline offset col strbef straft,Ast0.PLUS,
- ref pos)
+ (str,Ast0.NONE,make_info line lline offset col strbef straft,
+ Ast0.PLUS(Ast.ONE),ref pos,-1)
+ | (Data.PLUSPLUS,line,lline,offset,col,strbef,straft,pos) ->
+ (str,Ast0.NONE,make_info line lline offset col strbef straft,
+ Ast0.PLUS(Ast.MANY),ref pos,-1)
| (Data.CONTEXT,line,lline,offset,col,strbef,straft,pos) ->
(str,Ast0.NONE,make_info line lline offset col strbef straft,
Ast0.CONTEXT(ref(Ast.NOTHING,
Ast0.default_token_info,Ast0.default_token_info)),
- ref pos)
+ ref pos,-1)
| (Data.OPT,line,lline,offset,col,strbef,straft,pos) ->
(str,Ast0.OPT,make_info line lline offset col strbef straft,
Ast0.CONTEXT(ref(Ast.NOTHING,
Ast0.default_token_info,Ast0.default_token_info)),
- ref pos)
+ ref pos,-1)
| (Data.UNIQUE,line,lline,offset,col,strbef,straft,pos) ->
(str,Ast0.UNIQUE,make_info line lline offset col strbef straft,
Ast0.CONTEXT(ref(Ast.NOTHING,
Ast0.default_token_info,Ast0.default_token_info)),
- ref pos)
+ ref pos,-1)
let id2name (name, clt) = name
let id2clt (name, clt) = clt
| ("...",Some [w]) -> Ast0.wrap(Ast0.Ddots(clt2mcode str dot, Some w))
| _ -> failwith "cannot happen"
+let mkddots_one str (dot,whencode) =
+ match str with
+ "..." -> Ast0.wrap(Ast0.Ddots(clt2mcode str dot, whencode))
+ | _ -> failwith "cannot happen"
+
let mkpdots str dot =
match str with
"..." -> Ast0.wrap(Ast0.Pdots(clt2mcode str dot))
(function inner -> function cur -> Type_cocci.Pointer(inner))
ty m
+let arrayify ty ar =
+ List.fold_right
+ (function (l,i,r) ->
+ function rest ->
+ Ast0.wrap (Ast0.Array(rest,clt2mcode "[" l,i,clt2mcode "]" r)))
+ ar ty
+
(* Left is <=>, Right is =>. Collect <=>s. *)
(* The parser should have done this, with precedences. But whatever... *)
-let iso_adjust fn first rest =
+let iso_adjust first_fn fn first rest =
let rec loop = function
[] -> [[]]
| (Common.Left x)::rest ->
front::after -> []::(fn x::front)::after
| _ -> failwith "not possible") in
match loop rest with
- front::after -> (fn first::front)::after
+ front::after -> (first_fn first::front)::after
| _ -> failwith "not possible"
-let check_meta tok =
- let lookup rule name =
- try
- let info = Hashtbl.find Data.all_metadecls rule in
- List.find (function mv -> Ast.get_meta_name mv = (rule,name)) info
- with
- Not_found ->
- raise
- (Semantic_cocci.Semantic
- ("bad rule "^rule^" or bad variable "^name)) in
- match tok with
- Ast.MetaIdDecl(Ast.NONE,(rule,name)) ->
+let lookup rule name =
+ try
+ let info = Hashtbl.find Data.all_metadecls rule in
+ List.find (function mv -> Ast.get_meta_name mv = (rule,name)) info
+ with
+ Not_found ->
+ raise
+ (Semantic_cocci.Semantic("bad rule "^rule^" or bad variable "^name))
+
+let check_meta_tyopt type_irrelevant = function
+ Ast.MetaMetaDecl(Ast.NONE,(rule,name)) ->
+ (match lookup rule name with
+ Ast.MetaMetaDecl(_,_) -> ()
+ | _ ->
+ raise
+ (Semantic_cocci.Semantic
+ ("incompatible inheritance declaration "^name)))
+ | Ast.MetaIdDecl(Ast.NONE,(rule,name)) ->
(match lookup rule name with
Ast.MetaIdDecl(_,_) | Ast.MetaFreshIdDecl(_,_) -> ()
| _ ->
raise
(Semantic_cocci.Semantic
("incompatible inheritance declaration "^name)))
- | Ast.MetaFreshIdDecl(Ast.NONE,(rule,name)) ->
+ | Ast.MetaFreshIdDecl((rule,name),seed) ->
raise
(Semantic_cocci.Semantic
"can't inherit the freshness of an identifier")
raise
(Semantic_cocci.Semantic
("incompatible inheritance declaration "^name)))
+ | Ast.MetaInitDecl(Ast.NONE,(rule,name)) ->
+ (match lookup rule name with
+ Ast.MetaInitDecl(_,_) -> ()
+ | _ ->
+ raise
+ (Semantic_cocci.Semantic
+ ("incompatible inheritance declaration "^name)))
| Ast.MetaParamDecl(Ast.NONE,(rule,name)) ->
(match lookup rule name with
Ast.MetaParamDecl(_,_) -> ()
("incompatible inheritance declaration "^name)))
| Ast.MetaExpDecl(Ast.NONE,(rule,name),ty) ->
(match lookup rule name with
- Ast.MetaExpDecl(_,_,ty1) when ty = ty1 -> ()
+ Ast.MetaExpDecl(_,_,ty1) when type_irrelevant or ty = ty1 -> ()
| _ ->
raise
(Semantic_cocci.Semantic
("incompatible inheritance declaration "^name)))
| Ast.MetaIdExpDecl(Ast.NONE,(rule,name),ty) ->
(match lookup rule name with
- Ast.MetaIdExpDecl(_,_,ty1) when ty = ty1 -> ()
+ Ast.MetaIdExpDecl(_,_,ty1) when type_irrelevant or ty = ty1 -> ()
| _ ->
raise
(Semantic_cocci.Semantic
("incompatible inheritance declaration "^name)))
| Ast.MetaLocalIdExpDecl(Ast.NONE,(rule,name),ty) ->
(match lookup rule name with
- Ast.MetaLocalIdExpDecl(_,_,ty1) when ty = ty1 -> ()
+ Ast.MetaLocalIdExpDecl(_,_,ty1) when type_irrelevant or ty = ty1 -> ()
| _ ->
raise
(Semantic_cocci.Semantic
| Ast.MetaExpListDecl(Ast.NONE,(rule,name),len_name) ->
(match lookup rule name with
Ast.MetaExpListDecl(_,_,_) -> ()
+ | Ast.MetaParamListDecl(_,_,_) when not (!Flag.make_hrule = None) -> ()
| _ ->
raise
(Semantic_cocci.Semantic
("incompatible inheritance declaration "^name)))
| Ast.MetaConstDecl(Ast.NONE,(rule,name),ty) ->
(match lookup rule name with
- Ast.MetaConstDecl(_,_,ty1) when ty = ty1 -> ()
+ Ast.MetaConstDecl(_,_,ty1) when type_irrelevant or ty = ty1 -> ()
| _ ->
raise
(Semantic_cocci.Semantic
raise
(Semantic_cocci.Semantic ("arity not allowed on imported declaration"))
+let check_meta m = check_meta_tyopt false m
+
+let check_inherited_constraint meta_name fn =
+ match meta_name with
+ (None,_) -> failwith "constraint must be an inherited variable"
+ | (Some rule,name) ->
+ let i = (rule,name) in
+ check_meta_tyopt true (fn i);
+ i
+
let create_metadec ar ispure kindfn ids current_rule =
List.concat
(List.map
kindfn ar rule ispure checker)
ids)
-let create_metadec_ne ar ispure kindfn ids current_rule =
+
+let create_metadec_virt ar ispure kindfn ids current_rule =
List.concat
(List.map
- (function ((rule,nm),constraints) ->
+ (function nm ->
+ let checker = function x -> [Common.Right x] in
+ kindfn ar nm ispure checker !Flag.defined_virtual_env)
+ ids)
+
+let create_fresh_metadec kindfn ids current_rule =
+ List.concat
+ (List.map
+ (function ((rule,nm),seed) ->
let (rule,checker) =
match rule with
None -> ((current_rule,nm),function x -> [Common.Left x])
| Some rule ->
((rule,nm),
function x -> check_meta x; [Common.Right x]) in
- kindfn ar rule ispure checker constraints)
+ kindfn rule checker seed)
+ ids)
+
+let create_metadec_with_constraints ar ispure kindfn ids current_rule =
+ List.concat
+ (List.map
+ (function ((rule,nm),constraints) ->
+ let (rule,checker) =
+ match rule with
+ None -> ((current_rule,nm),function x -> [Common.Left x])
+ | Some rule ->
+ ((rule,nm),
+ function x -> check_meta x; [Common.Right x]) in
+ kindfn ar rule ispure checker constraints)
ids)
let create_metadec_ty ar ispure kindfn ids current_rule =
ids)
let create_len_metadec ar ispure kindfn lenid ids current_rule =
- let lendec =
- create_metadec Ast.NONE Ast0.Impure
- (fun _ name _ check_meta -> check_meta(Ast.MetaListlenDecl(name)))
- [lenid] current_rule in
- let lenname =
- match lendec with
- [Common.Left (Ast.MetaListlenDecl(x))] -> x
- | [Common.Right (Ast.MetaListlenDecl(x))] -> x
- | _ -> failwith "unexpected length declaration" in
+ let (lendec,lenname) =
+ match lenid with
+ Common.Left lenid ->
+ let lendec =
+ create_metadec Ast.NONE Ast0.Impure
+ (fun _ name _ check_meta -> check_meta(Ast.MetaListlenDecl(name)))
+ [lenid] current_rule in
+ let lenname =
+ match lendec with
+ [Common.Left (Ast.MetaListlenDecl(x))] -> Ast.MetaLen x
+ | [Common.Right (Ast.MetaListlenDecl(x))] -> Ast.MetaLen x
+ | _ -> failwith "unexpected length declaration" in
+ (lendec,lenname)
+ | Common.Right n -> ([],Ast.CstLen n) in
lendec@(create_metadec ar ispure (kindfn lenname) ids current_rule)
(* ---------------------------------------------------------------------- *)
List.map (function "..." -> Ast.IncDots | s -> Ast.IncPath s) elements
(* ---------------------------------------------------------------------- *)
-(* statements *)
+(* declarations and statements *)
+
+let meta_decl name =
+ let (nm,pure,clt) = name in
+ Ast0.wrap(Ast0.MetaDecl(clt2mcode nm clt,pure))
+
+let meta_field name =
+ let (nm,pure,clt) = name in
+ Ast0.wrap(Ast0.MetaField(clt2mcode nm clt,pure))
+
+let meta_field_list name =
+ let (nm,lenname,pure,clt) = name in
+ let lenname =
+ match lenname with
+ Ast.AnyLen -> Ast0.AnyListLen
+ | Ast.MetaLen nm -> Ast0.MetaListLen(clt2mcode nm clt)
+ | Ast.CstLen n -> Ast0.CstListLen n in
+ Ast0.wrap(Ast0.MetaFieldList(clt2mcode nm clt,lenname,pure))
let meta_stm name =
let (nm,pure,clt) = name in
Ast0.wrap(Ast0.Iterator(i,clt2mcode "(" lp,e,clt2mcode ")" rp,s,
(Ast0.default_info(),Ast0.context_befaft())))
-let switch s lp e rp lb c rb =
+let switch s lp e rp lb d c rb =
+ let d =
+ List.map
+ (function d ->
+ Ast0.wrap(Ast0.Decl((Ast0.default_info(),Ast0.context_befaft()),d)))
+ d in
Ast0.wrap(Ast0.Switch(clt2mcode "switch" s,clt2mcode "(" lp,e,
clt2mcode ")" rp,clt2mcode "{" lb,
+ Ast0.wrap(Ast0.DOTS(d)),
Ast0.wrap(Ast0.DOTS(c)),clt2mcode "}" rb))
let ret_exp r e pv =
(* ---------------------------------------------------------------------- *)
-let make_iso_rule_name_result n =
- (try let _ = Hashtbl.find Data.all_metadecls n in
- raise (Semantic_cocci.Semantic ("repeated rule name"))
- with Not_found -> ());
- Ast.CocciRulename (Some n,Ast.NoDep,[],[],Ast.Undetermined,false (*discarded*))
-
-let make_cocci_rule_name_result nm d i a e ee =
- match nm with
+let check_rule_name = function
Some nm ->
let n = id2name nm in
(try let _ = Hashtbl.find Data.all_metadecls n in
raise (Semantic_cocci.Semantic ("repeated rule name"))
- with Not_found -> ());
- Ast.CocciRulename (Some n,d,i,a,e,ee)
- | None -> Ast.CocciRulename (None,d,i,a,e,ee)
+ with Not_found -> Some n)
+ | None -> None
+
+let make_iso_rule_name_result n =
+ (try let _ = Hashtbl.find Data.all_metadecls n in
+ raise (Semantic_cocci.Semantic ("repeated rule name"))
+ with Not_found -> ());
+ Ast.CocciRulename
+ (Some n,Ast.NoDep,[],[],Ast.Undetermined,false (*discarded*))
+
+let make_cocci_rule_name_result nm d i a e ee =
+ Ast.CocciRulename (check_rule_name nm,d,i,a,e,ee)
-let make_script_rule_name_result lang deps =
+let make_generated_rule_name_result nm d i a e ee =
+ Ast.GeneratedRulename (check_rule_name nm,d,i,a,e,ee)
+
+let make_script_rule_name_result lang nm deps =
+ let l = id2name lang in
+ Ast.ScriptRulename (check_rule_name nm,l,deps)
+
+let make_initial_script_rule_name_result lang deps =
let l = id2name lang in
- Ast.ScriptRulename (l,deps)
+ Ast.InitialScriptRulename(None,l,deps)
+
+let make_final_script_rule_name_result lang deps =
+ let l = id2name lang in
+ Ast.FinalScriptRulename(None,l,deps)
+
+(* Allows type alone only when it is void and only when there is only one
+ parameter. This avoids ambiguity problems in the parser. *)
+let verify_parameter_declarations = function
+ [] -> ()
+ | [x] ->
+ (match Ast0.unwrap x with
+ Ast0.Param(t, None) ->
+ (match Ast0.unwrap t with
+ Ast0.BaseType(Ast.VoidType,_) -> ()
+ | _ ->
+ failwith
+ (Printf.sprintf
+ "%d: only void can be a parameter without an identifier"
+ (Ast0.get_line t)))
+ | _ -> ())
+ | l ->
+ List.iter
+ (function x ->
+ match Ast0.unwrap x with
+ Ast0.Param(t, None) ->
+ failwith
+ (Printf.sprintf
+ "%d: only void alone can be a parameter without an identifier"
+ (Ast0.get_line t))
+ | _ -> ())
+ l
+
+(* ---------------------------------------------------------------------- *)
+(* decide whether an init list is ordered or unordered *)
+
+let struct_initializer initlist =
+ let rec loop i =
+ match Ast0.unwrap i with
+ Ast0.InitGccExt _ -> true
+ | Ast0.InitGccName _ -> true
+ | Ast0.OptIni i | Ast0.UniqueIni i -> loop i
+ | Ast0.MetaInit _ -> true (* ambiguous... *)
+ | _ -> false in
+ let l = Ast0.undots initlist in
+ (l = []) or (List.exists loop l)
+
+let drop_dot_commas initlist =
+ match Ast0.unwrap initlist with
+ Ast0.DOTS(l) ->
+ let rec loop after_comma = function
+ [] -> []
+ | x::xs ->
+ (match Ast0.unwrap x with
+ Ast0.Idots(dots,whencode) -> x :: (loop true xs)
+ | Ast0.IComma(comma) when after_comma -> (*drop*) loop false xs
+ | _ -> x :: (loop false xs)) in
+ Ast0.rewrap initlist (Ast0.DOTS(loop false l))
+ | _ -> failwith "not supported"
HCoop / bpt / coccinelle.git / blobdiff