PageRenderTime 61ms CodeModel.GetById 19ms RepoModel.GetById 0ms app.codeStats 1ms

/compiler/typecheck/TcMType.hs

http://github.com/ghc/ghc
Haskell | 1516 lines | 767 code | 169 blank | 580 comment | 8 complexity | f9b8e5df1285067f179b5dae250601af MD5 | raw file
Possible License(s): MIT, BSD-3-Clause, GPL-3.0

Large files files are truncated, but you can click here to view the full file

  1. {-
  2. (c) The University of Glasgow 2006
  3. (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
  4. Monadic type operations
  5. This module contains monadic operations over types that contain
  6. mutable type variables
  7. -}
  8. {-# LANGUAGE CPP, TupleSections, MultiWayIf #-}
  9. module TcMType (
  10. TcTyVar, TcKind, TcType, TcTauType, TcThetaType, TcTyVarSet,
  11. --------------------------------
  12. -- Creating new mutable type variables
  13. newFlexiTyVar,
  14. newFlexiTyVarTy, -- Kind -> TcM TcType
  15. newFlexiTyVarTys, -- Int -> Kind -> TcM [TcType]
  16. newOpenFlexiTyVarTy,
  17. newMetaKindVar, newMetaKindVars,
  18. cloneMetaTyVar,
  19. newFmvTyVar, newFskTyVar,
  20. readMetaTyVar, writeMetaTyVar, writeMetaTyVarRef,
  21. newMetaDetails, isFilledMetaTyVar, isUnfilledMetaTyVar,
  22. --------------------------------
  23. -- Expected types
  24. ExpType(..), ExpSigmaType, ExpRhoType,
  25. mkCheckExpType, newOpenInferExpType, readExpType, readExpType_maybe,
  26. writeExpType, expTypeToType, checkingExpType_maybe, checkingExpType,
  27. tauifyExpType,
  28. --------------------------------
  29. -- Creating fresh type variables for pm checking
  30. genInstSkolTyVarsX,
  31. --------------------------------
  32. -- Creating new evidence variables
  33. newEvVar, newEvVars, newDict,
  34. newWanted, newWanteds,
  35. emitWanted, emitWantedEq, emitWantedEvVar, emitWantedEvVars,
  36. newTcEvBinds, addTcEvBind,
  37. newCoercionHole, fillCoercionHole, isFilledCoercionHole,
  38. unpackCoercionHole, unpackCoercionHole_maybe,
  39. checkCoercionHole,
  40. --------------------------------
  41. -- Instantiation
  42. newMetaTyVars, newMetaTyVarX,
  43. newMetaSigTyVars, newMetaSigTyVarX,
  44. newSigTyVar, newWildCardX,
  45. tcInstType,
  46. tcInstSkolTyVars, tcInstSuperSkolTyVarsX,
  47. tcInstSigTyVars,
  48. tcSkolDFunType, tcSuperSkolTyVars,
  49. instSkolTyCoVars, freshenTyVarBndrs, freshenCoVarBndrsX,
  50. --------------------------------
  51. -- Zonking and tidying
  52. zonkTidyTcType, zonkTidyOrigin,
  53. mkTypeErrorThing, mkTypeErrorThingArgs,
  54. tidyEvVar, tidyCt, tidySkolemInfo,
  55. skolemiseUnboundMetaTyVar,
  56. zonkTcTyVar, zonkTcTyVars, zonkTcTyVarToTyVar,
  57. zonkTyCoVarsAndFV, zonkTcTypeAndFV,
  58. zonkTyCoVarsAndFVList,
  59. zonkTcTypeAndSplitDepVars, zonkTcTypesAndSplitDepVars,
  60. zonkQuantifiedTyVar,
  61. quantifyTyVars, quantifyZonkedTyVars,
  62. zonkTcTyCoVarBndr, zonkTcTyBinder, zonkTyConBinder,
  63. zonkTcType, zonkTcTypes, zonkCo,
  64. zonkTyCoVarKind, zonkTcTypeMapper,
  65. zonkEvVar, zonkWC, zonkSimples, zonkId, zonkCt, zonkSkolemInfo,
  66. tcGetGlobalTyCoVars
  67. ) where
  68. #include "HsVersions.h"
  69. -- friends:
  70. import TyCoRep
  71. import TcType
  72. import Type
  73. import TyCon( TyConBinder )
  74. import Kind
  75. import Coercion
  76. import Class
  77. import Var
  78. -- others:
  79. import TcRnMonad -- TcType, amongst others
  80. import TcEvidence
  81. import Id
  82. import Name
  83. import VarSet
  84. import TysWiredIn
  85. import TysPrim
  86. import VarEnv
  87. import PrelNames
  88. import Util
  89. import Outputable
  90. import FastString
  91. import SrcLoc
  92. import Bag
  93. import Pair
  94. import UniqFM
  95. import qualified GHC.LanguageExtensions as LangExt
  96. import Control.Monad
  97. import Maybes
  98. import Data.List ( mapAccumL )
  99. import Control.Arrow ( second )
  100. {-
  101. ************************************************************************
  102. * *
  103. Kind variables
  104. * *
  105. ************************************************************************
  106. -}
  107. mkKindName :: Unique -> Name
  108. mkKindName unique = mkSystemName unique kind_var_occ
  109. kind_var_occ :: OccName -- Just one for all MetaKindVars
  110. -- They may be jiggled by tidying
  111. kind_var_occ = mkOccName tvName "k"
  112. newMetaKindVar :: TcM TcKind
  113. newMetaKindVar = do { uniq <- newUnique
  114. ; details <- newMetaDetails TauTv
  115. ; let kv = mkTcTyVar (mkKindName uniq) liftedTypeKind details
  116. ; return (mkTyVarTy kv) }
  117. newMetaKindVars :: Int -> TcM [TcKind]
  118. newMetaKindVars n = mapM (\ _ -> newMetaKindVar) (nOfThem n ())
  119. {-
  120. ************************************************************************
  121. * *
  122. Evidence variables; range over constraints we can abstract over
  123. * *
  124. ************************************************************************
  125. -}
  126. newEvVars :: TcThetaType -> TcM [EvVar]
  127. newEvVars theta = mapM newEvVar theta
  128. --------------
  129. newEvVar :: TcPredType -> TcRnIf gbl lcl EvVar
  130. -- Creates new *rigid* variables for predicates
  131. newEvVar ty = do { name <- newSysName (predTypeOccName ty)
  132. ; return (mkLocalIdOrCoVar name ty) }
  133. newWanted :: CtOrigin -> Maybe TypeOrKind -> PredType -> TcM CtEvidence
  134. -- Deals with both equality and non-equality predicates
  135. newWanted orig t_or_k pty
  136. = do loc <- getCtLocM orig t_or_k
  137. d <- if isEqPred pty then HoleDest <$> newCoercionHole
  138. else EvVarDest <$> newEvVar pty
  139. return $ CtWanted { ctev_dest = d
  140. , ctev_pred = pty
  141. , ctev_loc = loc }
  142. newWanteds :: CtOrigin -> ThetaType -> TcM [CtEvidence]
  143. newWanteds orig = mapM (newWanted orig Nothing)
  144. -- | Emits a new Wanted. Deals with both equalities and non-equalities.
  145. emitWanted :: CtOrigin -> TcPredType -> TcM EvTerm
  146. emitWanted origin pty
  147. = do { ev <- newWanted origin Nothing pty
  148. ; emitSimple $ mkNonCanonical ev
  149. ; return $ ctEvTerm ev }
  150. -- | Emits a new equality constraint
  151. emitWantedEq :: CtOrigin -> TypeOrKind -> Role -> TcType -> TcType -> TcM Coercion
  152. emitWantedEq origin t_or_k role ty1 ty2
  153. = do { hole <- newCoercionHole
  154. ; loc <- getCtLocM origin (Just t_or_k)
  155. ; emitSimple $ mkNonCanonical $
  156. CtWanted { ctev_pred = pty, ctev_dest = HoleDest hole, ctev_loc = loc }
  157. ; return (mkHoleCo hole role ty1 ty2) }
  158. where
  159. pty = mkPrimEqPredRole role ty1 ty2
  160. -- | Creates a new EvVar and immediately emits it as a Wanted.
  161. -- No equality predicates here.
  162. emitWantedEvVar :: CtOrigin -> TcPredType -> TcM EvVar
  163. emitWantedEvVar origin ty
  164. = do { new_cv <- newEvVar ty
  165. ; loc <- getCtLocM origin Nothing
  166. ; let ctev = CtWanted { ctev_dest = EvVarDest new_cv
  167. , ctev_pred = ty
  168. , ctev_loc = loc }
  169. ; emitSimple $ mkNonCanonical ctev
  170. ; return new_cv }
  171. emitWantedEvVars :: CtOrigin -> [TcPredType] -> TcM [EvVar]
  172. emitWantedEvVars orig = mapM (emitWantedEvVar orig)
  173. newDict :: Class -> [TcType] -> TcM DictId
  174. newDict cls tys
  175. = do { name <- newSysName (mkDictOcc (getOccName cls))
  176. ; return (mkLocalId name (mkClassPred cls tys)) }
  177. predTypeOccName :: PredType -> OccName
  178. predTypeOccName ty = case classifyPredType ty of
  179. ClassPred cls _ -> mkDictOcc (getOccName cls)
  180. EqPred _ _ _ -> mkVarOccFS (fsLit "cobox")
  181. IrredPred _ -> mkVarOccFS (fsLit "irred")
  182. {-
  183. ************************************************************************
  184. * *
  185. Coercion holes
  186. * *
  187. ************************************************************************
  188. -}
  189. newCoercionHole :: TcM CoercionHole
  190. newCoercionHole
  191. = do { u <- newUnique
  192. ; traceTc "New coercion hole:" (ppr u)
  193. ; ref <- newMutVar Nothing
  194. ; return $ CoercionHole u ref }
  195. -- | Put a value in a coercion hole
  196. fillCoercionHole :: CoercionHole -> Coercion -> TcM ()
  197. fillCoercionHole (CoercionHole u ref) co
  198. = do {
  199. #ifdef DEBUG
  200. ; cts <- readTcRef ref
  201. ; whenIsJust cts $ \old_co ->
  202. pprPanic "Filling a filled coercion hole" (ppr u $$ ppr co $$ ppr old_co)
  203. #endif
  204. ; traceTc "Filling coercion hole" (ppr u <+> text ":=" <+> ppr co)
  205. ; writeTcRef ref (Just co) }
  206. -- | Is a coercion hole filled in?
  207. isFilledCoercionHole :: CoercionHole -> TcM Bool
  208. isFilledCoercionHole (CoercionHole _ ref) = isJust <$> readTcRef ref
  209. -- | Retrieve the contents of a coercion hole. Panics if the hole
  210. -- is unfilled
  211. unpackCoercionHole :: CoercionHole -> TcM Coercion
  212. unpackCoercionHole hole
  213. = do { contents <- unpackCoercionHole_maybe hole
  214. ; case contents of
  215. Just co -> return co
  216. Nothing -> pprPanic "Unfilled coercion hole" (ppr hole) }
  217. -- | Retrieve the contents of a coercion hole, if it is filled
  218. unpackCoercionHole_maybe :: CoercionHole -> TcM (Maybe Coercion)
  219. unpackCoercionHole_maybe (CoercionHole _ ref) = readTcRef ref
  220. -- | Check that a coercion is appropriate for filling a hole. (The hole
  221. -- itself is needed only for printing. NB: This must be /lazy/ in the coercion,
  222. -- as it's used in TcHsSyn in the presence of knots.
  223. -- Always returns the checked coercion, but this return value is necessary
  224. -- so that the input coercion is forced only when the output is forced.
  225. checkCoercionHole :: Coercion -> CoercionHole -> Role -> Type -> Type -> TcM Coercion
  226. checkCoercionHole co h r t1 t2
  227. -- co is already zonked, but t1 and t2 might not be
  228. | debugIsOn
  229. = do { t1 <- zonkTcType t1
  230. ; t2 <- zonkTcType t2
  231. ; let (Pair _t1 _t2, _role) = coercionKindRole co
  232. ; return $
  233. ASSERT2( t1 `eqType` _t1 && t2 `eqType` _t2 && r == _role
  234. , (text "Bad coercion hole" <+>
  235. ppr h <> colon <+> vcat [ ppr _t1, ppr _t2, ppr _role
  236. , ppr co, ppr t1, ppr t2
  237. , ppr r ]) )
  238. co }
  239. | otherwise
  240. = return co
  241. {-
  242. ************************************************************************
  243. *
  244. Expected types
  245. *
  246. ************************************************************************
  247. Note [ExpType]
  248. ~~~~~~~~~~~~~~
  249. An ExpType is used as the "expected type" when type-checking an expression.
  250. An ExpType can hold a "hole" that can be filled in by the type-checker.
  251. This allows us to have one tcExpr that works in both checking mode and
  252. synthesis mode (that is, bidirectional type-checking). Previously, this
  253. was achieved by using ordinary unification variables, but we don't need
  254. or want that generality. (For example, #11397 was caused by doing the
  255. wrong thing with unification variables.) Instead, we observe that these
  256. holes should
  257. 1. never be nested
  258. 2. never appear as the type of a variable
  259. 3. be used linearly (never be duplicated)
  260. By defining ExpType, separately from Type, we can achieve goals 1 and 2
  261. statically.
  262. See also [wiki:Typechecking]
  263. Note [TcLevel of ExpType]
  264. ~~~~~~~~~~~~~~~~~~~~~~~~~
  265. Consider
  266. data G a where
  267. MkG :: G Bool
  268. foo MkG = True
  269. This is a classic untouchable-variable / ambiguous GADT return type
  270. scenario. But, with ExpTypes, we'll be inferring the type of the RHS.
  271. And, because there is only one branch of the case, we won't trigger
  272. Note [Case branches must never infer a non-tau type] of TcMatches.
  273. We thus must track a TcLevel in an Inferring ExpType. If we try to
  274. fill the ExpType and find that the TcLevels don't work out, we
  275. fill the ExpType with a tau-tv at the low TcLevel, hopefully to
  276. be worked out later by some means. This is triggered in
  277. test gadt/gadt-escape1.
  278. -}
  279. -- actual data definition is in TcType
  280. -- | Make an 'ExpType' suitable for inferring a type of kind * or #.
  281. newOpenInferExpType :: TcM ExpType
  282. newOpenInferExpType
  283. = do { rr <- newFlexiTyVarTy runtimeRepTy
  284. ; u <- newUnique
  285. ; tclvl <- getTcLevel
  286. ; let ki = tYPE rr
  287. ; traceTc "newOpenInferExpType" (ppr u <+> dcolon <+> ppr ki)
  288. ; ref <- newMutVar Nothing
  289. ; return (Infer u tclvl ki ref) }
  290. -- | Extract a type out of an ExpType, if one exists. But one should always
  291. -- exist. Unless you're quite sure you know what you're doing.
  292. readExpType_maybe :: ExpType -> TcM (Maybe TcType)
  293. readExpType_maybe (Check ty) = return (Just ty)
  294. readExpType_maybe (Infer _ _ _ ref) = readMutVar ref
  295. -- | Extract a type out of an ExpType. Otherwise, panics.
  296. readExpType :: ExpType -> TcM TcType
  297. readExpType exp_ty
  298. = do { mb_ty <- readExpType_maybe exp_ty
  299. ; case mb_ty of
  300. Just ty -> return ty
  301. Nothing -> pprPanic "Unknown expected type" (ppr exp_ty) }
  302. -- | Write into an 'ExpType'. It must be an 'Infer'.
  303. writeExpType :: ExpType -> TcType -> TcM ()
  304. writeExpType (Infer u tc_lvl ki ref) ty
  305. | debugIsOn
  306. = do { ki1 <- zonkTcType (typeKind ty)
  307. ; ki2 <- zonkTcType ki
  308. ; MASSERT2( ki1 `eqType` ki2, ppr ki1 $$ ppr ki2 $$ ppr u )
  309. ; lvl_now <- getTcLevel
  310. ; MASSERT2( tc_lvl == lvl_now, ppr u $$ ppr tc_lvl $$ ppr lvl_now )
  311. ; cts <- readTcRef ref
  312. ; case cts of
  313. Just already_there -> pprPanic "writeExpType"
  314. (vcat [ ppr u
  315. , ppr ty
  316. , ppr already_there ])
  317. Nothing -> write }
  318. | otherwise
  319. = write
  320. where
  321. write = do { traceTc "Filling ExpType" $
  322. ppr u <+> text ":=" <+> ppr ty
  323. ; writeTcRef ref (Just ty) }
  324. writeExpType (Check ty1) ty2 = pprPanic "writeExpType" (ppr ty1 $$ ppr ty2)
  325. -- | Returns the expected type when in checking mode.
  326. checkingExpType_maybe :: ExpType -> Maybe TcType
  327. checkingExpType_maybe (Check ty) = Just ty
  328. checkingExpType_maybe _ = Nothing
  329. -- | Returns the expected type when in checking mode. Panics if in inference
  330. -- mode.
  331. checkingExpType :: String -> ExpType -> TcType
  332. checkingExpType _ (Check ty) = ty
  333. checkingExpType err et = pprPanic "checkingExpType" (text err $$ ppr et)
  334. tauifyExpType :: ExpType -> TcM ExpType
  335. -- ^ Turn a (Infer hole) type into a (Check alpha),
  336. -- where alpha is a fresh unificaiton variable
  337. tauifyExpType (Check ty) = return (Check ty) -- No-op for (Check ty)
  338. tauifyExpType (Infer u tc_lvl ki ref) = do { ty <- inferTypeToType u tc_lvl ki ref
  339. ; return (Check ty) }
  340. -- | Extracts the expected type if there is one, or generates a new
  341. -- TauTv if there isn't.
  342. expTypeToType :: ExpType -> TcM TcType
  343. expTypeToType (Check ty) = return ty
  344. expTypeToType (Infer u tc_lvl ki ref) = inferTypeToType u tc_lvl ki ref
  345. inferTypeToType :: Unique -> TcLevel -> Kind -> IORef (Maybe TcType) -> TcM Type
  346. inferTypeToType u tc_lvl ki ref
  347. = do { uniq <- newUnique
  348. ; tv_ref <- newMutVar Flexi
  349. ; let details = MetaTv { mtv_info = TauTv
  350. , mtv_ref = tv_ref
  351. , mtv_tclvl = tc_lvl }
  352. name = mkMetaTyVarName uniq (fsLit "t")
  353. tau_tv = mkTcTyVar name ki details
  354. tau = mkTyVarTy tau_tv
  355. -- can't use newFlexiTyVarTy because we need to set the tc_lvl
  356. -- See also Note [TcLevel of ExpType]
  357. ; writeMutVar ref (Just tau)
  358. ; traceTc "Forcing ExpType to be monomorphic:"
  359. (ppr u <+> dcolon <+> ppr ki <+> text ":=" <+> ppr tau)
  360. ; return tau }
  361. {-
  362. ************************************************************************
  363. * *
  364. SkolemTvs (immutable)
  365. * *
  366. ************************************************************************
  367. -}
  368. tcInstType :: ([TyVar] -> TcM (TCvSubst, [TcTyVar]))
  369. -- ^ How to instantiate the type variables
  370. -> Id -- ^ Type to instantiate
  371. -> TcM ([(Name, TcTyVar)], TcThetaType, TcType) -- ^ Result
  372. -- (type vars, preds (incl equalities), rho)
  373. tcInstType inst_tyvars id
  374. = case tcSplitForAllTys (idType id) of
  375. ([], rho) -> let -- There may be overloading despite no type variables;
  376. -- (?x :: Int) => Int -> Int
  377. (theta, tau) = tcSplitPhiTy rho
  378. in
  379. return ([], theta, tau)
  380. (tyvars, rho) -> do { (subst, tyvars') <- inst_tyvars tyvars
  381. ; let (theta, tau) = tcSplitPhiTy (substTyAddInScope subst rho)
  382. tv_prs = map tyVarName tyvars `zip` tyvars'
  383. ; return (tv_prs, theta, tau) }
  384. tcSkolDFunType :: DFunId -> TcM ([TcTyVar], TcThetaType, TcType)
  385. -- Instantiate a type signature with skolem constants.
  386. -- We could give them fresh names, but no need to do so
  387. tcSkolDFunType dfun
  388. = do { (tv_prs, theta, tau) <- tcInstType tcInstSuperSkolTyVars dfun
  389. ; return (map snd tv_prs, theta, tau) }
  390. tcSuperSkolTyVars :: [TyVar] -> (TCvSubst, [TcTyVar])
  391. -- Make skolem constants, but do *not* give them new names, as above
  392. -- Moreover, make them "super skolems"; see comments with superSkolemTv
  393. -- see Note [Kind substitution when instantiating]
  394. -- Precondition: tyvars should be ordered by scoping
  395. tcSuperSkolTyVars = mapAccumL tcSuperSkolTyVar emptyTCvSubst
  396. tcSuperSkolTyVar :: TCvSubst -> TyVar -> (TCvSubst, TcTyVar)
  397. tcSuperSkolTyVar subst tv
  398. = (extendTvSubstWithClone subst tv new_tv, new_tv)
  399. where
  400. kind = substTyUnchecked subst (tyVarKind tv)
  401. new_tv = mkTcTyVar (tyVarName tv) kind superSkolemTv
  402. -- | Given a list of @['TyVar']@, skolemize the type variables,
  403. -- returning a substitution mapping the original tyvars to the
  404. -- skolems, and the list of newly bound skolems. See also
  405. -- tcInstSkolTyVars' for a precondition. The resulting
  406. -- skolems are non-overlappable; see Note [Overlap and deriving]
  407. -- for an example where this matters.
  408. tcInstSkolTyVars :: [TyVar] -> TcM (TCvSubst, [TcTyVar])
  409. tcInstSkolTyVars = tcInstSkolTyVars' False emptyTCvSubst
  410. tcInstSuperSkolTyVars :: [TyVar] -> TcM (TCvSubst, [TcTyVar])
  411. tcInstSuperSkolTyVars = tcInstSuperSkolTyVarsX emptyTCvSubst
  412. tcInstSuperSkolTyVarsX :: TCvSubst -> [TyVar] -> TcM (TCvSubst, [TcTyVar])
  413. tcInstSuperSkolTyVarsX subst = tcInstSkolTyVars' True subst
  414. tcInstSkolTyVars' :: Bool -> TCvSubst -> [TyVar] -> TcM (TCvSubst, [TcTyVar])
  415. -- Precondition: tyvars should be ordered (kind vars first)
  416. -- see Note [Kind substitution when instantiating]
  417. -- Get the location from the monad; this is a complete freshening operation
  418. tcInstSkolTyVars' overlappable subst tvs
  419. = do { loc <- getSrcSpanM
  420. ; instSkolTyCoVarsX (mkTcSkolTyVar loc overlappable) subst tvs }
  421. mkTcSkolTyVar :: SrcSpan -> Bool -> Unique -> Name -> Kind -> TcTyVar
  422. mkTcSkolTyVar loc overlappable uniq old_name kind
  423. = mkTcTyVar (mkInternalName uniq (getOccName old_name) loc)
  424. kind
  425. (SkolemTv overlappable)
  426. tcInstSigTyVars :: SrcSpan -> [TyVar]
  427. -> TcRnIf gbl lcl (TCvSubst, [TcTyVar])
  428. tcInstSigTyVars loc = instSkolTyCoVars (mkTcSkolTyVar loc False)
  429. ------------------
  430. freshenTyVarBndrs :: [TyVar] -> TcRnIf gbl lcl (TCvSubst, [TyVar])
  431. -- ^ Give fresh uniques to a bunch of TyVars, but they stay
  432. -- as TyVars, rather than becoming TcTyVars
  433. -- Used in FamInst.newFamInst, and Inst.newClsInst
  434. freshenTyVarBndrs = instSkolTyCoVars mk_tv
  435. where
  436. mk_tv uniq old_name kind = mkTyVar (setNameUnique old_name uniq) kind
  437. freshenCoVarBndrsX :: TCvSubst -> [CoVar] -> TcRnIf gbl lcl (TCvSubst, [CoVar])
  438. -- ^ Give fresh uniques to a bunch of CoVars
  439. -- Used in FamInst.newFamInst
  440. freshenCoVarBndrsX subst = instSkolTyCoVarsX mk_cv subst
  441. where
  442. mk_cv uniq old_name kind = mkCoVar (setNameUnique old_name uniq) kind
  443. ------------------
  444. instSkolTyCoVars :: (Unique -> Name -> Kind -> TyCoVar)
  445. -> [TyVar] -> TcRnIf gbl lcl (TCvSubst, [TyCoVar])
  446. instSkolTyCoVars mk_tcv = instSkolTyCoVarsX mk_tcv emptyTCvSubst
  447. instSkolTyCoVarsX :: (Unique -> Name -> Kind -> TyCoVar)
  448. -> TCvSubst -> [TyCoVar] -> TcRnIf gbl lcl (TCvSubst, [TyCoVar])
  449. instSkolTyCoVarsX mk_tcv = mapAccumLM (instSkolTyCoVarX mk_tcv)
  450. instSkolTyCoVarX :: (Unique -> Name -> Kind -> TyCoVar)
  451. -> TCvSubst -> TyCoVar -> TcRnIf gbl lcl (TCvSubst, TyCoVar)
  452. instSkolTyCoVarX mk_tcv subst tycovar
  453. = do { uniq <- newUnique -- using a new unique is critical. See
  454. -- Note [Skolems in zonkSyntaxExpr] in TcHsSyn
  455. ; let new_tcv = mk_tcv uniq old_name kind
  456. subst1 | isTyVar new_tcv
  457. = extendTvSubstWithClone subst tycovar new_tcv
  458. | otherwise
  459. = extendCvSubstWithClone subst tycovar new_tcv
  460. ; return (subst1, new_tcv) }
  461. where
  462. old_name = tyVarName tycovar
  463. kind = substTyUnchecked subst (tyVarKind tycovar)
  464. newFskTyVar :: TcType -> TcM TcTyVar
  465. newFskTyVar fam_ty
  466. = do { uniq <- newUnique
  467. ; let name = mkSysTvName uniq (fsLit "fsk")
  468. ; return (mkTcTyVar name (typeKind fam_ty) (FlatSkol fam_ty)) }
  469. {-
  470. Note [Kind substitution when instantiating]
  471. ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  472. When we instantiate a bunch of kind and type variables, first we
  473. expect them to be topologically sorted.
  474. Then we have to instantiate the kind variables, build a substitution
  475. from old variables to the new variables, then instantiate the type
  476. variables substituting the original kind.
  477. Exemple: If we want to instantiate
  478. [(k1 :: *), (k2 :: *), (a :: k1 -> k2), (b :: k1)]
  479. we want
  480. [(?k1 :: *), (?k2 :: *), (?a :: ?k1 -> ?k2), (?b :: ?k1)]
  481. instead of the buggous
  482. [(?k1 :: *), (?k2 :: *), (?a :: k1 -> k2), (?b :: k1)]
  483. ************************************************************************
  484. * *
  485. MetaTvs (meta type variables; mutable)
  486. * *
  487. ************************************************************************
  488. -}
  489. mkMetaTyVarName :: Unique -> FastString -> Name
  490. -- Makes a /System/ Name, which is eagerly eliminated by
  491. -- the unifier; see TcUnify.nicer_to_update_tv1, and
  492. -- TcCanonical.canEqTyVarTyVar (nicer_to_update_tv2)
  493. mkMetaTyVarName uniq str = mkSysTvName uniq str
  494. newSigTyVar :: Name -> Kind -> TcM TcTyVar
  495. newSigTyVar name kind
  496. = do { details <- newMetaDetails SigTv
  497. ; return (mkTcTyVar name kind details) }
  498. newFmvTyVar :: TcType -> TcM TcTyVar
  499. -- Very like newMetaTyVar, except sets mtv_tclvl to one less
  500. -- so that the fmv is untouchable.
  501. newFmvTyVar fam_ty
  502. = do { uniq <- newUnique
  503. ; ref <- newMutVar Flexi
  504. ; cur_lvl <- getTcLevel
  505. ; let details = MetaTv { mtv_info = FlatMetaTv
  506. , mtv_ref = ref
  507. , mtv_tclvl = fmvTcLevel cur_lvl }
  508. name = mkMetaTyVarName uniq (fsLit "s")
  509. ; return (mkTcTyVar name (typeKind fam_ty) details) }
  510. newMetaDetails :: MetaInfo -> TcM TcTyVarDetails
  511. newMetaDetails info
  512. = do { ref <- newMutVar Flexi
  513. ; tclvl <- getTcLevel
  514. ; return (MetaTv { mtv_info = info
  515. , mtv_ref = ref
  516. , mtv_tclvl = tclvl }) }
  517. cloneMetaTyVar :: TcTyVar -> TcM TcTyVar
  518. cloneMetaTyVar tv
  519. = ASSERT( isTcTyVar tv )
  520. do { uniq <- newUnique
  521. ; ref <- newMutVar Flexi
  522. ; let name' = setNameUnique (tyVarName tv) uniq
  523. details' = case tcTyVarDetails tv of
  524. details@(MetaTv {}) -> details { mtv_ref = ref }
  525. _ -> pprPanic "cloneMetaTyVar" (ppr tv)
  526. ; return (mkTcTyVar name' (tyVarKind tv) details') }
  527. -- Works for both type and kind variables
  528. readMetaTyVar :: TyVar -> TcM MetaDetails
  529. readMetaTyVar tyvar = ASSERT2( isMetaTyVar tyvar, ppr tyvar )
  530. readMutVar (metaTvRef tyvar)
  531. isFilledMetaTyVar :: TyVar -> TcM Bool
  532. -- True of a filled-in (Indirect) meta type variable
  533. isFilledMetaTyVar tv
  534. | MetaTv { mtv_ref = ref } <- tcTyVarDetails tv
  535. = do { details <- readMutVar ref
  536. ; return (isIndirect details) }
  537. | otherwise = return False
  538. isUnfilledMetaTyVar :: TyVar -> TcM Bool
  539. -- True of a un-filled-in (Flexi) meta type variable
  540. isUnfilledMetaTyVar tv
  541. | MetaTv { mtv_ref = ref } <- tcTyVarDetails tv
  542. = do { details <- readMutVar ref
  543. ; return (isFlexi details) }
  544. | otherwise = return False
  545. --------------------
  546. -- Works with both type and kind variables
  547. writeMetaTyVar :: TcTyVar -> TcType -> TcM ()
  548. -- Write into a currently-empty MetaTyVar
  549. writeMetaTyVar tyvar ty
  550. | not debugIsOn
  551. = writeMetaTyVarRef tyvar (metaTvRef tyvar) ty
  552. -- Everything from here on only happens if DEBUG is on
  553. | not (isTcTyVar tyvar)
  554. = WARN( True, text "Writing to non-tc tyvar" <+> ppr tyvar )
  555. return ()
  556. | MetaTv { mtv_ref = ref } <- tcTyVarDetails tyvar
  557. = writeMetaTyVarRef tyvar ref ty
  558. | otherwise
  559. = WARN( True, text "Writing to non-meta tyvar" <+> ppr tyvar )
  560. return ()
  561. --------------------
  562. writeMetaTyVarRef :: TcTyVar -> TcRef MetaDetails -> TcType -> TcM ()
  563. -- Here the tyvar is for error checking only;
  564. -- the ref cell must be for the same tyvar
  565. writeMetaTyVarRef tyvar ref ty
  566. | not debugIsOn
  567. = do { traceTc "writeMetaTyVar" (ppr tyvar <+> dcolon <+> ppr (tyVarKind tyvar)
  568. <+> text ":=" <+> ppr ty)
  569. ; writeTcRef ref (Indirect ty) }
  570. -- Everything from here on only happens if DEBUG is on
  571. | otherwise
  572. = do { meta_details <- readMutVar ref;
  573. -- Zonk kinds to allow the error check to work
  574. ; zonked_tv_kind <- zonkTcType tv_kind
  575. ; zonked_ty_kind <- zonkTcType ty_kind
  576. -- Check for double updates
  577. ; ASSERT2( isFlexi meta_details,
  578. hang (text "Double update of meta tyvar")
  579. 2 (ppr tyvar $$ ppr meta_details) )
  580. traceTc "writeMetaTyVar" (ppr tyvar <+> text ":=" <+> ppr ty)
  581. ; writeMutVar ref (Indirect ty)
  582. ; when ( not (isPredTy tv_kind)
  583. -- Don't check kinds for updates to coercion variables
  584. && not (zonked_ty_kind `tcEqKind` zonked_tv_kind))
  585. $ WARN( True, hang (text "Ill-kinded update to meta tyvar")
  586. 2 ( ppr tyvar <+> text "::" <+> (ppr tv_kind $$ ppr zonked_tv_kind)
  587. <+> text ":="
  588. <+> ppr ty <+> text "::" <+> (ppr ty_kind $$ ppr zonked_ty_kind) ) )
  589. (return ()) }
  590. where
  591. tv_kind = tyVarKind tyvar
  592. ty_kind = typeKind ty
  593. {-
  594. % Generating fresh variables for pattern match check
  595. -}
  596. -- UNINSTANTIATED VERSION OF tcInstSkolTyCoVars
  597. genInstSkolTyVarsX :: SrcSpan -> TCvSubst -> [TyVar]
  598. -> TcRnIf gbl lcl (TCvSubst, [TcTyVar])
  599. -- Precondition: tyvars should be scoping-ordered
  600. -- see Note [Kind substitution when instantiating]
  601. -- Get the location from the monad; this is a complete freshening operation
  602. genInstSkolTyVarsX loc subst tvs = instSkolTyCoVarsX (mkTcSkolTyVar loc False) subst tvs
  603. {-
  604. ************************************************************************
  605. * *
  606. MetaTvs: TauTvs
  607. * *
  608. ************************************************************************
  609. Note [Never need to instantiate coercion variables]
  610. ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  611. With coercion variables sloshing around in types, it might seem that we
  612. sometimes need to instantiate coercion variables. This would be problematic,
  613. because coercion variables inhabit unboxed equality (~#), and the constraint
  614. solver thinks in terms only of boxed equality (~). The solution is that
  615. we never need to instantiate coercion variables in the first place.
  616. The tyvars that we need to instantiate come from the types of functions,
  617. data constructors, and patterns. These will never be quantified over
  618. coercion variables, except for the special case of the promoted Eq#. But,
  619. that can't ever appear in user code, so we're safe!
  620. -}
  621. newAnonMetaTyVar :: MetaInfo -> Kind -> TcM TcTyVar
  622. -- Make a new meta tyvar out of thin air
  623. newAnonMetaTyVar meta_info kind
  624. = do { uniq <- newUnique
  625. ; let name = mkMetaTyVarName uniq s
  626. s = case meta_info of
  627. TauTv -> fsLit "t"
  628. FlatMetaTv -> fsLit "fmv"
  629. SigTv -> fsLit "a"
  630. ; details <- newMetaDetails meta_info
  631. ; return (mkTcTyVar name kind details) }
  632. newFlexiTyVar :: Kind -> TcM TcTyVar
  633. newFlexiTyVar kind = newAnonMetaTyVar TauTv kind
  634. newFlexiTyVarTy :: Kind -> TcM TcType
  635. newFlexiTyVarTy kind = do
  636. tc_tyvar <- newFlexiTyVar kind
  637. return (mkTyVarTy tc_tyvar)
  638. newFlexiTyVarTys :: Int -> Kind -> TcM [TcType]
  639. newFlexiTyVarTys n kind = mapM newFlexiTyVarTy (nOfThem n kind)
  640. -- | Create a tyvar that can be a lifted or unlifted type.
  641. newOpenFlexiTyVarTy :: TcM TcType
  642. newOpenFlexiTyVarTy
  643. = do { rr <- newFlexiTyVarTy runtimeRepTy
  644. ; newFlexiTyVarTy (tYPE rr) }
  645. newMetaSigTyVars :: [TyVar] -> TcM (TCvSubst, [TcTyVar])
  646. newMetaSigTyVars = mapAccumLM newMetaSigTyVarX emptyTCvSubst
  647. newMetaTyVars :: [TyVar] -> TcM (TCvSubst, [TcTyVar])
  648. -- Instantiate with META type variables
  649. -- Note that this works for a sequence of kind, type, and coercion variables
  650. -- variables. Eg [ (k:*), (a:k->k) ]
  651. -- Gives [ (k7:*), (a8:k7->k7) ]
  652. newMetaTyVars = mapAccumLM newMetaTyVarX emptyTCvSubst
  653. -- emptyTCvSubst has an empty in-scope set, but that's fine here
  654. -- Since the tyvars are freshly made, they cannot possibly be
  655. -- captured by any existing for-alls.
  656. newMetaTyVarX :: TCvSubst -> TyVar -> TcM (TCvSubst, TcTyVar)
  657. -- Make a new unification variable tyvar whose Name and Kind come from
  658. -- an existing TyVar. We substitute kind variables in the kind.
  659. newMetaTyVarX subst tyvar = new_meta_tv_x TauTv subst tyvar
  660. newMetaSigTyVarX :: TCvSubst -> TyVar -> TcM (TCvSubst, TcTyVar)
  661. -- Just like newMetaTyVarX, but make a SigTv
  662. newMetaSigTyVarX subst tyvar = new_meta_tv_x SigTv subst tyvar
  663. newWildCardX :: TCvSubst -> TyVar -> TcM (TCvSubst, TcTyVar)
  664. newWildCardX subst tv
  665. = do { new_tv <- newAnonMetaTyVar TauTv (substTy subst (tyVarKind tv))
  666. ; return (extendTvSubstWithClone subst tv new_tv, new_tv) }
  667. new_meta_tv_x :: MetaInfo -> TCvSubst -> TyVar -> TcM (TCvSubst, TcTyVar)
  668. new_meta_tv_x info subst tyvar
  669. = do { uniq <- newUnique
  670. ; details <- newMetaDetails info
  671. ; let name = mkSystemName uniq (getOccName tyvar)
  672. -- See Note [Name of an instantiated type variable]
  673. kind = substTy subst (tyVarKind tyvar)
  674. new_tv = mkTcTyVar name kind details
  675. subst1 = extendTvSubstWithClone subst tyvar new_tv
  676. ; return (subst1, new_tv) }
  677. {- Note [Name of an instantiated type variable]
  678. ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  679. At the moment we give a unification variable a System Name, which
  680. influences the way it is tidied; see TypeRep.tidyTyVarBndr.
  681. ************************************************************************
  682. * *
  683. Quantification
  684. * *
  685. ************************************************************************
  686. Note [quantifyTyVars]
  687. ~~~~~~~~~~~~~~~~~~~~~
  688. quantifyTyVars is given the free vars of a type that we
  689. are about to wrap in a forall.
  690. It takes these free type/kind variables (partitioned into dependent and
  691. non-dependent variables) and
  692. 1. Zonks them and remove globals and covars
  693. 2. Extends kvs1 with free kind vars in the kinds of tvs (removing globals)
  694. 3. Calls zonkQuantifiedTyVar on each
  695. Step (2) is often unimportant, because the kind variable is often
  696. also free in the type. Eg
  697. Typeable k (a::k)
  698. has free vars {k,a}. But the type (see Trac #7916)
  699. (f::k->*) (a::k)
  700. has free vars {f,a}, but we must add 'k' as well! Hence step (3).
  701. * This function distinguishes between dependent and non-dependent
  702. variables only to keep correct defaulting behavior with -XNoPolyKinds.
  703. With -XPolyKinds, it treats both classes of variables identically.
  704. * quantifyTyVars never quantifies over
  705. - a coercion variable
  706. - a runtime-rep variable
  707. Note [quantifyTyVars determinism]
  708. ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  709. The results of quantifyTyVars are wrapped in a forall and can end up in the
  710. interface file. One such example is inferred type signatures. They also affect
  711. the results of optimizations, for example worker-wrapper. This means that to
  712. get deterministic builds quantifyTyVars needs to be deterministic.
  713. To achieve this TcDepVars is backed by deterministic sets which allows them
  714. to be later converted to a list in a deterministic order.
  715. For more information about deterministic sets see
  716. Note [Deterministic UniqFM] in UniqDFM.
  717. -}
  718. quantifyTyVars, quantifyZonkedTyVars
  719. :: TcTyCoVarSet -- global tvs
  720. -> TcDepVars -- See Note [Dependent type variables] in TcType
  721. -> TcM [TcTyVar]
  722. -- See Note [quantifyTyVars]
  723. -- Can be given a mixture of TcTyVars and TyVars, in the case of
  724. -- associated type declarations. Also accepts covars, but *never* returns any.
  725. -- The zonked variant assumes everything is already zonked.
  726. quantifyTyVars gbl_tvs (DV { dv_kvs = dep_tkvs, dv_tvs = nondep_tkvs })
  727. = do { dep_tkvs <- zonkTyCoVarsAndFVDSet dep_tkvs
  728. ; nondep_tkvs <- zonkTyCoVarsAndFVDSet nondep_tkvs
  729. ; gbl_tvs <- zonkTyCoVarsAndFV gbl_tvs
  730. ; quantifyZonkedTyVars gbl_tvs (DV { dv_kvs = dep_tkvs, dv_tvs = nondep_tkvs }) }
  731. quantifyZonkedTyVars gbl_tvs dvs@(DV{ dv_kvs = dep_tkvs, dv_tvs = nondep_tkvs })
  732. = do { traceTc "quantifyZonkedTyVars" (vcat [ppr dvs, ppr gbl_tvs])
  733. ; let all_cvs = filterVarSet isCoVar $ dVarSetToVarSet dep_tkvs
  734. dep_kvs = dVarSetElemsWellScoped $
  735. dep_tkvs `dVarSetMinusVarSet` gbl_tvs
  736. `dVarSetMinusVarSet` closeOverKinds all_cvs
  737. -- dVarSetElemsWellScoped: put the kind variables into
  738. -- well-scoped order.
  739. -- E.g. [k, (a::k)] not the other way roud
  740. -- closeOverKinds all_cvs: do not quantify over coercion
  741. -- variables, or any any tvs that a covar depends on
  742. nondep_tvs = dVarSetElems $
  743. (nondep_tkvs `minusDVarSet` dep_tkvs)
  744. `dVarSetMinusVarSet` gbl_tvs
  745. -- See Note [Dependent type variables] in TcType
  746. -- The `minus` dep_tkvs removes any kind-level vars
  747. -- e.g. T k (a::k) Since k appear in a kind it'll
  748. -- be in dv_kvs, and is dependent. So remove it from
  749. -- dv_tvs which will also contain k
  750. -- No worry about dependent covars here;
  751. -- they are all in dep_tkvs
  752. -- No worry about scoping, because these are all
  753. -- type variables
  754. -- NB kinds of tvs are zonked by zonkTyCoVarsAndFV
  755. -- In the non-PolyKinds case, default the kind variables
  756. -- to *, and zonk the tyvars as usual. Notice that this
  757. -- may make quantifyTyVars return a shorter list
  758. -- than it was passed, but that's ok
  759. ; poly_kinds <- xoptM LangExt.PolyKinds
  760. ; dep_kvs' <- mapMaybeM (zonk_quant (not poly_kinds)) dep_kvs
  761. ; nondep_tvs' <- mapMaybeM (zonk_quant False) nondep_tvs
  762. -- Because of the order, any kind variables
  763. -- mentioned in the kinds of the nondep_tvs'
  764. -- now refer to the dep_kvs'
  765. ; traceTc "quantifyTyVars"
  766. (vcat [ text "globals:" <+> ppr gbl_tvs
  767. , text "nondep:" <+> ppr nondep_tvs
  768. , text "dep:" <+> ppr dep_kvs
  769. , text "dep_kvs'" <+> ppr dep_kvs'
  770. , text "nondep_tvs'" <+> ppr nondep_tvs' ])
  771. ; return (dep_kvs' ++ nondep_tvs') }
  772. where
  773. zonk_quant default_kind tkv
  774. | isTcTyVar tkv = zonkQuantifiedTyVar default_kind tkv
  775. | otherwise = return $ Just tkv
  776. -- For associated types, we have the class variables
  777. -- in scope, and they are TyVars not TcTyVars
  778. zonkQuantifiedTyVar :: Bool -- True <=> this is a kind var and -XNoPolyKinds
  779. -- False <=> not a kind var or -XPolyKinds
  780. -> TcTyVar
  781. -> TcM (Maybe TcTyVar)
  782. -- The quantified type variables often include meta type variables
  783. -- we want to freeze them into ordinary type variables, and
  784. -- default their kind (e.g. from TYPE v to TYPE Lifted)
  785. -- The meta tyvar is updated to point to the new skolem TyVar. Now any
  786. -- bound occurrences of the original type variable will get zonked to
  787. -- the immutable version.
  788. --
  789. -- We leave skolem TyVars alone; they are immutable.
  790. --
  791. -- This function is called on both kind and type variables,
  792. -- but kind variables *only* if PolyKinds is on.
  793. --
  794. -- This returns a tyvar if it should be quantified over;
  795. -- otherwise, it returns Nothing. The latter case happens for
  796. -- * Kind variables, with -XNoPolyKinds: don't quantify over these
  797. -- * RuntimeRep variables: we never quantify over these
  798. zonkQuantifiedTyVar default_kind tv
  799. = case tcTyVarDetails tv of
  800. SkolemTv {} -> do { kind <- zonkTcType (tyVarKind tv)
  801. ; return $ Just (setTyVarKind tv kind) }
  802. -- It might be a skolem type variable,
  803. -- for example from a user type signature
  804. MetaTv { mtv_ref = ref }
  805. -> do { when debugIsOn (check_empty ref)
  806. ; zonk_meta_tv tv }
  807. _other -> pprPanic "zonkQuantifiedTyVar" (ppr tv) -- FlatSkol, RuntimeUnk
  808. where
  809. zonk_meta_tv :: TcTyVar -> TcM (Maybe TcTyVar)
  810. zonk_meta_tv tv
  811. | isRuntimeRepVar tv -- Never quantify over a RuntimeRep var
  812. = do { writeMetaTyVar tv ptrRepLiftedTy
  813. ; return Nothing }
  814. | default_kind -- -XNoPolyKinds and this is a kind var
  815. = do { _ <- default_kind_var tv
  816. ; return Nothing }
  817. | otherwise
  818. = do { tv' <- skolemiseUnboundMetaTyVar tv vanillaSkolemTv
  819. ; return (Just tv') }
  820. default_kind_var :: TyVar -> TcM Type
  821. -- defaultKindVar is used exclusively with -XNoPolyKinds
  822. -- See Note [Defaulting with -XNoPolyKinds]
  823. -- It takes an (unconstrained) meta tyvar and defaults it.
  824. -- Works only on vars of type *; for other kinds, it issues an error.
  825. default_kind_var kv
  826. | isStarKind (tyVarKind kv)
  827. = do { writeMetaTyVar kv liftedTypeKind
  828. ; return liftedTypeKind }
  829. | otherwise
  830. = do { addErr (vcat [ text "Cannot default kind variable" <+> quotes (ppr kv')
  831. , text "of kind:" <+> ppr (tyVarKind kv')
  832. , text "Perhaps enable PolyKinds or add a kind signature" ])
  833. ; return (mkTyVarTy kv) }
  834. where
  835. (_, kv') = tidyOpenTyCoVar emptyTidyEnv kv
  836. check_empty ref -- [Sept 04] Check for non-empty.
  837. = when debugIsOn $ -- See note [Silly Type Synonym]
  838. do { cts <- readMutVar ref
  839. ; case cts of
  840. Flexi -> return ()
  841. Indirect ty -> WARN( True, ppr tv $$ ppr ty )
  842. return () }
  843. skolemiseUnboundMetaTyVar :: TcTyVar -> TcTyVarDetails -> TcM TyVar
  844. -- We have a Meta tyvar with a ref-cell inside it
  845. -- Skolemise it, so that
  846. -- we are totally out of Meta-tyvar-land
  847. -- We create a skolem TyVar, not a regular TyVar
  848. -- See Note [Zonking to Skolem]
  849. skolemiseUnboundMetaTyVar tv details
  850. = ASSERT2( isMetaTyVar tv, ppr tv )
  851. do { span <- getSrcSpanM -- Get the location from "here"
  852. -- ie where we are generalising
  853. ; kind <- zonkTcType (tyVarKind tv)
  854. ; let uniq = getUnique tv
  855. -- NB: Use same Unique as original tyvar. This is
  856. -- important for TcHsType.splitTelescopeTvs to work properly
  857. tv_name = getOccName tv
  858. final_name = mkInternalName uniq tv_name span
  859. final_tv = mkTcTyVar final_name kind details
  860. ; traceTc "Skolemising" (ppr tv <+> text ":=" <+> ppr final_tv)
  861. ; writeMetaTyVar tv (mkTyVarTy final_tv)
  862. ; return final_tv }
  863. {- Note [Defaulting with -XNoPolyKinds]
  864. ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  865. Consider
  866. data Compose f g a = Mk (f (g a))
  867. We infer
  868. Compose :: forall k1 k2. (k2 -> *) -> (k1 -> k2) -> k1 -> *
  869. Mk :: forall k1 k2 (f :: k2 -> *) (g :: k1 -> k2) (a :: k1).
  870. f (g a) -> Compose k1 k2 f g a
  871. Now, in another module, we have -XNoPolyKinds -XDataKinds in effect.
  872. What does 'Mk mean? Pre GHC-8.0 with -XNoPolyKinds,
  873. we just defaulted all kind variables to *. But that's no good here,
  874. because the kind variables in 'Mk aren't of kind *, so defaulting to *
  875. is ill-kinded.
  876. After some debate on #11334, we decided to issue an error in this case.
  877. The code is in defaultKindVar.
  878. Note [What is a meta variable?]
  879. ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  880. A "meta type-variable", also know as a "unification variable" is a placeholder
  881. introduced by the typechecker for an as-yet-unknown monotype.
  882. For example, when we see a call `reverse (f xs)`, we know that we calling
  883. reverse :: forall a. [a] -> [a]
  884. So we know that the argument `f xs` must be a "list of something". But what is
  885. the "something"? We don't know until we explore the `f xs` a bit more. So we set
  886. out what we do know at the call of `reverse` by instantiate its type with a fresh
  887. meta tyvar, `alpha` say. So now the type of the argument `f xs`, and of the
  888. result, is `[alpha]`. The unification variable `alpha` stands for the
  889. as-yet-unknown type of the elements of the list.
  890. As type inference progresses we may learn more about `alpha`. For example, suppose
  891. `f` has the type
  892. f :: forall b. b -> [Maybe b]
  893. Then we instantiate `f`'s type with another fresh unification variable, say
  894. `beta`; and equate `f`'s result type with reverse's argument type, thus
  895. `[alpha] ~ [Maybe beta]`.
  896. Now we can solve this equality to learn that `alpha ~ Maybe beta`, so we've
  897. refined our knowledge about `alpha`. And so on.
  898. If you found this Note useful, you may also want to have a look at
  899. Section 5 of "Practical type inference for higher rank types" (Peyton Jones,
  900. Vytiniotis, Weirich and Shields. J. Functional Programming. 2011).
  901. Note [What is zonking?]
  902. ~~~~~~~~~~~~~~~~~~~~~~~
  903. GHC relies heavily on mutability in the typechecker for efficient operation.
  904. For this reason, throughout much of the type checking process meta type
  905. variables (the MetaTv constructor of TcTyVarDetails) are represented by mutable
  906. variables (known as TcRefs).
  907. Zonking is the process of ripping out these mutable variables and replacing them
  908. with a real TcType. This involves traversing the entire type expression, but the
  909. interesting part of replacing the mutable variables occurs in zonkTyVarOcc.
  910. There are two ways to zonk a Type:
  911. * zonkTcTypeToType, which is intended to be used at the end of type-checking
  912. for the final zonk. It has to deal with unfilled metavars, either by filling
  913. it with a value like Any or failing (determined by the UnboundTyVarZonker
  914. used).
  915. * zonkTcType, which will happily ignore unfilled metavars. This is the
  916. appropriate function to use while in the middle of type-checking.
  917. Note [Zonking to Skolem]
  918. ~~~~~~~~~~~~~~~~~~~~~~~~
  919. We used to zonk quantified type variables to regular TyVars. However, this
  920. leads to problems. Consider this program from the regression test suite:
  921. eval :: Int -> String -> String -> String
  922. eval 0 root actual = evalRHS 0 root actual
  923. evalRHS :: Int -> a
  924. evalRHS 0 root actual = eval 0 root actual
  925. It leads to the deferral of an equality (wrapped in an implication constraint)
  926. forall a. () => ((String -> String -> String) ~ a)
  927. which is propagated up to the toplevel (see TcSimplify.tcSimplifyInferCheck).
  928. In the meantime `a' is zonked and quantified to form `evalRHS's signature.
  929. This has the *side effect* of also zonking the `a' in the deferred equality
  930. (which at this point is being handed around wrapped in an implication
  931. constraint).
  932. Finally, the equality (with the zonked `a') will be handed back to the
  933. simplifier by TcRnDriver.tcRnSrcDecls calling TcSimplify.tcSimplifyTop.
  934. If we zonk `a' with a regular type variable, we will have this regular type
  935. variable now floating around in the simplifier, which in many places assumes to
  936. only see proper TcTyVars.
  937. We can avoid this problem by zonking with a skolem. The skolem is rigid
  938. (which we require for a quantified variable), but is still a TcTyVar that the
  939. simplifier knows how to deal with.
  940. Note [Silly Type Synonyms]
  941. ~~~~~~~~~~~~~~~~~~~~~~~~~~
  942. Consider this:
  943. type C u a = u -- Note 'a' unused
  944. foo :: (forall a. C u a -> C u a) -> u
  945. foo x = ...
  946. bar :: Num u => u
  947. bar = foo (\t -> t + t)
  948. * From the (\t -> t+t) we get type {Num d} => d -> d
  949. where d is fresh.
  950. * Now unify with type of foo's arg, and we get:
  951. {Num (C d a)} => C d a -> C d a
  952. where a is fresh.
  953. * Now abstract over the 'a', but float out the Num (C d a) constraint
  954. because it does not 'really' mention a. (see exactTyVarsOfType)
  955. The arg to foo becomes
  956. \/\a -> \t -> t+t
  957. * So we get a dict binding for Num (C d a), which is zonked to give
  958. a = ()
  959. [Note Sept 04: now that we are zonking quantified type variables
  960. on construction, the 'a' will be frozen as a regular tyvar on
  961. quantification, so the floated dict will still have type (C d a).
  962. Which renders this whole note moot; happily!]
  963. * Then the \/\a abstraction has a zonked 'a' in it.
  964. All very silly. I think its harmless to ignore the problem. We'll end up with
  965. a \/\a in the final result but all the occurrences of a will be zonked to ()
  966. ************************************************************************
  967. * *
  968. Zonking types
  969. * *
  970. ************************************************************************
  971. -}
  972. -- | @tcGetGlobalTyCoVars@ returns a fully-zonked set of *scoped* tyvars free in
  973. -- the environment. To improve subsequent calls to the same function it writes
  974. -- the zonked set back into the environment. Note that this returns all
  975. -- variables free in anything (term-level or type-level) in scope. We thus
  976. -- don't have to worry about clashes with things that are not in scope, because
  977. -- if they are reachable, then they'll be returned here.
  978. tcGetGlobalTyCoVars :: TcM TcTyVarSet
  979. tcGetGlobalTyCoVars
  980. = do { (TcLclEnv {tcl_tyvars = gtv_var}) <- getLclEnv
  981. ; gbl_tvs <- readMutVar gtv_var
  982. ; gbl_tvs' <- zonkTyCoVarsAndFV gbl_tvs
  983. ; writeMutVar gtv_var gbl_tvs'
  984. ; return gbl_tvs' }
  985. -- | Zonk a type without using the smart constructors; the result type
  986. -- is available for inspection within the type-checking knot.
  987. zonkTcTypeInKnot :: TcType -> TcM TcType
  988. zonkTcTypeInKnot = mapType (zonkTcTypeMapper { tcm_smart = False }) ()
  989. zonkTcTypeAndFV :: TcType -> TcM DTyCoVarSet
  990. -- Zonk a type and take its free variables
  991. -- With kind polymorphism it can be essential to zonk *first*
  992. -- so that we find the right set of free variables. Eg
  993. -- forall k1. forall (a:k2). a
  994. -- where k2:=k1 is in the substitution. We don't want
  995. -- k2 to look free in this type!
  996. -- NB: This might be called from within the knot, so don't use
  997. -- smart constructors. See Note [Zonking within the knot] in TcHsType
  998. zonkTcTypeAndFV ty
  999. = tyCoVarsOfTypeDSet <$> zonkTcTypeInKnot ty
  1000. -- | Zonk a type and call 'splitDepVarsOfType' on it.
  1001. -- Works within the knot.
  1002. zonkTcTypeAndSplitDepVars :: TcType -> TcM TcDepVars
  1003. zonkTcTypeAndSplitDepVars ty
  1004. = splitDepVarsOfType <$> zonkTcTypeInKnot ty
  1005. zonkTcTypesAndSplitDepVars :: [TcType] -> TcM TcDepVars
  1006. zonkTcTypesAndSplitDepVars tys
  1007. = splitDepVarsOfTypes <$> mapM zonkTcTypeInKnot tys
  1008. zonkTyCoVar :: TyCoVar -> TcM TcType
  1009. -- Works on TyVars and TcTyVars
  1010. zonkTyCoVar tv | isTcTyVar tv = zonkTcTyVar tv
  1011. | isTyVar tv = mkTyVarTy <$> zonkTyCoVarKind tv
  1012. | otherwise = ASSERT2( isCoVar tv, ppr tv )
  1013. mkCoercionTy . mkCoVarCo <$> zonkTyCoVarKind tv
  1014. -- Hackily, when typechecking type and class decls
  1015. -- we have TyVars in scopeadded (only) in
  1016. -- TcHsType.tcTyClTyVars, but it seems
  1017. -- painful to make them into TcTyVars there
  1018. zonkTyCoVarsAndFV :: TyCoVarSet -> TcM TyCoVarSet
  1019. zonkTyCoVarsAndFV tycovars =
  1020. tyCoVarsOfTypes <$> mapM zonkTyCoVar (nonDetEltsUFM tycovars)
  1021. -- It's OK to use nonDetEltsUFM here because we immediately forget about
  1022. -- the ordering by turning it into a nondeterministic set and the order
  1023. -- of zonking doesn't matter for determinism.
  1024. -- Takes a list of TyCoVars, zonks them and returns a
  1025. -- deterministically ordered list of their free variables.
  1026. zonkTyCoVarsAndFVList :: [TyCoVar] -> TcM [TyCoVar]
  1027. zonkTyCoVarsAndFVList tycovars =
  1028. tyCoVarsOfTypesList <$> mapM zonkTyCoVar tycovars
  1029. -- Takes a deterministic set of TyCoVars, zonks them and returns a
  1030. -- deterministic set of their free variables.
  1031. -- See Note [quantifyTyVars determinism].
  1032. zonkTyCoVarsAndFVDSet :: DTyCoVarSet -> TcM DTyCoVarSet
  1033. zonkTyCoVarsAndFVDSet tycovars =
  1034. tyCoVarsOfTypesDSet <$> mapM zonkTyCoVar (dVarSetElems tycovars)
  1035. zonkTcTyVars :: [TcTyVar] -> TcM [TcType]
  1036. zonkTcTyVars tyvars = mapM zonkTcTyVar tyvars
  1037. ----------------- Types
  1038. zonkTyCoVarKind :: TyCoVar -> TcM TyCoVar
  1039. zonkTyCoVarKind tv = do { kind' <- zonkTcType (tyVarKind tv)
  1040. ; return (setTyVarKind tv kind') }
  1041. zonkTcTypes :: [TcType] -> TcM [TcType]
  1042. zonkTcTypes tys = mapM zonkTcType tys
  1043. {-
  1044. ************************************************************************
  1045. * *
  1046. Zonking constraints
  1047. * *
  1048. ***********************************************…

Large files files are truncated, but you can click here to view the full file