diff options
Diffstat (limited to 'compiler/GHC/Tc/Utils/Zonk.hs')
| -rw-r--r-- | compiler/GHC/Tc/Utils/Zonk.hs | 11 |
1 files changed, 4 insertions, 7 deletions
diff --git a/compiler/GHC/Tc/Utils/Zonk.hs b/compiler/GHC/Tc/Utils/Zonk.hs index 9207e1805f..7755ff0f14 100644 --- a/compiler/GHC/Tc/Utils/Zonk.hs +++ b/compiler/GHC/Tc/Utils/Zonk.hs @@ -53,6 +53,7 @@ import GHC.Builtin.Names import GHC.Hs +import GHC.Tc.Errors.Types ( LevityCheckProvenance(..) ) import {-# SOURCE #-} GHC.Tc.Gen.Splice (runTopSplice) import GHC.Tc.Utils.Monad import GHC.Tc.TyCl.Build ( TcMethInfo, MethInfo ) @@ -444,8 +445,7 @@ zonkIdOccs env ids = map (zonkIdOcc env) ids zonkIdBndr :: ZonkEnv -> TcId -> TcM Id zonkIdBndr env v = do Scaled w' ty' <- zonkScaledTcTypeToTypeX env (idScaledType v) - ensureNotLevPoly ty' - (text "In the type of binder" <+> quotes (ppr v)) + ensureNotLevPoly ty' (LevityCheckInBinder v) return (modifyIdInfo (`setLevityInfoWithType` ty') (setIdMult (setIdType v ty') w')) @@ -1418,8 +1418,7 @@ zonk_pat env (ParPat x lpar p rpar) zonk_pat env (WildPat ty) = do { ty' <- zonkTcTypeToTypeX env ty - ; ensureNotLevPoly ty' - (text "In a wildcard pattern") + ; ensureNotLevPoly ty' LevityCheckInWildcardPattern ; return (env, WildPat ty') } zonk_pat env (VarPat x (L l v)) @@ -1485,7 +1484,7 @@ zonk_pat env p@(ConPat { pat_con = L _ con ; case con of RealDataCon dc | isUnboxedTupleTyCon (dataConTyCon dc) - -> mapM_ (checkForLevPoly doc) (dropRuntimeRepArgs new_tys) + -> mapM_ (checkForLevPoly (LevityCheckInUnboxedTuplePattern p)) (dropRuntimeRepArgs new_tys) _ -> return () ; (env0, new_tyvars) <- zonkTyBndrsX env tyvars @@ -1509,8 +1508,6 @@ zonk_pat env p@(ConPat { pat_con = L _ con } ) } - where - doc = text "In the type of an element of an unboxed tuple pattern:" $$ ppr p zonk_pat env (LitPat x lit) = return (env, LitPat x lit) |