morewip/no-skolem-info2

4 files changed, 60 insertions, 65 deletions

diff --git a/compiler/GHC/Tc/Gen/Sig.hs b/compiler/GHC/Tc/Gen/Sig.hs
index 3413d3e9b6..8e2f1f58fa 100644
--- a/compiler/GHC/Tc/Gen/Sig.hs
+++ b/compiler/GHC/Tc/Gen/Sig.hs
@@ -406,7 +406,7 @@ tcPatSynSig name sig_ty@(L _ (HsSig{sig_bndrs = hs_outer_bndrs, sig_body = hs_ty
   , (ex_hs_tvbndrs, hs_prov, hs_body_ty) <- splitLHsSigmaTyInvis hs_ty1
   = do { traceTc "tcPatSynSig 1" (ppr sig_ty)
 
-       ; skol_info <- mkSkolemInfo (DataConSkol name)
+       ; skol_info <- mkSkolemDetails (DataConSkol name)
        ; (tclvl, wanted, (outer_bndrs, (ex_bndrs, (req, prov, body_ty))))
            <- pushLevelAndSolveEqualitiesX "tcPatSynSig"           $
                      -- See Note [solveEqualities in tcPatSynSig]
diff --git a/compiler/GHC/Tc/Types/Origin.hs b/compiler/GHC/Tc/Types/Origin.hs
index 4fc977ee14..d5ff630740 100644
--- a/compiler/GHC/Tc/Types/Origin.hs
+++ b/compiler/GHC/Tc/Types/Origin.hs
@@ -13,8 +13,8 @@ module GHC.Tc.Types.Origin (
   redundantConstraintsSpan,
 
   -- SkolemInfo
-  SkolemInfo(..), SkolemInfoAnon(..), mkSkolemInfo, getSkolemInfo, pprSigSkolInfo, pprSkolInfo,
-  unkSkol, unkSkolAnon,
+  SkolemInfo(..), mkSkolemInfo, getSkolemInfo, pprSigSkolInfo, pprSkolInfo,
+  unkSkol,
 
   -- CtOrigin
   CtOrigin(..), exprCtOrigin, lexprCtOrigin, matchesCtOrigin, grhssCtOrigin,
@@ -197,20 +197,7 @@ isSigMaybe _                = Nothing
 ************************************************************************
 -}
 
--- | 'SkolemInfo' stores the origin of a skolem type variable,
--- so that we can display this information to the user in case of a type error.
---
--- The 'Unique' field allows us to report all skolem type variables bound in the
--- same place in a single report.
-data SkolemInfo
-  = SkolemInfo
-      Unique -- ^ used to common up skolem variables bound at the same location
-      SkolemInfoAnon -- ^ the information about the origin of the skolem type variable
-
-instance Uniquable SkolemInfo where
-  getUnique (SkolemInfo u _) = u
-
--- | 'SkolemInfoAnon' stores the origin of a skolem type variable (e.g. bound by
+-- | 'SkolemInfo' stores the origin of a skolem type variable (e.g. bound by
 -- a user-written forall, the header of a data declaration, a deriving clause, ...).
 --
 -- This information is displayed when reporting an error message, such as
@@ -218,10 +205,7 @@ instance Uniquable SkolemInfo where
 --  @"Couldn't match 'k' with 'l'"@
 --
 -- This allows us to explain where the type variable came from.
---
--- When several skolem type variables are bound at once, prefer using 'SkolemInfo',
--- which stores a 'Unique' which allows these type variables to be reported
-data SkolemInfoAnon
+data SkolemInfo
   = SigSkol -- A skolem that is created by instantiating
             -- a programmer-supplied type signature
             -- Location of the binding site is on the TyVar
@@ -283,39 +267,18 @@ data SkolemInfoAnon
 
   | UnkSkol CallStack
 
-
-
-
--- | Use this when you can't specify a helpful origin for
+-- | Use 'unkSkol' when you can't specify a helpful origin for
 -- some skolem type variable.
 --
 -- We're hoping to be able to get rid of this entirely, but for the moment
 -- it's still needed.
 unkSkol :: HasCallStack => SkolemInfo
-unkSkol = SkolemInfo (mkUniqueGrimily 0) unkSkolAnon
-
-unkSkolAnon :: HasCallStack => SkolemInfoAnon
-unkSkolAnon = UnkSkol callStack
-
--- | Wrap up the origin of a skolem type variable with a new 'Unique',
--- so that we can common up skolem type variables whose 'SkolemInfo'
--- shares a certain 'Unique'.
-mkSkolemInfo :: MonadIO m => SkolemInfoAnon -> m SkolemInfo
-mkSkolemInfo sk_anon = do
-  u <- liftIO $! uniqFromMask 's'
-  return (SkolemInfo u sk_anon)
-
-getSkolemInfo :: SkolemInfo -> SkolemInfoAnon
-getSkolemInfo (SkolemInfo _ skol_anon) = skol_anon
-
+unkSkol = UnkSkol callStack
 
 instance Outputable SkolemInfo where
-  ppr (SkolemInfo _ sk_info ) = ppr sk_info
-
-instance Outputable SkolemInfoAnon where
   ppr = pprSkolInfo
 
-pprSkolInfo :: SkolemInfoAnon -> SDoc
+pprSkolInfo :: SkolemInfo -> SDoc
 -- Complete the sentence "is a rigid type variable bound by..."
 pprSkolInfo (SigSkol cx ty _) = pprSigSkolInfo cx ty
 pprSkolInfo (SigTypeSkol cx)  = pprUserTypeCtxt cx
@@ -418,7 +381,7 @@ in the right place.  So we proceed as follows:
 data CtOrigin
   = -- | A given constraint from a user-written type signature. The
     -- 'SkolemInfo' inside gives more information.
-    GivenOrigin SkolemInfoAnon
+    GivenOrigin SkolemInfo
 
   -- The following are other origins for given constraints that cannot produce
   -- new skolems -- hence no SkolemInfo.
@@ -449,7 +412,7 @@ data CtOrigin
   -- Note [Use only the best local instance], both in GHC.Tc.Solver.Interact.
   | OtherSCOrigin ScDepth -- ^ The number of superclass selections necessary to
                           -- get this constraint
-                  SkolemInfoAnon   -- ^ Where the sub-class constraint arose from
+                  SkolemInfo   -- ^ Where the sub-class constraint arose from
                                -- (used only for printing)
 
   -- All the others are for *wanted* constraints
diff --git a/compiler/GHC/Tc/Utils/Instantiate.hs b/compiler/GHC/Tc/Utils/Instantiate.hs
index 4ecfcd479a..18c27673d1 100644
--- a/compiler/GHC/Tc/Utils/Instantiate.hs
+++ b/compiler/GHC/Tc/Utils/Instantiate.hs
@@ -497,6 +497,27 @@ tcInstTypeBndrs id
       = do { (subst', tv') <- newMetaTyVarTyVarX subst tv
            ; return (subst', Bndr tv' spec) }
 
+--------------------------
+-- | Wrap up the origin of a skolem type variable with a new 'Unique',
+-- so that we can common up skolem type variables whose 'SkolemInfo'
+-- shares a certain 'Unique'.
+-- Allocate a TcLevel of "one level down"; we allocate skolems before
+-- pushing the level to create the implication constraints
+mkSkolemDetails, mkSuperSkolemDetails :: SkolemInfo -> TcM SkolemDetails
+mkSkolemDetails      = mk_skolem_info False
+mkSuperSkolemDetails = mk_skolem_info True
+
+mk_skolem_details :: Bool -> SkolemInfo -> TcM SkolemDetails
+mk_skolem_details overlappable skol_info
+  = do { uniq <- getUnique
+       ; lvl  <- getTcLevel
+       ; let pushed_lvl = pushTcLevel lvl
+       ; return (SkolemDetails { skol_uniq = uniq
+                               , skol_overlap = overlappable
+                               , sk_lvl = pushed_lvl
+                               , sk_info = skol_info }) }
+
+-------------------------
 tcSkolDFunType :: SkolemInfo -> DFunId -> TcM ([TcTyVar], TcThetaType, TcType)
 -- Instantiate a type signature with skolem constants.
 -- This freshens the names, but no need to do so
diff --git a/compiler/GHC/Tc/Utils/TcType.hs b/compiler/GHC/Tc/Utils/TcType.hs
index 346a9f8396..16e23eb1fb 100644
--- a/compiler/GHC/Tc/Utils/TcType.hs
+++ b/compiler/GHC/Tc/Utils/TcType.hs
@@ -345,9 +345,9 @@ type TcInvisTVBinder   = InvisTVBinder
 type TcReqTVBinder     = ReqTVBinder
 
 -- See Note [TcTyCon, MonoTcTyCon, and PolyTcTyCon]
-type TcTyCon     = TyCon
-type MonoTcTyCon = TcTyCon
-type PolyTcTyCon = TcTyCon
+type TcTyCon        = TyCon
+type MonoTcTyCon    = TcTyCon
+type PolyTcTyCon   = TcTyCon
 
 -- These types do not have boxy type variables in them
 type TcPredType     = PredType
@@ -503,14 +503,7 @@ we would need to enforce the separation.
 -- A TyVarDetails is inside a TyVar
 -- See Note [TyVars and TcTyVars]
 data TcTyVarDetails
-  = SkolemTv      -- A skolem
-       SkolemInfo
-       TcLevel    -- Level of the implication that binds it
-                  -- See GHC.Tc.Utils.Unify Note [Deeper level on the left] for
-                  --     how this level number is used
-       Bool       -- True <=> this skolem type variable can be overlapped
-                  --          when looking up instances
-                  -- See Note [Binding when looking up instances] in GHC.Core.InstEnv
+  = SkolemTv SkolemDetails      -- A skolem
 
   | RuntimeUnk    -- Stands for an as-yet-unknown type in the GHCi
                   -- interactive context
@@ -519,6 +512,29 @@ data TcTyVarDetails
            , mtv_ref   :: IORef MetaDetails
            , mtv_tclvl :: TcLevel }  -- See Note [TcLevel invariants]
 
+pprTcTyVarDetails :: TcTyVarDetails -> SDoc
+-- For debugging
+pprTcTyVarDetails (RuntimeUnk {})    = text "rt"
+pprTcTyVarDetails (SkolemTv skd)     = pprSkolemDetails skd
+pprTcTyVarDetails (MetaTv { mtv_info = info, mtv_tclvl = tclvl })
+  = ppr info <> colon <> ppr tclvl
+
+-----------------------------
+data SkolemDetails
+  = SkolemDetails
+       { skol_uniq :: !Unique
+       , skol_info :: SkolemInfo
+       , skol_lvl  :: !TcLevel   -- Level of the implication that binds it
+                                 -- See GHC.Tc.Utils.Unify Note [Deeper level on the left] for
+                                 --     how this level number is used
+       , skol_overlap :: Bool    -- True <=> this skolem type variable can be overlapped
+       }                         --          when looking up instances
+                                 -- See Note [Binding when looking up instances] in GHC.Core.InstEnv
+
+pprSkolemDetails (SkolemTv { skol_lvl = lvl, skol_overlap = overlap })
+  | overlap   = text "ssk" <> colon <> ppr lvl
+  | otherwise = text "sk" <> colon <> ppr lvl
+
 vanillaSkolemTv, superSkolemTv :: SkolemInfo -> TcTyVarDetails
 -- See Note [Binding when looking up instances] in GHC.Core.InstEnv
 vanillaSkolemTv sk = SkolemTv sk topTcLevel False  -- Might be instantiated
@@ -532,13 +548,8 @@ vanillaSkolemTvUnk = vanillaSkolemTv unkSkol
 instance Outputable TcTyVarDetails where
   ppr = pprTcTyVarDetails
 
-pprTcTyVarDetails :: TcTyVarDetails -> SDoc
--- For debugging
-pprTcTyVarDetails (RuntimeUnk {})      = text "rt"
-pprTcTyVarDetails (SkolemTv _sk lvl True)  = text "ssk" <> colon <> ppr lvl
-pprTcTyVarDetails (SkolemTv _sk lvl False) = text "sk"  <> colon <> ppr lvl
-pprTcTyVarDetails (MetaTv { mtv_info = info, mtv_tclvl = tclvl })
-  = ppr info <> colon <> ppr tclvl
+instance Outputable SkolemDetails where
+  ppr skd = pprSkolemDetails skd
 
 -----------------------------
 data MetaDetails