[commit: ghc] master: Improve pretty-printing for pattern synonyms (c732711)

git at git.haskell.org git at git.haskell.org
Fri Jan 5 09:46:57 UTC 2018


Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/c73271163a3a025f0d1d49bcd6fa7763892dfb48/ghc

>---------------------------------------------------------------

commit c73271163a3a025f0d1d49bcd6fa7763892dfb48
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date:   Fri Jan 5 09:11:32 2018 +0000

    Improve pretty-printing for pattern synonyms
    
    Just better layout in output for the user


>---------------------------------------------------------------

c73271163a3a025f0d1d49bcd6fa7763892dfb48
 compiler/iface/IfaceSyn.hs                         | 12 +++++----
 testsuite/tests/ghci/scripts/T11524a.stdout        | 31 +++++++++++++---------
 .../tests/patsyn/should_compile/T14394.stdout      |  7 +++--
 3 files changed, 31 insertions(+), 19 deletions(-)

diff --git a/compiler/iface/IfaceSyn.hs b/compiler/iface/IfaceSyn.hs
index ac988c2..9afd2b8 100644
--- a/compiler/iface/IfaceSyn.hs
+++ b/compiler/iface/IfaceSyn.hs
@@ -862,11 +862,13 @@ pprIfaceDecl _ (IfacePatSyn { ifName = name,
   = sdocWithDynFlags mk_msg
   where
     mk_msg dflags
-      = hsep [ text "pattern", pprPrefixOcc name, dcolon
-             , univ_msg, pprIfaceContextArr req_ctxt
-             , ppWhen insert_empty_ctxt $ parens empty <+> darrow
-             , ex_msg, pprIfaceContextArr prov_ctxt
-             , pprIfaceType $ foldr IfaceFunTy pat_ty arg_tys]
+      = hang (text "pattern" <+> pprPrefixOcc name)
+           2 (dcolon <+> sep [univ_msg
+                             , pprIfaceContextArr req_ctxt
+                             , ppWhen insert_empty_ctxt $ parens empty <+> darrow
+                             , ex_msg
+                             , pprIfaceContextArr prov_ctxt
+                             , pprIfaceType $ foldr IfaceFunTy pat_ty arg_tys ])
       where
         univ_msg = pprUserIfaceForAll univ_bndrs
         ex_msg   = pprUserIfaceForAll ex_bndrs
diff --git a/testsuite/tests/ghci/scripts/T11524a.stdout b/testsuite/tests/ghci/scripts/T11524a.stdout
index d1ab96e..ea91ef9 100644
--- a/testsuite/tests/ghci/scripts/T11524a.stdout
+++ b/testsuite/tests/ghci/scripts/T11524a.stdout
@@ -6,13 +6,13 @@ pattern Pu :: p -> p 	-- Defined at <interactive>:18:1
 pattern Pue :: a -> a1 -> (a, Ex) 	-- Defined at <interactive>:19:1
 pattern Pur :: (Eq a, Num a) => a -> [a]
   	-- Defined at <interactive>:20:1
-pattern Purp :: (Eq a, Num a) => Show a1 => a
-                                            -> a1 -> ([a], UnivProv a1)
+pattern Purp
+  :: (Eq a, Num a) => Show a1 => a -> a1 -> ([a], UnivProv a1)
   	-- Defined at <interactive>:21:1
 pattern Pure :: (Eq a, Num a) => a -> a1 -> ([a], Ex)
   	-- Defined at <interactive>:22:1
-pattern Purep :: (Eq a, Num a) => Show a1 => a
-                                             -> a1 -> ([a], ExProv)
+pattern Purep
+  :: (Eq a, Num a) => Show a1 => a -> a1 -> ([a], ExProv)
   	-- Defined at <interactive>:23:1
 pattern Pep :: () => Show a => a -> ExProv
   	-- Defined at <interactive>:24:1
@@ -31,19 +31,26 @@ pattern Pue :: forall {a}. () => forall {a1}. a -> a1 -> (a, Ex)
   	-- Defined at <interactive>:19:1
 pattern Pur :: forall {a}. (Eq a, Num a) => a -> [a]
   	-- Defined at <interactive>:20:1
-pattern Purp :: forall {a} {a1}. (Eq a, Num a) => Show a1 => a
-                                                             -> a1 -> ([a], UnivProv a1)
+pattern Purp
+  :: forall {a} {a1}.
+     (Eq a, Num a) =>
+     Show a1 =>
+     a -> a1 -> ([a], UnivProv a1)
   	-- Defined at <interactive>:21:1
-pattern Pure :: forall {a}. (Eq a, Num a) => forall {a1}. a
-                                                          -> a1 -> ([a], Ex)
+pattern Pure
+  :: forall {a}. (Eq a, Num a) => forall {a1}. a -> a1 -> ([a], Ex)
   	-- Defined at <interactive>:22:1
-pattern Purep :: forall {a}. (Eq a, Num a) => forall {a1}. Show
-                                                             a1 => a -> a1 -> ([a], ExProv)
+pattern Purep
+  :: forall {a}.
+     (Eq a, Num a) =>
+     forall {a1}.
+     Show a1 =>
+     a -> a1 -> ([a], ExProv)
   	-- Defined at <interactive>:23:1
 pattern Pep :: () => forall {a}. Show a => a -> ExProv
   	-- Defined at <interactive>:24:1
 pattern Pup :: forall {a}. () => Show a => a -> UnivProv a
   	-- Defined at <interactive>:25:1
-pattern Puep :: forall {b}. () => forall {a}. Show a => a
-                                                        -> b -> (ExProv, b)
+pattern Puep
+  :: forall {b}. () => forall {a}. Show a => a -> b -> (ExProv, b)
   	-- Defined at <interactive>:26:1
diff --git a/testsuite/tests/patsyn/should_compile/T14394.stdout b/testsuite/tests/patsyn/should_compile/T14394.stdout
index 2dc3415..6495f9e 100644
--- a/testsuite/tests/patsyn/should_compile/T14394.stdout
+++ b/testsuite/tests/patsyn/should_compile/T14394.stdout
@@ -1,7 +1,10 @@
 pattern Foo :: () => (b ~ a) => a :~~: b
   	-- Defined at <interactive>:5:1
-pattern Bar :: forall k2 k1 (a :: k1) (b :: k2). () => (k2 ~ k1,
-                                                        (b :: k2) ~~ (a :: k1)) => a :~~: b
+pattern Bar
+  :: forall k2 k1 (a :: k1) (b :: k2).
+     () =>
+     (k2 ~ k1, (b :: k2) ~~ (a :: k1)) =>
+     a :~~: b
   	-- Defined at <interactive>:11:1
 pattern Bam :: () => Ord a => a -> a -> (S a, S a)
   	-- Defined at <interactive>:21:1



More information about the ghc-commits mailing list