Better -ddump-types
authorSimon Peyton Jones <simonpj@microsoft.com>
Wed, 3 Oct 2018 12:24:11 +0000 (13:24 +0100)
committerSimon Peyton Jones <simonpj@microsoft.com>
Thu, 4 Oct 2018 14:37:58 +0000 (15:37 +0100)
The debug flag -ddump-types is supposed to show the type
of Ids, and the kinds of type constructors.  It was doing
the former but not the latter -- instead it was using
showTyTying, which is actually less helpful when debugging.

This patch changes it to print the kind and roles of the thing.

I also made -ddump-types show pattern synonyms

19 files changed:
compiler/typecheck/TcRnDriver.hs
testsuite/tests/driver/json2.stderr
testsuite/tests/indexed-types/should_compile/T3017.stderr
testsuite/tests/partial-sigs/should_compile/ADT.stderr
testsuite/tests/partial-sigs/should_compile/DataFamilyInstanceLHS.stderr
testsuite/tests/partial-sigs/should_compile/Meltdown.stderr
testsuite/tests/partial-sigs/should_compile/NamedWildcardInDataFamilyInstanceLHS.stderr
testsuite/tests/partial-sigs/should_compile/NamedWildcardInTypeFamilyInstanceLHS.stderr
testsuite/tests/partial-sigs/should_compile/SkipMany.stderr
testsuite/tests/partial-sigs/should_compile/TypeFamilyInstanceLHS.stderr
testsuite/tests/roles/should_compile/Roles1.stderr
testsuite/tests/roles/should_compile/Roles14.stderr
testsuite/tests/roles/should_compile/Roles2.stderr
testsuite/tests/roles/should_compile/Roles3.stderr
testsuite/tests/roles/should_compile/Roles4.stderr
testsuite/tests/roles/should_compile/T8958.stderr
testsuite/tests/th/TH_Roles2.stderr
testsuite/tests/typecheck/should_compile/T12763.stderr
testsuite/tests/typecheck/should_compile/tc231.stderr

index 0648edd..9118f57 100644 (file)
@@ -66,6 +66,7 @@ import DynFlags
 import HsSyn
 import IfaceSyn ( ShowSub(..), showToHeader )
 import IfaceType( ShowForAllFlag(..) )
+import PatSyn( pprPatSynType )
 import PrelNames
 import PrelInfo
 import RdrName
@@ -76,7 +77,6 @@ import TcRnExports
 import TcEvidence
 import qualified BooleanFormula as BF
 import PprTyThing( pprTyThingInContext )
-import MkIface( tyThingToIfaceDecl )
 import Coercion( pprCoAxiom )
 import CoreFVs( orphNamesOfFamInst )
 import FamInst
@@ -2683,9 +2683,10 @@ pprTcGblEnv (TcGblEnv { tcg_type_env  = type_env,
                         tcg_imports   = imports })
   = vcat [ ppr_types type_env
          , ppr_tycons fam_insts type_env
+         , ppr_patsyns type_env
          , ppr_insts insts
          , ppr_fam_insts fam_insts
-         , vcat (map ppr rules)
+         , ppr_rules rules
          , text "Dependent modules:" <+>
                 pprUFM (imp_dep_mods imports) (ppr . sort)
          , text "Dependent packages:" <+>
@@ -2693,6 +2694,12 @@ pprTcGblEnv (TcGblEnv { tcg_type_env  = type_env,
   where         -- The use of sort is just to reduce unnecessary
                 -- wobbling in testsuite output
 
+ppr_rules :: [LRuleDecl GhcTc] -> SDoc
+ppr_rules rules
+  = ppUnless (null rules) $
+    hang (text "RULES")
+       2 (vcat (map ppr rules))
+
 ppr_types :: TypeEnv -> SDoc
 ppr_types type_env = getPprDebug $ \dbg ->
   let
@@ -2705,7 +2712,7 @@ ppr_types type_env = getPprDebug $ \dbg ->
         -- Top-level user-defined things have External names.
         -- Suppress internally-generated things unless -dppr-debug
   in
-  text "TYPE SIGNATURES" $$ nest 2 (ppr_sigs ids)
+  ppr_sigs ids
 
 ppr_tycons :: [FamInst] -> TypeEnv -> SDoc
 ppr_tycons fam_insts type_env = getPprDebug $ \dbg ->
@@ -2717,24 +2724,35 @@ ppr_tycons fam_insts type_env = getPprDebug $ \dbg ->
                                     isExternalName (tyConName tycon) &&
                                     not (tycon `elem` fi_tycons)
   in
-  vcat [ text "TYPE CONSTRUCTORS"
-       ,   nest 2 (ppr_tydecls tycons)
-       , text "COERCION AXIOMS"
-       ,   nest 2 (vcat (map pprCoAxiom (typeEnvCoAxioms type_env))) ]
+  vcat [ hang (text "TYPE CONSTRUCTORS")
+            2 (ppr_tydecls tycons)
+       , hang (text "COERCION AXIOMS")
+            2 (vcat (map pprCoAxiom (typeEnvCoAxioms type_env))) ]
+
+ppr_patsyns :: TypeEnv -> SDoc
+ppr_patsyns type_env
+  = ppUnless (null patsyns) $
+    hang (text "PATTERN SYNONYMS")
+       2 (vcat (map ppr_ps patsyns))
+  where
+    patsyns = typeEnvPatSyns type_env
+    ppr_ps ps = ppr ps <+> dcolon <+> pprPatSynType ps
 
 ppr_insts :: [ClsInst] -> SDoc
-ppr_insts []     = empty
-ppr_insts ispecs = text "INSTANCES" $$ nest 2 (pprInstances ispecs)
+ppr_insts ispecs
+  = ppUnless (null ispecs) $
+    hang (text "INSTANCES") 2 (pprInstances ispecs)
 
 ppr_fam_insts :: [FamInst] -> SDoc
-ppr_fam_insts []        = empty
-ppr_fam_insts fam_insts =
-  text "FAMILY INSTANCES" $$ nest 2 (pprFamInsts fam_insts)
+ppr_fam_insts fam_insts
+  = ppUnless (null fam_insts) $
+    hang (text "FAMILY INSTANCES")
+       2 (pprFamInsts fam_insts)
 
 ppr_sigs :: [Var] -> SDoc
-ppr_sigs ids
-        -- Print type signatures; sort by OccName
-  = vcat (map ppr_sig (sortBy (comparing getOccName) ids))
+ppr_sigs ids -- Print type signatures; sort by OccName
+  = hang (text "TYPE SIGNATURES")
+       2 (vcat (map ppr_sig (sortBy (comparing getOccName) ids)))
   where
     ppr_sig id = hang (ppr id <+> dcolon) 2 (ppr (tidyTopType (idType id)))
 
@@ -2742,11 +2760,21 @@ ppr_tydecls :: [TyCon] -> SDoc
 ppr_tydecls tycons
   -- Print type constructor info for debug purposes
   -- Sort by OccName to reduce unnecessary changes
-  = vcat [ ppr (tyThingToIfaceDecl (ATyCon tc))
-         | tc <- sortBy (comparing getOccName) tycons ]
-    -- The Outputable instance for IfaceDecl uses
-    -- showToIface, which is what we want here, whereas
-    -- pprTyThing uses ShowSome.
+  = getPprDebug $ \ debug ->
+    vcat $ map (ppr_tc debug) $ sortBy (comparing getOccName) tycons
+  where
+    ppr_tc debug tc
+       = vcat [ ppWhen show_roles $
+                hang (text "type role" <+> ppr tc)
+                   2 (hsep (map ppr roles))
+              , hang (ppr tc <+> dcolon)
+                   2 (ppr (tidyTopType (tyConKind tc))) ]
+       where
+         roles = tyConRoles tc
+         show_roles = debug || not (all (== boring_role) roles)
+         boring_role | isClassTyCon tc = Nominal
+                     | otherwise       = Representational
+            -- Matches the choice in IfaceSyn, calls to pprRoles
 
 {-
 ********************************************************************************
index bf7f80a..b9e4297 100644 (file)
@@ -1 +1 @@
-{"span": null,"doc": "TYPE SIGNATURES\n  foo :: forall a. a -> a\nTYPE CONSTRUCTORS\nCOERCION AXIOMS\nDependent modules: []\nDependent packages: [base-4.12.0.0, ghc-prim-0.5.3,\n                     integer-gmp-1.0.2.0]","severity": "SevOutput","reason": null}
+{"span": null,"doc": "TYPE SIGNATURES foo :: forall a. a -> a\nTYPE CONSTRUCTORS\nCOERCION AXIOMS\nDependent modules: []\nDependent packages: [base-4.12.0.0, ghc-prim-0.5.3,\n                     integer-gmp-1.0.2.0]","severity": "SevOutput","reason": null}
index 5aaf3ce..2c82e8e 100644 (file)
@@ -6,12 +6,8 @@ TYPE SIGNATURES
   test2 ::
     forall c a b. (Coll c, Num a, Num b, Elem c ~ (a, b)) => c -> c
 TYPE CONSTRUCTORS
-  class Coll c where
-    type family Elem c :: * open
-    empty :: c
-    insert :: Elem c -> c -> c
-    {-# MINIMAL empty, insert #-}
-  data ListColl a = L [a]
+  Coll :: * -> Constraint
+  ListColl :: * -> *
 COERCION AXIOMS
   axiom Foo.D:R:ElemListColl ::
     Elem (ListColl a) = a -- Defined at T3017.hs:13:9
index ce0f93a..92e1bf5 100644 (file)
@@ -2,7 +2,7 @@ TYPE SIGNATURES
   ADT.Foo :: forall x y z. x -> y -> z -> Foo x y z
   bar :: Int -> Foo Bool () Int
 TYPE CONSTRUCTORS
-  data Foo x y z = Foo x y z
+  Foo :: * -> * -> * -> *
 COERCION AXIOMS
 Dependent modules: []
 Dependent packages: [base-4.12.0.0, ghc-prim-0.5.3,
index 4e0975e..f3be34f 100644 (file)
@@ -11,8 +11,9 @@ TYPE SIGNATURES
     DataFamilyInstanceLHS.R:SingMyKind_ _
   foo :: Sing 'A
 TYPE CONSTRUCTORS
-  data MyKind = A | B
-  data family Sing (a :: k)
+  MyKind :: *
+  type role Sing nominal nominal
+  Sing :: forall k. k -> *
 COERCION AXIOMS
   axiom DataFamilyInstanceLHS.D:R:SingMyKind_0 ::
     Sing _ = DataFamilyInstanceLHS.R:SingMyKind_
index 3dba495..752ee4d 100644 (file)
@@ -5,7 +5,7 @@ TYPE SIGNATURES
     NukeMonad param1 param2 () -> NukeMonad param1 param2 ()
 TYPE CONSTRUCTORS
   type role NukeMonad phantom phantom phantom
-  data NukeMonad a b c
+  NukeMonad :: * -> * -> * -> *
 COERCION AXIOMS
 INSTANCES
   instance Functor (NukeMonad a b) -- Defined at Meltdown.hs:8:10
index 8fae725..1c8a89a 100644 (file)
@@ -10,8 +10,9 @@ TYPE SIGNATURES
     (_a ~ 'B) =>
     NamedWildcardInDataFamilyInstanceLHS.R:SingMyKind_a _a
 TYPE CONSTRUCTORS
-  data MyKind = A | B
-  data family Sing (a :: k)
+  MyKind :: *
+  type role Sing nominal nominal
+  Sing :: forall k. k -> *
 COERCION AXIOMS
   axiom NamedWildcardInDataFamilyInstanceLHS.D:R:SingMyKind_a0 ::
     Sing _a = NamedWildcardInDataFamilyInstanceLHS.R:SingMyKind_a
index 92785a7..bb3720a 100644 (file)
@@ -1,9 +1,7 @@
 TYPE SIGNATURES
 TYPE CONSTRUCTORS
-  type family F a :: *
-    where
-        F _t = Int
-      axiom NamedWildcardInTypeFamilyInstanceLHS.D:R:F
+  type role F nominal
+  F :: * -> *
 COERCION AXIOMS
   axiom NamedWildcardInTypeFamilyInstanceLHS.D:R:F ::
     F _t = Int
index 5033a0c..3508652 100644 (file)
@@ -6,7 +6,7 @@ TYPE SIGNATURES
   skipMany' ::
     forall tok st a. GenParser tok st a -> GenParser tok st ()
 TYPE CONSTRUCTORS
-  data GenParser tok st a = GenParser tok st a
+  GenParser :: * -> * -> * -> *
 COERCION AXIOMS
 Dependent modules: []
 Dependent packages: [base-4.12.0.0, ghc-prim-0.5.3,
index 6e61c44..1a783cb 100644 (file)
@@ -1,7 +1,8 @@
 TYPE SIGNATURES
   foo :: F Int Char -> Int
 TYPE CONSTRUCTORS
-  type family F a b :: * open
+  type role F nominal nominal
+  F :: * -> * -> *
 COERCION AXIOMS
   axiom TypeFamilyInstanceLHS.D:R:FBool_ ::
     F Bool _ = Bool -- Defined at TypeFamilyInstanceLHS.hs:6:15
index 4eae0a4..e11b454 100644 (file)
@@ -8,17 +8,17 @@ TYPE SIGNATURES
   Roles1.K7 :: forall {k} (a :: k) b. b -> T7 a b
 TYPE CONSTRUCTORS
   type role T1 nominal
-  data T1 a = K1 a
-  data T2 a = K2 a
-  type role T3 phantom
-  data T3 (a :: k) = K3
+  T1 :: * -> *
+  T2 :: * -> *
+  type role T3 nominal phantom
+  T3 :: forall k. k -> *
   type role T4 nominal nominal
-  data T4 (a :: * -> *) b = K4 (a b)
-  data T5 a = K5 a
-  type role T6 phantom
-  data T6 (a :: k) = K6
-  type role T7 phantom representational
-  data T7 (a :: k) b = K7 b
+  T4 :: (* -> *) -> * -> *
+  T5 :: * -> *
+  type role T6 nominal phantom
+  T6 :: forall {k}. k -> *
+  type role T7 nominal phantom representational
+  T7 :: forall {k}. k -> * -> *
 COERCION AXIOMS
 Dependent modules: []
 Dependent packages: [base-4.12.0.0, ghc-prim-0.5.3,
index 86434f1..5789914 100644 (file)
@@ -2,9 +2,7 @@ TYPE SIGNATURES
   meth2 :: forall a. C2 a => a -> a
 TYPE CONSTRUCTORS
   type role C2 representational
-  class C2 a where
-    meth2 :: a -> a
-    {-# MINIMAL meth2 #-}
+  C2 :: * -> Constraint
 COERCION AXIOMS
   axiom Roles12.N:C2 :: C2 a = a -> a -- Defined at Roles14.hs:6:1
 Dependent modules: []
index 244b32f..81cf221 100644 (file)
@@ -2,9 +2,9 @@ TYPE SIGNATURES
   Roles2.K1 :: forall a. IO a -> T1 a
   Roles2.K2 :: forall a. FunPtr a -> T2 a
 TYPE CONSTRUCTORS
-  data T1 a = K1 (IO a)
+  T1 :: * -> *
   type role T2 phantom
-  data T2 a = K2 (FunPtr a)
+  T2 :: * -> *
 COERCION AXIOMS
 Dependent modules: []
 Dependent packages: [base-4.12.0.0, ghc-prim-0.5.3,
index aa2a07f..ff36be8 100644 (file)
@@ -4,22 +4,15 @@ TYPE SIGNATURES
   meth3 :: forall a b. C3 a b => a -> F3 b -> F3 b
   meth4 :: forall a b. C4 a b => a -> F4 b -> F4 b
 TYPE CONSTRUCTORS
-  class C1 a where
-    meth1 :: a -> a
-    {-# MINIMAL meth1 #-}
-  class C2 a b where
-    meth2 :: (a ~ b) => a -> b
-    {-# MINIMAL meth2 #-}
-  class C3 a b where
-    type family F3 b :: * open
-    meth3 :: a -> F3 b -> F3 b
-    {-# MINIMAL meth3 #-}
-  class C4 a b where
-    meth4 :: a -> F4 b -> F4 b
-    {-# MINIMAL meth4 #-}
-  type family F4 a :: * open
-  type Syn1 a = F4 a
-  type Syn2 a = [a]
+  C1 :: * -> Constraint
+  C2 :: * -> * -> Constraint
+  C3 :: * -> * -> Constraint
+  C4 :: * -> * -> Constraint
+  type role F4 nominal
+  F4 :: * -> *
+  type role Syn1 nominal
+  Syn1 :: * -> *
+  Syn2 :: * -> *
 COERCION AXIOMS
   axiom Roles3.N:C1 :: C1 a = a -> a -- Defined at Roles3.hs:6:1
   axiom Roles3.N:C2 ::
index 9f8803d..93a86a5 100644 (file)
@@ -2,13 +2,9 @@ TYPE SIGNATURES
   meth1 :: forall a. C1 a => a -> a
   meth3 :: forall a. C3 a => a -> Syn1 a
 TYPE CONSTRUCTORS
-  class C1 a where
-    meth1 :: a -> a
-    {-# MINIMAL meth1 #-}
-  class C3 a where
-    meth3 :: a -> Syn1 a
-    {-# MINIMAL meth3 #-}
-  type Syn1 a = [a]
+  C1 :: * -> Constraint
+  C3 :: * -> Constraint
+  Syn1 :: * -> *
 COERCION AXIOMS
   axiom Roles4.N:C1 :: C1 a = a -> a -- Defined at Roles4.hs:6:1
   axiom Roles4.N:C3 ::
index db4e833..55a6303 100644 (file)
@@ -5,10 +5,10 @@ TYPE SIGNATURES
   T8958.MkMap :: forall k v. [(k, v)] -> Map k v
 TYPE CONSTRUCTORS
   type role Map nominal representational
-  newtype (Nominal k, Representational v) => Map k v = MkMap [(k, v)]
-  class Nominal a
+  Map :: * -> * -> *
+  Nominal :: * -> Constraint
   type role Representational representational
-  class Representational a
+  Representational :: * -> Constraint
 COERCION AXIOMS
   axiom T8958.N:Map :: Map k v = [(k, v)] -- Defined at T8958.hs:13:1
 INSTANCES
index a94a52d..9112faf 100644 (file)
@@ -1,12 +1,12 @@
 TYPE SIGNATURES
 TYPE CONSTRUCTORS
-  type role T representational
-  data T (a :: k)
+  type role T nominal representational
+  T :: forall k. k -> *
 COERCION AXIOMS
 Dependent modules: []
-Dependent packages: [array-0.5.2.0, base-4.11.0.0, deepseq-1.4.3.0,
-                     ghc-boot-th-8.3, ghc-prim-0.5.2.1, integer-gmp-1.0.1.0,
-                     pretty-1.1.3.5, template-haskell-2.14.0.0]
+Dependent packages: [array-0.5.2.0, base-4.12.0.0, deepseq-1.4.4.0,
+                     ghc-boot-th-8.7, ghc-prim-0.5.3, integer-gmp-1.0.2.0,
+                     pretty-1.1.3.6, template-haskell-2.14.0.0]
 
 ==================== Typechecker ====================
 TH_Roles2.$tcT
index 6ad6961..c2c09d5 100644 (file)
@@ -2,9 +2,7 @@ TYPE SIGNATURES
   f :: Int -> ()
   m :: forall a. C a => a -> ()
 TYPE CONSTRUCTORS
-  class C a | -> a where
-    m :: a -> ()
-    {-# MINIMAL m #-}
+  C :: * -> Constraint
 COERCION AXIOMS
   axiom T12763.N:C :: C a = a -> () -- Defined at T12763.hs:6:1
 INSTANCES
index 485370c..10128de 100644 (file)
@@ -8,15 +8,13 @@ TYPE SIGNATURES
   huh :: forall s a b chain. Zork s a b => Q s a chain -> ST s ()
   s :: forall t t1. Q t (Z [Char]) t1 -> Q t (Z [Char]) t1
 TYPE CONSTRUCTORS
-  data Q s a chain = Node s a chain
-  data Z a = Z a
-  class Zork s a b | a -> b where
-    huh :: Q s a chain -> ST s ()
-    {-# MINIMAL huh #-}
+  Q :: * -> * -> * -> *
+  Z :: * -> *
+  Zork :: * -> * -> * -> Constraint
 COERCION AXIOMS
   axiom N:Zork ::
     Zork s a b = forall chain. Q s a chain -> ST s ()
       -- Defined at tc231.hs:25:1
 Dependent modules: []
 Dependent packages: [base-4.12.0.0, ghc-prim-0.5.3,
-                     integer-simple-0.1.1.1]
+                     integer-gmp-1.0.2.0]