diff options
author | Simon Peyton Jones <simonpj@microsoft.com> | 2018-05-21 09:00:32 +0100 |
---|---|---|
committer | Simon Peyton Jones <simonpj@microsoft.com> | 2018-05-21 13:04:09 +0100 |
commit | b7e80ae005d0072eda79135c371a794dc48f70e1 (patch) | |
tree | d58ed53143606ea688e5e1a5e175a5725625393e | |
parent | 5f3fb71213e78838cd3060be37ad2d9dd1ed247f (diff) | |
download | haskell-b7e80ae005d0072eda79135c371a794dc48f70e1.tar.gz |
Remove TcType.toTcType
In the olden days we insisted that only TcTyVars could appear
in a TcType. But now we are more accommodating; see TcType
Note [TcTyVars and TyVars in the typechecker]
This patch removes a function that converted a Type to a TcType.
It didn't do anything useful except statisfy an invariant that
we no longer have. Now it's gone.
-rw-r--r-- | compiler/deSugar/Check.hs | 8 | ||||
-rw-r--r-- | compiler/deSugar/DsBinds.hs | 2 | ||||
-rw-r--r-- | compiler/deSugar/Match.hs | 3 | ||||
-rw-r--r-- | compiler/typecheck/TcType.hs | 76 |
4 files changed, 20 insertions, 69 deletions
diff --git a/compiler/deSugar/Check.hs b/compiler/deSugar/Check.hs index b383fb2f5d..39f585394a 100644 --- a/compiler/deSugar/Check.hs +++ b/compiler/deSugar/Check.hs @@ -44,7 +44,7 @@ import HscTypes (CompleteMatch(..)) import DsMonad import TcSimplify (tcCheckSatisfiability) -import TcType (toTcType, isStringTy, isIntTy, isWordTy) +import TcType (isStringTy, isIntTy, isWordTy) import Bag import ErrUtils import Var (EvVar) @@ -624,12 +624,12 @@ inhabitationCandidates fam_insts ty Just (tc, _) | tc `elem` trivially_inhabited -> case dcs of [] -> return (Left src_ty) - (_:_) -> do var <- liftD $ mkPmId (toTcType core_ty) + (_:_) -> do var <- liftD $ mkPmId core_ty let va = build_tm (PmVar var) dcs return $ Right [(va, mkIdEq var, emptyBag)] | pmIsClosedType core_ty -> liftD $ do - var <- mkPmId (toTcType core_ty) -- it would be wrong to unify x + var <- mkPmId core_ty -- it would be wrong to unify x alts <- mapM (mkOneConFull var . RealDataCon) (tyConDataCons tc) return $ Right [(build_tm va dcs, eq, cs) | (va, eq, cs) <- alts] -- For other types conservatively assume that they are inhabited. @@ -1330,7 +1330,7 @@ allCompleteMatches cl tys = do -- * Types and constraints newEvVar :: Name -> Type -> EvVar -newEvVar name ty = mkLocalId name (toTcType ty) +newEvVar name ty = mkLocalId name ty nameType :: String -> Type -> DsM EvVar nameType name ty = do diff --git a/compiler/deSugar/DsBinds.hs b/compiler/deSugar/DsBinds.hs index ad666a2ce2..4684d436a4 100644 --- a/compiler/deSugar/DsBinds.hs +++ b/compiler/deSugar/DsBinds.hs @@ -181,7 +181,7 @@ dsHsBind dflags (AbsBinds { abs_tvs = tyvars, abs_ev_vars = dicts , abs_exports = exports , abs_ev_binds = ev_binds , abs_binds = binds, abs_sig = has_sig }) - = do { ds_binds <- addDictsDs (toTcTypeBag (listToBag dicts)) $ + = do { ds_binds <- addDictsDs (listToBag dicts) $ dsLHsBinds binds -- addDictsDs: push type constraints deeper -- for inner pattern match check diff --git a/compiler/deSugar/Match.hs b/compiler/deSugar/Match.hs index 0044cbe49f..6b548a4f5a 100644 --- a/compiler/deSugar/Match.hs +++ b/compiler/deSugar/Match.hs @@ -39,7 +39,6 @@ import MatchCon import MatchLit import Type import Coercion ( eqCoercion ) -import TcType ( toTcTypeBag ) import TyCon( isNewTyCon ) import TysWiredIn import SrcLoc @@ -733,7 +732,7 @@ matchWrapper ctxt mb_scr (MG { mg_alts = L _ matches mk_eqn_info vars (L _ (Match { m_pats = pats, m_grhss = grhss })) = do { dflags <- getDynFlags ; let upats = map (unLoc . decideBangHood dflags) pats - dicts = toTcTypeBag (collectEvVarsPats upats) -- Only TcTyVars + dicts = collectEvVarsPats upats ; tm_cs <- genCaseTmCs2 mb_scr upats vars ; match_result <- addDictsDs dicts $ -- See Note [Type and Term Equality Propagation] addTmCsDs tm_cs $ -- See Note [Type and Term Equality Propagation] diff --git a/compiler/typecheck/TcType.hs b/compiler/typecheck/TcType.hs index 9abd264949..f5f7532075 100644 --- a/compiler/typecheck/TcType.hs +++ b/compiler/typecheck/TcType.hs @@ -176,10 +176,6 @@ module TcType ( noFreeVarsOfType, -------------------------------- - -- Transforming Types to TcTypes - toTcType, -- :: Type -> TcType - toTcTypeBag, -- :: Bag EvVar -> Bag EvVar - pprKind, pprParendKind, pprSigmaType, pprType, pprParendType, pprTypeApp, pprTyThingCategory, tyThingCategory, pprTheta, pprParendTheta, pprThetaArrowTy, pprClassPred, @@ -222,7 +218,6 @@ import TysWiredIn( coercibleClass, unitTyCon, unitTyConKey , listTyCon, constraintKind ) import BasicTypes import Util -import Bag import Maybes import ListSetOps ( getNth, findDupsEq ) import Outputable @@ -233,7 +228,6 @@ import qualified GHC.LanguageExtensions as LangExt import Data.List ( mapAccumL ) import Data.IORef import Data.List.NonEmpty( NonEmpty(..) ) -import Data.Functor.Identity import qualified Data.Semigroup as Semi {- @@ -272,13 +266,20 @@ tau ::= tyvar -- In all cases, a (saturated) type synonym application is legal, -- provided it expands to the required form. -Note [TcTyVars in the typechecker] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Note [TcTyVars and TyVars in the typechecker] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ The typechecker uses a lot of type variables with special properties, notably being a unification variable with a mutable reference. These use the 'TcTyVar' variant of Var.Var. -However, the type checker and constraint solver can encounter type +Note, though, that a /bound/ type variable can (and probably should) +be a TyVar. E.g + forall a. a -> a +Here 'a' is really just a deBruijn-number; it certainly does not have +a signficant TcLevel (as every TcTyVar does). So a forall-bound type +variable should be TyVars; and hence a TyVar can appear free in a TcType. + +The type checker and constraint solver can also encounter /free/ type variables that use the 'TyVar' variant of Var.Var, for a couple of reasons: @@ -299,7 +300,8 @@ reasons: long afer TcTyVars have been zonked away It's convenient to simply treat these TyVars as skolem constants, -which of course they are. So +which of course they are. We give them a level number of "outermost", +so they behave as global constants. Specifically: * Var.tcTyVarDetails succeeds on a TyVar, returning vanillaSkolemTv, as well as on a TcTyVar. @@ -326,7 +328,7 @@ for coercion variables--on the variable. Failing to do so led to GHC Trac #12785. -} --- See Note [TcTyVars in the typechecker] +-- See Note [TcTyVars and TyVars in the typechecker] type TcCoVar = CoVar -- Used only during type inference type TcType = Type -- A TcType can have mutable type variables type TcTyCoVar = Var -- Either a TcTyVar or a CoVar @@ -1172,7 +1174,7 @@ candidateQTyVarsOfTypes = foldl (split_dvs emptyVarSet) mempty -} tcIsTcTyVar :: TcTyVar -> Bool --- See Note [TcTyVars in the typechecker] +-- See Note [TcTyVars and TyVars in the typechecker] tcIsTcTyVar tv = isTyVar tv isTouchableMetaTyVar :: TcLevel -> TcTyVar -> Bool @@ -2319,56 +2321,6 @@ isRigidTy ty | isForAllTy ty = True | otherwise = False -{- -************************************************************************ -* * -\subsection{Transformation of Types to TcTypes} -* * -************************************************************************ --} - -toTcType :: Type -> TcType --- The constraint solver expects EvVars to have TcType, in which the --- free type variables are TcTyVars. So we convert from Type to TcType here --- A bit tiresome; but one day I expect the two types to be entirely separate --- in which case we'll definitely need to do this -toTcType = runIdentity . to_tc_type emptyVarSet - -toTcTypeBag :: Bag EvVar -> Bag EvVar -- All TyVars are transformed to TcTyVars -toTcTypeBag evvars = mapBag (\tv -> setTyVarKind tv (toTcType (tyVarKind tv))) evvars - -to_tc_mapper :: TyCoMapper VarSet Identity -to_tc_mapper - = TyCoMapper { tcm_smart = False -- more efficient not to use smart ctors - , tcm_tyvar = tyvar - , tcm_covar = covar - , tcm_hole = hole - , tcm_tybinder = tybinder } - where - tyvar :: VarSet -> TyVar -> Identity Type - tyvar ftvs tv - | Just var <- lookupVarSet ftvs tv = return $ TyVarTy var - | isTcTyVar tv = TyVarTy <$> updateTyVarKindM (to_tc_type ftvs) tv - | otherwise - = do { kind' <- to_tc_type ftvs (tyVarKind tv) - ; return $ TyVarTy $ mkTcTyVar (tyVarName tv) kind' vanillaSkolemTv } - - covar :: VarSet -> CoVar -> Identity Coercion - covar ftvs cv - | Just var <- lookupVarSet ftvs cv = return $ CoVarCo var - | otherwise = CoVarCo <$> updateVarTypeM (to_tc_type ftvs) cv - - hole :: VarSet -> CoercionHole -> Identity Coercion - hole _ hole = pprPanic "toTcType: found a coercion hole" (ppr hole) - - tybinder :: VarSet -> TyVar -> ArgFlag -> Identity (VarSet, TyVar) - tybinder ftvs tv _vis = do { kind' <- to_tc_type ftvs (tyVarKind tv) - ; let tv' = mkTcTyVar (tyVarName tv) kind' - vanillaSkolemTv - ; return (ftvs `extendVarSet` tv', tv') } - -to_tc_type :: VarSet -> Type -> Identity TcType -to_tc_type = mapType to_tc_mapper {- ************************************************************************ |