Better pretty-printing of forall types
authorSimon Peyton Jones <simonpj@microsoft.com>
Wed, 3 Oct 2018 14:58:13 +0000 (15:58 +0100)
committerSimon Peyton Jones <simonpj@microsoft.com>
Thu, 4 Oct 2018 14:37:58 +0000 (15:37 +0100)
Currently forall-types with a lot of type variables,
or type variables with big kinds, are pretty-printed too
horizontally, and dribble off to the right in an illegible
way.

This patch treats the type variables as a group, and uses
'fsep' to lay them out decently.

compiler/iface/IfaceType.hs
testsuite/tests/ghci/scripts/T12550.stdout

index 23b09da..264dfa0 100644 (file)
@@ -929,9 +929,10 @@ ppr_iface_forall_part show_forall tvs ctxt sdoc
 pprIfaceForAll :: [IfaceForAllBndr] -> SDoc
 pprIfaceForAll [] = empty
 pprIfaceForAll bndrs@(Bndr _ vis : _)
-  = add_separator (forAllLit <+> doc) <+> pprIfaceForAll bndrs'
+  = sep [ add_separator (forAllLit <+> fsep docs)
+        , pprIfaceForAll bndrs' ]
   where
-    (bndrs', doc) = ppr_itv_bndrs bndrs vis
+    (bndrs', docs) = ppr_itv_bndrs bndrs vis
 
     add_separator stuff = case vis of
                             Required -> stuff <+> arrow
@@ -943,12 +944,12 @@ pprIfaceForAll bndrs@(Bndr _ vis : _)
 -- No anonymous binders here!
 ppr_itv_bndrs :: [IfaceForAllBndr]
              -> ArgFlag  -- ^ visibility of the first binder in the list
-             -> ([IfaceForAllBndr], SDoc)
+             -> ([IfaceForAllBndr], [SDoc])
 ppr_itv_bndrs all_bndrs@(bndr@(Bndr _ vis) : bndrs) vis1
   | vis `sameVis` vis1 = let (bndrs', doc) = ppr_itv_bndrs bndrs vis1 in
-                         (bndrs', pprIfaceForAllBndr bndr <+> doc)
-  | otherwise   = (all_bndrs, empty)
-ppr_itv_bndrs [] _ = ([], empty)
+                         (bndrs', pprIfaceForAllBndr bndr : doc)
+  | otherwise   = (all_bndrs, [])
+ppr_itv_bndrs [] _ = ([], [])
 
 pprIfaceForAllCo :: [(IfLclName, IfaceCoercion)] -> SDoc
 pprIfaceForAllCo []  = empty
index 0955db3..c7173fc 100644 (file)
@@ -57,8 +57,8 @@ datatypeName
     Datatype d ⇒
     t d f a → [Char]
 class Datatype (d ∷ k) where
-  datatypeName ∷ ∀ k1 (t ∷ k → (k1 → ★) → k1 → ★) (f ∷ k1
-                                                       → ★) (a ∷ k1).
+  datatypeName ∷ ∀ k1 (t ∷ k → (k1 → ★) → k1 → ★) (f ∷ k1 → ★)
+                   (a ∷ k1).
                  t d f a → [Char]
   ...
        -- Defined in ‘GHC.Generics’