parsing_c/unparse_cocci.ml

   1 (*
   2  * Copyright (C) 2010, University of Copenhagen DIKU and INRIA.
   3  * Copyright (C) 2006, 2007 Julia Lawall
   4  *
   5  * This program is free software; you can redistribute it and/or
   6  * modify it under the terms of the GNU General Public License (GPL)
   7  * version 2 as published by the Free Software Foundation.
   8  *
   9  * This program is distributed in the hope that it will be useful,
  10  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  11  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  12  * file license.txt for more details.
  13  *
  14  * This file was part of Coccinelle.
  15  *)
  16 open Common
  17
  18 (*****************************************************************************)
  19 (* mostly a copy paste of parsing_cocci/pretty_print_cocci.ml
  20  * todo?: try to factorize ?
  21  *)
  22 (*****************************************************************************)
  23
  24 module Ast = Ast_cocci
  25
  26 let term s = Ast.unwrap_mcode s
  27
  28 (* or perhaps can have in plus, for instance a Disj, but those Disj must be
  29  *  handled by interactive tool (by proposing alternatives)
  30  *)
  31 exception CantBeInPlus
  32
  33 (*****************************************************************************)
  34
  35 type pos = Before | After | InPlace
  36 type nlhint = StartBox | EndBox | SpaceOrNewline of string ref
  37
  38 let unknown = -1
  39
  40 let rec do_all
  41     (env, pr, pr_celem, pr_cspace, pr_space, pr_arity, pr_barrier,
  42      indent, unindent)
  43     generating xxs before =
  44
  45 (* Just to be able to copy paste the code from pretty_print_cocci.ml. *)
  46 let print_string s line lcol =
  47   let rcol = if lcol = unknown then unknown else lcol + (String.length s) in
  48   pr s line lcol rcol None in
  49 let print_string_with_hint hint s line lcol =
  50   let rcol = if lcol = unknown then unknown else lcol + (String.length s) in
  51   pr s line lcol rcol (Some hint) in
  52 let print_text s = pr s unknown unknown unknown None in
  53 let close_box _ = () in
  54 let force_newline _ = print_text "\n" in
  55
  56 let start_block () = force_newline(); indent() in
  57 let end_block () = unindent true; force_newline () in
  58 let print_string_box s = print_string s in
  59
  60 let print_option = Common.do_option in
  61 let print_option_prespace fn = function
  62     None -> ()
  63   | Some x -> pr_space(); fn x in
  64 let print_option_space fn = function
  65     None -> ()
  66   | Some x -> fn x; pr_space() in
  67 let print_between = Common.print_between in
  68
  69 let outdent _ = () (* should go to leftmost col, does nothing now *) in
  70
  71 let pretty_print_c =
  72   Pretty_print_c.mk_pretty_printers pr_celem pr_cspace
  73     force_newline indent outdent (function _ -> unindent true) in
  74
  75 (* --------------------------------------------------------------------- *)
  76 (* Only for make_hrule, print plus code, unbound metavariables *)
  77
  78 (* avoid polyvariance problems *)
  79 let anything : (Ast.anything -> unit) ref = ref (function _ -> ()) in
  80
  81 let rec print_anything = function
  82     [] -> ()
  83   | stream ->
  84       start_block();
  85       print_between force_newline print_anything_list stream;
  86       end_block()
  87
  88 and print_anything_list = function
  89     [] -> ()
  90   | [x] -> !anything x
  91   | bef::((aft::_) as rest) ->
  92       !anything bef;
  93       let space =
  94         (match bef with
  95           Ast.Rule_elemTag(_) | Ast.AssignOpTag(_) | Ast.BinaryOpTag(_)
  96         | Ast.ArithOpTag(_) | Ast.LogicalOpTag(_)
  97         | Ast.Token("if",_) | Ast.Token("while",_) -> true | _ -> false) or
  98         (match aft with
  99           Ast.Rule_elemTag(_) | Ast.AssignOpTag(_) | Ast.BinaryOpTag(_)
 100         | Ast.ArithOpTag(_) | Ast.LogicalOpTag(_) | Ast.Token("{",_) -> true
 101         | _ -> false) in
 102       if space then pr_space ();
 103       print_anything_list rest in
 104
 105 let print_around printer term = function
 106     Ast.NOTHING -> printer term
 107   | Ast.BEFORE(bef,_) -> print_anything bef; printer term
 108   | Ast.AFTER(aft,_) -> printer term; print_anything aft
 109   | Ast.BEFOREAFTER(bef,aft,_) ->
 110       print_anything bef; printer term; print_anything aft in
 111
 112 let print_string_befaft fn fn1 x info =
 113   let print ln col =
 114     function Ast.Noindent s | Ast.Indent s -> print_string s ln col in
 115   List.iter
 116     (function (s,ln,col) -> fn1(); print ln col s; force_newline())
 117     info.Ast.strbef;
 118   fn x;
 119   List.iter
 120     (function (s,ln,col) -> force_newline(); fn1(); print ln col s)
 121     info.Ast.straft in
 122 let print_meta (r,x) = print_text x in
 123
 124 let print_pos = function
 125     Ast.MetaPos(name,_,_,_,_) ->
 126       let name = Ast.unwrap_mcode name in
 127       print_text "@"; print_meta name
 128   | _ -> () in
 129
 130 (* --------------------------------------------------------------------- *)
 131
 132 let mcode fn (s,info,mc,pos) =
 133   let line = info.Ast.line in
 134   let lcol = info.Ast.column in
 135   match (generating,mc) with
 136     (false,_) ->
 137     (* printing for transformation *)
 138     (* Here we don't care about the annotation on s. *)
 139       let print_comments lb comments =
 140         List.fold_left
 141           (function line_before ->
 142             function (str,line,col) ->
 143               match line_before with
 144                 None ->
 145                   let str =
 146                     match str with
 147                       Ast.Noindent s -> unindent false; s
 148                     | Ast.Indent s -> s in
 149                   print_string str line col; Some line
 150               | Some lb when line =|= lb ->
 151                   let str = match str with Ast.Noindent s | Ast.Indent s -> s in
 152                   print_string str line col; Some line
 153               | _ ->
 154                   force_newline();
 155                   (* not super elegant to put side-effecting unindent in a let
 156                      expression... *)
 157                   let str =
 158                     match str with
 159                       Ast.Noindent s -> unindent false; s
 160                     | Ast.Indent s -> s in
 161                   print_string str line col; Some line)
 162           lb comments in
 163       let line_before = print_comments None info.Ast.strbef in
 164       (match line_before with
 165         None -> ()
 166       | Some lb when lb =|= info.Ast.line -> ()
 167       | _ -> force_newline());
 168       fn s line lcol;
 169       let _ = print_comments (Some info.Ast.line) info.Ast.straft in
 170       (* newline after a pragma
 171          should really store parsed versions of the strings, but make a cheap
 172          effort here
 173          print_comments takes care of interior newlines *)
 174       ()
 175       (* printing for rule generation *)
 176   | (true, Ast.MINUS(_,_,_,plus_stream)) ->
 177       force_newline();
 178       print_text "- ";
 179       fn s line lcol; print_pos pos;
 180       print_anything plus_stream
 181   | (true, Ast.CONTEXT(_,plus_streams)) ->
 182       let fn s = force_newline(); fn s line lcol; print_pos pos in
 183       print_around fn s plus_streams
 184   | (true,Ast.PLUS Ast.ONE) ->
 185       let fn s =
 186         force_newline(); print_text "+ "; fn s line lcol; print_pos pos in
 187       print_string_befaft fn (function _ -> print_text "+ ") s info
 188   | (true,Ast.PLUS Ast.MANY) ->
 189       let fn s =
 190         force_newline(); print_text "++ "; fn s line lcol; print_pos pos in
 191       print_string_befaft fn (function _ -> print_text "++ ") s info
 192 in
 193
 194
 195 (* --------------------------------------------------------------------- *)
 196
 197 let handle_metavar name fn =
 198   let ((_,b) as s,info,mc,pos) = name in
 199   let line = info.Ast.line in
 200   let lcol = info.Ast.column in
 201   match Common.optionise (fun () -> List.assoc s env) with
 202     None ->
 203       let name_string (_,s) = s in
 204       if generating
 205       then
 206         mcode (function _ -> print_string (name_string s)) name
 207       else
 208         failwith
 209           (Printf.sprintf "SP line %d: Not found a value in env for: %s"
 210              line (name_string s))
 211   | Some e  ->
 212       pr_barrier line lcol;
 213       (if generating
 214       then
 215         (* call mcode to preserve the -+ annotation *)
 216         mcode (fun _ _ _ -> fn e) name
 217       else fn e);
 218       let rcol =
 219         if lcol = unknown then unknown else lcol + (String.length b) in
 220       pr_barrier line rcol
 221 in
 222 (* --------------------------------------------------------------------- *)
 223 let dots between fn d =
 224   match Ast.unwrap d with
 225     Ast.DOTS(l) -> print_between between fn l
 226   | Ast.CIRCLES(l) -> print_between between fn l
 227   | Ast.STARS(l) -> print_between between fn l
 228 in
 229
 230 let nest_dots starter ender fn f d =
 231   mcode print_string starter;
 232   f(); start_block();
 233   (match Ast.unwrap d with
 234     Ast.DOTS(l)    -> print_between force_newline fn l
 235   | Ast.CIRCLES(l) -> print_between force_newline fn l
 236   | Ast.STARS(l)   -> print_between force_newline fn l);
 237   end_block();
 238   mcode print_string ender
 239 in
 240
 241 let print_disj_list fn l =
 242   print_text "\n(\n";
 243   print_between (function _ -> print_text "\n|\n") fn l;
 244   print_text "\n)\n" in
 245
 246 (* --------------------------------------------------------------------- *)
 247 (* Identifier *)
 248
 249 let rec ident i =
 250   match Ast.unwrap i with
 251       Ast.Id(name) -> mcode print_string name
 252     | Ast.MetaId(name,_,_,_) ->
 253         handle_metavar name (function
 254                                | (Ast_c.MetaIdVal (id,_)) -> print_text id
 255                                | _ -> raise Impossible
 256                             )
 257     | Ast.MetaFunc(name,_,_,_) ->
 258         handle_metavar name (function
 259                                | (Ast_c.MetaFuncVal id) -> print_text id
 260                                | _ -> raise Impossible
 261                             )
 262     | Ast.MetaLocalFunc(name,_,_,_) ->
 263         handle_metavar name (function
 264                                | (Ast_c.MetaLocalFuncVal id) -> print_text id
 265                                | _ -> raise Impossible
 266                             )
 267
 268     | Ast.DisjId(id_list) ->
 269         if generating
 270         then print_disj_list ident id_list
 271         else raise CantBeInPlus
 272     | Ast.OptIdent(_) | Ast.UniqueIdent(_) ->
 273         raise CantBeInPlus
 274
 275 in
 276
 277 (* --------------------------------------------------------------------- *)
 278 (* Expression *)
 279
 280 let rec expression e =
 281   match Ast.unwrap e with
 282     Ast.Ident(id) -> ident id
 283   | Ast.Constant(const) -> mcode constant const
 284   | Ast.FunCall(fn,lp,args,rp) ->
 285       expression fn; mcode (print_string_with_hint StartBox) lp;
 286       dots (function _ -> ()) arg_expression args;
 287       mcode (print_string_with_hint EndBox) rp
 288   | Ast.Assignment(left,op,right,_) ->
 289       expression left; pr_space(); mcode assignOp op;
 290       pr_space(); expression right
 291   | Ast.CondExpr(exp1,why,exp2,colon,exp3) ->
 292       expression exp1; pr_space(); mcode print_string why;
 293       print_option (function e -> pr_space(); expression e) exp2;
 294       pr_space(); mcode print_string colon; pr_space(); expression exp3
 295   | Ast.Postfix(exp,op) -> expression exp; mcode fixOp op
 296   | Ast.Infix(exp,op) -> mcode fixOp op; expression exp
 297   | Ast.Unary(exp,op) -> mcode unaryOp op; expression exp
 298   | Ast.Binary(left,op,right) ->
 299       expression left; pr_space(); mcode binaryOp op; pr_space();
 300       expression right
 301   | Ast.Nested(left,op,right) -> failwith "nested only in minus code"
 302   | Ast.Paren(lp,exp,rp) ->
 303       mcode print_string_box lp; expression exp; close_box();
 304       mcode print_string rp
 305   | Ast.ArrayAccess(exp1,lb,exp2,rb) ->
 306       expression exp1; mcode print_string_box lb; expression exp2; close_box();
 307       mcode print_string rb
 308   | Ast.RecordAccess(exp,pt,field) ->
 309       expression exp; mcode print_string pt; ident field
 310   | Ast.RecordPtAccess(exp,ar,field) ->
 311       expression exp; mcode print_string ar; ident field
 312   | Ast.Cast(lp,ty,rp,exp) ->
 313       mcode print_string_box lp; fullType ty; close_box();
 314       mcode print_string rp; expression exp
 315   | Ast.SizeOfExpr(sizeof,exp) ->
 316       mcode print_string sizeof; expression exp
 317   | Ast.SizeOfType(sizeof,lp,ty,rp) ->
 318       mcode print_string sizeof;
 319       mcode print_string_box lp; fullType ty; close_box();
 320       mcode print_string rp
 321   | Ast.TypeExp(ty) -> fullType ty
 322
 323   | Ast.MetaErr(name,_,_,_) ->
 324       failwith "metaErr not handled"
 325
 326   | Ast.MetaExpr (name,_,_,_typedontcare,_formdontcare,_) ->
 327       handle_metavar name  (function
 328         | Ast_c.MetaExprVal (exp,_) ->
 329             pretty_print_c.Pretty_print_c.expression exp
 330         | _ -> raise Impossible
 331       )
 332
 333   | Ast.MetaExprList (name,_,_,_) ->
 334       handle_metavar name  (function
 335         | Ast_c.MetaExprListVal args ->
 336             pretty_print_c.Pretty_print_c.arg_list args
 337         | Ast_c.MetaParamListVal _ ->
 338             failwith "have meta param list matching meta exp list\n";
 339         | _ -> raise Impossible
 340       )
 341
 342   | Ast.EComma(cm) -> mcode print_string cm
 343
 344   | Ast.DisjExpr(exp_list) ->
 345       if generating
 346       then print_disj_list expression exp_list
 347       else raise CantBeInPlus
 348   | Ast.NestExpr(starter,expr_dots,ender,Some whencode,multi)
 349     when generating ->
 350       nest_dots starter ender expression
 351         (function _ -> print_text "   when != "; expression whencode)
 352         expr_dots
 353   | Ast.NestExpr(starter,expr_dots,ender,None,multi) when generating ->
 354       nest_dots starter ender expression (function _ -> ()) expr_dots
 355   | Ast.NestExpr _ -> raise CantBeInPlus
 356   | Ast.Edots(dots,Some whencode)
 357   | Ast.Ecircles(dots,Some whencode)
 358   | Ast.Estars(dots,Some whencode) ->
 359       if generating
 360       then
 361         (mcode print_string dots;
 362          print_text "   when != ";
 363          expression whencode)
 364       else raise CantBeInPlus
 365   | Ast.Edots(dots,None)
 366   | Ast.Ecircles(dots,None)
 367   | Ast.Estars(dots,None) ->
 368       if generating
 369       then mcode print_string dots
 370       else raise CantBeInPlus
 371
 372   | Ast.OptExp(exp) | Ast.UniqueExp(exp) ->
 373       raise CantBeInPlus
 374
 375 and arg_expression e =
 376   match Ast.unwrap e with
 377     Ast.EComma(cm) ->
 378       (* space is only used by add_newline, and only if not using SMPL
 379          spacing.  pr_cspace uses a " " in unparse_c.ml.  Not so nice... *)
 380       mcode (print_string_with_hint (SpaceOrNewline (ref " ")))  cm
 381   | _ -> expression e
 382
 383 and  unaryOp = function
 384     Ast.GetRef -> print_string "&"
 385   | Ast.DeRef -> print_string "*"
 386   | Ast.UnPlus -> print_string "+"
 387   | Ast.UnMinus -> print_string "-"
 388   | Ast.Tilde -> print_string "~"
 389   | Ast.Not -> print_string "!"
 390
 391 and  assignOp = function
 392     Ast.SimpleAssign -> print_string "="
 393   | Ast.OpAssign(aop) ->
 394       (function line -> function lcol ->
 395         arithOp aop line lcol; print_string "=" line lcol)
 396
 397 and  fixOp = function
 398     Ast.Dec -> print_string "--"
 399   | Ast.Inc -> print_string "++"
 400
 401 and  binaryOp = function
 402     Ast.Arith(aop) -> arithOp aop
 403   | Ast.Logical(lop) -> logicalOp lop
 404
 405 and  arithOp = function
 406     Ast.Plus -> print_string "+"
 407   | Ast.Minus -> print_string "-"
 408   | Ast.Mul -> print_string "*"
 409   | Ast.Div -> print_string "/"
 410   | Ast.Mod -> print_string "%"
 411   | Ast.DecLeft -> print_string "<<"
 412   | Ast.DecRight -> print_string ">>"
 413   | Ast.And -> print_string "&"
 414   | Ast.Or -> print_string "|"
 415   | Ast.Xor -> print_string "^"
 416
 417 and  logicalOp = function
 418     Ast.Inf -> print_string "<"
 419   | Ast.Sup -> print_string ">"
 420   | Ast.InfEq -> print_string "<="
 421   | Ast.SupEq -> print_string ">="
 422   | Ast.Eq -> print_string "=="
 423   | Ast.NotEq -> print_string "!="
 424   | Ast.AndLog -> print_string "&&"
 425   | Ast.OrLog -> print_string "||"
 426
 427 and constant = function
 428     Ast.String(s) -> print_string ("\""^s^"\"")
 429   | Ast.Char(s) -> print_string ("\'"^s^"\'")
 430   | Ast.Int(s) -> print_string s
 431   | Ast.Float(s) -> print_string s
 432
 433 (* --------------------------------------------------------------------- *)
 434 (* Types *)
 435
 436
 437 and fullType ft =
 438   match Ast.unwrap ft with
 439     Ast.Type(cv,ty) -> print_option_space (mcode const_vol) cv; typeC ty
 440   | Ast.DisjType _ -> failwith "can't be in plus"
 441   | Ast.OptType(_) | Ast.UniqueType(_) ->
 442       raise CantBeInPlus
 443
 444 and print_function_pointer (ty,lp1,star,rp1,lp2,params,rp2) fn =
 445   fullType ty; mcode print_string lp1; mcode print_string star; fn();
 446   mcode print_string rp1; mcode print_string lp1;
 447   parameter_list params; mcode print_string rp2
 448
 449 and print_function_type (ty,lp1,params,rp1) fn =
 450   print_option fullType ty; fn(); mcode print_string lp1;
 451   parameter_list params; mcode print_string rp1
 452
 453 and typeC ty =
 454   match Ast.unwrap ty with
 455     Ast.BaseType(ty,strings) ->
 456       print_between pr_space (mcode print_string) strings
 457   | Ast.SignedT(sgn,ty) -> mcode sign sgn; print_option_prespace typeC ty
 458   | Ast.Pointer(ty,star) -> fullType ty; ft_space ty; mcode print_string star
 459   | Ast.FunctionPointer(ty,lp1,star,rp1,lp2,params,rp2) ->
 460       print_function_pointer (ty,lp1,star,rp1,lp2,params,rp2)
 461         (function _ -> ())
 462   | Ast.FunctionType (am,ty,lp1,params,rp1) ->
 463       print_function_type (ty,lp1,params,rp1) (function _ -> ())
 464   | Ast.Array(ty,lb,size,rb) ->
 465       fullType ty; mcode print_string lb; print_option expression size;
 466       mcode print_string rb
 467   | Ast.EnumName(kind,name) ->
 468       mcode print_string kind;
 469       print_option_prespace ident name
 470   | Ast.EnumDef(ty,lb,ids,rb) ->
 471       fullType ty; ft_space ty;
 472       mcode print_string lb;
 473       dots force_newline expression ids;
 474       mcode print_string rb
 475   | Ast.StructUnionName(kind,name) ->
 476       mcode structUnion kind; print_option_prespace ident name
 477   | Ast.StructUnionDef(ty,lb,decls,rb) ->
 478       fullType ty; ft_space ty;
 479       mcode print_string lb;
 480       dots force_newline declaration decls;
 481       mcode print_string rb
 482   | Ast.TypeName(name)-> mcode print_string name
 483   | Ast.MetaType(name,_,_) ->
 484       handle_metavar name  (function
 485           Ast_c.MetaTypeVal exp ->
 486             pretty_print_c.Pretty_print_c.ty exp
 487         | _ -> raise Impossible)
 488
 489 and baseType = function
 490     Ast.VoidType -> print_string "void"
 491   | Ast.CharType -> print_string "char"
 492   | Ast.ShortType -> print_string "short"
 493   | Ast.IntType -> print_string "int"
 494   | Ast.DoubleType -> print_string "double"
 495   | Ast.FloatType -> print_string "float"
 496   | Ast.LongType -> print_string "long"
 497   | Ast.LongLongType -> print_string "long long"
 498   | Ast.SizeType -> print_string "size_t "
 499   | Ast.SSizeType -> print_string "ssize_t "
 500   | Ast.PtrDiffType -> print_string "ptrdiff_t "
 501
 502 and structUnion = function
 503     Ast.Struct -> print_string "struct"
 504   | Ast.Union -> print_string "union"
 505
 506 and sign = function
 507     Ast.Signed -> print_string "signed"
 508   | Ast.Unsigned -> print_string "unsigned"
 509
 510
 511 and const_vol = function
 512     Ast.Const -> print_string "const"
 513   | Ast.Volatile -> print_string "volatile"
 514
 515 (* --------------------------------------------------------------------- *)
 516 (* Function declaration *)
 517
 518 and storage = function
 519     Ast.Static -> print_string "static"
 520   | Ast.Auto -> print_string "auto"
 521   | Ast.Register -> print_string "register"
 522   | Ast.Extern -> print_string "extern"
 523
 524 (* --------------------------------------------------------------------- *)
 525 (* Variable declaration *)
 526
 527 and print_named_type ty id =
 528   match Ast.unwrap ty with
 529     Ast.Type(None,ty1) ->
 530       (match Ast.unwrap ty1 with
 531         Ast.FunctionPointer(ty,lp1,star,rp1,lp2,params,rp2) ->
 532           print_function_pointer (ty,lp1,star,rp1,lp2,params,rp2)
 533             (function _ -> pr_space(); ident id)
 534       | Ast.FunctionType(am,ty,lp1,params,rp1) ->
 535           print_function_type (ty,lp1,params,rp1)
 536             (function _ -> pr_space(); ident id)
 537       | Ast.Array(_,_,_,_) ->
 538           let rec loop ty k =
 539             match Ast.unwrap ty with
 540               Ast.Array(ty,lb,size,rb) ->
 541                 (match Ast.unwrap ty with
 542                   Ast.Type(None,ty) ->
 543                     loop ty
 544                       (function _ ->
 545                         k ();
 546                         mcode print_string lb;
 547                         print_option expression size;
 548                         mcode print_string rb)
 549                 | _ -> failwith "complex array types not supported")
 550             | _ -> typeC ty; ty_space ty; ident id; k () in
 551           loop ty1 (function _ -> ())
 552     (*| should have a case here for pointer to array or function type
 553         that would put ( * ) around the variable.  This makes one wonder
 554         why we really need a special case for function pointer *)
 555       | _ -> fullType ty; ft_space ty; ident id)
 556   | _ -> fullType ty; ft_space ty; ident id
 557
 558 and ty_space ty =
 559   match Ast.unwrap ty with
 560     Ast.Pointer(_,_) -> ()
 561   | _ -> pr_space()
 562
 563 and ft_space ty =
 564   match Ast.unwrap ty with
 565     Ast.Type(cv,ty) ->
 566       (match Ast.unwrap ty with
 567         Ast.Pointer(_,_) -> ()
 568       | Ast.MetaType(name,_,_) ->
 569           (match List.assoc (Ast.unwrap_mcode name) env with
 570             Ast_c.MetaTypeVal (tq,ty) ->
 571               (match Ast_c.unwrap ty with
 572                 Ast_c.Pointer(_,_) -> ()
 573               | _ -> pr_space())
 574           | _ -> pr_space())
 575       | _ -> pr_space())
 576   | _ -> pr_space()
 577
 578 and declaration d =
 579   match Ast.unwrap d with
 580     Ast.MetaDecl(name,_,_) ->
 581       handle_metavar name
 582         (function
 583             Ast_c.MetaDeclVal d ->
 584               pretty_print_c.Pretty_print_c.decl d
 585           | _ -> raise Impossible)
 586   | Ast.MetaField(name,_,_) ->
 587       handle_metavar name
 588         (function
 589             Ast_c.MetaFieldVal d ->
 590               pretty_print_c.Pretty_print_c.field d
 591           | _ -> raise Impossible)
 592   | Ast.Init(stg,ty,id,eq,ini,sem) ->
 593       print_option (mcode storage) stg;
 594       print_option (function _ -> pr_space()) stg;
 595       print_named_type ty id;
 596       pr_space(); mcode print_string eq;
 597       pr_space(); initialiser true ini; mcode print_string sem
 598   | Ast.UnInit(stg,ty,id,sem) ->
 599       print_option (mcode storage) stg;
 600       print_option (function _ -> pr_space()) stg;
 601       print_named_type ty id;
 602       mcode print_string sem
 603   | Ast.MacroDecl(name,lp,args,rp,sem) ->
 604       ident name; mcode print_string_box lp;
 605       dots (function _ -> ()) expression args;
 606       close_box(); mcode print_string rp; mcode print_string sem
 607   | Ast.TyDecl(ty,sem) -> fullType ty; mcode print_string sem
 608   | Ast.Typedef(stg,ty,id,sem) ->
 609       mcode print_string stg;
 610       fullType ty; typeC id;
 611       mcode print_string sem
 612   | Ast.DisjDecl(_) -> raise CantBeInPlus
 613   | Ast.Ddots(_,_) -> raise CantBeInPlus
 614   | Ast.OptDecl(decl)  | Ast.UniqueDecl(decl) ->
 615       raise CantBeInPlus
 616
 617 (* --------------------------------------------------------------------- *)
 618 (* Initialiser *)
 619
 620 and initialiser nlcomma i =
 621   match Ast.unwrap i with
 622     Ast.MetaInit(name,_,_) ->
 623       handle_metavar name  (function
 624           Ast_c.MetaInitVal ini ->
 625             pretty_print_c.Pretty_print_c.init ini
 626         | _ -> raise Impossible)
 627   | Ast.InitExpr(exp) -> expression exp
 628   | Ast.ArInitList(lb,initlist,rb) ->
 629       (match Ast.undots initlist with
 630         [] -> mcode print_string lb; mcode print_string rb
 631       | _ ->
 632           mcode print_string lb; start_block();
 633           dots force_newline (initialiser false) initlist;
 634           end_block(); mcode print_string rb)
 635   | Ast.StrInitList(_,lb,[],rb,[]) ->
 636       mcode print_string lb; mcode print_string rb
 637   | Ast.StrInitList(_,lb,initlist,rb,[]) ->
 638       mcode print_string lb; start_block();
 639       (* awkward, because the comma is separate from the initialiser *)
 640       let rec loop = function
 641           [] -> ()
 642         | [x] -> initialiser false x
 643         | x::xs -> initialiser nlcomma x; loop xs in
 644       loop initlist;
 645       end_block(); mcode print_string rb
 646   | Ast.StrInitList(_,lb,initlist,rb,_) ->
 647       failwith "unexpected whencode in plus"
 648   | Ast.InitGccExt(designators,eq,ini) ->
 649       List.iter designator designators; pr_space();
 650       mcode print_string eq; pr_space(); initialiser nlcomma ini
 651   | Ast.InitGccName(name,eq,ini) ->
 652       ident name; mcode print_string eq; initialiser nlcomma ini
 653   | Ast.IComma(comma) ->
 654       mcode print_string comma;
 655       if nlcomma then force_newline()
 656   | Ast.Idots(dots,Some whencode) ->
 657       if generating
 658       then
 659         (mcode print_string dots;
 660          print_text "   when != ";
 661          initialiser nlcomma whencode)
 662       else raise CantBeInPlus
 663   | Ast.Idots(dots,None) ->
 664       if generating
 665       then mcode print_string dots
 666       else raise CantBeInPlus
 667   | Ast.OptIni(ini) | Ast.UniqueIni(ini) ->
 668       raise CantBeInPlus
 669
 670 and designator = function
 671     Ast.DesignatorField(dot,id) -> mcode print_string dot; ident id
 672   | Ast.DesignatorIndex(lb,exp,rb) ->
 673       mcode print_string lb; expression exp; mcode print_string rb
 674   | Ast.DesignatorRange(lb,min,dots,max,rb) ->
 675       mcode print_string lb; expression min; mcode print_string dots;
 676       expression max; mcode print_string rb
 677
 678 (* --------------------------------------------------------------------- *)
 679 (* Parameter *)
 680
 681 and parameterTypeDef p =
 682   match Ast.unwrap p with
 683     Ast.VoidParam(ty) -> fullType ty
 684   | Ast.Param(ty,Some id) -> print_named_type ty id
 685   | Ast.Param(ty,None) -> fullType ty
 686
 687   | Ast.MetaParam(name,_,_) ->
 688       handle_metavar name
 689         (function
 690             Ast_c.MetaParamVal p ->
 691               pretty_print_c.Pretty_print_c.param p
 692           | _ -> raise Impossible)
 693   | Ast.MetaParamList(name,_,_,_) ->
 694       failwith "not handling MetaParamList"
 695
 696   | Ast.PComma(cm) -> mcode print_string cm
 697   | Ast.Pdots(dots) | Ast.Pcircles(dots) when generating ->
 698       mcode print_string dots
 699   | Ast.Pdots(dots) | Ast.Pcircles(dots) -> raise CantBeInPlus
 700   | Ast.OptParam(param) | Ast.UniqueParam(param) -> raise CantBeInPlus
 701
 702 and parameter_list l =
 703   let comma p =
 704     parameterTypeDef p;
 705     match Ast.unwrap p with
 706       Ast.PComma(cm) -> pr_space()
 707     | _ -> () in
 708   dots (function _ -> ()) comma l
 709 in
 710
 711
 712 (* --------------------------------------------------------------------- *)
 713 (* CPP code *)
 714
 715 let rec inc_file = function
 716     Ast.Local(elems) ->
 717       print_string ("\""^(String.concat "/" (List.map inc_elem elems))^"\"")
 718   | Ast.NonLocal(elems) ->
 719       print_string ("<"^(String.concat "/" (List.map inc_elem elems))^">")
 720
 721 and inc_elem = function
 722     Ast.IncPath s -> s
 723   | Ast.IncDots -> "..."
 724
 725 (* --------------------------------------------------------------------- *)
 726 (* Top-level code *)
 727
 728 and rule_elem arity re =
 729   match Ast.unwrap re with
 730     Ast.FunHeader(_,_,fninfo,name,lp,params,rp) ->
 731       pr_arity arity; List.iter print_fninfo fninfo;
 732       ident name; mcode print_string_box lp;
 733       parameter_list params; close_box(); mcode print_string rp;
 734       pr_space()
 735   | Ast.Decl(_,_,decl) -> pr_arity arity; declaration decl
 736
 737   | Ast.SeqStart(brace) ->
 738       pr_arity arity; mcode print_string brace; start_block()
 739   | Ast.SeqEnd(brace) ->
 740       end_block(); pr_arity arity; mcode print_string brace
 741
 742   | Ast.ExprStatement(exp,sem) ->
 743       pr_arity arity; expression exp; mcode print_string sem
 744
 745   | Ast.IfHeader(iff,lp,exp,rp) ->
 746       pr_arity arity;
 747       mcode print_string iff; pr_space(); mcode print_string_box lp;
 748       expression exp; close_box(); mcode print_string rp
 749   | Ast.Else(els) ->
 750       pr_arity arity; mcode print_string els
 751
 752   | Ast.WhileHeader(whl,lp,exp,rp) ->
 753       pr_arity arity;
 754       mcode print_string whl; pr_space(); mcode print_string_box lp;
 755       expression exp; close_box(); mcode print_string rp
 756   | Ast.DoHeader(d) ->
 757       pr_arity arity; mcode print_string d
 758   | Ast.WhileTail(whl,lp,exp,rp,sem) ->
 759       pr_arity arity;
 760       mcode print_string whl; pr_space(); mcode print_string_box lp;
 761       expression exp; close_box(); mcode print_string rp;
 762       mcode print_string sem
 763   | Ast.ForHeader(fr,lp,e1,sem1,e2,sem2,e3,rp) ->
 764       pr_arity arity;
 765       mcode print_string fr; mcode print_string_box lp;
 766       print_option expression e1; mcode print_string sem1;
 767       print_option expression e2; mcode print_string sem2;
 768       print_option expression e3; close_box();
 769       mcode print_string rp
 770   | Ast.IteratorHeader(nm,lp,args,rp) ->
 771       pr_arity arity;
 772       ident nm; pr_space(); mcode print_string_box lp;
 773       dots (function _ -> ()) expression args; close_box();
 774       mcode print_string rp
 775
 776   | Ast.SwitchHeader(switch,lp,exp,rp) ->
 777       pr_arity arity;
 778       mcode print_string switch; pr_space(); mcode print_string_box lp;
 779       expression exp; close_box(); mcode print_string rp
 780
 781   | Ast.Break(br,sem) ->
 782       pr_arity arity; mcode print_string br; mcode print_string sem
 783   | Ast.Continue(cont,sem) ->
 784       pr_arity arity; mcode print_string cont; mcode print_string sem
 785   | Ast.Label(l,dd) -> ident l; mcode print_string dd
 786   | Ast.Goto(goto,l,sem) ->
 787       mcode print_string goto; ident l; mcode print_string sem
 788   | Ast.Return(ret,sem) ->
 789       pr_arity arity; mcode print_string ret;
 790       mcode print_string sem
 791   | Ast.ReturnExpr(ret,exp,sem) ->
 792       pr_arity arity; mcode print_string ret; pr_space();
 793       expression exp; mcode print_string sem
 794
 795   | Ast.Exp(exp) -> pr_arity arity; expression exp
 796   | Ast.TopExp(exp) -> pr_arity arity; expression exp
 797   | Ast.Ty(ty) -> pr_arity arity; fullType ty
 798   | Ast.TopInit(init) -> initialiser false init
 799   | Ast.Include(inc,s) ->
 800       mcode print_string inc; print_text " "; mcode inc_file s
 801   | Ast.Undef(def,id) ->
 802       mcode print_string def; pr_space(); ident id
 803   | Ast.DefineHeader(def,id,params) ->
 804       mcode print_string def; pr_space(); ident id;
 805       print_define_parameters params
 806   | Ast.Default(def,colon) ->
 807       mcode print_string def; mcode print_string colon; pr_space()
 808   | Ast.Case(case,exp,colon) ->
 809       mcode print_string case; pr_space(); expression exp;
 810       mcode print_string colon; pr_space()
 811   | Ast.DisjRuleElem(res) ->
 812       if generating
 813       then
 814         (pr_arity arity; print_text "\n(\n";
 815          print_between (function _ -> print_text "\n|\n") (rule_elem arity)
 816            res;
 817          print_text "\n)")
 818       else raise CantBeInPlus
 819
 820   | Ast.MetaRuleElem(name,_,_) ->
 821       raise Impossible
 822
 823   | Ast.MetaStmt(name,_,_,_) ->
 824       handle_metavar name  (function
 825         | Ast_c.MetaStmtVal stm ->
 826             pretty_print_c.Pretty_print_c.statement stm
 827         | _ -> raise Impossible
 828                            )
 829   | Ast.MetaStmtList(name,_,_) ->
 830       failwith
 831         "MetaStmtList not supported (not even in ast_c metavars binding)"
 832
 833 and print_define_parameters params =
 834   match Ast.unwrap params with
 835     Ast.NoParams -> ()
 836   | Ast.DParams(lp,params,rp) ->
 837       mcode print_string lp;
 838       dots (function _ -> ()) print_define_param params; mcode print_string rp
 839
 840 and print_define_param param =
 841   match Ast.unwrap param with
 842     Ast.DParam(id) -> ident id
 843   | Ast.DPComma(comma) -> mcode print_string comma
 844   | Ast.DPdots(dots) -> mcode print_string dots
 845   | Ast.DPcircles(circles) -> mcode print_string circles
 846   | Ast.OptDParam(dp) -> print_text "?"; print_define_param dp
 847   | Ast.UniqueDParam(dp) -> print_text "!"; print_define_param dp
 848
 849 and print_fninfo = function
 850     Ast.FStorage(stg) -> mcode storage stg
 851   | Ast.FType(ty) -> fullType ty
 852   | Ast.FInline(inline) -> mcode print_string inline; pr_space()
 853   | Ast.FAttr(attr) -> mcode print_string attr; pr_space() in
 854
 855 let indent_if_needed s f =
 856   match Ast.unwrap s with
 857     Ast.Seq(lbrace,body,rbrace) -> pr_space(); f()
 858   | _ ->
 859       (*no newline at the end - someone else will do that*)
 860       start_block(); f(); unindent true in
 861
 862 let rec statement arity s =
 863   match Ast.unwrap s with
 864     Ast.Seq(lbrace,body,rbrace) ->
 865       rule_elem arity lbrace;
 866       dots force_newline (statement arity) body;
 867       rule_elem arity rbrace
 868
 869   | Ast.IfThen(header,branch,_) ->
 870       rule_elem arity header;
 871       indent_if_needed branch (function _ -> statement arity branch)
 872   | Ast.IfThenElse(header,branch1,els,branch2,_) ->
 873       rule_elem arity header;
 874       indent_if_needed branch1 (function _ -> statement arity branch1);
 875       force_newline();
 876       rule_elem arity els;
 877       indent_if_needed branch2 (function _ -> statement arity branch2)
 878   | Ast.While(header,body,_) ->
 879       rule_elem arity header;
 880       indent_if_needed body (function _ -> statement arity body)
 881   | Ast.Do(header,body,tail) ->
 882       rule_elem arity header;
 883       indent_if_needed body (function _ -> statement arity body);
 884       rule_elem arity tail
 885   | Ast.For(header,body,_) ->
 886       rule_elem arity header;
 887       indent_if_needed body (function _ -> statement arity body)
 888   | Ast.Iterator(header,body,(_,_,_,aft)) ->
 889       rule_elem arity header;
 890       indent_if_needed body (function _ -> statement arity body);
 891       mcode (fun _ _ _ -> ()) ((),Ast.no_info,aft,Ast.NoMetaPos)
 892
 893   | Ast.Switch(header,lb,decls,cases,rb) ->
 894       rule_elem arity header; pr_space(); rule_elem arity lb;
 895       dots force_newline (statement arity) decls;
 896       List.iter (function x -> case_line arity x; force_newline()) cases;
 897       rule_elem arity rb
 898
 899   | Ast.Atomic(re) -> rule_elem arity re
 900
 901   | Ast.FunDecl(header,lbrace,body,rbrace) ->
 902       rule_elem arity header; rule_elem arity lbrace;
 903       dots force_newline (statement arity) body; rule_elem arity rbrace
 904
 905   | Ast.Define(header,body) ->
 906       rule_elem arity header; pr_space();
 907       dots force_newline (statement arity) body
 908
 909   | Ast.Disj([stmt_dots]) ->
 910       if generating
 911       then
 912         (pr_arity arity;
 913          dots force_newline (statement arity) stmt_dots)
 914       else raise CantBeInPlus
 915   | Ast.Disj(stmt_dots_list) -> (* ignores newline directive for readability *)
 916       if generating
 917       then
 918         (pr_arity arity; print_text "\n(\n";
 919          print_between (function _ -> print_text "\n|\n")
 920            (dots force_newline (statement arity))
 921            stmt_dots_list;
 922          print_text "\n)")
 923       else raise CantBeInPlus
 924   | Ast.Nest(starter,stmt_dots,ender,whn,multi,_,_) when generating ->
 925       pr_arity arity;
 926       nest_dots starter ender (statement arity)
 927         (function _ ->
 928           print_between force_newline
 929             (whencode (dots force_newline (statement "")) (statement "")) whn;
 930           force_newline())
 931         stmt_dots
 932   | Ast.Nest(_) -> raise CantBeInPlus
 933   | Ast.Dots(d,whn,_,_) | Ast.Circles(d,whn,_,_) | Ast.Stars(d,whn,_,_) ->
 934       if generating
 935       then
 936         (pr_arity arity; mcode print_string d;
 937          print_between force_newline
 938            (whencode (dots force_newline (statement "")) (statement "")) whn;
 939          force_newline())
 940       else raise CantBeInPlus
 941
 942   | Ast.OptStm(s) | Ast.UniqueStm(s) ->
 943       raise CantBeInPlus
 944
 945 and whencode notfn alwaysfn = function
 946     Ast.WhenNot a ->
 947       print_text "   WHEN != "; notfn a
 948   | Ast.WhenAlways a ->
 949       print_text "   WHEN = "; alwaysfn a
 950   | Ast.WhenModifier x -> print_text "   WHEN "; print_when_modif x
 951   | Ast.WhenNotTrue a ->
 952       print_text "   WHEN != TRUE "; rule_elem "" a
 953   | Ast.WhenNotFalse a ->
 954       print_text "   WHEN != FALSE "; rule_elem "" a
 955
 956 and print_when_modif = function
 957   | Ast.WhenAny    -> print_text "ANY"
 958   | Ast.WhenStrict -> print_text "STRICT"
 959   | Ast.WhenForall -> print_text "FORALL"
 960   | Ast.WhenExists -> print_text "EXISTS"
 961
 962 and case_line arity c =
 963   match Ast.unwrap c with
 964     Ast.CaseLine(header,code) ->
 965       rule_elem arity header; pr_space();
 966       dots force_newline (statement arity) code
 967   | Ast.OptCase(case) -> raise CantBeInPlus in
 968
 969 let top_level t =
 970   match Ast.unwrap t with
 971     Ast.FILEINFO(old_file,new_file) -> raise CantBeInPlus
 972   | Ast.DECL(stmt) -> statement "" stmt
 973   | Ast.CODE(stmt_dots) -> dots force_newline (statement "") stmt_dots
 974   | Ast.ERRORWORDS(exps) -> raise CantBeInPlus
 975 in
 976
 977 (*
 978 let rule =
 979   print_between (function _ -> force_newline(); force_newline()) top_level
 980 in
 981 *)
 982
 983 let if_open_brace  = function "{" -> true | _ -> false in
 984
 985 (* boolean result indicates whether an indent is needed *)
 986 let rec pp_any = function
 987   (* assert: normally there is only CONTEXT NOTHING tokens in any *)
 988     Ast.FullTypeTag(x) -> fullType x; false
 989   | Ast.BaseTypeTag(x) -> baseType x unknown unknown; false
 990   | Ast.StructUnionTag(x) -> structUnion x unknown unknown; false
 991   | Ast.SignTag(x) -> sign x unknown unknown; false
 992
 993   | Ast.IdentTag(x) -> ident x; false
 994
 995   | Ast.ExpressionTag(x) -> expression x; false
 996
 997   | Ast.ConstantTag(x) -> constant x unknown unknown; false
 998   | Ast.UnaryOpTag(x) -> unaryOp x unknown unknown; false
 999   | Ast.AssignOpTag(x) -> assignOp x unknown unknown; false
1000   | Ast.FixOpTag(x) -> fixOp x unknown unknown; false
1001   | Ast.BinaryOpTag(x) -> binaryOp x unknown unknown; false
1002   | Ast.ArithOpTag(x) -> arithOp x unknown unknown; false
1003   | Ast.LogicalOpTag(x) -> logicalOp x unknown unknown; false
1004
1005   | Ast.InitTag(x) -> initialiser false x; false
1006   | Ast.DeclarationTag(x) -> declaration x; false
1007
1008   | Ast.StorageTag(x) -> storage x unknown unknown; false
1009   | Ast.IncFileTag(x) -> inc_file x unknown unknown; false
1010
1011   | Ast.Rule_elemTag(x) -> rule_elem "" x; false
1012   | Ast.StatementTag(x) -> statement "" x; false
1013   | Ast.CaseLineTag(x) -> case_line "" x; false
1014
1015   | Ast.ConstVolTag(x) -> const_vol x unknown unknown; false
1016   | Ast.Pragma(xs) ->
1017       let print = function Ast.Noindent s | Ast.Indent s -> print_text s in
1018       print_between force_newline print xs; false
1019   | Ast.Token(x,None) -> print_text x; if_open_brace x
1020   | Ast.Token(x,Some info) ->
1021       mcode
1022         (fun x line lcol ->
1023           (match x with
1024             "else" -> force_newline()
1025           | _ -> ());
1026           print_string x line lcol)
1027         (let nomcodekind = Ast.CONTEXT(Ast.DontCarePos,Ast.NOTHING) in
1028         (x,info,nomcodekind,Ast.NoMetaPos));
1029       if_open_brace x
1030
1031   | Ast.Code(x) -> let _ = top_level x in false
1032
1033   (* this is not '...', but a list of expr/statement/params, and
1034      normally there should be no '...' inside them *)
1035   | Ast.ExprDotsTag(x) -> dots (function _ -> ()) expression x; false
1036   | Ast.ParamDotsTag(x) -> parameter_list x; false
1037   | Ast.StmtDotsTag(x) -> dots force_newline (statement "") x; false
1038   | Ast.DeclDotsTag(x) -> dots force_newline declaration x; false
1039
1040   | Ast.TypeCTag(x) -> typeC x; false
1041   | Ast.ParamTag(x) -> parameterTypeDef x; false
1042   | Ast.SgrepStartTag(x) -> failwith "unexpected start tag"
1043   | Ast.SgrepEndTag(x) -> failwith "unexpected end tag"
1044 in
1045
1046   anything := (function x -> let _ = pp_any x in ());
1047
1048   (* todo? imitate what is in pretty_print_cocci ? *)
1049   match xxs with
1050     [] -> ()
1051   | x::xs ->
1052       (* for many tags, we must not do a newline before the first '+' *)
1053       let isfn s =
1054         match Ast.unwrap s with Ast.FunDecl _ -> true | _ -> false in
1055       let unindent_before = function
1056         (* need to get unindent before newline for } *)
1057           (Ast.Token ("}",_)::_) -> true
1058         | _ -> false in
1059       let prnl x =
1060         (if unindent_before x then unindent true);
1061         force_newline() in
1062       let newline_before _ =
1063         if before =*= After
1064         then
1065           let hd = List.hd xxs in
1066           match hd with
1067             (Ast.StatementTag s::_) when isfn s ->
1068               force_newline(); force_newline()
1069           | (Ast.Pragma _::_)
1070           | (Ast.Rule_elemTag _::_) | (Ast.StatementTag _::_)
1071           | (Ast.InitTag _::_)
1072           | (Ast.DeclarationTag _::_) | (Ast.Token ("}",_)::_) -> prnl hd
1073           | _ -> () in
1074       let newline_after _ =
1075         if before =*= Before
1076         then
1077           match List.rev(List.hd(List.rev xxs)) with
1078             (Ast.StatementTag s::_) ->
1079               (if isfn s then force_newline());
1080               force_newline()
1081           | (Ast.Pragma _::_)
1082           | (Ast.Rule_elemTag _::_) | (Ast.InitTag _::_)
1083           | (Ast.DeclarationTag _::_) | (Ast.Token ("{",_)::_) ->
1084               force_newline()
1085           | _ -> () in
1086       (* print a newline at the beginning, if needed *)
1087       newline_before();
1088       (* print a newline before each of the rest *)
1089       let rec loop leading_newline indent_needed = function
1090           [] -> ()
1091         | x::xs ->
1092             (if leading_newline
1093             then
1094               match (indent_needed,unindent_before x) with
1095                 (true,true) -> force_newline()
1096               | (true,false) -> force_newline(); indent()
1097               | (false,true) -> unindent true; force_newline()
1098               | (false,false) -> force_newline());
1099             let space_needed_before = function
1100                 Ast.ParamTag(x) ->
1101                   (match Ast.unwrap x with
1102                     Ast.PComma _ -> false
1103                   | _ -> true)
1104               | Ast.ExpressionTag(x) ->
1105                   (match Ast.unwrap x with
1106                     Ast.EComma _ -> false
1107                   | _ -> true)
1108               | Ast.InitTag(x) ->
1109                   (match Ast.unwrap x with
1110                     Ast.IComma _ -> false
1111                   | _ -> true)
1112               | Ast.Token(t,_) when List.mem t [",";";";"(";")"] -> false
1113               | _ -> true in
1114             let space_needed_after = function
1115                 Ast.Token(t,_) when List.mem t ["("] -> (*never needed*) false
1116               | Ast.Token(t,_) when List.mem t ["if";"for";"while";"do"] ->
1117                   (* space always needed *)
1118                   pr_space(); false
1119               | Ast.ExpressionTag(e) ->
1120                   (match Ast.unwrap e with
1121                     Ast.EComma _ ->
1122                       (* space always needed *)
1123                       pr_space(); false
1124                   | _ -> true)
1125               | t -> true in
1126             let indent_needed =
1127               let rec loop space_after indent_needed = function
1128                   [] -> indent_needed
1129                 | x::xs ->
1130                     (if space_after && space_needed_before x
1131                     then pr_space());
1132                     let indent_needed = pp_any x in
1133                     let space_after = space_needed_after x in
1134                     loop space_after indent_needed xs in
1135               loop false false x in
1136             loop true indent_needed xs in
1137       loop false false (x::xs);
1138       (* print a newline at the end, if needed *)
1139       newline_after()
1140
1141 let rec pp_list_list_any (envs, pr, pr_celem, pr_cspace, pr_space, pr_arity,
1142                           pr_barrier, indent, unindent)
1143     generating xxs before =
1144   List.iter
1145     (function env ->
1146       do_all (env, pr, pr_celem, pr_cspace, pr_space, pr_arity, pr_barrier,
1147               indent, unindent)
1148         generating xxs before)
1149     envs