Commit 3300eeac authored by Krzysztof Gogolewski's avatar Krzysztof Gogolewski Committed by Marge Bot

Misc cleanup

- Remove Note [Existentials in shift_con_pat].
  The function shift_con_pat has been removed 15 years ago in 23f40f0e.
- Remove kcLookupTcTyCon - it's the same as tcLookupTcTyCon
- Remove ASSERT in tyConAppArgN. It's already done by getNth,
  and it's the only reason getNth exists.
- Remove unused function nextRole
parent 7b2c827b
Pipeline #16565 passed with stages
in 563 minutes and 20 seconds
......@@ -261,36 +261,4 @@ positional patterns (T a b) and (a `T` b) all match the arguments
in order. Also T {} is special because it's equivalent to (T _ _).
Hence the (null rpats) checks here and there.
Note [Existentials in shift_con_pat]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Consider
data T = forall a. Ord a => T a (a->Int)
f (T x f) True = ...expr1...
f (T y g) False = ...expr2..
When we put in the tyvars etc we get
f (T a (d::Ord a) (x::a) (f::a->Int)) True = ...expr1...
f (T b (e::Ord b) (y::a) (g::a->Int)) True = ...expr2...
After desugaring etc we'll get a single case:
f = \t::T b::Bool ->
case t of
T a (d::Ord a) (x::a) (f::a->Int)) ->
case b of
True -> ...expr1...
False -> ...expr2...
*** We have to substitute [a/b, d/e] in expr2! **
Hence
False -> ....((/\b\(e:Ord b).expr2) a d)....
Originally I tried to use
(\b -> let e = d in expr2) a
to do this substitution. While this is "correct" in a way, it fails
Lint, because e::Ord b but d::Ord a.
-}
......@@ -456,6 +456,9 @@ tcLookupLocalIds ns
Just (ATcId { tct_id = id }) -> id
_ -> pprPanic "tcLookupLocalIds" (ppr name)
-- inferInitialKind has made a suitably-shaped kind for the type or class
-- Look it up in the local environment. This is used only for tycons
-- that we're currently type-checking, so we're sure to find a TcTyCon.
tcLookupTcTyCon :: HasDebugCallStack => Name -> TcM TcTyCon
tcLookupTcTyCon name = do
thing <- tcLookup name
......
......@@ -32,7 +32,7 @@ module TcHsType (
ContextKind(..),
-- Type checking type and class decls
kcLookupTcTyCon, bindTyClTyVars,
bindTyClTyVars,
etaExpandAlgTyCon, tcbVisibilities,
-- tyvars
......@@ -2753,7 +2753,7 @@ bindTyClTyVars :: Name
-- in the "kind checking" and "type checking" pass,
-- but not in the initial-kind run.
bindTyClTyVars tycon_name thing_inside
= do { tycon <- kcLookupTcTyCon tycon_name
= do { tycon <- tcLookupTcTyCon tycon_name
; let scoped_prs = tcTyConScopedTyVars tycon
res_kind = tyConResKind tycon
binders = tyConBinders tycon
......@@ -2761,16 +2761,6 @@ bindTyClTyVars tycon_name thing_inside
; tcExtendNameTyVarEnv scoped_prs $
thing_inside binders res_kind }
-- inferInitialKind has made a suitably-shaped kind for the type or class
-- Look it up in the local environment. This is used only for tycons
-- that we're currently type-checking, so we're sure to find a TcTyCon.
kcLookupTcTyCon :: Name -> TcM TcTyCon
kcLookupTcTyCon nm
= do { tc_ty_thing <- tcLookup nm
; return $ case tc_ty_thing of
ATcTyCon tc -> tc
_ -> pprPanic "kcLookupTcTyCon" (ppr tc_ty_thing) }
{- *********************************************************************
* *
......
......@@ -1503,7 +1503,7 @@ kcLTyClDecl :: LTyClDecl GhcRn -> TcM ()
-- Called only for declarations without a signature (no CUSKs or SAKs here)
kcLTyClDecl (L loc decl)
= setSrcSpan loc $
do { tycon <- kcLookupTcTyCon tc_name
do { tycon <- tcLookupTcTyCon tc_name
; traceTc "kcTyClDecl {" (ppr tc_name)
; addVDQNote tycon $ -- See Note [Inferring visible dependent quantification]
addErrCtxt (tcMkDeclCtxt decl) $
......
......@@ -68,7 +68,7 @@ module TcType (
tcTyConAppTyCon, tcTyConAppTyCon_maybe, tcTyConAppArgs,
tcSplitAppTy_maybe, tcSplitAppTy, tcSplitAppTys, tcRepSplitAppTy_maybe,
tcRepGetNumAppTys,
tcGetCastedTyVar_maybe, tcGetTyVar_maybe, tcGetTyVar, nextRole,
tcGetCastedTyVar_maybe, tcGetTyVar_maybe, tcGetTyVar,
tcSplitSigmaTy, tcSplitNestedSigmaTys, tcDeepSplitSigmaTy_maybe,
---------------------------------
......
......@@ -34,7 +34,7 @@ module Type (
mkTyConApp, mkTyConTy,
tyConAppTyCon_maybe, tyConAppTyConPicky_maybe,
tyConAppArgs_maybe, tyConAppTyCon, tyConAppArgs,
splitTyConApp_maybe, splitTyConApp, tyConAppArgN, nextRole,
splitTyConApp_maybe, splitTyConApp, tyConAppArgN,
tcSplitTyConApp_maybe,
splitListTyConApp_maybe,
repSplitTyConApp_maybe,
......@@ -1267,7 +1267,7 @@ tyConAppArgN :: Int -> Type -> Type
-- Executing Nth
tyConAppArgN n ty
= case tyConAppArgs_maybe ty of
Just tys -> ASSERT2( tys `lengthExceeds` n, ppr n <+> ppr tys ) tys `getNth` n
Just tys -> tys `getNth` n
Nothing -> pprPanic "tyConAppArgN" (ppr n <+> ppr ty)
-- | Attempts to tease a type apart into a type constructor and the application
......@@ -1322,16 +1322,6 @@ splitListTyConApp_maybe ty = case splitTyConApp_maybe ty of
Just (tc,[e]) | tc == listTyCon -> Just e
_other -> Nothing
nextRole :: Type -> Role
nextRole ty
| Just (tc, tys) <- splitTyConApp_maybe ty
, let num_tys = length tys
, num_tys < tyConArity tc
= tyConRoles tc `getNth` num_tys
| otherwise
= Nominal
newTyConInstRhs :: TyCon -> [Type] -> Type
-- ^ Unwrap one 'layer' of newtype on a type constructor and its
-- arguments, using an eta-reduced version of the @newtype@ if possible.
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment