From 745eb8d6d9f99b69d11c16e8fb5e133e8e27d0a8 Mon Sep 17 00:00:00 2001
From: Hugo Herbelin
Date: Tue, 15 Aug 2017 14:47:15 +0200
Subject: Improving spacing in printing disjunctive patterns.

Adding a space before the bar separating disjunctive patterns.
Removing an extra space after the bar for inner disjunctive patterns.
---
 lib/pp.ml            | 1 +
 lib/pp.mli           | 3 +++
 printing/ppconstr.ml | 4 ++--
 3 files changed, 6 insertions(+), 2 deletions(-)

diff --git a/lib/pp.ml b/lib/pp.ml
index c3338688d2..770e650cbd 100644
--- a/lib/pp.ml
+++ b/lib/pp.ml
@@ -208,6 +208,7 @@ let string_of_ppcmds c =
 let pr_comma () = str "," ++ spc ()
 let pr_semicolon () = str ";" ++ spc ()
 let pr_bar () = str "|" ++ spc ()
+let pr_spcbar () = str " |" ++ spc ()
 let pr_arg pr x = spc () ++ pr x
 let pr_non_empty_arg pr x = let pp = pr x in if ismt pp then mt () else spc () ++ pr x
 let pr_opt pr = function None -> mt () | Some x -> pr_arg pr x
diff --git a/lib/pp.mli b/lib/pp.mli
index 2d11cad86e..d9be1c5ce9 100644
--- a/lib/pp.mli
+++ b/lib/pp.mli
@@ -120,6 +120,9 @@ val pr_semicolon : unit -> t
 val pr_bar : unit -> t
 (** Well-spaced pipe bar. *)
 
+val pr_spcbar : unit -> t
+(** Pipe bar with space before and after. *)
+
 val pr_arg : ('a -> t) -> 'a -> t
 (** Adds a space in front of its argument. *)
 
diff --git a/printing/ppconstr.ml b/printing/ppconstr.ml
index 2abbc389fa..2c03d7c8df 100644
--- a/printing/ppconstr.ml
+++ b/printing/ppconstr.ml
@@ -286,7 +286,7 @@ let tag_var = tag Tag.variable
         pr_reference r, latom
 
       | CPatOr pl ->
-        hov 0 (prlist_with_sep pr_bar (pr_patt spc (lpator,L)) pl), lpator
+        hov 0 (prlist_with_sep pr_spcbar (pr_patt mt (lpator,L)) pl), lpator
 
       | CPatNotation ("( _ )",([p],[]),[]) ->
         pr_patt (fun()->str"(") (max_int,E) p ++ str")", latom
@@ -315,7 +315,7 @@ let tag_var = tag Tag.variable
     spc() ++ hov 4
       (pr_with_comments ?loc
          (str "| " ++
-            hov 0 (prlist_with_sep pr_bar (prlist_with_sep sep_v (pr_patt ltop)) pl
+            hov 0 (prlist_with_sep pr_spcbar (prlist_with_sep sep_v (pr_patt ltop)) pl
                    ++ str " =>") ++
             pr_sep_com spc (pr ltop) rhs))
 
-- 
cgit v1.2.3