← Back to branch summary

~ubuntu-branches/ubuntu/maverick/coccinelle/maverick

« back to all changes in this revision

Viewing changes to parsing_c/unparse_cocci.ml

  • Committer: Bazaar Package Importer
  • Author(s): Євгеній Мещеряков
  • Date: 2009-05-11 15:32:24 UTC
  • mfrom: (1.1.3 upstream)
  • Revision ID: james.westby@ubuntu.com-20090511153224-1odv41d4dkr3y80v
Tags: 0.1.8.deb-2
Use common install Makefile target for both native and bytecode
build. This hopefully fixes FTBFS on bytecode archs 

Show diffs side-by-side

added added

removed removed

Lines of Context:
parsing_c/unparse_cocci.ml
19
19
 
20
20
type pos = Before | After | InPlace
21
21
 
22
 
let rec pp_list_list_any (env, pr, pr_elem, pr_space, indent, unindent)
 
22
let unknown = -1
 
23
 
 
24
let rec pp_list_list_any
 
25
    (env, pr, pr_celem, pr_cspace, pr_space, pr_arity, pr_barrier,
 
26
     indent, unindent)
23
27
    generating xxs before =
24
28
 
25
29
(* Just to be able to copy paste the code from pretty_print_cocci.ml. *)
26
 
let print_string = pr in
 
30
let print_string s line lcol =
 
31
  let rcol = if lcol = unknown then unknown else lcol + (String.length s) in
 
32
  pr s line lcol rcol in
 
33
let print_text s = pr s unknown unknown unknown in
27
34
let close_box _ = () in
28
 
let print_space() = pr " "  in
29
 
let force_newline () = pr "\n" in
 
35
let force_newline () = print_text "\n" in
30
36
 
31
37
let start_block () = force_newline(); indent() in
32
38
let end_block () = unindent(); force_newline () in
38
44
let outdent _ = () (* should go to leftmost col, does nothing now *) in
39
45
 
40
46
let pretty_print_c =
41
 
  Pretty_print_c.pretty_print_c pr_elem pr_space
 
47
  Pretty_print_c.pretty_print_c pr_celem pr_cspace
42
48
    force_newline indent outdent unindent in
43
49
 
44
50
(* --------------------------------------------------------------------- *)
68
74
          Ast.Rule_elemTag(_) | Ast.AssignOpTag(_) | Ast.BinaryOpTag(_)
69
75
        | Ast.ArithOpTag(_) | Ast.LogicalOpTag(_) | Ast.Token("{",_) -> true
70
76
        | _ -> false) in
71
 
      if space then print_string " ";
 
77
      if space then pr_space ();
72
78
      print_anything_list rest in
73
79
 
74
80
let print_around printer term = function
79
85
      print_anything bef; printer term; print_anything aft in
80
86
 
81
87
let print_string_befaft fn fn1 x info =
82
 
  List.iter (function (s,_,_) -> fn1(); print_string s; force_newline())
 
88
  List.iter
 
89
    (function (s,ln,col) -> fn1(); print_string s ln col; force_newline())
83
90
    info.Ast.strbef;
84
91
  fn x;
85
 
  List.iter (function (s,_,_) -> force_newline(); fn1(); print_string s)
 
92
  List.iter
 
93
    (function (s,ln,col) -> force_newline(); fn1(); print_string s ln col)
86
94
    info.Ast.straft in
87
95
 
88
 
let print_meta (r,x) = print_string x in
 
96
let print_meta (r,x) = print_text x in
89
97
 
90
98
let print_pos = function
91
99
    Ast.MetaPos(name,_,_,_,_) ->
92
100
      let name = Ast.unwrap_mcode name in
93
 
      print_string "@"; print_meta name
 
101
      print_text "@"; print_meta name
94
102
  | _ -> () in
95
103
 
96
104
(* --------------------------------------------------------------------- *)
97
105
 
98
 
let mcode fn arg =
99
 
  match (generating,arg) with
100
 
    (false,(s,info,_,_)) ->
 
106
let mcode fn (s,info,mc,pos) =
 
107
  let line = info.Ast.line in
 
108
  let lcol = info.Ast.column in
 
109
  match (generating,mc) with
 
110
    (false,_) ->
101
111
    (* printing for transformation *)
102
112
    (* Here we don't care about the annotation on s. *)
103
113
      let print_comments lb comments =
105
115
          (function line_before ->
106
116
            function (str,line,col) ->
107
117
              match line_before with
108
 
                None -> print_string str; Some line
109
 
              | Some lb when line =|= lb -> print_string str; Some line
110
 
              | _ -> print_string "\n"; print_string str; Some line)
 
118
                None -> print_string str line col; Some line
 
119
              | Some lb when line =|= lb ->
 
120
                  print_string str line col; Some line
 
121
              | _ -> force_newline(); print_string str line col; Some line)
111
122
          lb comments in
112
123
      let line_before = print_comments None info.Ast.strbef in
113
124
      (match line_before with
114
125
        None -> ()
115
126
      | Some lb when lb =|= info.Ast.line -> ()
116
 
      | _ -> print_string "\n");
117
 
      fn s;
 
127
      | _ -> force_newline());
 
128
      fn s line lcol;
118
129
      let _ = print_comments (Some info.Ast.line) info.Ast.straft in
119
130
      ()
120
131
      (* printing for rule generation *)
121
 
  | (true, (x, _, Ast.MINUS(_,plus_stream), pos)) ->
122
 
      print_string "\n- ";
123
 
      fn x; print_pos pos;
 
132
  | (true, Ast.MINUS(_,_,_,plus_stream)) ->
 
133
      force_newline();
 
134
      print_text "- ";
 
135
      fn s line lcol; print_pos pos;
124
136
      print_anything plus_stream
125
 
  | (true, (x, _, Ast.CONTEXT(_,plus_streams), pos)) ->
126
 
      let fn x = print_string "\n "; fn x; print_pos pos in
127
 
      print_around fn x plus_streams
128
 
  | (true,( x, info, Ast.PLUS, pos)) ->
129
 
      let fn x = print_string "\n+ "; fn x; print_pos pos in
130
 
      print_string_befaft fn (function _ -> print_string "+ ") x info
 
137
  | (true, Ast.CONTEXT(_,plus_streams)) ->
 
138
      let fn s = force_newline(); fn s line lcol; print_pos pos in
 
139
      print_around fn s plus_streams
 
140
  | (true,Ast.PLUS) ->
 
141
      let fn s =
 
142
        force_newline(); print_text "+ "; fn s line lcol; print_pos pos in
 
143
      print_string_befaft fn (function _ -> print_text "+ ") s info
131
144
in
132
145
 
133
146
 
134
147
(* --------------------------------------------------------------------- *)
135
148
 
136
149
let handle_metavar name fn =
137
 
  match (Common.optionise (fun () -> List.assoc (term name) env)) with
138
 
  | None ->
 
150
  let ((_,b) as s,info,mc,pos) = name in
 
151
  let line = info.Ast.line in
 
152
  let lcol = info.Ast.column in
 
153
  match Common.optionise (fun () -> List.assoc s env) with
 
154
    None ->
139
155
      let name_string (_,s) = s in
140
156
      if generating
141
 
      then mcode (function _ -> pr (name_string (term name))) name
 
157
      then
 
158
        mcode (function _ -> print_string (name_string s)) name
142
159
      else
143
160
        failwith
144
161
          (Printf.sprintf "SP line %d: Not found a value in env for: %s"
145
 
             (Ast_cocci.get_mcode_line name) (name_string (term name)))
 
162
             line (name_string s))
146
163
  | Some e  ->
147
 
      if generating
148
 
      then mcode (function _ -> fn e) name
149
 
      else fn e
 
164
      pr_barrier line lcol;
 
165
      (if generating
 
166
      then
 
167
        (* call mcode to preserve the -+ annotation *)
 
168
        mcode (fun _ _ _ -> fn e) name
 
169
      else fn e);
 
170
      let rcol = if lcol = unknown then unknown else lcol + (String.length b) in
 
171
      pr_barrier line rcol
150
172
in
151
173
(* --------------------------------------------------------------------- *)
152
174
let dots between fn d =
161
183
  let mc s = if multi then s^"+>" else s^">" in
162
184
  match Ast.unwrap d with
163
185
    Ast.DOTS(l) ->
164
 
      print_string (mo "..."); f(); start_block();
 
186
      print_text (mo "..."); f(); start_block();
165
187
      print_between force_newline fn l;
166
 
      end_block(); print_string (mc "...")
 
188
      end_block(); print_text (mc "...")
167
189
  | Ast.CIRCLES(l) ->
168
 
      print_string (mo "ooo"); f(); start_block();
 
190
      print_text (mo "ooo"); f(); start_block();
169
191
      print_between force_newline fn l;
170
 
      end_block(); print_string (mc "ooo")
 
192
      end_block(); print_text (mc "ooo")
171
193
  | Ast.STARS(l) ->
172
 
      print_string (mo "***"); f(); start_block();
 
194
      print_text (mo "***"); f(); start_block();
173
195
      print_between force_newline fn l;
174
 
      end_block(); print_string (mc "***")
 
196
      end_block(); print_text (mc "***")
175
197
in
176
198
 
177
199
(* --------------------------------------------------------------------- *)
182
204
    Ast.Id(name) -> mcode print_string name
183
205
  | Ast.MetaId(name,_,_,_) -> 
184
206
      handle_metavar name (function
185
 
        | (Ast_c.MetaIdVal id) -> pr id
 
207
        | (Ast_c.MetaIdVal id) -> print_text id
186
208
        | _ -> raise Impossible
187
209
        ) 
188
210
  | Ast.MetaFunc(name,_,_,_) -> 
189
211
      handle_metavar name (function
190
 
        | (Ast_c.MetaFuncVal id) -> pr id
 
212
        | (Ast_c.MetaFuncVal id) -> print_text id
191
213
        | _ -> raise Impossible
192
214
        ) 
193
215
  | Ast.MetaLocalFunc(name,_,_,_) -> 
194
216
      handle_metavar name (function
195
 
        | (Ast_c.MetaLocalFuncVal id) -> pr id
 
217
        | (Ast_c.MetaLocalFuncVal id) -> print_text id
196
218
        | _ -> raise Impossible
197
219
        )
198
220
 
205
227
(* Expression *)
206
228
 
207
229
let print_disj_list fn l =
208
 
  force_newline(); print_string "("; force_newline();
209
 
  print_between
210
 
    (function _ ->
211
 
      force_newline(); print_string "|"; force_newline())
212
 
    fn l;
213
 
  force_newline(); print_string ")"; force_newline() in
 
230
  print_text "\n(\n";
 
231
  print_between (function _ -> print_text "\n|\n") fn l;
 
232
  print_text "\n)\n" in
214
233
 
215
234
let rec expression e =
216
235
  match Ast.unwrap e with
217
236
    Ast.Ident(id) -> ident id
218
 
 
219
237
  | Ast.Constant(const) -> mcode constant const
220
238
  | Ast.FunCall(fn,lp,args,rp) ->
221
239
      expression fn; mcode print_string_box lp;
222
240
      dots (function _ -> ()) expression args;
223
241
      close_box(); mcode print_string rp
224
242
  | Ast.Assignment(left,op,right,_) ->
225
 
      expression left; print_string " "; mcode assignOp op;
226
 
      print_string " "; expression right
 
243
      expression left; pr_space(); mcode assignOp op;
 
244
      pr_space(); expression right
227
245
  | Ast.CondExpr(exp1,why,exp2,colon,exp3) ->
228
 
      expression exp1; print_string " "; mcode print_string why;
229
 
      print_option (function e -> print_string " "; expression e) exp2;
230
 
      print_string " "; mcode print_string colon; expression exp3
 
246
      expression exp1; pr_space(); mcode print_string why;
 
247
      print_option (function e -> pr_space(); expression e) exp2;
 
248
      pr_space(); mcode print_string colon; expression exp3
231
249
  | Ast.Postfix(exp,op) -> expression exp; mcode fixOp op
232
250
  | Ast.Infix(exp,op) -> mcode fixOp op; expression exp
233
251
  | Ast.Unary(exp,op) -> mcode unaryOp op; expression exp
234
252
  | Ast.Binary(left,op,right) ->
235
 
      expression left; print_string " "; mcode binaryOp op; print_string " ";
 
253
      expression left; pr_space(); mcode binaryOp op; pr_space();
236
254
      expression right
237
255
  | Ast.Nested(left,op,right) -> failwith "nested only in minus code"
238
256
  | Ast.Paren(lp,exp,rp) ->
273
291
        | _ -> raise Impossible
274
292
      )
275
293
 
276
 
  | Ast.EComma(cm) -> mcode print_string cm; print_space()
 
294
  | Ast.EComma(cm) -> mcode print_string cm; pr_space()
277
295
 
278
296
  | Ast.DisjExpr(exp_list) ->
279
297
      if generating
281
299
      else raise CantBeInPlus
282
300
  | Ast.NestExpr(expr_dots,Some whencode,multi) when generating ->
283
301
      nest_dots multi expression
284
 
        (function _ -> print_string "   when != "; expression whencode)
 
302
        (function _ -> print_text "   when != "; expression whencode)
285
303
        expr_dots
286
304
  | Ast.NestExpr(expr_dots,None,multi) when generating ->
287
305
      nest_dots multi expression (function _ -> ()) expr_dots
292
310
      if generating
293
311
      then
294
312
        (mcode print_string dots;
295
 
         print_string "   when != ";
 
313
         print_text "   when != ";
296
314
         expression whencode)
297
315
      else raise CantBeInPlus
298
316
  | Ast.Edots(dots,None)
315
333
 
316
334
and  assignOp = function
317
335
    Ast.SimpleAssign -> print_string "="
318
 
  | Ast.OpAssign(aop) -> arithOp aop; print_string "="
 
336
  | Ast.OpAssign(aop) ->
 
337
      (function line -> function lcol ->
 
338
        arithOp aop line lcol; print_string "=" line lcol)
319
339
 
320
340
and  fixOp = function
321
341
    Ast.Dec -> print_string "--"
348
368
  | Ast.OrLog -> print_string "||"
349
369
 
350
370
and constant = function
351
 
    Ast.String(s) -> print_string "\""; print_string s; print_string "\""
 
371
    Ast.String(s) -> print_string ("\""^s^"\"")
352
372
  | Ast.Char(s) -> print_string s
353
373
  | Ast.Int(s) -> print_string s
354
374
  | Ast.Float(s) -> print_string s
390
410
  | Ast.Array(ty,lb,size,rb) ->
391
411
      fullType ty; mcode print_string lb; print_option expression size;
392
412
      mcode print_string rb
393
 
  | Ast.EnumName(kind,name) -> mcode print_string kind; print_string " ";
 
413
  | Ast.EnumName(kind,name) -> mcode print_string kind; pr_space();
394
414
      ident name
395
415
  | Ast.StructUnionName(kind,name) ->
396
416
      mcode structUnion kind;
397
417
      print_option ident name
398
418
  | Ast.StructUnionDef(ty,lb,decls,rb) ->
399
 
      fullType ty;
 
419
      fullType ty; ft_space ty;
400
420
      mcode print_string lb;
401
421
      dots force_newline declaration decls;
402
422
      mcode print_string rb
452
472
      (match Ast.unwrap ty1 with
453
473
        Ast.FunctionPointer(ty,lp1,star,rp1,lp2,params,rp2) ->
454
474
          print_function_pointer (ty,lp1,star,rp1,lp2,params,rp2)
455
 
            (function _ -> print_string " "; ident id)
 
475
            (function _ -> pr_space(); ident id)
456
476
      | Ast.FunctionType(am,ty,lp1,params,rp1) ->
457
477
          print_function_type (ty,lp1,params,rp1)
458
 
            (function _ -> print_string " "; ident id)
 
478
            (function _ -> pr_space(); ident id)
459
479
      | Ast.Array(_,_,_,_) ->
460
480
          let rec loop ty k =
461
481
            match Ast.unwrap ty with
480
500
and ty_space ty =
481
501
  match Ast.unwrap ty with
482
502
    Ast.Pointer(_,_) -> ()
483
 
  | _ -> print_space()
 
503
  | _ -> pr_space()
484
504
 
485
505
and ft_space ty =
486
506
  match Ast.unwrap ty with
487
507
    Ast.Type(cv,ty) ->
488
508
      (match Ast.unwrap ty with
489
509
        Ast.Pointer(_,_) -> ()
490
 
      | _ -> print_space())
491
 
  | _ -> print_space()
 
510
      | _ -> pr_space())
 
511
  | _ -> pr_space()
492
512
 
493
513
and declaration d =
494
514
  match Ast.unwrap d with
495
515
    Ast.Init(stg,ty,id,eq,ini,sem) ->
496
516
      print_option (mcode storage) stg;
497
517
      print_named_type ty id;
498
 
      print_string " "; mcode print_string eq;
499
 
      print_string " "; initialiser true ini; mcode print_string sem
 
518
      pr_space(); mcode print_string eq;
 
519
      pr_space(); initialiser true ini; mcode print_string sem
500
520
  | Ast.UnInit(stg,ty,id,sem) ->
501
521
      print_option (mcode storage) stg;
502
522
      print_named_type ty id;
537
557
      end_block(); mcode print_string rb
538
558
  | Ast.InitList(lb,initlist,rb,_) -> failwith "unexpected whencode in plus"
539
559
  | Ast.InitGccExt(designators,eq,ini) ->
540
 
      List.iter designator designators; print_string " ";
541
 
      mcode print_string eq; print_string " "; initialiser nlcomma ini
 
560
      List.iter designator designators; pr_space();
 
561
      mcode print_string eq; pr_space(); initialiser nlcomma ini
542
562
  | Ast.InitGccName(name,eq,ini) ->
543
563
      ident name; mcode print_string eq; initialiser nlcomma ini
544
564
  | Ast.IComma(comma) ->
569
589
  | Ast.MetaParamList(name,_,_,_) -> 
570
590
      failwith "not handling MetaParamList"
571
591
 
572
 
  | Ast.PComma(cm) -> mcode print_string cm; print_space()
 
592
  | Ast.PComma(cm) -> mcode print_string cm; pr_space()
573
593
  | Ast.Pdots(dots) | Ast.Pcircles(dots) when generating ->
574
594
      mcode print_string dots
575
595
  | Ast.Pdots(dots) | Ast.Pcircles(dots) -> raise CantBeInPlus
584
604
 
585
605
let rec inc_file = function
586
606
    Ast.Local(elems) ->
587
 
      print_string "\"";
588
 
      print_between (function _ -> print_string "/") inc_elem elems;
589
 
      print_string "\""
 
607
      print_string ("\""^(String.concat "/" (List.map inc_elem elems))^"\"")
590
608
  | Ast.NonLocal(elems) ->
591
 
      print_string "<";
592
 
      print_between (function _ -> print_string "/") inc_elem elems;
593
 
      print_string ">"
 
609
      print_string ("<"^(String.concat "/" (List.map inc_elem elems))^">")
594
610
 
595
611
and inc_elem = function
596
 
    Ast.IncPath s -> print_string s
597
 
  | Ast.IncDots -> print_string "..."
 
612
    Ast.IncPath s -> s
 
613
  | Ast.IncDots -> "..."
598
614
 
599
615
(* --------------------------------------------------------------------- *)
600
616
(* Top-level code *)
602
618
and rule_elem arity re =
603
619
  match Ast.unwrap re with
604
620
    Ast.FunHeader(_,_,fninfo,name,lp,params,rp) ->
605
 
      print_string arity; List.iter print_fninfo fninfo;
 
621
      pr_arity arity; List.iter print_fninfo fninfo;
606
622
      ident name; mcode print_string_box lp;
607
623
      parameter_list params; close_box(); mcode print_string rp;
608
 
      print_string " "
609
 
  | Ast.Decl(_,_,decl) -> print_string arity; declaration decl
 
624
      pr_space()
 
625
  | Ast.Decl(_,_,decl) -> pr_arity arity; declaration decl
610
626
 
611
627
  | Ast.SeqStart(brace) ->
612
 
      print_string arity; mcode print_string brace; start_block()
 
628
      pr_arity arity; mcode print_string brace; start_block()
613
629
  | Ast.SeqEnd(brace) ->
614
 
      end_block(); print_string arity; mcode print_string brace
 
630
      end_block(); pr_arity arity; mcode print_string brace
615
631
 
616
632
  | Ast.ExprStatement(exp,sem) ->
617
 
      print_string arity; expression exp; mcode print_string sem
 
633
      pr_arity arity; expression exp; mcode print_string sem
618
634
 
619
635
  | Ast.IfHeader(iff,lp,exp,rp) ->
620
 
      print_string arity;
621
 
      mcode print_string iff; print_string " "; mcode print_string_box lp;
 
636
      pr_arity arity;
 
637
      mcode print_string iff; pr_space(); mcode print_string_box lp;
622
638
      expression exp; close_box(); mcode print_string rp
623
639
  | Ast.Else(els) ->
624
 
      print_string arity; mcode print_string els
 
640
      pr_arity arity; mcode print_string els
625
641
 
626
642
  | Ast.WhileHeader(whl,lp,exp,rp) ->
627
 
      print_string arity;
628
 
      mcode print_string whl; print_string " "; mcode print_string_box lp;
 
643
      pr_arity arity;
 
644
      mcode print_string whl; pr_space(); mcode print_string_box lp;
629
645
      expression exp; close_box(); mcode print_string rp
630
646
  | Ast.DoHeader(d) ->
631
 
      print_string arity; mcode print_string d
 
647
      pr_arity arity; mcode print_string d
632
648
  | Ast.WhileTail(whl,lp,exp,rp,sem) ->
633
 
      print_string arity;
634
 
      mcode print_string whl; print_string " "; mcode print_string_box lp;
 
649
      pr_arity arity;
 
650
      mcode print_string whl; pr_space(); mcode print_string_box lp;
635
651
      expression exp; close_box(); mcode print_string rp;
636
652
      mcode print_string sem
637
653
  | Ast.ForHeader(fr,lp,e1,sem1,e2,sem2,e3,rp) ->
638
 
      print_string arity;
 
654
      pr_arity arity;
639
655
      mcode print_string fr; mcode print_string_box lp;
640
656
      print_option expression e1; mcode print_string sem1;
641
657
      print_option expression e2; mcode print_string sem2;
642
658
      print_option expression e3; close_box();
643
659
      mcode print_string rp
644
660
  | Ast.IteratorHeader(nm,lp,args,rp) ->
645
 
      print_string arity;
646
 
      ident nm; print_string " "; mcode print_string_box lp;
 
661
      pr_arity arity;
 
662
      ident nm; pr_space(); mcode print_string_box lp;
647
663
      dots (function _ -> ()) expression args; close_box();
648
664
      mcode print_string rp
649
665
 
650
666
  | Ast.SwitchHeader(switch,lp,exp,rp) ->
651
 
      print_string arity;
652
 
      mcode print_string switch; print_string " "; mcode print_string_box lp;
 
667
      pr_arity arity;
 
668
      mcode print_string switch; pr_space(); mcode print_string_box lp;
653
669
      expression exp; close_box(); mcode print_string rp
654
670
 
655
671
  | Ast.Break(br,sem) ->
656
 
      print_string arity; mcode print_string br; mcode print_string sem
 
672
      pr_arity arity; mcode print_string br; mcode print_string sem
657
673
  | Ast.Continue(cont,sem) ->
658
 
      print_string arity; mcode print_string cont; mcode print_string sem
 
674
      pr_arity arity; mcode print_string cont; mcode print_string sem
659
675
  | Ast.Label(l,dd) -> ident l; mcode print_string dd
660
676
  | Ast.Goto(goto,l,sem) ->
661
677
      mcode print_string goto; ident l; mcode print_string sem
662
678
  | Ast.Return(ret,sem) ->
663
 
      print_string arity; mcode print_string ret; 
 
679
      pr_arity arity; mcode print_string ret; 
664
680
      mcode print_string sem
665
681
  | Ast.ReturnExpr(ret,exp,sem) ->
666
 
      print_string arity; mcode print_string ret; print_string " ";
 
682
      pr_arity arity; mcode print_string ret; pr_space();
667
683
      expression exp; mcode print_string sem
668
684
 
669
 
  | Ast.Exp(exp) -> print_string arity; expression exp
670
 
  | Ast.TopExp(exp) -> print_string arity; expression exp
671
 
  | Ast.Ty(ty) -> print_string arity; fullType ty
 
685
  | Ast.Exp(exp) -> pr_arity arity; expression exp
 
686
  | Ast.TopExp(exp) -> pr_arity arity; expression exp
 
687
  | Ast.Ty(ty) -> pr_arity arity; fullType ty
672
688
  | Ast.TopInit(init) -> initialiser false init
673
689
  | Ast.Include(inc,s) ->
674
 
      mcode print_string inc; print_string " "; mcode inc_file s
 
690
      mcode print_string inc; print_text " "; mcode inc_file s
675
691
  | Ast.DefineHeader(def,id,params) ->
676
 
      mcode print_string def; print_string " "; ident id; 
 
692
      mcode print_string def; pr_space(); ident id; 
677
693
      print_define_parameters params
678
694
  | Ast.Default(def,colon) ->
679
 
      mcode print_string def; mcode print_string colon; print_string " "
 
695
      mcode print_string def; mcode print_string colon; pr_space()
680
696
  | Ast.Case(case,exp,colon) ->
681
 
      mcode print_string case; print_string " "; expression exp;
682
 
      mcode print_string colon; print_string " "
 
697
      mcode print_string case; pr_space(); expression exp;
 
698
      mcode print_string colon; pr_space()
683
699
  | Ast.DisjRuleElem(res) ->
684
700
      if generating
685
701
      then
686
 
        (print_string arity;
687
 
         force_newline(); print_string "("; force_newline();
688
 
         print_between
689
 
           (function _ -> force_newline(); print_string "|"; force_newline())
690
 
           (rule_elem arity)
 
702
        (pr_arity arity; print_text "\n(\n";
 
703
         print_between (function _ -> print_text "\n|\n") (rule_elem arity)
691
704
           res;
692
 
         force_newline(); print_string ")")
 
705
         print_text "\n)")
693
706
      else raise CantBeInPlus
694
707
 
695
708
  | Ast.MetaRuleElem(name,_,_) ->
718
731
  | Ast.DPComma(comma) -> mcode print_string comma
719
732
  | Ast.DPdots(dots) -> mcode print_string dots
720
733
  | Ast.DPcircles(circles) -> mcode print_string circles
721
 
  | Ast.OptDParam(dp) -> print_string "?"; print_define_param dp
722
 
  | Ast.UniqueDParam(dp) -> print_string "!"; print_define_param dp
 
734
  | Ast.OptDParam(dp) -> print_text "?"; print_define_param dp
 
735
  | Ast.UniqueDParam(dp) -> print_text "!"; print_define_param dp
723
736
 
724
737
and print_fninfo = function
725
738
    Ast.FStorage(stg) -> mcode storage stg
726
739
  | Ast.FType(ty) -> fullType ty
727
 
  | Ast.FInline(inline) -> mcode print_string inline; print_string " "
728
 
  | Ast.FAttr(attr) -> mcode print_string attr; print_string " " in
 
740
  | Ast.FInline(inline) -> mcode print_string inline; pr_space()
 
741
  | Ast.FAttr(attr) -> mcode print_string attr; pr_space() in
729
742
 
730
743
let indent_if_needed s f =
731
744
  match Ast.unwrap s with
732
 
    Ast.Seq(lbrace,decls,body,rbrace) -> pr_space(); f()
 
745
    Ast.Seq(lbrace,body,rbrace) -> pr_space(); f()
733
746
  | _ ->
734
747
      (*no newline at the end - someone else will do that*)
735
748
      start_block(); f(); unindent() in
736
749
 
737
750
let rec statement arity s =
738
751
  match Ast.unwrap s with
739
 
    Ast.Seq(lbrace,decls,body,rbrace) ->
 
752
    Ast.Seq(lbrace,body,rbrace) ->
740
753
      rule_elem arity lbrace;
741
 
      dots force_newline (statement arity) decls;
742
754
      dots force_newline (statement arity) body;
743
755
      rule_elem arity rbrace
744
756
 
748
760
  | Ast.IfThenElse(header,branch1,els,branch2,_) ->
749
761
      rule_elem arity header;
750
762
      indent_if_needed branch1 (function _ -> statement arity branch1);
751
 
      print_string " ";
 
763
      force_newline();
752
764
      rule_elem arity els;
753
765
      indent_if_needed branch2 (function _ -> statement arity branch2)
754
 
 
755
766
  | Ast.While(header,body,_) ->
756
767
      rule_elem arity header;
757
768
      indent_if_needed body (function _ -> statement arity body)
765
776
  | Ast.Iterator(header,body,(_,_,_,aft)) ->
766
777
      rule_elem arity header;
767
778
      indent_if_needed body (function _ -> statement arity body);
768
 
      mcode (function _ -> ()) ((),Ast.no_info,aft,Ast.NoMetaPos)
 
779
      mcode (fun _ _ _ -> ()) ((),Ast.no_info,aft,Ast.NoMetaPos)
769
780
 
770
781
  | Ast.Switch(header,lb,cases,rb) ->
771
 
      rule_elem arity header; print_string " "; rule_elem arity lb;
 
782
      rule_elem arity header; pr_space(); rule_elem arity lb;
772
783
      List.iter (function x -> case_line arity x; force_newline()) cases;
773
784
      rule_elem arity rb
774
785
 
775
786
  | Ast.Atomic(re) -> rule_elem arity re
776
787
 
777
 
  | Ast.FunDecl(header,lbrace,decls,body,rbrace) ->
 
788
  | Ast.FunDecl(header,lbrace,body,rbrace) ->
778
789
      rule_elem arity header; rule_elem arity lbrace;
779
 
      dots force_newline (statement arity) decls;
780
790
      dots force_newline (statement arity) body; rule_elem arity rbrace
781
791
 
782
792
  | Ast.Define(header,body) ->
783
 
      rule_elem arity header; print_string " ";
 
793
      rule_elem arity header; pr_space();
784
794
      dots force_newline (statement arity) body
785
795
 
786
796
  | Ast.Disj([stmt_dots]) ->
787
797
      if generating
788
798
      then
789
 
        (print_string arity;
 
799
        (pr_arity arity;
790
800
         dots force_newline (statement arity) stmt_dots)
791
801
      else raise CantBeInPlus
792
802
  | Ast.Disj(stmt_dots_list) -> (* ignores newline directive for readability *)
793
803
      if generating
794
804
      then
795
 
        (print_string arity;
796
 
         force_newline(); print_string "("; force_newline();
797
 
         print_between
798
 
           (function _ -> force_newline();print_string "|"; force_newline())
 
805
        (pr_arity arity; print_text "\n(\n";
 
806
         print_between (function _ -> print_text "\n|\n")
799
807
           (dots force_newline (statement arity))
800
808
           stmt_dots_list;
801
 
         force_newline(); print_string ")")
 
809
         print_text "\n)")
802
810
      else raise CantBeInPlus
803
811
  | Ast.Nest(stmt_dots,whn,multi,_,_) when generating ->
804
 
      print_string arity;
 
812
      pr_arity arity;
805
813
      nest_dots multi (statement arity)
806
814
        (function _ ->
807
815
          print_between force_newline
812
820
  | Ast.Dots(d,whn,_,_) | Ast.Circles(d,whn,_,_) | Ast.Stars(d,whn,_,_) ->
813
821
      if generating
814
822
      then
815
 
        (print_string arity; mcode print_string d;
 
823
        (pr_arity arity; mcode print_string d;
816
824
         print_between force_newline
817
825
           (whencode (dots force_newline (statement "")) (statement "")) whn;
818
826
         force_newline())
823
831
 
824
832
and whencode notfn alwaysfn = function
825
833
    Ast.WhenNot a ->
826
 
      print_string "   WHEN != "; notfn a
 
834
      print_text "   WHEN != "; notfn a
827
835
  | Ast.WhenAlways a ->
828
 
      print_string "   WHEN = "; alwaysfn a
829
 
  | Ast.WhenModifier x -> print_string "   WHEN "; print_when_modif x
 
836
      print_text "   WHEN = "; alwaysfn a
 
837
  | Ast.WhenModifier x -> print_text "   WHEN "; print_when_modif x
830
838
  | Ast.WhenNotTrue a ->
831
 
      print_string "   WHEN != TRUE "; rule_elem "" a
 
839
      print_text "   WHEN != TRUE "; rule_elem "" a
832
840
  | Ast.WhenNotFalse a ->
833
 
      print_string "   WHEN != FALSE "; rule_elem "" a
 
841
      print_text "   WHEN != FALSE "; rule_elem "" a
834
842
 
835
843
and print_when_modif = function
836
 
  | Ast.WhenAny    -> print_string "ANY"
837
 
  | Ast.WhenStrict -> print_string "STRICT"
838
 
  | Ast.WhenForall -> print_string "FORALL"
839
 
  | Ast.WhenExists -> print_string "EXISTS"
 
844
  | Ast.WhenAny    -> print_text "ANY"
 
845
  | Ast.WhenStrict -> print_text "STRICT"
 
846
  | Ast.WhenForall -> print_text "FORALL"
 
847
  | Ast.WhenExists -> print_text "EXISTS"
840
848
 
841
849
and case_line arity c =
842
850
  match Ast.unwrap c with
843
851
    Ast.CaseLine(header,code) ->
844
 
      rule_elem arity header; print_string " ";
 
852
      rule_elem arity header; pr_space();
845
853
      dots force_newline (statement arity) code
846
854
  | Ast.OptCase(case) -> raise CantBeInPlus in
847
855
 
865
873
let rec pp_any = function
866
874
  (* assert: normally there is only CONTEXT NOTHING tokens in any *)
867
875
    Ast.FullTypeTag(x) -> fullType x; false
868
 
  | Ast.BaseTypeTag(x) -> baseType x; false
869
 
  | Ast.StructUnionTag(x) -> structUnion x; false
870
 
  | Ast.SignTag(x) -> sign x; false
 
876
  | Ast.BaseTypeTag(x) -> baseType x unknown unknown; false
 
877
  | Ast.StructUnionTag(x) -> structUnion x unknown unknown; false
 
878
  | Ast.SignTag(x) -> sign x unknown unknown; false
871
879
 
872
880
  | Ast.IdentTag(x) -> ident x; false
873
881
 
874
882
  | Ast.ExpressionTag(x) -> expression x; false
875
883
 
876
 
  | Ast.ConstantTag(x) -> constant x; false
877
 
  | Ast.UnaryOpTag(x) -> unaryOp x; false
878
 
  | Ast.AssignOpTag(x) -> assignOp x; false
879
 
  | Ast.FixOpTag(x) -> fixOp x; false
880
 
  | Ast.BinaryOpTag(x) -> binaryOp x; false
881
 
  | Ast.ArithOpTag(x) -> arithOp x; false
882
 
  | Ast.LogicalOpTag(x) -> logicalOp x; false
 
884
  | Ast.ConstantTag(x) -> constant x unknown unknown; false
 
885
  | Ast.UnaryOpTag(x) -> unaryOp x unknown unknown; false
 
886
  | Ast.AssignOpTag(x) -> assignOp x unknown unknown; false
 
887
  | Ast.FixOpTag(x) -> fixOp x unknown unknown; false
 
888
  | Ast.BinaryOpTag(x) -> binaryOp x unknown unknown; false
 
889
  | Ast.ArithOpTag(x) -> arithOp x unknown unknown; false
 
890
  | Ast.LogicalOpTag(x) -> logicalOp x unknown unknown; false
883
891
 
884
892
  | Ast.InitTag(x) -> initialiser false x; false
885
893
  | Ast.DeclarationTag(x) -> declaration x; false
886
894
 
887
 
  | Ast.StorageTag(x) -> storage x; false
888
 
  | Ast.IncFileTag(x) -> inc_file x; false
 
895
  | Ast.StorageTag(x) -> storage x unknown unknown; false
 
896
  | Ast.IncFileTag(x) -> inc_file x unknown unknown; false
889
897
 
890
898
  | Ast.Rule_elemTag(x) -> rule_elem "" x; false
891
899
  | Ast.StatementTag(x) -> statement "" x; false
892
900
  | Ast.CaseLineTag(x) -> case_line "" x; false
893
901
 
894
 
  | Ast.ConstVolTag(x) -> const_vol x; false
895
 
  | Ast.Pragma(xs) -> print_between force_newline print_string xs; false
896
 
  | Ast.Token(x,None) -> print_string x; if_open_brace x
 
902
  | Ast.ConstVolTag(x) -> const_vol x unknown unknown; false
 
903
  | Ast.Pragma(xs) -> print_between force_newline print_text xs; false
 
904
  | Ast.Token(x,None) -> print_text x; if_open_brace x
897
905
  | Ast.Token(x,Some info) -> 
898
906
      mcode
899
 
        (function x ->
 
907
        (fun x line lcol ->
900
908
          (match x with
901
 
            "else" -> pr "\n"
 
909
            "else" -> force_newline()
902
910
          | _ -> ());
903
 
          print_string x;
904
 
          (* if x ==~ Common.regexp_alpha then print_string " "; *)
 
911
          print_string x line lcol;
905
912
          (match x with
906
 
            (*"return" |*) "else" -> print_string " "
 
913
            "else" -> pr_space()
907
914
          | _ -> ()))
908
915
        (let nomcodekind = Ast.CONTEXT(Ast.DontCarePos,Ast.NOTHING) in
909
916
        (x,info,nomcodekind,Ast.NoMetaPos));
915
922
     normally there should be no '...' inside them *)
916
923
  | Ast.ExprDotsTag(x) -> dots (function _ -> ()) expression x; false
917
924
  | Ast.ParamDotsTag(x) -> parameter_list x; false
918
 
  | Ast.StmtDotsTag(x) -> dots (function _ -> pr "\n") (statement "") x; false
919
 
  | Ast.DeclDotsTag(x) -> dots (function _ -> pr "\n") declaration x; false
 
925
  | Ast.StmtDotsTag(x) -> dots force_newline (statement "") x; false
 
926
  | Ast.DeclDotsTag(x) -> dots force_newline declaration x; false
920
927
 
921
928
  | Ast.TypeCTag(x) -> typeC x; false
922
929
  | Ast.ParamTag(x) -> parameterTypeDef x; false
939
946
        | _ -> false in
940
947
      let prnl x =
941
948
        (if unindent_before x then unindent());
942
 
        pr "\n" in
 
949
        force_newline() in
943
950
      let newline_before _ =
944
951
        if before =*= After
945
952
        then
946
953
          let hd = List.hd xxs in
947
954
          match hd with
948
 
            (Ast.StatementTag s::_) when isfn s -> pr "\n\n"
 
955
            (Ast.StatementTag s::_) when isfn s ->
 
956
              force_newline(); force_newline()
949
957
          | (Ast.Pragma _::_)
950
958
          | (Ast.Rule_elemTag _::_) | (Ast.StatementTag _::_)
951
959
          | (Ast.InitTag _::_)
956
964
        then
957
965
          match List.rev(List.hd(List.rev xxs)) with
958
966
            (Ast.StatementTag s::_) ->
959
 
              if isfn s then pr "\n\n" else pr "\n"
 
967
              (if isfn s then force_newline());
 
968
              force_newline()
960
969
          | (Ast.Pragma _::_)
961
970
          | (Ast.Rule_elemTag _::_) | (Ast.InitTag _::_)
962
 
          | (Ast.DeclarationTag _::_) | (Ast.Token ("{",_)::_) -> pr "\n"
 
971
          | (Ast.DeclarationTag _::_) | (Ast.Token ("{",_)::_) ->
 
972
              force_newline()
963
973
          | _ -> () in
964
974
      (* print a newline at the beginning, if needed *)
965
975
      newline_before();
970
980
            (if leading_newline
971
981
            then
972
982
              match (indent_needed,unindent_before x) with
973
 
                (true,true) -> pr "\n"
974
 
              | (true,false) -> pr "\n"; indent()
975
 
              | (false,true) -> unindent(); pr "\n"
976
 
              | (false,false) -> pr "\n");
 
983
                (true,true) -> force_newline()
 
984
              | (true,false) -> force_newline(); indent()
 
985
              | (false,true) -> unindent(); force_newline()
 
986
              | (false,false) -> force_newline());
977
987
            let indent_needed =
978
988
              List.fold_left (function indent_needed -> pp_any) false x in
979
989
            loop true indent_needed xs in