From 93863aac894fb0f6c31b95b1c841fd20894696fb Mon Sep 17 00:00:00 2001
From: Alain Frisch <alain@frisch.fr>
Date: Thu, 9 Oct 2014 12:52:56 +0000
Subject: [PATCH] Factorize code to print constructors.

git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@15508 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
---
 parsing/pprintast.ml  | 60 ++++++++++++++++++++++++-------------------
 parsing/pprintast.mli |  2 ++
 2 files changed, 35 insertions(+), 27 deletions(-)

diff --git a/parsing/pprintast.ml b/parsing/pprintast.ml
index ad1e5daab..327d67041 100644
--- a/parsing/pprintast.ml
+++ b/parsing/pprintast.ml
@@ -1240,6 +1240,13 @@ class printer  ()= object(self:'self)
     | x :: xs -> pp f "@[<v>%a@,%a@]"
           (type_decl "type") x
           (self#list ~sep:"@," (type_decl "and")) xs
+
+  method record_declaration f lbls =
+    let type_record_field f pld =
+      pp f "@[<2>%a%s:@;%a@]" self#mutable_flag pld.pld_mutable pld.pld_name.txt self#core_type pld.pld_type in
+    pp f "{@\n%a}"
+      (self#list type_record_field ~sep:";@\n" )  lbls
+
   method type_declaration f x =
     let priv f =
       match x.ptype_private with
@@ -1252,18 +1259,8 @@ class printer  ()= object(self:'self)
       | Some y -> pp f "@;%a" self#core_type y
     in
     let constructor_declaration f pcd =
-      match pcd.pcd_res with
-      | None ->
-          pp f "|@;%s%a%a" pcd.pcd_name.txt
-             self#attributes pcd.pcd_attributes
-             (fun f -> function
-              | [] -> ()
-              | l -> pp f "@;of@;%a" (self#list self#core_type1 ~sep:"*@;") l)
-             pcd.pcd_args
-      | Some x ->
-          pp f "|@;%s%a:@;%a" pcd.pcd_name.txt
-             self#attributes pcd.pcd_attributes
-             (self#list self#core_type1 ~sep:"@;->@;") (pcd.pcd_args@[x])
+      pp f "|@;";
+      self#constructor_declaration f (pcd.pcd_name.txt, pcd.pcd_args, pcd.pcd_res, pcd.pcd_attributes)
     in
     let label_declaration f pld =
       pp f "@[<2>%a%s%a:@;%a;@]"
@@ -1310,23 +1307,32 @@ class printer  ()= object(self:'self)
          x.ptyext_constructors
          self#item_attributes x.ptyext_attributes
 
+  method constructor_declaration f (name, args, res, attrs) =
+    match res with
+    | None ->
+        pp f "%s%a%a" name
+          self#attributes attrs
+          (fun f -> function
+             | [] -> ()
+             | l ->
+                 pp f "@;of@;%a" (self#list self#core_type1 ~sep:"*@;") l
+          ) args
+    | Some r ->
+        pp f "%s%a:@;%a" name
+          self#attributes attrs
+          (fun f -> function
+             | [] -> self#core_type1 f r
+             | l -> pp f "%a@;->@;%a"
+                                  (self#list self#core_type1 ~sep:"*@;") l
+                                  self#core_type1 r
+          )
+          args
+
+
   method extension_constructor f x =
     match x.pext_kind with
-    | Pext_decl(l, None) ->
-        pp f "%s%a%a" x.pext_name.txt
-          self#attributes x.pext_attributes
-          (fun f -> function
-                 | [] -> ()
-                 | l -> pp f "@;of@;%a" (self#list self#core_type1 ~sep:"*@;") l) l
-    | Pext_decl(l, Some r) ->
-        pp f "%s%a:@;%a" x.pext_name.txt
-          self#attributes x.pext_attributes
-          (fun f -> function
-                 | [] -> self#core_type1 f r
-                 | l -> pp f "%a@;->@;%a"
-                           (self#list self#core_type1 ~sep:"*@;") l
-                           self#core_type1 r)
-          l
+    | Pext_decl(l, r) ->
+        self#constructor_declaration f (x.pext_name.txt, l, r, x.pext_attributes)
     | Pext_rebind li ->
         pp f "%s%a@;=@;%a" x.pext_name.txt
           self#attributes x.pext_attributes
diff --git a/parsing/pprintast.mli b/parsing/pprintast.mli
index 13e3d09ae..22e21adc6 100644
--- a/parsing/pprintast.mli
+++ b/parsing/pprintast.mli
@@ -37,6 +37,7 @@ class printer :
       Format.formatter -> Parsetree.class_type_declaration list -> unit
     method constant : Format.formatter -> Asttypes.constant -> unit
     method constant_string : Format.formatter -> string -> unit
+    method constructor_declaration : Format.formatter -> (string * Parsetree.core_type list * Parsetree.core_type option * Parsetree.attributes) -> unit
     method core_type : Format.formatter -> Parsetree.core_type -> unit
     method core_type1 : Format.formatter -> Parsetree.core_type -> unit
     method direction_flag :
@@ -80,6 +81,7 @@ class printer :
     method payload : Format.formatter -> Parsetree.payload -> unit
     method private_flag : Format.formatter -> Asttypes.private_flag -> unit
     method rec_flag : Format.formatter -> Asttypes.rec_flag -> unit
+    method record_declaration : Format.formatter -> Parsetree.label_declaration list -> unit
 
     method reset : 'b
     method reset_semi : 'b