Only pretty-print binders in closed type families with -fprint-explicit-foralls
authorRyan Scott <ryan.gl.scott@gmail.com>
Tue, 25 Apr 2017 22:38:34 +0000 (18:38 -0400)
committerBen Gamari <ben@smart-cactus.org>
Tue, 25 Apr 2017 22:39:51 +0000 (18:39 -0400)
Previously, we were unconditionally pretty-printing all type variable
binders when pretty-printing closed type families (e.g., in the output
of `:info` in GHCi). This threw me for a loop, so let's guard this behind
the `-fprint-explicit-foralls` flag.

Test Plan: make test TEST=T13420

Reviewers: goldfire, austin, bgamari

Reviewed By: bgamari

Subscribers: rwbarton, thomie

GHC Trac Issues: #13420

Differential Revision: https://phabricator.haskell.org/D3497

compiler/iface/IfaceSyn.hs
testsuite/tests/backpack/should_fail/bkpfail42.stderr
testsuite/tests/ghci/scripts/T13420.hs [new file with mode: 0644]
testsuite/tests/ghci/scripts/T13420.script [new file with mode: 0644]
testsuite/tests/ghci/scripts/T13420.stdout [new file with mode: 0644]
testsuite/tests/ghci/scripts/T7939.stdout
testsuite/tests/ghci/scripts/all.T
testsuite/tests/partial-sigs/should_compile/NamedWildcardInTypeFamilyInstanceLHS.stderr

index 5db8c99..047ed25 100644 (file)
@@ -67,6 +67,7 @@ import TyCon ( Role (..), Injectivity(..) )
 import Util( filterOut, filterByList )
 import DataCon (SrcStrictness(..), SrcUnpackedness(..))
 import Lexeme (isLexSym)
+import DynFlags
 
 import Control.Monad
 import System.IO.Unsafe
@@ -554,7 +555,10 @@ pprAxBranch pp_tc (IfaceAxBranch { ifaxbTyVars = tvs
     $+$
     nest 2 maybe_incomps
   where
-    ppr_binders
+    ppr_binders = sdocWithDynFlags $ \dflags ->
+                  ppWhen (gopt Opt_PrintExplicitForalls dflags) ppr_binders'
+
+    ppr_binders'
       | null tvs && null cvs = empty
       | null cvs
       = brackets (pprWithCommas (pprIfaceTvBndr True) tvs)
index 5a9e1aa..467ab71 100644 (file)
@@ -7,9 +7,9 @@ bkpfail42.bkp:9:9: error:
     • Type constructor ‘F’ has conflicting definitions in the module
       and its hsig file
       Main module: type family F a :: *
-                     where [a] F a = Int
+                     where F a = Int
       Hsig file:  type family F a :: *
-                    where [a] F a = Bool
+                    where F a = Bool
     • while merging the signatures from:
         • p[A=<A>]:A
         • ...and the local signature for A
diff --git a/testsuite/tests/ghci/scripts/T13420.hs b/testsuite/tests/ghci/scripts/T13420.hs
new file mode 100644 (file)
index 0000000..6b84e65
--- /dev/null
@@ -0,0 +1,7 @@
+{-# LANGUAGE TypeFamilies #-}
+module T13420 where
+
+type family F a where
+  F [Int] = Bool
+  F [a]   = Double
+  F (a b) = Char
diff --git a/testsuite/tests/ghci/scripts/T13420.script b/testsuite/tests/ghci/scripts/T13420.script
new file mode 100644 (file)
index 0000000..aba31bf
--- /dev/null
@@ -0,0 +1,2 @@
+:load T13420
+:i F
diff --git a/testsuite/tests/ghci/scripts/T13420.stdout b/testsuite/tests/ghci/scripts/T13420.stdout
new file mode 100644 (file)
index 0000000..e6b81ad
--- /dev/null
@@ -0,0 +1,6 @@
+type family F a :: *
+  where
+      F [Int] = Bool
+      F [a] = Double
+      F (a b) = Char
+       -- Defined at T13420.hs:4:1
index 2b2c8b7..db2590c 100644 (file)
@@ -15,13 +15,13 @@ type family H (a :: Bool) :: Bool
 H :: Bool -> Bool
 type family J (a :: [k]) :: Bool
   where
-    [k] J k '[] = 'False
-    [k, (h :: k), (t :: [k])] J k (h : t) = 'True
+      J k '[] = 'False
+      J k (h : t) = 'True
        -- Defined at T7939.hs:17:1
 J :: [k] -> Bool
 type family K (a1 :: [a]) :: Maybe a
   where
-    [a] K a '[] = 'Nothing
-    [a, (h :: a), (t :: [a])] K a (h : t) = 'Just h
+      K a '[] = 'Nothing
+      K a (h : t) = 'Just h
        -- Defined at T7939.hs:21:1
 K :: [a] -> Maybe a
index 917537b..ae0a528 100755 (executable)
@@ -251,6 +251,7 @@ test('T12550', normal, ghci_script, ['T12550.script'])
 test('StaticPtr', normal, ghci_script, ['StaticPtr.script'])
 test('T13202', normal, ghci_script, ['T13202.script'])
 test('T13202a', normal, ghci_script, ['T13202a.script'])
+test('T13420', normal, ghci_script, ['T13420.script'])
 test('T13466', normal, ghci_script, ['T13466.script'])
 test('GhciCurDir', normal, ghci_script, ['GhciCurDir.script'])
 test('T13591', expect_broken(13591), ghci_script, ['T13591.script'])
index 4fb8877..9d7618d 100644 (file)
@@ -2,7 +2,7 @@ TYPE SIGNATURES
 TYPE CONSTRUCTORS
   type family F a :: *
     where
-      [_t] F _t = Int
+        F _t = Int
       axiom NamedWildcardInTypeFamilyInstanceLHS.D:R:F
 COERCION AXIOMS
   axiom NamedWildcardInTypeFamilyInstanceLHS.D:R:F ::