(*
-* Copyright 2005-2009, 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 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.
+ *
+ * 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 | Ast.Space 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 print_pos = function
- Ast.MetaPos(name,_,_,_,_) ->
- let name = Ast.unwrap_mcode name in
- print_string "@"; print_meta name
- | _ -> ()
+let print_pos l =
+ List.iter
+ (function
+ Ast.MetaPos(name,_,_,_,_) ->
+ let name = Ast.unwrap_mcode name in
+ print_string "@"; print_meta name)
+ l
let mcode fn = function
(x, _, Ast.MINUS(_,_,adj,plus_stream), pos) ->
then print_string (if !Flag.sgrep_mode2 then "*" else "-");
fn x; print_pos pos;
if !print_plus_flag
- then print_anything ">>> " plus_stream
+ then
+ (match plus_stream with
+ Ast.NOREPLACEMENT -> ()
+ | Ast.REPLACEMENT(plus_stream,_) -> print_anything ">>> " plus_stream)
| (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) ->
print_string "MINUS";
- print_anything ">>> " plus_stream
+ (match plus_stream with
+ Ast.NOREPLACEMENT -> ()
+ | Ast.REPLACEMENT(plus_stream,_) -> 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
+
+(* --------------------------------------------------------------------- *)
+(* Disjunctions *)
+
+let print_disj_list fn l =
+ if !print_newlines_disj
+ then (force_newline(); print_string "("; force_newline())
+ else print_string "(";
+ print_between
+ (function _ ->
+ if !print_newlines_disj
+ then (force_newline(); print_string "|"; force_newline())
+ else print_string " | ")
+ fn l;
+ if !print_newlines_disj
+ then (force_newline(); print_string ")"; force_newline())
+ else print_string ")"
(* --------------------------------------------------------------------- *)
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 *)
| Ast.MetaId(name,_,keep,inherited) -> mcode print_meta name
| Ast.MetaFunc(name,_,_,_) -> mcode print_meta name
| Ast.MetaLocalFunc(name,_,_,_) -> mcode print_meta name
+ | Ast.DisjId(id_list) -> print_disj_list ident id_list
| Ast.OptIdent(id) -> print_string "?"; ident id
| Ast.UniqueIdent(id) -> print_string "!"; ident id
(* --------------------------------------------------------------------- *)
(* Expression *)
-let print_disj_list fn l =
- if !print_newlines_disj
- then (force_newline(); print_string "("; force_newline())
- else print_string "(";
- print_between
- (function _ ->
- if !print_newlines_disj
- then (force_newline(); print_string "|"; force_newline())
- else print_string " | ")
- fn l;
- if !print_newlines_disj
- then (force_newline(); print_string ")"; force_newline())
- else print_string ")"
-
let rec expression e =
match Ast.unwrap e with
Ast.Ident(id) -> ident id
| Ast.Assignment(left,op,right,simple) ->
expression left; print_string " "; mcode assignOp op;
print_string " "; expression right
+ | Ast.Sequence(left,op,right) ->
+ expression left; mcode print_string op;
+ print_string " "; expression right
| Ast.CondExpr(exp1,why,exp2,colon,exp3) ->
expression exp1; print_string " "; mcode print_string why;
print_option (function e -> print_string " "; expression e) exp2;
mcode print_string_box lp; fullType ty; close_box();
mcode print_string rp
| Ast.TypeExp(ty) -> fullType ty
+ | Ast.Constructor(lp,ty,rp,init) ->
+ mcode print_string_box lp; fullType ty; close_box();
+ mcode print_string rp; initialiser init
| Ast.MetaErr(name,_,_,_) -> mcode print_meta name
| Ast.MetaExpr(name,_,keep,ty,form,inherited) ->
mcode print_meta name; print_type keep inherited ty
| Ast.MetaExprList(name,_,_,_) -> mcode print_meta name
+ | Ast.AsExpr(exp,asexp) -> expression exp; print_string "@"; expression asexp
| 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 unaryOp = function
Ast.GetRef -> print_string "&"
+ | Ast.GetRefLabel -> print_string "&&"
| Ast.DeRef -> print_string "*"
| Ast.UnPlus -> print_string "+"
| Ast.UnMinus -> print_string "-"
and fullType ft =
match Ast.unwrap ft with
- Ast.Type(cv,ty) ->
+ Ast.Type(_,cv,ty) ->
print_option (function x -> mcode const_vol x; print_string " ") cv;
typeC ty
+ | Ast.AsType(ty,asty) -> fullType ty; print_string "@"; fullType asty
| Ast.DisjType(decls) -> print_disj_list fullType decls
| Ast.OptType(ty) -> print_string "?"; fullType ty
| Ast.UniqueType(ty) -> print_string "!"; fullType ty
| 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_string " ";
- ident name
+ | 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.VoidType -> print_string "void "
| Ast.CharType -> print_string "char "
| Ast.ShortType -> print_string "short "
+ | Ast.ShortIntType -> print_string "short int "
| Ast.IntType -> print_string "int "
| Ast.DoubleType -> print_string "double "
+ | Ast.LongDoubleType -> print_string "long double "
| Ast.FloatType -> print_string "float "
| Ast.LongType -> print_string "long "
+ | Ast.LongIntType -> print_string "long int "
| Ast.LongLongType -> print_string "long long "
+ | Ast.LongLongIntType -> print_string "long long int "
+ | 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 print_named_type ty id =
match Ast.unwrap ty with
- Ast.Type(None,ty1) ->
+ Ast.Type(_,None,ty1) ->
(match Ast.unwrap ty1 with
Ast.FunctionPointer(ty,lp1,star,rp1,lp2,params,rp2) ->
print_function_pointer (ty,lp1,star,rp1,lp2,params,rp2)
match Ast.unwrap ty with
Ast.Array(ty,lb,size,rb) ->
(match Ast.unwrap ty with
- Ast.Type(None,ty) ->
+ Ast.Type(_,cv,ty) ->
+ print_option
+ (function x -> mcode const_vol x; print_string " ")
+ cv;
loop ty
(function _ ->
k ();
and declaration d =
match Ast.unwrap d with
- Ast.Init(stg,ty,id,eq,ini,sem) ->
+ Ast.MetaDecl(name,_,_) | Ast.MetaField(name,_,_)
+ | Ast.MetaFieldList(name,_,_,_) ->
+ mcode print_meta name
+ | Ast.AsDecl(decl,asdecl) -> declaration decl; print_string "@";
+ declaration asdecl
+ | 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
ident name; mcode print_string_box lp;
dots (function _ -> ()) expression args;
close_box(); mcode print_string rp; mcode print_string sem
+ | Ast.MacroDeclInit(name,lp,args,rp,eq,ini,sem) ->
+ ident name; mcode print_string_box lp;
+ dots (function _ -> ()) expression args;
+ close_box(); mcode print_string rp;
+ print_string " "; mcode print_string eq;
+ print_string " "; initialiser ini; mcode print_string sem
| Ast.TyDecl(ty,sem) -> fullType ty; mcode print_string sem
| Ast.Typedef(stg,ty,id,sem) ->
mcode print_string stg; print_string " "; fullType ty; typeC id;
| 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
match Ast.unwrap i with
Ast.MetaInit(name,_,_) ->
mcode print_meta name; print_string " "
+ | Ast.MetaInitList(name,_,_,_) ->
+ mcode print_meta name; print_string " "
+ | Ast.AsInit(ini,asini) -> initialiser ini; print_string "@";
+ initialiser asini
| Ast.InitExpr(exp) -> expression exp
- | Ast.InitList(lb,initlist,rb,whencode) ->
+ | 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
| Ast.InitGccName(name,eq,ini) ->
ident name; mcode print_string eq; 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
let rec rule_elem arity re =
match Ast.unwrap re with
Ast.FunHeader(bef,allminus,fninfo,name,lp,params,rp) ->
- mcode (function _ -> ()) ((),Ast.no_info,bef,Ast.NoMetaPos);
+ mcode (function _ -> ()) ((),Ast.no_info,bef,[]);
print_string arity; List.iter print_fninfo fninfo;
ident name; mcode print_string_box lp;
parameter_list params; close_box(); mcode print_string rp;
print_string " "
| Ast.Decl(bef,allminus,decl) ->
- mcode (function _ -> ()) ((),Ast.no_info,bef,Ast.NoMetaPos);
+ mcode (function _ -> ()) ((),Ast.no_info,bef,[]);
print_string arity;
declaration decl
| Ast.SeqStart(brace) ->
if !print_newlines_disj then end_block();
print_string arity; mcode print_string brace
| Ast.ExprStatement(exp,sem) ->
- print_string arity; expression exp; mcode print_string sem
+ print_string arity; print_option expression exp; mcode print_string sem
| Ast.IfHeader(iff,lp,exp,rp) ->
print_string arity;
mcode print_string iff; print_string " "; mcode print_string_box lp;
| Ast.TopInit(init) -> initialiser init
| Ast.Include(inc,s) ->
mcode print_string inc; print_string " "; mcode inc_file s
+ | Ast.Undef(def,id) ->
+ mcode print_string def; print_string " "; ident id
| Ast.DefineHeader(def,id,params) ->
mcode print_string def; print_string " "; ident id;
print_define_parameters params
rule_elem arity rbrace
| Ast.IfThen(header,branch,(_,_,_,aft)) ->
rule_elem arity header; statement arity branch;
- mcode (function _ -> ()) ((),Ast.no_info,aft,Ast.NoMetaPos)
+ mcode (function _ -> ()) ((),Ast.no_info,aft,[])
| Ast.IfThenElse(header,branch1,els,branch2,(_,_,_,aft)) ->
rule_elem arity header; statement arity branch1; print_string " ";
rule_elem arity els; statement arity branch2;
- mcode (function _ -> ()) ((),Ast.no_info,aft,Ast.NoMetaPos)
+ mcode (function _ -> ()) ((),Ast.no_info,aft,[])
| Ast.While(header,body,(_,_,_,aft)) ->
rule_elem arity header; statement arity body;
- mcode (function _ -> ()) ((),Ast.no_info,aft,Ast.NoMetaPos)
+ mcode (function _ -> ()) ((),Ast.no_info,aft,[])
| Ast.Do(header,body,tail) ->
rule_elem arity header; statement arity body;
rule_elem arity tail
| Ast.For(header,body,(_,_,_,aft)) ->
rule_elem arity header; statement arity body;
- mcode (function _ -> ()) ((),Ast.no_info,aft,Ast.NoMetaPos)
+ mcode (function _ -> ()) ((),Ast.no_info,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) ->
+ mcode (function _ -> ()) ((),Ast.no_info,aft,[])
+ | 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.Define(header,body) ->
rule_elem arity header; print_string " ";
dots force_newline (statement arity) body
- | Ast.Nest(stmt_dots,whn,multi,_,_) ->
+ | Ast.AsStmt(stm,asstm) ->
+ statement arity stm; print_string "@"; statement arity asstm
+ | 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.FILEINFO(old_file,new_file) ->
print_string "--- "; mcode print_string old_file; force_newline();
print_string "+++ "; mcode print_string new_file
- | Ast.DECL(stmt) -> statement "" stmt
+ | Ast.NONDECL(stmt) -> statement "" stmt
| Ast.CODE(stmt_dots) ->
dots force_newline (statement "") stmt_dots
| Ast.ERRORWORDS(exps) ->
| 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) -> print_between force_newline print_string xs
+ | Ast.Pragma(xs) ->
+ let print = function
+ Ast.Noindent s | Ast.Indent s | Ast.Space 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.InitialScriptRule (lang,code) ->
- print_string "@@";
- force_newline();
- print_string ("initialize:" ^ lang);
- force_newline();
- print_string "@@";
- force_newline();
- print_string code;
- force_newline()
- | Ast.FinalScriptRule (lang,code) ->
- print_string "@@";
- force_newline();
- print_string ("finalize:" ^ lang);
- force_newline();
- print_string "@@";
- force_newline();
- print_string code;
- force_newline()
- | 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.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();
HCoop / bpt / coccinelle.git / blobdiff