+(*
+ * Copyright (C) 2010, University of Copenhagen DIKU and INRIA.
+ * Copyright (C) 2006, 2007 Julia Lawall
+ *
+ * This program is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU General Public License (GPL)
+ * version 2 as published by the Free Software Foundation.
+ *
+ * This program 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
+ * file license.txt for more details.
+ *
+ * This file was part of Coccinelle.
+ *)
+
module Ast = Ast_cocci
module V = Visitor_ast
[] any_list_list in
let mcode r mc =
match Ast.get_mcodekind mc with
- Ast.MINUS(_,any_list_list) -> do_any_list_list r any_list_list
+ Ast.MINUS(_,_,_,any_list_list) ->
+ (match any_list_list with
+ Ast.NOREPLACEMENT -> []
+ | Ast.REPLACEMENT(any_list_list,_) ->
+ do_any_list_list r any_list_list)
| Ast.CONTEXT(_,any_befaft) ->
(match any_befaft with
- Ast.BEFORE(any_list_list) | Ast.AFTER(any_list_list) ->
+ Ast.BEFORE(any_list_list,_) | Ast.AFTER(any_list_list,_) ->
do_any_list_list r any_list_list
- | Ast.BEFOREAFTER(ba,aa) ->
+ | Ast.BEFOREAFTER(ba,aa,_) ->
bind (do_any_list_list r ba) (do_any_list_list r aa)
| Ast.NOTHING -> [])
- | Ast.PLUS -> [] in
+ | Ast.PLUS _ -> [] in
let expression r k e =
bind (k e)
(match Ast.unwrap e with
[e] ->
(match Ast.unwrap e with
Ast.MetaExprList(nm,_,_,_) ->
- (match Ast.unwrap_mcode nm with
- (_,"ARGS") when Ast.get_mcodekind nm = Ast.PLUS ->
+ (match (Ast.unwrap_mcode nm,Ast.get_mcodekind nm) with
+ ((_,"ARGS"), Ast.PLUS _) ->
(match Ast.unwrap fn with
Ast.Ident(id) ->
(match Ast.unwrap id with
let names =
(V.combiner bind option_default
mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
- donothing donothing donothing donothing
+ donothing donothing donothing donothing donothing
donothing expression donothing donothing donothing donothing donothing
donothing donothing donothing donothing donothing).V.combiner_top_level
rule in
match names with
[name] ->
(match env_lookup (function nm -> nm = name) env with
- Ast_c.MetaIdVal(s) | Ast_c.MetaFuncVal(s)
+ Ast_c.MetaIdVal(s,_) | Ast_c.MetaFuncVal(s)
| Ast_c.MetaLocalFuncVal(s) -> s
| _ -> error rule "not possible")
| _ -> error rule "inconsistent rule generation"
| Ast_c.AbstractLineTok pi ->
Ast_c.AbstractLineTok { pi with Common.str = s;})}
-let rewrap_prefix_name prefix name =
+let rewrap_prefix_name prefix name =
match name with
- | Ast_c.RegularName (s, iiname) ->
- let iis = Common.tuple_of_list1 iiname in
+ | Ast_c.RegularName (s, iiname) ->
+ let iis = Common.tuple_of_list1 iiname in
let iis' = rewrap_str (prefix^s) iis in
Ast_c.RegularName (prefix ^ s, [iis'])
- | Ast_c.CppConcatenatedName _ | Ast_c.CppVariadicName _
+ | Ast_c.CppConcatenatedName _ | Ast_c.CppVariadicName _
| Ast_c.CppIdentBuilder _
-> raise Common.Todo
pr ("expression "^prefix); pr param
| ({Ast_c.p_namei = Some name; p_type = (_,ty)} : Ast_c.parameterType) ->
- let name' = rewrap_prefix_name prefix name in
+ let name' = rewrap_prefix_name prefix name in
print_typedef pr ty;
let print_extra_typedefs pr env =
let bigf =
{ Visitor_c.default_visitor_c with
- Visitor_c.ktype = (fun (k, bigf) ty ->
+ Visitor_c.ktype = (fun (k, bigf) ty ->
match ty with
(_,((Ast_c.TypeName(_,_),_) as ty)) -> print_typedef pr ty
| _ -> k ty) } in
match vl with
Ast_c.MetaIdVal(_) | Ast_c.MetaFuncVal(_)
| Ast_c.MetaLocalFuncVal(_) -> ()
- | Ast_c.MetaExprVal(exp) -> Visitor_c.vk_expr bigf exp
+ | Ast_c.MetaExprVal(exp,_) -> Visitor_c.vk_expr bigf exp
| Ast_c.MetaExprListVal(args) -> Visitor_c.vk_argument_list bigf args
| Ast_c.MetaParamVal(param) -> Visitor_c.vk_param bigf param
| Ast_c.MetaParamListVal(params) -> Visitor_c.vk_param_list bigf params
| Ast_c.MetaTypeVal(ty) -> Visitor_c.vk_type bigf ty
| Ast_c.MetaInitVal(ty) -> Visitor_c.vk_ini bigf ty
+ | Ast_c.MetaInitListVal(ty) -> Visitor_c.vk_ini_list bigf ty
+ | Ast_c.MetaDeclVal(decl) -> Visitor_c.vk_decl bigf decl
+ | Ast_c.MetaFieldVal(field) -> Visitor_c.vk_struct_field bigf field
+ | Ast_c.MetaFieldListVal(fields) -> Visitor_c.vk_struct_fields bigf fields
| Ast_c.MetaStmtVal(stm) -> Visitor_c.vk_statement bigf stm
| Ast_c.MetaPosVal _ | Ast_c.MetaPosValList _
| Ast_c.MetaListlenVal _ -> ())
env
let rename argids env =
- let argenv = List.map (function name ->
+ let argenv = List.map (function name ->
let arg = Ast_c.str_of_name name in
(arg,prefix^arg)
) argids in
let lookup x = try List.assoc x argenv with Not_found -> x in
let bigf =
{ Visitor_c.default_visitor_c_s with
- Visitor_c.kexpr_s = (fun (k,bigf) e ->
+ Visitor_c.kexpr_s = (fun (k,bigf) e ->
match e with
((Ast_c.Ident (name), info), []) ->
match vl with
Ast_c.MetaIdVal(_) | Ast_c.MetaFuncVal(_)
| Ast_c.MetaLocalFuncVal(_) -> vl
- | Ast_c.MetaExprVal(exp) ->
- Ast_c.MetaExprVal(Visitor_c.vk_expr_s bigf exp)
+ | Ast_c.MetaExprVal(exp,c) ->
+ Ast_c.MetaExprVal(Visitor_c.vk_expr_s bigf exp,c)
| Ast_c.MetaExprListVal(args) ->
Ast_c.MetaExprListVal(Visitor_c.vk_arguments_s bigf args)
| Ast_c.MetaParamVal(param) ->
Ast_c.MetaTypeVal(Visitor_c.vk_type_s bigf ty)
| Ast_c.MetaInitVal(ini) ->
Ast_c.MetaInitVal(Visitor_c.vk_ini_s bigf ini)
+ | Ast_c.MetaInitListVal(ini) ->
+ Ast_c.MetaInitListVal(Visitor_c.vk_inis_s bigf ini)
+ | Ast_c.MetaDeclVal(stm) ->
+ Ast_c.MetaDeclVal(Visitor_c.vk_decl_s bigf stm)
+ | Ast_c.MetaFieldVal(stm) ->
+ Ast_c.MetaFieldVal(Visitor_c.vk_struct_field_s bigf stm)
+ | Ast_c.MetaFieldListVal(stm) ->
+ Ast_c.MetaFieldListVal(Visitor_c.vk_struct_fields_s bigf stm)
| Ast_c.MetaStmtVal(stm) ->
Ast_c.MetaStmtVal(Visitor_c.vk_statement_s bigf stm)
| Ast_c.MetaPosVal _ | Ast_c.MetaPosValList _
(Type_cocci.MetaType(name,keep,inherited)) as ty ->
(try
match List.assoc name env with
- Ast_c.MetaTypeVal ty ->
+ Ast_c.MetaTypeVal ty ->
Pretty_print_c.pp_type_gen
(function x -> pr (Ast_c.str_of_info x))
(function _ -> pr " ")
types;
pr "}"
+let pp_len pr len =
+ let pp_name (_,n) = pr n in
+ match len with
+ Ast.AnyLen -> ()
+ | Ast.MetaLen len -> pr "["; pp_name len; pr "]"
+ | Ast.CstLen len -> pr "["; pr (string_of_int len); pr "]"
+
let pp_meta_decl pr env decl =
let no_arity = function Ast.NONE -> () | _ -> failwith "no arity allowed" in
let pp_name (_,n) = pr n in
match decl with
- Ast.MetaIdDecl(ar, name) ->
+ Ast.MetaMetaDecl(ar, name) ->
+ (* ignore virtual *)
+ no_arity ar; pr "metavariable "; pp_name name; pr ";\n"
+ | Ast.MetaIdDecl(ar, name) ->
+ (* ignore virtual *)
no_arity ar; pr "identifier "; pp_name name; pr ";\n"
- | Ast.MetaFreshIdDecl(name, None) ->
+ | Ast.MetaFreshIdDecl(name, Ast.NoVal) ->
pr "fresh identifier "; pp_name name; pr ";\n"
- | Ast.MetaFreshIdDecl(name, Some x) ->
+ | Ast.MetaFreshIdDecl(name, Ast.StringSeed x) ->
pr "fresh identifier "; pp_name name; pr " = \""; pr x; pr "\";\n"
+ | Ast.MetaFreshIdDecl(name, Ast.ListSeed x) ->
+ failwith "unparse_hrule: not supported"
| Ast.MetaTypeDecl(ar, name) ->
no_arity ar; pr "type "; pp_name name; pr ";\n"
| Ast.MetaInitDecl(ar, name) ->
no_arity ar; pr "initialiser "; pp_name name; pr ";\n"
+ | Ast.MetaInitListDecl(ar, name, len) ->
+ no_arity ar; pr "initialiser list "; pp_name name; pp_len pr len; pr ";\n"
| Ast.MetaListlenDecl(name) -> ()
| Ast.MetaParamDecl(ar, name) ->
no_arity ar; pr "parameter "; pp_name name; pr ";\n"
- | Ast.MetaParamListDecl(ar, name, None) ->
- no_arity ar; pr "parameter list "; pp_name name; pr ";\n"
- | Ast.MetaParamListDecl(ar, name, Some len) ->
- no_arity ar; pr "parameter list "; pp_name name;
- pr "["; pp_name len; pr "]"; pr ";\n"
+ | Ast.MetaParamListDecl(ar, name, len) ->
+ no_arity ar; pr "parameter list "; pp_name name; pp_len pr len; pr ";\n"
| Ast.MetaConstDecl(ar, name, types) ->
no_arity ar; pr "constant "; print_types pr env types;
pp_name name; pr ";\n"
| Ast.MetaLocalIdExpDecl(ar, name, types) ->
no_arity ar; pr "local idexpression ";
print_types pr env types; pp_name name; pr ";\n"
- | Ast.MetaExpListDecl(ar, name, None) ->
- no_arity ar; pr "parameter list "; pp_name name; pr ";\n"
- | Ast.MetaExpListDecl(ar, name, Some len) ->
- no_arity ar; pr "parameter list ";
- pp_name name; pr "["; pp_name len; pr "]"; pr ";\n"
+ | Ast.MetaExpListDecl(ar, name, len) ->
+ no_arity ar; pr "parameter list "; pp_name name; pp_len pr len; pr ";\n"
+ | Ast.MetaDeclDecl(ar, name) ->
+ no_arity ar; pr "declaration "; pp_name name; pr ";\n"
+ | Ast.MetaFieldDecl(ar, name) ->
+ no_arity ar; pr "field "; pp_name name; pr ";\n"
+ | Ast.MetaFieldListDecl(ar, name, len) ->
+ no_arity ar; pr "field list "; pp_name name; pp_len pr len; pr ";\n"
| Ast.MetaStmDecl(ar, name) ->
no_arity ar; pr "statement "; pp_name name; pr ";\n"
| Ast.MetaStmListDecl(ar, name) ->
Ast.CocciRule(_,_,[body],_,_) -> (* could extend to use attributes *)
(body,
match Ast.unwrap body with
- Ast.DECL(s) -> [[Ast.StatementTag s]]
+ Ast.NONDECL(s) -> [[Ast.StatementTag s]]
| Ast.CODE(ss) -> [[Ast.StmtDotsTag ss]]
| _ -> error body "bad rule body")
| _ -> failwith "bad rule" in
| _ ->
Printf.printf "line: %s\n" (Common.dump info);
error rule "not an abstract line" in
+ let pr_space _ = pr " " in
Unparse_cocci.pp_list_list_any
- (env, pr, pr_c, (function _ -> pr " "),
- (function _ -> ()), (function _ -> ()))
+ ([env], (fun s _ _ _ _ -> pr s), pr_c, pr_space, pr_space, pr,
+ (fun _ _ -> ()), (function _ -> ()), (function _ -> ()),
+ (function _ -> ()))
true printable Unparse_cocci.InPlace;
print_end pr;
pr "\n")
HCoop / bpt / coccinelle.git / blobdiff