(*****************************************************************************)
type pos = Before | After | InPlace
+type nlhint = StartBox | EndBox | SpaceOrNewline of string ref
+
+let get_string_info = function
+ Ast.Noindent s | Ast.Indent s | Ast.Space s -> s
let unknown = -1
let rec do_all
(env, pr, pr_celem, pr_cspace, pr_space, pr_arity, pr_barrier,
- indent, unindent)
+ indent, unindent, eatspace)
generating xxs before =
(* Just to be able to copy paste the code from pretty_print_cocci.ml. *)
let print_string s line lcol =
let rcol = if lcol = unknown then unknown else lcol + (String.length s) in
- pr s line lcol rcol in
-let print_text s = pr s unknown unknown unknown in
+ pr s line lcol rcol None in
+let print_string_with_hint hint s line lcol =
+ let rcol = if lcol = unknown then unknown else lcol + (String.length s) in
+ pr s line lcol rcol (Some hint) in
+let print_text s = pr s unknown unknown unknown None in
let close_box _ = () in
let force_newline _ = print_text "\n" in
let start_block () = force_newline(); indent() in
-let end_block () = unindent(); force_newline () in
+let end_block () = unindent true; force_newline () in
let print_string_box s = print_string s in
let print_option = Common.do_option in
let pretty_print_c =
Pretty_print_c.mk_pretty_printers pr_celem pr_cspace
- force_newline indent outdent unindent in
+ force_newline indent outdent (function _ -> unindent true) in
(* --------------------------------------------------------------------- *)
(* Only for make_hrule, print plus code, unbound metavariables *)
print_anything bef; printer term; print_anything aft in
let print_string_befaft fn fn1 x info =
+ let print ln col s = print_string (get_string_info s) ln col in
List.iter
- (function (s,ln,col) -> fn1(); print_string s ln col; force_newline())
+ (function (s,ln,col) -> fn1(); print ln col s; force_newline())
info.Ast.strbef;
fn x;
List.iter
- (function (s,ln,col) -> force_newline(); fn1(); print_string s ln col)
+ (function (s,ln,col) -> force_newline(); fn1(); print ln col s)
info.Ast.straft in
let print_meta (r,x) = print_text x in
-let print_pos = function
- Ast.MetaPos(name,_,_,_,_) ->
- let name = Ast.unwrap_mcode name in
- print_text "@"; print_meta name
- | _ -> () in
+let print_pos l =
+ List.iter
+ (function
+ Ast.MetaPos(name,_,_,_,_) ->
+ let name = Ast.unwrap_mcode name in
+ print_text "@"; print_meta name)
+ l in
(* --------------------------------------------------------------------- *)
(function line_before ->
function (str,line,col) ->
match line_before with
- None -> print_string str line col; Some line
- | Some lb when line =|= lb ->
+ None ->
+ let str =
+ match str with
+ Ast.Noindent s -> unindent false; s
+ | Ast.Indent s -> s
+ | Ast.Space s -> s in
print_string str line col; Some line
- | _ -> force_newline(); print_string str line col; Some line)
+ | Some lb when line =|= lb ->
+ print_string (get_string_info str) line col; Some line
+ | _ ->
+ force_newline();
+ (* not super elegant to put side-effecting unindent in a let
+ expression... *)
+ let str =
+ match str with
+ Ast.Noindent s -> unindent false; s
+ | Ast.Indent s -> s
+ | Ast.Space s -> s in
+ print_string str line col; Some line)
lb comments in
let line_before = print_comments None info.Ast.strbef in
(match line_before with
should really store parsed versions of the strings, but make a cheap
effort here
print_comments takes care of interior newlines *)
- (match List.rev info.Ast.straft with
- (str,_,_)::_ when String.length str > 0 && String.get str 0 = '#' ->
- force_newline()
- | _ -> ());
()
(* printing for rule generation *)
| (true, Ast.MINUS(_,_,_,plus_stream)) ->
force_newline();
print_text "- ";
fn s line lcol; print_pos pos;
- print_anything plus_stream
+ (match plus_stream with
+ Ast.NOREPLACEMENT -> ()
+ | Ast.REPLACEMENT(plus_stream,ct) -> print_anything plus_stream)
| (true, Ast.CONTEXT(_,plus_streams)) ->
let fn s = force_newline(); fn s line lcol; print_pos pos in
print_around fn s plus_streams
(* call mcode to preserve the -+ annotation *)
mcode (fun _ _ _ -> fn e) name
else fn e);
- let rcol = if lcol = unknown then unknown else lcol + (String.length b) in
+ let rcol =
+ if lcol = unknown then unknown else lcol + (String.length b) in
pr_barrier line rcol
in
(* --------------------------------------------------------------------- *)
| Ast.STARS(l) -> print_between between fn l
in
-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_text (mo "..."); f(); start_block();
- print_between force_newline fn l;
- end_block(); print_text (mc "...")
- | Ast.CIRCLES(l) ->
- print_text (mo "ooo"); f(); start_block();
- print_between force_newline fn l;
- end_block(); print_text (mc "ooo")
- | Ast.STARS(l) ->
- print_text (mo "***"); f(); start_block();
- print_between force_newline fn l;
- end_block(); print_text (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
in
+let print_disj_list fn l =
+ print_text "\n(\n";
+ print_between (function _ -> print_text "\n|\n") fn l;
+ print_text "\n)\n" in
+
(* --------------------------------------------------------------------- *)
(* Identifier *)
Ast.Id(name) -> mcode print_string name
| Ast.MetaId(name,_,_,_) ->
handle_metavar name (function
- | (Ast_c.MetaIdVal id) -> print_text id
+ | (Ast_c.MetaIdVal (id,_)) -> print_text id
| _ -> raise Impossible
)
| Ast.MetaFunc(name,_,_,_) ->
| _ -> raise Impossible
)
+ | Ast.DisjId(id_list) ->
+ if generating
+ then print_disj_list ident id_list
+ else raise CantBeInPlus
| Ast.OptIdent(_) | Ast.UniqueIdent(_) ->
raise CantBeInPlus
(* --------------------------------------------------------------------- *)
(* Expression *)
-let print_disj_list fn l =
- print_text "\n(\n";
- print_between (function _ -> print_text "\n|\n") fn l;
- print_text "\n)\n" in
-
let rec expression e =
match Ast.unwrap e with
Ast.Ident(id) -> ident id
| Ast.Constant(const) -> mcode constant const
| Ast.FunCall(fn,lp,args,rp) ->
- expression fn; mcode print_string_box lp;
- let comma e =
- expression e;
- match Ast.unwrap e with
- Ast.EComma(cm) -> pr_space()
- | _ -> () in
- dots (function _ -> ()) comma args;
- close_box(); mcode print_string rp
+ expression fn; mcode (print_string_with_hint StartBox) lp;
+ dots (function _ -> ()) arg_expression args;
+ mcode (print_string_with_hint EndBox) rp
| Ast.Assignment(left,op,right,_) ->
expression left; pr_space(); mcode assignOp op;
pr_space(); expression right
| Ast.CondExpr(exp1,why,exp2,colon,exp3) ->
expression exp1; pr_space(); mcode print_string why;
print_option (function e -> pr_space(); expression e) exp2;
- pr_space(); mcode print_string colon; expression exp3
+ pr_space(); mcode print_string colon; pr_space(); expression exp3
| Ast.Postfix(exp,op) -> expression exp; mcode fixOp op
| Ast.Infix(exp,op) -> mcode fixOp op; expression exp
| Ast.Unary(exp,op) -> mcode unaryOp op; expression exp
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 true init
| Ast.MetaErr(name,_,_,_) ->
failwith "metaErr not handled"
| Ast.MetaExpr (name,_,_,_typedontcare,_formdontcare,_) ->
handle_metavar name (function
- | Ast_c.MetaExprVal exp ->
+ | Ast_c.MetaExprVal (exp,_) ->
pretty_print_c.Pretty_print_c.expression exp
| _ -> raise Impossible
)
handle_metavar name (function
| Ast_c.MetaExprListVal args ->
pretty_print_c.Pretty_print_c.arg_list args
+ | Ast_c.MetaParamListVal _ ->
+ failwith "have meta param list matching meta exp list\n";
| _ -> raise Impossible
)
if generating
then print_disj_list expression exp_list
else raise CantBeInPlus
- | Ast.NestExpr(expr_dots,Some whencode,multi) when generating ->
- nest_dots multi expression
+ | Ast.NestExpr(starter,expr_dots,ender,Some whencode,multi)
+ when generating ->
+ nest_dots starter ender expression
(function _ -> print_text " when != "; expression whencode)
expr_dots
- | Ast.NestExpr(expr_dots,None,multi) when generating ->
- nest_dots multi expression (function _ -> ()) expr_dots
- | Ast.NestExpr(_) -> raise CantBeInPlus
+ | Ast.NestExpr(starter,expr_dots,ender,None,multi) when generating ->
+ nest_dots starter ender expression (function _ -> ()) expr_dots
+ | Ast.NestExpr _ -> raise CantBeInPlus
| Ast.Edots(dots,Some whencode)
| Ast.Ecircles(dots,Some whencode)
| Ast.Estars(dots,Some whencode) ->
| Ast.OptExp(exp) | Ast.UniqueExp(exp) ->
raise CantBeInPlus
+and arg_expression e =
+ match Ast.unwrap e with
+ Ast.EComma(cm) ->
+ (* space is only used by add_newline, and only if not using SMPL
+ spacing. pr_cspace uses a " " in unparse_c.ml. Not so nice... *)
+ mcode (print_string_with_hint (SpaceOrNewline (ref " "))) cm
+ | _ -> expression e
+
and unaryOp = function
Ast.GetRef -> print_string "&"
+ | Ast.GetRefLabel -> print_string "&&"
| Ast.DeRef -> print_string "*"
| Ast.UnPlus -> print_string "+"
| Ast.UnMinus -> print_string "-"
| Ast.Logical(lop) -> logicalOp lop
and arithOp = function
- Ast.Plus -> print_string "+"
+ Ast.Plus -> print_string "+"
| Ast.Minus -> print_string "-"
| Ast.Mul -> print_string "*"
| Ast.Div -> print_string "/"
Ast.BaseType(ty,strings) ->
print_between pr_space (mcode print_string) strings
| Ast.SignedT(sgn,ty) -> mcode sign sgn; print_option_prespace typeC ty
- | Ast.Pointer(ty,star) -> fullType ty; ft_space ty; mcode print_string star
+ | Ast.Pointer(ty,star) ->
+ fullType ty; ft_space ty; mcode print_string star; eatspace()
| Ast.FunctionPointer(ty,lp1,star,rp1,lp2,params,rp2) ->
print_function_pointer (ty,lp1,star,rp1,lp2,params,rp2)
(function _ -> ())
| 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; pr_space();
- ident name
+ | Ast.EnumName(kind,name) ->
+ mcode print_string kind;
+ print_option_prespace ident name
+ | Ast.EnumDef(ty,lb,ids,rb) ->
+ fullType ty; ft_space ty;
+ mcode print_string lb;
+ dots force_newline expression ids;
+ mcode print_string rb
| Ast.StructUnionName(kind,name) ->
mcode structUnion kind; print_option_prespace ident name
| Ast.StructUnionDef(ty,lb,decls,rb) ->
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"
Ast.Type(cv,ty) ->
(match Ast.unwrap ty with
Ast.Pointer(_,_) -> ()
+ | Ast.MetaType(name,_,_) ->
+ (match List.assoc (Ast.unwrap_mcode name) env with
+ Ast_c.MetaTypeVal (tq,ty) ->
+ (match Ast_c.unwrap ty with
+ Ast_c.Pointer(_,_) -> ()
+ | _ -> pr_space())
+ | _ -> pr_space())
| _ -> pr_space())
| _ -> pr_space()
and declaration d =
match Ast.unwrap d with
- Ast.Init(stg,ty,id,eq,ini,sem) ->
+ Ast.MetaDecl(name,_,_) ->
+ handle_metavar name
+ (function
+ Ast_c.MetaDeclVal d ->
+ pretty_print_c.Pretty_print_c.decl d
+ | _ -> raise Impossible)
+ | Ast.MetaField(name,_,_) ->
+ handle_metavar name
+ (function
+ Ast_c.MetaFieldVal f ->
+ pretty_print_c.Pretty_print_c.field f
+ | _ -> raise Impossible)
+
+ | Ast.MetaFieldList(name,_,_,_) ->
+ handle_metavar name
+ (function
+ Ast_c.MetaFieldListVal f ->
+ print_between force_newline pretty_print_c.Pretty_print_c.field f
+ | _ -> raise Impossible)
+
+ | Ast.Init(stg,ty,id,eq,ini,sem) ->
print_option (mcode storage) stg;
print_option (function _ -> pr_space()) stg;
print_named_type ty id;
mcode print_string stg;
fullType ty; typeC id;
mcode print_string sem
- | Ast.DisjDecl(_) | Ast.MetaDecl(_,_,_) -> raise CantBeInPlus
+ | Ast.DisjDecl(_) -> raise CantBeInPlus
| Ast.Ddots(_,_) -> raise CantBeInPlus
| Ast.OptDecl(decl) | Ast.UniqueDecl(decl) ->
raise CantBeInPlus
Ast_c.MetaInitVal ini ->
pretty_print_c.Pretty_print_c.init ini
| _ -> raise Impossible)
+ | Ast.MetaInitList(name,_,_,_) ->
+ handle_metavar name (function
+ Ast_c.MetaInitListVal ini ->
+ pretty_print_c.Pretty_print_c.init_list ini
+ | _ -> raise Impossible)
| Ast.InitExpr(exp) -> expression exp
- | Ast.InitList(lb,initlist,rb,[]) ->
+ | Ast.ArInitList(lb,initlist,rb) ->
+ (match Ast.undots initlist with
+ [] -> mcode print_string lb; mcode print_string rb
+ | lst ->
+ mcode print_string lb; start_block();
+ initialiser_list nlcomma lst;
+ end_block(); mcode print_string rb)
+ | Ast.StrInitList(_,lb,[],rb,[]) ->
+ mcode print_string lb; mcode print_string rb
+ | Ast.StrInitList(_,lb,initlist,rb,[]) ->
mcode print_string lb; start_block();
- (* awkward, because the comma is separate from the initialiser *)
- let rec loop = function
- [] -> ()
- | [x] -> initialiser false x
- | x::xs -> initialiser nlcomma x; loop xs in
- loop initlist;
+ initialiser_list nlcomma initlist;
end_block(); mcode print_string rb
- | Ast.InitList(lb,initlist,rb,_) -> failwith "unexpected whencode in plus"
+ | Ast.StrInitList(_,lb,initlist,rb,_) ->
+ failwith "unexpected whencode in plus"
| Ast.InitGccExt(designators,eq,ini) ->
List.iter designator designators; pr_space();
mcode print_string eq; pr_space(); initialiser nlcomma ini
ident name; mcode print_string eq; initialiser nlcomma ini
| Ast.IComma(comma) ->
mcode print_string comma;
- if nlcomma then force_newline()
+ if nlcomma then force_newline() else pr_space()
+ | Ast.Idots(dots,Some whencode) ->
+ if generating
+ then
+ (mcode print_string dots;
+ print_text " when != ";
+ initialiser nlcomma whencode)
+ else raise CantBeInPlus
+ | Ast.Idots(dots,None) ->
+ if generating
+ then mcode print_string dots
+ else raise CantBeInPlus
| Ast.OptIni(ini) | Ast.UniqueIni(ini) ->
raise CantBeInPlus
+and initialiser_list nlcomma = function
+ (* awkward, because the comma is separate from the initialiser *)
+ [] -> ()
+ | [x] -> initialiser false x
+ | x::xs -> initialiser nlcomma x; initialiser_list nlcomma xs
+
and designator = function
Ast.DesignatorField(dot,id) -> mcode print_string dot; ident id
| Ast.DesignatorIndex(lb,exp,rb) ->
| Ast.Param(ty,None) -> fullType ty
| Ast.MetaParam(name,_,_) ->
- failwith "not handling MetaParam"
+ handle_metavar name
+ (function
+ Ast_c.MetaParamVal p ->
+ pretty_print_c.Pretty_print_c.param p
+ | _ -> raise Impossible)
| Ast.MetaParamList(name,_,_,_) ->
- failwith "not handling MetaParamList"
+ handle_metavar name
+ (function
+ Ast_c.MetaParamListVal p ->
+ pretty_print_c.Pretty_print_c.paramlist p
+ | _ -> raise Impossible)
| Ast.PComma(cm) -> mcode print_string cm
| Ast.Pdots(dots) | Ast.Pcircles(dots) when generating ->
end_block(); pr_arity arity; mcode print_string brace
| Ast.ExprStatement(exp,sem) ->
- pr_arity arity; expression exp; mcode print_string sem
+ pr_arity arity; print_option expression exp; mcode print_string sem
| Ast.IfHeader(iff,lp,exp,rp) ->
pr_arity arity;
| Ast.TopInit(init) -> initialiser false init
| Ast.Include(inc,s) ->
mcode print_string inc; print_text " "; mcode inc_file s
+ | Ast.Undef(def,id) ->
+ mcode print_string def; pr_space(); ident id
| Ast.DefineHeader(def,id,params) ->
mcode print_string def; pr_space(); ident id;
print_define_parameters params
Ast.Seq(lbrace,body,rbrace) -> pr_space(); f()
| _ ->
(*no newline at the end - someone else will do that*)
- start_block(); f(); unindent() in
+ start_block(); f(); unindent true in
let rec statement arity s =
match Ast.unwrap s with
| Ast.Iterator(header,body,(_,_,_,aft)) ->
rule_elem arity header;
indent_if_needed body (function _ -> statement arity body);
- mcode (fun _ _ _ -> ()) ((),Ast.no_info,aft,Ast.NoMetaPos)
+ mcode (fun _ _ _ -> ()) ((),Ast.no_info,aft,[])
| Ast.Switch(header,lb,decls,cases,rb) ->
rule_elem arity header; pr_space(); rule_elem arity lb;
stmt_dots_list;
print_text "\n)")
else raise CantBeInPlus
- | Ast.Nest(stmt_dots,whn,multi,_,_) when generating ->
+ | Ast.Nest(starter,stmt_dots,ender,whn,multi,_,_) when generating ->
pr_arity arity;
- nest_dots multi (statement arity)
+ nest_dots starter ender (statement arity)
(function _ ->
print_between force_newline
(whencode (dots force_newline (statement "")) (statement "")) whn;
let top_level t =
match Ast.unwrap t with
Ast.FILEINFO(old_file,new_file) -> raise CantBeInPlus
- | Ast.DECL(stmt) -> statement "" stmt
+ | Ast.NONDECL(stmt) -> statement "" stmt
| Ast.CODE(stmt_dots) -> dots force_newline (statement "") stmt_dots
| Ast.ERRORWORDS(exps) -> raise CantBeInPlus
in
| Ast.CaseLineTag(x) -> case_line "" x; false
| Ast.ConstVolTag(x) -> const_vol x unknown unknown; false
- | Ast.Pragma(xs) -> print_between force_newline print_text xs; false
+ | Ast.Pragma(xs) ->
+ (match xs with (Ast.Space s)::_ -> pr_space() | _ -> ());
+ let rec loop = function
+ [] -> ()
+ | [Ast.Noindent s] -> unindent false; print_text s
+ | [Ast.Indent s] -> print_text s
+ | (Ast.Space s) :: (((Ast.Indent _ | Ast.Noindent _) :: _) as rest) ->
+ print_text s; force_newline(); loop rest
+ | (Ast.Space s) :: rest -> print_text s; pr_space(); loop rest
+ | Ast.Noindent s :: rest ->
+ unindent false; print_text s; force_newline(); loop rest
+ | Ast.Indent s :: rest ->
+ print_text s; force_newline(); loop rest in
+ loop xs; false
| Ast.Token(x,None) -> print_text x; if_open_brace x
| Ast.Token(x,Some info) ->
mcode
| _ -> ());
print_string x line lcol)
(let nomcodekind = Ast.CONTEXT(Ast.DontCarePos,Ast.NOTHING) in
- (x,info,nomcodekind,Ast.NoMetaPos));
+ (x,info,nomcodekind,[]));
if_open_brace x
| Ast.Code(x) -> let _ = top_level x in false
| Ast.SgrepEndTag(x) -> failwith "unexpected end tag"
in
+(*Printf.printf "start of the function\n";*)
+
anything := (function x -> let _ = pp_any x in ());
(* todo? imitate what is in pretty_print_cocci ? *)
(Ast.Token ("}",_)::_) -> true
| _ -> false in
let prnl x =
- (if unindent_before x then unindent());
+ (if unindent_before x then unindent true);
force_newline() in
let newline_before _ =
if before =*= After
then
let hd = List.hd xxs in
match hd with
- (Ast.StatementTag s::_) when isfn s ->
+ (Ast.Pragma l::_)
+ when List.for_all (function Ast.Space x -> true | _ -> false) l ->
+ ()
+ | (Ast.StatementTag s::_) when isfn s ->
force_newline(); force_newline()
| (Ast.Pragma _::_)
| (Ast.Rule_elemTag _::_) | (Ast.StatementTag _::_)
match (indent_needed,unindent_before x) with
(true,true) -> force_newline()
| (true,false) -> force_newline(); indent()
- | (false,true) -> unindent(); force_newline()
+ | (false,true) -> unindent true; force_newline()
| (false,false) -> force_newline());
let space_needed_before = function
Ast.ParamTag(x) ->
(match Ast.unwrap x with
Ast.IComma _ -> false
| _ -> true)
- | Ast.Token(t,_) when List.mem t [",";";";"(";")"] -> false
+ | Ast.Token(t,_) when List.mem t [",";";";"(";")";".";"->"] ->
+ false
| _ -> true in
let space_needed_after = function
- Ast.Token(t,_) when List.mem t ["("] -> (*never needed*) false
+ Ast.Token(t,_)
+ when List.mem t ["(";".";"->"] -> (*never needed*) false
| Ast.Token(t,_) when List.mem t ["if";"for";"while";"do"] ->
(* space always needed *)
pr_space(); false
- | _ -> true in
+ | Ast.ExpressionTag(e) ->
+ (match Ast.unwrap e with
+ Ast.EComma _ ->
+ (* space always needed *)
+ pr_space(); false
+ | _ -> true)
+ | t -> true in
let indent_needed =
let rec loop space_after indent_needed = function
[] -> indent_needed
newline_after()
let rec pp_list_list_any (envs, pr, pr_celem, pr_cspace, pr_space, pr_arity,
- pr_barrier, indent, unindent)
+ pr_barrier, indent, unindent, eatspace)
generating xxs before =
List.iter
(function env ->
do_all (env, pr, pr_celem, pr_cspace, pr_space, pr_arity, pr_barrier,
- indent, unindent)
+ indent, unindent, eatspace)
generating xxs before)
envs
HCoop / bpt / coccinelle.git / blobdiff