parsing/printast.ml

   1 (***********************************************************************)
   2 (*                                                                     *)
   3 (*                           Objective Caml                            *)
   4 (*                                                                     *)
   5 (*             Damien Doligez, projet Para, INRIA Rocquencourt         *)
   6 (*                                                                     *)
   7 (*  Copyright 1999 Institut National de Recherche en Informatique et   *)
   8 (*  en Automatique.  All rights reserved.  This file is distributed    *)
   9 (*  under the terms of the Q Public License version 1.0.               *)
  10 (*                                                                     *)
  11 (***********************************************************************)
  12
  13 (* $Id$ *)
  14
  15 open Asttypes;;
  16 open Format;;
  17 open Lexing;;
  18 open Location;;
  19 open Parsetree;;
  20
  21 let fmt_position f l =
  22   if l.pos_fname = "" && l.pos_lnum = 1
  23   then fprintf f "%d" l.pos_cnum
  24   else if l.pos_lnum = -1
  25   then fprintf f "%s[%d]" l.pos_fname l.pos_cnum
  26   else fprintf f "%s[%d,%d+%d]" l.pos_fname l.pos_lnum l.pos_bol
  27                (l.pos_cnum - l.pos_bol)
  28 ;;
  29
  30 let fmt_location f loc =
  31   fprintf f "(%a..%a)" fmt_position loc.loc_start fmt_position loc.loc_end;
  32   if loc.loc_ghost then fprintf f " ghost";
  33 ;;
  34
  35 let rec fmt_longident_aux f x =
  36   match x with
  37   | Longident.Lident (s) -> fprintf f "%s" s;
  38   | Longident.Ldot (y, s) -> fprintf f "%a.%s" fmt_longident_aux y s;
  39   | Longident.Lapply (y, z) ->
  40       fprintf f "%a(%a)" fmt_longident_aux y fmt_longident_aux z;
  41 ;;
  42
  43 let fmt_longident f x = fprintf f "\"%a\"" fmt_longident_aux x;;
  44
  45 let fmt_constant f x =
  46   match x with
  47   | Const_int (i) -> fprintf f "Const_int %d" i;
  48   | Const_char (c) -> fprintf f "Const_char %02x" (Char.code c);
  49   | Const_string (s) -> fprintf f "Const_string %S" s;
  50   | Const_float (s) -> fprintf f "Const_float %s" s;
  51   | Const_int32 (i) -> fprintf f "Const_int32 %ld" i;
  52   | Const_int64 (i) -> fprintf f "Const_int64 %Ld" i;
  53   | Const_nativeint (i) -> fprintf f "Const_nativeint %nd" i;
  54 ;;
  55
  56 let fmt_mutable_flag f x =
  57   match x with
  58   | Immutable -> fprintf f "Immutable";
  59   | Mutable -> fprintf f "Mutable";
  60 ;;
  61
  62 let fmt_virtual_flag f x =
  63   match x with
  64   | Virtual -> fprintf f "Virtual";
  65   | Concrete -> fprintf f "Concrete";
  66 ;;
  67
  68 let fmt_rec_flag f x =
  69   match x with
  70   | Nonrecursive -> fprintf f "Nonrec";
  71   | Recursive -> fprintf f "Rec";
  72   | Default -> fprintf f "Default";
  73 ;;
  74
  75 let fmt_direction_flag f x =
  76   match x with
  77   | Upto -> fprintf f "Up";
  78   | Downto -> fprintf f "Down";
  79 ;;
  80
  81 let fmt_private_flag f x =
  82   match x with
  83   | Public -> fprintf f "Public";
  84   | Private -> fprintf f "Private";
  85 ;;
  86
  87 let line i f s (*...*) =
  88   fprintf f "%s" (String.make (2*i) ' ');
  89   fprintf f s (*...*)
  90 ;;
  91
  92 let list i f ppf l =
  93   match l with
  94   | [] -> line i ppf "[]\n";
  95   | h::t ->
  96      line i ppf "[\n";
  97      List.iter (f (i+1) ppf) l;
  98      line i ppf "]\n";
  99 ;;
 100
 101 let option i f ppf x =
 102   match x with
 103   | None -> line i ppf "None\n";
 104   | Some x ->
 105       line i ppf "Some\n";
 106       f (i+1) ppf x;
 107 ;;
 108
 109 let longident i ppf li = line i ppf "%a\n" fmt_longident li;;
 110 let string i ppf s = line i ppf "\"%s\"\n" s;;
 111 let bool i ppf x = line i ppf "%s\n" (string_of_bool x);;
 112 let label i ppf x = line i ppf "label=\"%s\"\n" x;;
 113
 114 let rec core_type i ppf x =
 115   line i ppf "core_type %a\n" fmt_location x.ptyp_loc;
 116   let i = i+1 in
 117   match x.ptyp_desc with
 118   | Ptyp_any -> line i ppf "Ptyp_any\n";
 119   | Ptyp_var (s) -> line i ppf "Ptyp_var %s\n" s;
 120   | Ptyp_arrow (l, ct1, ct2) ->
 121       line i ppf "Ptyp_arrow\n";
 122       string i ppf l;
 123       core_type i ppf ct1;
 124       core_type i ppf ct2;
 125   | Ptyp_tuple l ->
 126       line i ppf "Ptyp_tuple\n";
 127       list i core_type ppf l;
 128   | Ptyp_constr (li, l) ->
 129       line i ppf "Ptyp_constr %a\n" fmt_longident li;
 130       list i core_type ppf l;
 131   | Ptyp_variant (l, closed, low) ->
 132       line i ppf "Ptyp_variant closed=%s\n" (string_of_bool closed);
 133       list i label_x_bool_x_core_type_list ppf l;
 134       option i (fun i -> list i string) ppf low
 135   | Ptyp_object (l) ->
 136       line i ppf "Ptyp_object\n";
 137       list i core_field_type ppf l;
 138   | Ptyp_class (li, l, low) ->
 139       line i ppf "Ptyp_class %a\n" fmt_longident li;
 140       list i core_type ppf l;
 141       list i string ppf low
 142   | Ptyp_alias (ct, s) ->
 143       line i ppf "Ptyp_alias \"%s\"\n" s;
 144       core_type i ppf ct;
 145   | Ptyp_poly (sl, ct) ->
 146       line i ppf "Ptyp_poly%a\n"
 147         (fun ppf -> List.iter (fun x -> fprintf ppf " '%s" x)) sl;
 148       core_type i ppf ct;
 149
 150 and core_field_type i ppf x =
 151   line i ppf "core_field_type %a\n" fmt_location x.pfield_loc;
 152   let i = i+1 in
 153   match x.pfield_desc with
 154   | Pfield (s, ct) ->
 155       line i ppf "Pfield \"%s\"\n" s;
 156       core_type i ppf ct;
 157   | Pfield_var -> line i ppf "Pfield_var\n";
 158
 159 and pattern i ppf x =
 160   line i ppf "pattern %a\n" fmt_location x.ppat_loc;
 161   let i = i+1 in
 162   match x.ppat_desc with
 163   | Ppat_any -> line i ppf "Ppat_any\n";
 164   | Ppat_var (s) -> line i ppf "Ppat_var \"%s\"\n" s;
 165   | Ppat_alias (p, s) ->
 166       line i ppf "Ppat_alias \"%s\"\n" s;
 167       pattern i ppf p;
 168   | Ppat_constant (c) -> line i ppf "Ppat_constant %a\n" fmt_constant c;
 169   | Ppat_tuple (l) ->
 170       line i ppf "Ppat_tuple\n";
 171       list i pattern ppf l;
 172   | Ppat_construct (li, po, b) ->
 173       line i ppf "Ppat_construct %a\n" fmt_longident li;
 174       option i pattern ppf po;
 175       bool i ppf b;
 176   | Ppat_variant (l, po) ->
 177       line i ppf "Ppat_variant \"%s\"\n" l;
 178       option i pattern ppf po;
 179   | Ppat_record (l) ->
 180       line i ppf "Ppat_record\n";
 181       list i longident_x_pattern ppf l;
 182   | Ppat_array (l) ->
 183       line i ppf "Ppat_array\n";
 184       list i pattern ppf l;
 185   | Ppat_or (p1, p2) ->
 186       line i ppf "Ppat_or\n";
 187       pattern i ppf p1;
 188       pattern i ppf p2;
 189   | Ppat_constraint (p, ct) ->
 190       line i ppf "Ppat_constraint";
 191       pattern i ppf p;
 192       core_type i ppf ct;
 193   | Ppat_type li ->
 194       line i ppf "PPat_type";
 195       longident i ppf li
 196
 197 and expression i ppf x =
 198   line i ppf "expression %a\n" fmt_location x.pexp_loc;
 199   let i = i+1 in
 200   match x.pexp_desc with
 201   | Pexp_ident (li) -> line i ppf "Pexp_ident %a\n" fmt_longident li;
 202   | Pexp_constant (c) -> line i ppf "Pexp_constant %a\n" fmt_constant c;
 203   | Pexp_let (rf, l, e) ->
 204       line i ppf "Pexp_let %a\n" fmt_rec_flag rf;
 205       list i pattern_x_expression_def ppf l;
 206       expression i ppf e;
 207   | Pexp_function (p, eo, l) ->
 208       line i ppf "Pexp_function \"%s\"\n" p;
 209       option i expression ppf eo;
 210       list i pattern_x_expression_case ppf l;
 211   | Pexp_apply (e, l) ->
 212       line i ppf "Pexp_apply\n";
 213       expression i ppf e;
 214       list i label_x_expression ppf l;
 215   | Pexp_match (e, l) ->
 216       line i ppf "Pexp_match\n";
 217       expression i ppf e;
 218       list i pattern_x_expression_case ppf l;
 219   | Pexp_try (e, l) ->
 220       line i ppf "Pexp_try\n";
 221       expression i ppf e;
 222       list i pattern_x_expression_case ppf l;
 223   | Pexp_tuple (l) ->
 224       line i ppf "Pexp_tuple\n";
 225       list i expression ppf l;
 226   | Pexp_construct (li, eo, b) ->
 227       line i ppf "Pexp_construct %a\n" fmt_longident li;
 228       option i expression ppf eo;
 229       bool i ppf b;
 230   | Pexp_variant (l, eo) ->
 231       line i ppf "Pexp_variant \"%s\"\n" l;
 232       option i expression ppf eo;
 233   | Pexp_record (l, eo) ->
 234       line i ppf "Pexp_record\n";
 235       list i longident_x_expression ppf l;
 236       option i expression ppf eo;
 237   | Pexp_field (e, li) ->
 238       line i ppf "Pexp_field\n";
 239       expression i ppf e;
 240       longident i ppf li;
 241   | Pexp_setfield (e1, li, e2) ->
 242       line i ppf "Pexp_setfield\n";
 243       expression i ppf e1;
 244       longident i ppf li;
 245       expression i ppf e2;
 246   | Pexp_array (l) ->
 247       line i ppf "Pexp_array\n";
 248       list i expression ppf l;
 249   | Pexp_ifthenelse (e1, e2, eo) ->
 250       line i ppf "Pexp_ifthenelse\n";
 251       expression i ppf e1;
 252       expression i ppf e2;
 253       option i expression ppf eo;
 254   | Pexp_sequence (e1, e2) ->
 255       line i ppf "Pexp_sequence\n";
 256       expression i ppf e1;
 257       expression i ppf e2;
 258   | Pexp_while (e1, e2) ->
 259       line i ppf "Pexp_while\n";
 260       expression i ppf e1;
 261       expression i ppf e2;
 262   | Pexp_for (s, e1, e2, df, e3) ->
 263       line i ppf "Pexp_for \"%s\" %a\n" s fmt_direction_flag df;
 264       expression i ppf e1;
 265       expression i ppf e2;
 266       expression i ppf e3;
 267   | Pexp_constraint (e, cto1, cto2) ->
 268       line i ppf "Pexp_constraint\n";
 269       expression i ppf e;
 270       option i core_type ppf cto1;
 271       option i core_type ppf cto2;
 272   | Pexp_when (e1, e2) ->
 273       line i ppf "Pexp_when\n";
 274       expression i ppf e1;
 275       expression i ppf e2;
 276   | Pexp_send (e, s) ->
 277       line i ppf "Pexp_send \"%s\"\n" s;
 278       expression i ppf e;
 279   | Pexp_new (li) -> line i ppf "Pexp_new %a\n" fmt_longident li;
 280   | Pexp_setinstvar (s, e) ->
 281       line i ppf "Pexp_setinstvar \"%s\"\n" s;
 282       expression i ppf e;
 283   | Pexp_override (l) ->
 284       line i ppf "Pexp_override\n";
 285       list i string_x_expression ppf l;
 286   | Pexp_letmodule (s, me, e) ->
 287       line i ppf "Pexp_letmodule \"%s\"\n" s;
 288       module_expr i ppf me;
 289       expression i ppf e;
 290   | Pexp_assert (e) ->
 291       line i ppf "Pexp_assert";
 292       expression i ppf e;
 293   | Pexp_assertfalse ->
 294       line i ppf "Pexp_assertfalse";
 295   | Pexp_lazy (e) ->
 296       line i ppf "Pexp_lazy";
 297       expression i ppf e;
 298   | Pexp_poly (e, cto) ->
 299       line i ppf "Pexp_poly\n";
 300       expression i ppf e;
 301       option i core_type ppf cto;
 302   | Pexp_object s ->
 303       line i ppf "Pexp_object";
 304       class_structure i ppf s
 305
 306 and value_description i ppf x =
 307   line i ppf "value_description\n";
 308   core_type (i+1) ppf x.pval_type;
 309   list (i+1) string ppf x.pval_prim;
 310
 311 and type_declaration i ppf x =
 312   line i ppf "type_declaration %a\n" fmt_location x.ptype_loc;
 313   let i = i+1 in
 314   line i ppf "ptype_params =\n";
 315   list (i+1) string ppf x.ptype_params;
 316   line i ppf "ptype_cstrs =\n";
 317   list (i+1) core_type_x_core_type_x_location ppf x.ptype_cstrs;
 318   line i ppf "ptype_kind =\n";
 319   type_kind (i+1) ppf x.ptype_kind;
 320   line i ppf "ptype_manifest =\n";
 321   option (i+1) core_type ppf x.ptype_manifest;
 322
 323 and type_kind i ppf x =
 324   match x with
 325   | Ptype_abstract ->
 326       line i ppf "Ptype_abstract\n"
 327   | Ptype_variant (l, priv) ->
 328       line i ppf "Ptype_variant %a\n" fmt_private_flag priv;
 329       list (i+1) string_x_core_type_list_x_location ppf l;
 330   | Ptype_record (l, priv) ->
 331       line i ppf "Ptype_record %a\n" fmt_private_flag priv;
 332       list (i+1) string_x_mutable_flag_x_core_type_x_location ppf l;
 333   | Ptype_private ->
 334       line i ppf "Ptype_private\n"
 335
 336 and exception_declaration i ppf x = list i core_type ppf x
 337
 338 and class_type i ppf x =
 339   line i ppf "class_type %a\n" fmt_location x.pcty_loc;
 340   let i = i+1 in
 341   match x.pcty_desc with
 342   | Pcty_constr (li, l) ->
 343       line i ppf "Pcty_constr %a\n" fmt_longident li;
 344       list i core_type ppf l;
 345   | Pcty_signature (cs) ->
 346       line i ppf "Pcty_signature\n";
 347       class_signature i ppf cs;
 348   | Pcty_fun (l, co, cl) ->
 349       line i ppf "Pcty_fun \"%s\"\n" l;
 350       core_type i ppf co;
 351       class_type i ppf cl;
 352
 353 and class_signature i ppf (ct, l) =
 354   line i ppf "class_signature\n";
 355   core_type (i+1) ppf ct;
 356   list (i+1) class_type_field ppf l;
 357
 358 and class_type_field i ppf x =
 359   match x with
 360   | Pctf_inher (ct) ->
 361       line i ppf "Pctf_inher\n";
 362       class_type i ppf ct;
 363   | Pctf_val (s, mf, vf, ct, loc) ->
 364       line i ppf
 365         "Pctf_val \"%s\" %a %a %a\n" s
 366         fmt_mutable_flag mf fmt_virtual_flag vf fmt_location loc;
 367       core_type (i+1) ppf ct;
 368   | Pctf_virt (s, pf, ct, loc) ->
 369       line i ppf
 370         "Pctf_virt \"%s\" %a %a\n" s fmt_private_flag pf fmt_location loc;
 371       core_type (i+1) ppf ct;
 372   | Pctf_meth (s, pf, ct, loc) ->
 373       line i ppf
 374         "Pctf_meth \"%s\" %a %a\n" s fmt_private_flag pf fmt_location loc;
 375       core_type (i+1) ppf ct;
 376   | Pctf_cstr (ct1, ct2, loc) ->
 377       line i ppf "Pctf_cstr %a\n" fmt_location loc;
 378       core_type i ppf ct1;
 379       core_type i ppf ct2;
 380
 381 and class_description i ppf x =
 382   line i ppf "class_description %a\n" fmt_location x.pci_loc;
 383   let i = i+1 in
 384   line i ppf "pci_virt = %a\n" fmt_virtual_flag x.pci_virt;
 385   line i ppf "pci_params =\n";
 386   string_list_x_location (i+1) ppf x.pci_params;
 387   line i ppf "pci_name = \"%s\"\n" x.pci_name;
 388   line i ppf "pci_expr =\n";
 389   class_type (i+1) ppf x.pci_expr;
 390
 391 and class_type_declaration i ppf x =
 392   line i ppf "class_type_declaration %a\n" fmt_location x.pci_loc;
 393   let i = i+1 in
 394   line i ppf "pci_virt = %a\n" fmt_virtual_flag x.pci_virt;
 395   line i ppf "pci_params =\n";
 396   string_list_x_location (i+1) ppf x.pci_params;
 397   line i ppf "pci_name = \"%s\"\n" x.pci_name;
 398   line i ppf "pci_expr =\n";
 399   class_type (i+1) ppf x.pci_expr;
 400
 401 and class_expr i ppf x =
 402   line i ppf "class_expr %a\n" fmt_location x.pcl_loc;
 403   let i = i+1 in
 404   match x.pcl_desc with
 405   | Pcl_constr (li, l) ->
 406       line i ppf "Pcl_constr %a\n" fmt_longident li;
 407       list i core_type ppf l;
 408   | Pcl_structure (cs) ->
 409       line i ppf "Pcl_structure\n";
 410       class_structure i ppf cs;
 411   | Pcl_fun (l, eo, p, e) ->
 412       line i ppf "Pcl_fun\n";
 413       label i ppf l;
 414       option i expression ppf eo;
 415       pattern i ppf p;
 416       class_expr i ppf e;
 417   | Pcl_apply (ce, l) ->
 418       line i ppf "Pcl_apply\n";
 419       class_expr i ppf ce;
 420       list i label_x_expression ppf l;
 421   | Pcl_let (rf, l, ce) ->
 422       line i ppf "Pcl_let %a\n" fmt_rec_flag rf;
 423       list i pattern_x_expression_def ppf l;
 424       class_expr i ppf ce;
 425   | Pcl_constraint (ce, ct) ->
 426       line i ppf "Pcl_constraint\n";
 427       class_expr i ppf ce;
 428       class_type i ppf ct;
 429
 430 and class_structure i ppf (p, l) =
 431   line i ppf "class_structure\n";
 432   pattern (i+1) ppf p;
 433   list (i+1) class_field ppf l;
 434
 435 and class_field i ppf x =
 436   match x with
 437   | Pcf_inher (ce, so) ->
 438       line i ppf "Pcf_inher\n";
 439       class_expr (i+1) ppf ce;
 440       option (i+1) string ppf so;
 441   | Pcf_valvirt (s, mf, ct, loc) ->
 442       line i ppf
 443         "Pcf_valvirt \"%s\" %a %a\n" s fmt_mutable_flag mf fmt_location loc;
 444       core_type (i+1) ppf ct;
 445   | Pcf_val (s, mf, e, loc) ->
 446       line i ppf
 447         "Pcf_val \"%s\" %a %a\n" s fmt_mutable_flag mf fmt_location loc;
 448       expression (i+1) ppf e;
 449   | Pcf_virt (s, pf, ct, loc) ->
 450       line i ppf
 451         "Pcf_virt \"%s\" %a %a\n" s fmt_private_flag pf fmt_location loc;
 452       core_type (i+1) ppf ct;
 453   | Pcf_meth (s, pf, e, loc) ->
 454       line i ppf
 455         "Pcf_meth \"%s\" %a %a\n" s fmt_private_flag pf fmt_location loc;
 456       expression (i+1) ppf e;
 457   | Pcf_cstr (ct1, ct2, loc) ->
 458       line i ppf "Pcf_cstr %a\n" fmt_location loc;
 459       core_type (i+1) ppf ct1;
 460       core_type (i+1) ppf ct2;
 461   | Pcf_let (rf, l, loc) ->
 462       line i ppf "Pcf_let %a %a\n" fmt_rec_flag rf fmt_location loc;
 463       list (i+1) pattern_x_expression_def ppf l;
 464   | Pcf_init (e) ->
 465       line i ppf "Pcf_init\n";
 466       expression (i+1) ppf e;
 467
 468 and class_declaration i ppf x =
 469   line i ppf "class_declaration %a\n" fmt_location x.pci_loc;
 470   let i = i+1 in
 471   line i ppf "pci_virt = %a\n" fmt_virtual_flag x.pci_virt;
 472   line i ppf "pci_params =\n";
 473   string_list_x_location (i+1) ppf x.pci_params;
 474   line i ppf "pci_name = \"%s\"\n" x.pci_name;
 475   line i ppf "pci_expr =\n";
 476   class_expr (i+1) ppf x.pci_expr;
 477
 478 and module_type i ppf x =
 479   line i ppf "module_type %a\n" fmt_location x.pmty_loc;
 480   let i = i+1 in
 481   match x.pmty_desc with
 482   | Pmty_ident (li) -> line i ppf "Pmty_ident %a\n" fmt_longident li;
 483   | Pmty_signature (s) ->
 484       line i ppf "Pmty_signature\n";
 485       signature i ppf s;
 486   | Pmty_functor (s, mt1, mt2) ->
 487       line i ppf "Pmty_functor \"%s\"\n" s;
 488       module_type i ppf mt1;
 489       module_type i ppf mt2;
 490   | Pmty_with (mt, l) ->
 491       line i ppf "Pmty_with\n";
 492       module_type i ppf mt;
 493       list i longident_x_with_constraint ppf l;
 494
 495 and signature i ppf x = list i signature_item ppf x
 496
 497 and signature_item i ppf x =
 498   line i ppf "signature_item %a\n" fmt_location x.psig_loc;
 499   let i = i+1 in
 500   match x.psig_desc with
 501   | Psig_value (s, vd) ->
 502       line i ppf "Psig_value \"%s\"\n" s;
 503       value_description i ppf vd;
 504   | Psig_type (l) ->
 505       line i ppf "Psig_type\n";
 506       list i string_x_type_declaration ppf l;
 507   | Psig_exception (s, ed) ->
 508       line i ppf "Psig_exception \"%s\"\n" s;
 509       exception_declaration i ppf ed;
 510   | Psig_module (s, mt) ->
 511       line i ppf "Psig_module \"%s\"\n" s;
 512       module_type i ppf mt;
 513   | Psig_recmodule decls ->
 514       line i ppf "Psig_recmodule\n";
 515       list i string_x_module_type ppf decls;
 516   | Psig_modtype (s, md) ->
 517       line i ppf "Psig_modtype \"%s\"\n" s;
 518       modtype_declaration i ppf md;
 519   | Psig_open (li) -> line i ppf "Psig_open %a\n" fmt_longident li;
 520   | Psig_include (mt) ->
 521       line i ppf "Psig_include\n";
 522       module_type i ppf mt;
 523   | Psig_class (l) ->
 524       line i ppf "Psig_class\n";
 525       list i class_description ppf l;
 526   | Psig_class_type (l) ->
 527       line i ppf "Psig_class_type\n";
 528       list i class_type_declaration ppf l;
 529
 530 and modtype_declaration i ppf x =
 531   match x with
 532   | Pmodtype_abstract -> line i ppf "Pmodtype_abstract\n";
 533   | Pmodtype_manifest (mt) ->
 534       line i ppf "Pmodtype_manifest\n";
 535       module_type (i+1) ppf mt;
 536
 537 and with_constraint i ppf x =
 538   match x with
 539   | Pwith_type (td) ->
 540       line i ppf "Pwith_type\n";
 541       type_declaration (i+1) ppf td;
 542   | Pwith_module (li) -> line i ppf "Pwith_module %a\n" fmt_longident li;
 543
 544 and module_expr i ppf x =
 545   line i ppf "module_expr %a\n" fmt_location x.pmod_loc;
 546   let i = i+1 in
 547   match x.pmod_desc with
 548   | Pmod_ident (li) -> line i ppf "Pmod_ident %a\n" fmt_longident li;
 549   | Pmod_structure (s) ->
 550       line i ppf "Pmod_structure\n";
 551       structure i ppf s;
 552   | Pmod_functor (s, mt, me) ->
 553       line i ppf "Pmod_functor \"%s\"\n" s;
 554       module_type i ppf mt;
 555       module_expr i ppf me;
 556   | Pmod_apply (me1, me2) ->
 557       line i ppf "Pmod_apply\n";
 558       module_expr i ppf me1;
 559       module_expr i ppf me2;
 560   | Pmod_constraint (me, mt) ->
 561       line i ppf "Pmod_constraint\n";
 562       module_expr i ppf me;
 563       module_type i ppf mt;
 564
 565 and structure i ppf x = list i structure_item ppf x
 566
 567 and structure_item i ppf x =
 568   line i ppf "structure_item %a\n" fmt_location x.pstr_loc;
 569   let i = i+1 in
 570   match x.pstr_desc with
 571   | Pstr_eval (e) ->
 572       line i ppf "Pstr_eval\n";
 573       expression i ppf e;
 574   | Pstr_value (rf, l) ->
 575       line i ppf "Pstr_value %a\n" fmt_rec_flag rf;
 576       list i pattern_x_expression_def ppf l;
 577   | Pstr_primitive (s, vd) ->
 578       line i ppf "Pstr_primitive \"%s\"\n" s;
 579       value_description i ppf vd;
 580   | Pstr_type (l) ->
 581       line i ppf "Pstr_type\n";
 582       list i string_x_type_declaration ppf l;
 583   | Pstr_exception (s, ed) ->
 584       line i ppf "Pstr_exception \"%s\"\n" s;
 585       exception_declaration i ppf ed;
 586   | Pstr_exn_rebind (s, li) ->
 587       line i ppf "Pstr_exn_rebind \"%s\" %a\n" s fmt_longident li;
 588   | Pstr_module (s, me) ->
 589       line i ppf "Pstr_module \"%s\"\n" s;
 590       module_expr i ppf me;
 591   | Pstr_recmodule bindings ->
 592       line i ppf "Pstr_recmodule\n";
 593       list i string_x_modtype_x_module ppf bindings;
 594   | Pstr_modtype (s, mt) ->
 595       line i ppf "Pstr_modtype \"%s\"\n" s;
 596       module_type i ppf mt;
 597   | Pstr_open (li) -> line i ppf "Pstr_open %a\n" fmt_longident li;
 598   | Pstr_class (l) ->
 599       line i ppf "Pstr_class\n";
 600       list i class_declaration ppf l;
 601   | Pstr_class_type (l) ->
 602       line i ppf "Pstr_class_type\n";
 603       list i class_type_declaration ppf l;
 604   | Pstr_include me ->
 605       line i ppf "Pstr_include";
 606       module_expr i ppf me
 607
 608 and string_x_type_declaration i ppf (s, td) =
 609   string i ppf s;
 610   type_declaration (i+1) ppf td;
 611
 612 and string_x_module_type i ppf (s, mty) =
 613   string i ppf s;
 614   module_type (i+1) ppf mty;
 615
 616 and string_x_modtype_x_module i ppf (s, mty, modl) =
 617   string i ppf s;
 618   module_type (i+1) ppf mty;
 619   module_expr (i+1) ppf modl;
 620
 621 and longident_x_with_constraint i ppf (li, wc) =
 622   line i ppf "%a\n" fmt_longident li;
 623   with_constraint (i+1) ppf wc;
 624
 625 and core_type_x_core_type_x_location i ppf (ct1, ct2, l) =
 626   line i ppf "<constraint> %a\n" fmt_location l;
 627   core_type (i+1) ppf ct1;
 628   core_type (i+1) ppf ct2;
 629
 630 and string_x_core_type_list_x_location i ppf (s, l, loc) =
 631   line i ppf "\"%s\" %a\n" s fmt_location loc;
 632   list (i+1) core_type ppf l;
 633
 634 and string_x_mutable_flag_x_core_type_x_location i ppf (s, mf, ct, loc) =
 635   line i ppf "\"%s\" %a %a\n" s fmt_mutable_flag mf fmt_location loc;
 636   core_type (i+1) ppf ct;
 637
 638 and string_list_x_location i ppf (l, loc) =
 639   line i ppf "<params> %a\n" fmt_location loc;
 640   list (i+1) string ppf l;
 641
 642 and longident_x_pattern i ppf (li, p) =
 643   line i ppf "%a\n" fmt_longident li;
 644   pattern (i+1) ppf p;
 645
 646 and pattern_x_expression_case i ppf (p, e) =
 647   line i ppf "<case>\n";
 648   pattern (i+1) ppf  p;
 649   expression (i+1) ppf e;
 650
 651 and pattern_x_expression_def i ppf (p, e) =
 652   line i ppf "<def>\n";
 653   pattern (i+1) ppf p;
 654   expression (i+1) ppf e;
 655
 656 and string_x_expression i ppf (s, e) =
 657   line i ppf "<override> \"%s\"\n" s;
 658   expression (i+1) ppf e;
 659
 660 and longident_x_expression i ppf (li, e) =
 661   line i ppf "%a\n" fmt_longident li;
 662   expression (i+1) ppf e;
 663
 664 and label_x_expression i ppf (l,e) =
 665   line i ppf "<label> \"%s\"\n" l;
 666   expression (i+1) ppf e;
 667
 668 and label_x_bool_x_core_type_list i ppf x =
 669   match x with
 670     Rtag (l, b, ctl) ->
 671       line i ppf "Rtag \"%s\" %s\n" l (string_of_bool b);
 672       list (i+1) core_type ppf ctl
 673   | Rinherit (ct) ->
 674       line i ppf "Rinherit\n";
 675       core_type (i+1) ppf ct
 676 ;;
 677
 678 let rec toplevel_phrase i ppf x =
 679   match x with
 680   | Ptop_def (s) ->
 681       line i ppf "Ptop_def\n";
 682       structure (i+1) ppf s;
 683   | Ptop_dir (s, da) ->
 684       line i ppf "Ptop_dir \"%s\"\n" s;
 685       directive_argument i ppf da;
 686
 687 and directive_argument i ppf x =
 688   match x with
 689   | Pdir_none -> line i ppf "Pdir_none\n"
 690   | Pdir_string (s) -> line i ppf "Pdir_string \"%s\"\n" s;
 691   | Pdir_int (i) -> line i ppf "Pdir_int %d\n" i;
 692   | Pdir_ident (li) -> line i ppf "Pdir_ident %a\n" fmt_longident li;
 693   | Pdir_bool (b) -> line i ppf "Pdir_bool %s\n" (string_of_bool b);
 694 ;;
 695
 696 let interface ppf x = list 0 signature_item ppf x;;
 697
 698 let implementation ppf x = list 0 structure_item ppf x;;
 699
 700 let top_phrase ppf x = toplevel_phrase 0 ppf x;;