(*
-* 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.
+ *)
open Format
let print_around printer term = function
Ast.NOTHING -> printer term
- | Ast.BEFORE(bef) -> print_anything "<<< " bef; printer term
- | Ast.AFTER(aft) -> printer term; print_anything ">>> " aft
- | Ast.BEFOREAFTER(bef,aft) ->
+ | Ast.BEFORE(bef,_) -> print_anything "<<< " bef; printer term
+ | Ast.AFTER(aft,_) -> printer term; print_anything ">>> " aft
+ | Ast.BEFOREAFTER(bef,aft,_) ->
print_anything "<<< " bef; printer term; print_anything ">>> " aft
let print_string_befaft fn x info =
- List.iter (function s -> print_string s; force_newline())
- info.Ast.strbef;
+ let print = function Ast.Noindent s | Ast.Indent s -> print_string s in
+ List.iter (function (s,_,_) -> print s; force_newline()) info.Ast.strbef;
fn x;
- List.iter (function s -> force_newline(); print_string s)
- info.Ast.straft
+ List.iter (function (s,_,_) -> force_newline(); print s) info.Ast.straft
let print_meta (r,x) = print_string r; print_string ":"; print_string x
| _ -> ()
let mcode fn = function
- (x, _, Ast.MINUS(_,plus_stream), pos) ->
+ (x, _, Ast.MINUS(_,_,adj,plus_stream), pos) ->
if !print_minus_flag
then print_string (if !Flag.sgrep_mode2 then "*" else "-");
fn x; print_pos pos;
- if !print_plus_flag
+ if !print_plus_flag
then print_anything ">>> " plus_stream
- | (x, _, Ast.CONTEXT(_,plus_streams), pos) ->
+ | (x, _, Ast.CONTEXT(_,plus_streams), pos) ->
if !print_plus_flag
then
let fn x = fn x; print_pos pos in
print_around fn x plus_streams
else (fn x; print_pos pos)
- | (x, info, Ast.PLUS, pos) ->
+ | (x, info, Ast.PLUS _, pos) ->
let fn x = fn x; print_pos pos in
print_string_befaft fn x info
-let print_mcodekind = function
- Ast.MINUS(_,plus_stream) ->
+let print_mcodekind = function
+ Ast.MINUS(_,_,_,plus_stream) ->
print_string "MINUS";
print_anything ">>> " plus_stream
| Ast.CONTEXT(_,plus_streams) ->
print_around (function _ -> print_string "CONTEXT") () plus_streams
- | Ast.PLUS -> print_string "PLUS"
+ | Ast.PLUS _ -> print_string "PLUS"
(* --------------------------------------------------------------------- *)
(* --------------------------------------------------------------------- *)
| Ast.CIRCLES(l) -> print_between between fn l
| Ast.STARS(l) -> print_between between fn l
-let nest_dots multi fn f d =
- let mo s = if multi then "<+"^s else "<"^s in
- let mc s = if multi then s^"+>" else s^">" in
- match Ast.unwrap d with
- Ast.DOTS(l) ->
- print_string (mo "..."); f(); start_block();
- print_between force_newline fn l;
- end_block(); print_string (mc "...")
- | Ast.CIRCLES(l) ->
- print_string (mo "ooo"); f(); start_block();
- print_between force_newline fn l;
- end_block(); print_string (mc "ooo")
- | Ast.STARS(l) ->
- print_string (mo "***"); f(); start_block();
- print_between force_newline fn l;
- end_block(); print_string (mc "***")
+let nest_dots starter ender fn f d =
+ mcode print_string starter;
+ f(); start_block();
+ (match Ast.unwrap d with
+ Ast.DOTS(l) -> print_between force_newline fn l
+ | Ast.CIRCLES(l) -> print_between force_newline fn l
+ | Ast.STARS(l) -> print_between force_newline fn l);
+ end_block();
+ mcode print_string ender
(* --------------------------------------------------------------------- *)
print_string " inherited:"; print_bool inherited;*)
print_string " */"*)
+(* --------------------------------------------------------------------- *)
+(* Contraint on Identifier and Function *)
+(* FIXME: Not called at the moment *)
+
+let rec idconstraint = function
+ Ast.IdNoConstraint -> print_string "/* No constraint */"
+ | Ast.IdNegIdSet (str,meta) ->
+ List.iter (function s -> print_string (" "^s)) str;
+ List.iter (function (r,n) -> print_string " "; print_meta(r,n)) meta
+ | Ast.IdRegExpConstraint re -> regconstraint re
+
+and regconstraint = function
+ Ast.IdRegExp (re,_) ->
+ print_string "~= \""; print_string re; print_string "\""
+ | Ast.IdNotRegExp (re,_) ->
+ print_string "~!= \""; print_string re; print_string "\""
+
(* --------------------------------------------------------------------- *)
(* Identifier *)
let rec ident i =
match Ast.unwrap i with
- Ast.Id(name) -> mcode print_string name
- | Ast.MetaId(name,_,keep,inherited) -> mcode print_meta name
- | Ast.MetaFunc(name,_,_,_) -> mcode print_meta name
- | Ast.MetaLocalFunc(name,_,_,_) -> mcode print_meta name
- | Ast.OptIdent(id) -> print_string "?"; ident id
- | Ast.UniqueIdent(id) -> print_string "!"; ident id
+ Ast.Id(name) -> mcode print_string name
+ | Ast.MetaId(name,_,keep,inherited) -> mcode print_meta name
+ | Ast.MetaFunc(name,_,_,_) -> mcode print_meta name
+ | Ast.MetaLocalFunc(name,_,_,_) -> mcode print_meta name
+ | Ast.OptIdent(id) -> print_string "?"; ident id
+ | Ast.UniqueIdent(id) -> print_string "!"; ident id
and print_unitary = function
Type_cocci.Unitary -> print_string "unitary"
| Ast.MetaExprList(name,_,_,_) -> mcode print_meta name
| Ast.EComma(cm) -> mcode print_string cm; print_space()
| Ast.DisjExpr(exp_list) -> print_disj_list expression exp_list
- | Ast.NestExpr(expr_dots,Some whencode,multi) ->
- nest_dots multi expression
+ | Ast.NestExpr(starter,expr_dots,ender,Some whencode,multi) ->
+ nest_dots starter ender expression
(function _ -> print_string " when != "; expression whencode)
expr_dots
- | Ast.NestExpr(expr_dots,None,multi) ->
- nest_dots multi expression (function _ -> ()) expr_dots
+ | Ast.NestExpr(starter,expr_dots,ender,None,multi) ->
+ nest_dots starter ender expression (function _ -> ()) expr_dots
| Ast.Edots(dots,Some whencode)
| Ast.Ecircles(dots,Some whencode)
| Ast.Estars(dots,Some whencode) ->
and typeC ty =
match Ast.unwrap ty with
- Ast.BaseType(ty,sgn) -> print_option (mcode sign) sgn; mcode baseType ty
- | Ast.ImplicitInt(sgn) -> mcode sign sgn
+ Ast.BaseType(ty,strings) ->
+ List.iter (function s -> mcode print_string s; print_string " ") strings
+ | Ast.SignedT(sgn,ty) -> mcode sign sgn; print_option typeC ty
| Ast.Pointer(ty,star) -> fullType ty; mcode print_string star
| Ast.FunctionPointer(ty,lp1,star,rp1,lp2,params,rp2) ->
print_function_pointer (ty,lp1,star,rp1,lp2,params,rp2)
| Ast.Array(ty,lb,size,rb) ->
fullType ty; mcode print_string lb; print_option expression size;
mcode print_string rb
+ | Ast.EnumName(kind,name) ->
+ mcode print_string kind;
+ print_option (function x -> ident x; print_string " ") name
+ | Ast.EnumDef(ty,lb,ids,rb) ->
+ fullType ty; mcode print_string lb;
+ dots force_newline expression ids;
+ mcode print_string rb
| Ast.StructUnionName(kind,name) ->
mcode structUnion kind;
print_option (function x -> ident x; print_string " ") name
| Ast.DoubleType -> print_string "double "
| Ast.FloatType -> print_string "float "
| Ast.LongType -> print_string "long "
+ | Ast.LongLongType -> print_string "long long "
+ | Ast.SizeType -> print_string "size_t "
+ | Ast.SSizeType -> print_string "ssize_t "
+ | Ast.PtrDiffType -> print_string "ptrdiff_t "
and structUnion = function
Ast.Struct -> print_string "struct "
and declaration d =
match Ast.unwrap d with
- Ast.Init(stg,ty,id,eq,ini,sem) ->
+ Ast.MetaDecl(name,_,_) | Ast.MetaField(name,_,_) -> mcode print_meta name
+ | Ast.Init(stg,ty,id,eq,ini,sem) ->
print_option (mcode storage) stg; print_named_type ty id;
print_string " "; mcode print_string eq;
print_string " "; initialiser ini; mcode print_string sem
mcode print_string stg; print_string " "; fullType ty; typeC id;
mcode print_string sem
| Ast.DisjDecl(decls) -> print_disj_list declaration decls
- | Ast.Ddots(dots,Some whencode) ->
+ | Ast.Ddots(dots,Some whencode) ->
mcode print_string dots; print_string " when != "; declaration whencode
| Ast.Ddots(dots,None) -> mcode print_string dots
- | Ast.MetaDecl(name,_,_) -> mcode print_meta name
| Ast.OptDecl(decl) -> print_string "?"; declaration decl
| Ast.UniqueDecl(decl) -> print_string "!"; declaration decl
and initialiser i =
match Ast.unwrap i with
- Ast.InitExpr(exp) -> expression exp
- | Ast.InitList(lb,initlist,rb,whencode) ->
+ Ast.MetaInit(name,_,_) ->
+ mcode print_meta name; print_string " "
+ | Ast.InitExpr(exp) -> expression exp
+ | Ast.ArInitList(lb,initlist,rb) ->
+ mcode print_string lb; open_box 0;
+ dots force_newline initialiser initlist; close_box();
+ mcode print_string rb
+ | Ast.StrInitList(allminus,lb,initlist,rb,whencode) ->
mcode print_string lb; open_box 0;
if not (whencode = [])
then
force_newline());
List.iter initialiser initlist; close_box();
mcode print_string rb
- | Ast.InitGccDotName(dot,name,eq,ini) ->
- mcode print_string dot; ident name; print_string " ";
+ | Ast.InitGccExt(designators,eq,ini) ->
+ List.iter designator designators; print_string " ";
mcode print_string eq; print_string " "; initialiser ini
| Ast.InitGccName(name,eq,ini) ->
ident name; mcode print_string eq; initialiser ini
- | Ast.InitGccIndex(lb,exp,rb,eq,ini) ->
- mcode print_string lb; expression exp; mcode print_string rb;
- print_string " "; mcode print_string eq; print_string " ";
- initialiser ini
- | Ast.InitGccRange(lb,exp1,dots,exp2,rb,eq,ini) ->
- mcode print_string lb; expression exp1; mcode print_string dots;
- expression exp2; mcode print_string rb;
- print_string " "; mcode print_string eq; print_string " ";
- initialiser ini
| Ast.IComma(comma) -> mcode print_string comma; force_newline()
+ | Ast.Idots(dots,Some whencode) ->
+ mcode print_string dots; print_string " when != "; initialiser whencode
+ | Ast.Idots(dots,None) -> mcode print_string dots
| Ast.OptIni(ini) -> print_string "?"; initialiser ini
| Ast.UniqueIni(ini) -> print_string "!"; initialiser ini
+and designator = function
+ Ast.DesignatorField(dot,id) -> mcode print_string dot; ident id
+ | Ast.DesignatorIndex(lb,exp,rb) ->
+ mcode print_string lb; expression exp; mcode print_string rb
+ | Ast.DesignatorRange(lb,min,dots,max,rb) ->
+ mcode print_string lb; expression min; mcode print_string dots;
+ expression max; mcode print_string rb
+
(* --------------------------------------------------------------------- *)
(* Parameter *)
and statement arity s =
match Ast.unwrap s with
- Ast.Seq(lbrace,decls,body,rbrace) ->
+ Ast.Seq(lbrace,body,rbrace) ->
rule_elem arity lbrace;
- dots force_newline (statement arity) decls;
dots force_newline (statement arity) body;
rule_elem arity rbrace
| Ast.IfThen(header,branch,(_,_,_,aft)) ->
| Ast.Iterator(header,body,(_,_,_,aft)) ->
rule_elem arity header; statement arity body;
mcode (function _ -> ()) ((),Ast.no_info,aft,Ast.NoMetaPos)
- | Ast.Switch(header,lb,cases,rb) ->
+ | Ast.Switch(header,lb,decls,cases,rb) ->
rule_elem arity header; rule_elem arity lb;
+ dots force_newline (statement arity) decls;
List.iter (function x -> case_line arity x; force_newline()) cases;
rule_elem arity rb
| Ast.Atomic(re) -> rule_elem arity re
- | Ast.FunDecl(header,lbrace,decls,body,rbrace) ->
+ | Ast.FunDecl(header,lbrace,body,rbrace) ->
rule_elem arity header; rule_elem arity lbrace;
- dots force_newline (statement arity) decls;
dots force_newline (statement arity) body;
rule_elem arity rbrace
| Ast.Disj([stmt_dots]) ->
| Ast.Define(header,body) ->
rule_elem arity header; print_string " ";
dots force_newline (statement arity) body
- | Ast.Nest(stmt_dots,whn,multi,_,_) ->
+ | Ast.Nest(starter,stmt_dots,ender,whn,multi,_,_) ->
print_string arity;
- nest_dots multi (statement arity)
+ nest_dots starter ender (statement arity)
(function _ ->
open_box 0;
print_between force_newline
| Ast.ConstVolTag(x) -> const_vol x
| Ast.Token(x,Some info) -> print_string_befaft print_string x info
| Ast.Token(x,None) -> print_string x
+ | Ast.Pragma(xs) ->
+ let print = function Ast.Noindent s | Ast.Indent s -> print_string s in
+ print_between force_newline print xs
| Ast.Code(x) -> let _ = top_level x in ()
| Ast.ExprDotsTag(x) -> dots (function _ -> ()) expression x
| Ast.ParamDotsTag(x) -> parameter_list x
if not in_and
then print_or ()
else (print_string "("; print_or(); print_string ")")
- | Ast.NoDep -> failwith "not possible"
+ | Ast.NoDep -> print_string "no_dep"
+ | Ast.FailDep -> print_string "fail_dep"
+
+let script_header str lang deps code =
+ print_string "@@";
+ force_newline();
+ print_string (str ^ ":" ^ lang);
+ (match deps with
+ Ast.NoDep -> ()
+ | _ -> print_string " depends on "; dep true deps);
+ force_newline();
+ print_string "@@";
+ force_newline();
+ print_string code;
+ force_newline()
let unparse z =
match z with
- Ast.ScriptRule (lang,deps,bindings,code) ->
- print_string "@@";
- force_newline();
- print_string ("script:" ^ lang);
- (match deps with
- Ast.NoDep -> ()
- | _ -> print_string " depends on "; dep true deps);
- force_newline();
- print_string "@@";
- force_newline();
- print_string code;
- force_newline()
- | Ast.CocciRule (nm, (deps, drops, exists), x, _) ->
- print_string "@@";
- force_newline();
- print_string nm;
- (match deps with
- Ast.NoDep -> ()
- | _ -> print_string " depends on "; dep true deps);
+ Ast.InitialScriptRule (name,lang,deps,code) ->
+ script_header "initialize" lang deps code
+ | Ast.FinalScriptRule (name,lang,deps,code) ->
+ script_header "finalize" lang deps code
+ | Ast.ScriptRule (name,lang,deps,bindings,script_vars,code) ->
+ script_header "script" lang deps code
+ | Ast.CocciRule (nm, (deps, drops, exists), x, _, _) ->
+ print_string "@@";
+ force_newline();
+ print_string nm;
+ (match deps with
+ Ast.NoDep -> ()
+ | _ -> print_string " depends on "; dep true deps);
(*
print_string "line ";
print_int (Ast.get_line (List.hd x));
*)
- force_newline();
- print_string "@@";
- print_newlines_disj := true;
- force_newline();
- force_newline();
- rule x;
- force_newline()
+ force_newline();
+ print_string "@@";
+ print_newlines_disj := true;
+ force_newline();
+ force_newline();
+ rule x;
+ force_newline()
let rule_elem_to_string x =
print_newlines_disj := true;
HCoop / bpt / coccinelle.git / blobdiff