+(*
+ * 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
module Ast = Ast_cocci
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
| 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
(* --------------------------------------------------------------------- *)
(* Contraint on Identifier and Function *)
(* FIXME: Not called at the moment *)
-let idconstraint c =
- match c with
- Ast.IdNoConstraint -> print_string "/* No constraint */"
- | Ast.IdNegIdSet ids -> List.iter (fun s -> print_string (" "^s)) ids
- | Ast.IdRegExp (re,_) -> print_string "~= \""; print_string re; print_string "\""
- | Ast.IdNotRegExp (re,_) -> print_string "~!= \""; print_string re; print_string "\""
+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.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) ->
Ast.MetaInit(name,_,_) ->
mcode print_meta name; print_string " "
| Ast.InitExpr(exp) -> expression exp
- | Ast.InitList(lb,initlist,rb,whencode) ->
+ | Ast.InitList(allminus,lb,initlist,rb,whencode) ->
mcode print_string lb; open_box 0;
if not (whencode = [])
then
| 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) -> print_between force_newline print_string xs
+ | 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
| 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.InitialScriptRule (lang,deps,code) ->
+ script_header "initialize" lang deps code
+ | Ast.FinalScriptRule (lang,deps,code) ->
+ script_header "finalize" lang deps code
| 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()
+ script_header "script" lang deps code
| Ast.CocciRule (nm, (deps, drops, exists), x, _, _) ->
print_string "@@";
force_newline();
HCoop / bpt / coccinelle.git / blobdiff