--------------------------------
-- Creating new evidence variables
newEvVar, newCoVar, newEvVars,
- writeWantedCoVar, readWantedCoVar,
newIP, newDict, newSilentGiven, isSilentEvVar,
newWantedEvVar, newWantedEvVars,
--------------------------------
-- Instantiation
- tcInstTyVar, tcInstTyVars, tcInstSigTyVars,
- tcInstType, instMetaTyVar,
+ tcInstTyVars, tcInstSigTyVars,
+ tcInstType,
tcInstSkolTyVars, tcInstSuperSkolTyVars, tcInstSkolTyVar, tcInstSkolType,
tcSkolDFunType, tcSuperSkolTyVars,
-- Checking type validity
Rank, UserTypeCtxt(..), checkValidType, checkValidMonoType,
SourceTyCtxt(..), checkValidTheta,
- checkValidInstance,
- checkValidTypeInst, checkTyFamFreeness,
+ checkValidInstHead, checkValidInstance,
+ checkInstTermination, checkValidTypeInst, checkTyFamFreeness,
arityErr,
growPredTyVars, growThetaTyVars, validDerivPred,
--------------------------------
-- Zonking
zonkType, mkZonkTcTyVar, zonkTcPredType,
- zonkTcTypeCarefully,
- skolemiseUnboundMetaTyVar,
+ zonkTcTypeCarefully, skolemiseUnboundMetaTyVar,
zonkTcTyVar, zonkTcTyVars, zonkTcTyVarsAndFV, zonkSigTyVar,
zonkQuantifiedTyVar, zonkQuantifiedTyVars,
zonkTcType, zonkTcTypes, zonkTcThetaType,
import TypeRep
import TcType
import Type
-import Coercion
import Class
import TyCon
import Var
newCoVar :: TcType -> TcType -> TcM CoVar
newCoVar ty1 ty2
- = do { name <- newName (mkTyVarOccFS (fsLit "co"))
+ = do { name <- newName (mkVarOccFS (fsLit "co"))
; return (mkCoVar name (mkPredTy (EqPred ty1 ty2))) }
newIP :: IPName Name -> TcType -> TcM IpId
tcInstSigTyVars :: [TyVar] -> TcM [TcTyVar]
-- Make meta SigTv type variables for patten-bound scoped type varaibles
-- We use SigTvs for them, so that they can't unify with arbitrary types
-tcInstSigTyVars = mapM (\tv -> instMetaTyVar (SigTv (tyVarName tv)) tv)
- -- ToDo: the "function binding site is bogus
+tcInstSigTyVars = mapM tcInstSigTyVar
+
+tcInstSigTyVar :: TyVar -> TcM TcTyVar
+tcInstSigTyVar tyvar
+ = do { uniq <- newMetaUnique
+ ; ref <- newMutVar Flexi
+ ; let name = setNameUnique (tyVarName tyvar) uniq
+ -- Use the same OccName so that the tidy-er
+ -- doesn't rename 'a' to 'a0' etc
+ kind = tyVarKind tyvar
+ ; return (mkTcTyVar name kind (MetaTv SigTv ref)) }
\end{code}
; ref <- newMutVar Flexi
; let name = mkTcTyVarName uniq s
s = case meta_info of
- TauTv -> fsLit "t"
- TcsTv -> fsLit "u"
- SigTv _ -> fsLit "a"
+ TauTv -> fsLit "t"
+ TcsTv -> fsLit "u"
+ SigTv -> fsLit "a"
; return (mkTcTyVar name kind (MetaTv meta_info ref)) }
mkTcTyVarName :: Unique -> FastString -> Name
-- leaving the un-cluttered names free for user names
mkTcTyVarName uniq str = mkSysTvName uniq str
-instMetaTyVar :: MetaInfo -> TyVar -> TcM TcTyVar
--- Make a new meta tyvar whose Name and Kind
--- come from an existing TyVar
-instMetaTyVar meta_info tyvar
- = do { uniq <- newMetaUnique
- ; ref <- newMutVar Flexi
- ; let name = mkSystemName uniq (getOccName tyvar)
- kind = tyVarKind tyvar
- ; return (mkTcTyVar name kind (MetaTv meta_info ref)) }
-
readMetaTyVar :: TyVar -> TcM MetaDetails
readMetaTyVar tyvar = ASSERT2( isMetaTyVar tyvar, ppr tyvar )
readMutVar (metaTvRef tyvar)
-readWantedCoVar :: CoVar -> TcM MetaDetails
-readWantedCoVar covar = ASSERT2( isMetaTyVar covar, ppr covar )
- readMutVar (metaTvRef covar)
-
isFilledMetaTyVar :: TyVar -> TcM Bool
-- True of a filled-in (Indirect) meta type variable
isFilledMetaTyVar tv
= WARN( True, text "Writing to non-meta tyvar" <+> ppr tyvar )
return ()
-writeWantedCoVar :: CoVar -> Coercion -> TcM ()
-writeWantedCoVar cv co = writeMetaTyVar cv co
-
--------------------
writeMetaTyVarRef :: TcTyVar -> TcRef MetaDetails -> TcType -> TcM ()
-- Here the tyvar is for error checking only;
newFlexiTyVarTys :: Int -> Kind -> TcM [TcType]
newFlexiTyVarTys n kind = mapM newFlexiTyVarTy (nOfThem n kind)
-tcInstTyVar :: TyVar -> TcM TcTyVar
--- Instantiate with a META type variable
-tcInstTyVar tyvar = instMetaTyVar TauTv tyvar
-
tcInstTyVars :: [TyVar] -> TcM ([TcTyVar], [TcType], TvSubst)
-- Instantiate with META type variables
tcInstTyVars tyvars
-- Since the tyvars are freshly made,
-- they cannot possibly be captured by
-- any existing for-alls. Hence zipTopTvSubst
+
+tcInstTyVar :: TyVar -> TcM TcTyVar
+-- Make a new unification variable tyvar whose Name and Kind
+-- come from an existing TyVar
+tcInstTyVar tyvar
+ = do { uniq <- newMetaUnique
+ ; ref <- newMutVar Flexi
+ ; let name = mkSystemName uniq (getOccName tyvar)
+ kind = tyVarKind tyvar
+ ; return (mkTcTyVar name kind (MetaTv TauTv ref)) }
\end{code}
zonkWantedEvVar (EvVarX v l) = do { v' <- zonkEvVar v; return (EvVarX v' l) }
zonkFlavor :: CtFlavor -> TcM CtFlavor
-zonkFlavor (Given loc) = do { loc' <- zonkGivenLoc loc; return (Given loc') }
-zonkFlavor fl = return fl
+zonkFlavor (Given loc gk) = do { loc' <- zonkGivenLoc loc; return (Given loc' gk) }
+zonkFlavor fl = return fl
zonkGivenLoc :: GivenLoc -> TcM GivenLoc
-- GivenLocs may have unification variables inside them!
-- The two interesting cases!
go (TyVarTy tyvar) | isTcTyVar tyvar = zonk_tc_tyvar tyvar
- | otherwise = liftM TyVarTy $
- zonkTyVar zonk_tc_tyvar tyvar
+ | otherwise = return (TyVarTy tyvar)
-- Ordinary (non Tc) tyvars occur inside quantified types
go (ForAllTy tyvar ty) = ASSERT( isImmutableTyVar tyvar ) do
ty' <- go ty
- tyvar' <- zonkTyVar zonk_tc_tyvar tyvar
+ tyvar' <- return tyvar
return (ForAllTy tyvar' ty')
go_pred (ClassP c tys) = do tys' <- mapM go tys
; case cts of
Flexi -> unbound_var_fn tyvar
Indirect ty -> zonkType (mkZonkTcTyVar unbound_var_fn) ty }
-
--- Zonk the kind of a non-TC tyvar in case it is a coercion variable
--- (their kind contains types).
-zonkTyVar :: (TcTyVar -> TcM Type) -- What to do for a TcTyVar
- -> TyVar -> TcM TyVar
-zonkTyVar zonk_tc_tyvar tv
- | isCoVar tv
- = do { kind <- zonkType zonk_tc_tyvar (tyVarKind tv)
- ; return $ setTyVarKind tv kind }
- | otherwise = return tv
\end{code}
warnTc (notNull dups) (dupPredWarn dups)
mapM_ (check_pred_ty dflags ctxt) theta
where
- (_,dups) = removeDups tcCmpPred theta
+ (_,dups) = removeDups cmpPred theta
-------------------------
check_pred_ty :: DynFlags -> SourceTyCtxt -> PredType -> TcM ()
ambigErr :: PredType -> SDoc
ambigErr pred
- = sep [ptext (sLit "Ambiguous constraint") <+> quotes (pprPred pred),
+ = sep [ptext (sLit "Ambiguous constraint") <+> quotes (pprPredTy pred),
nest 2 (ptext (sLit "At least one of the forall'd type variables mentioned by the constraint") $$
ptext (sLit "must be reachable from the type after the '=>'"))]
\end{code}
2 (ppr pred)
badPredTyErr, eqPredTyErr, predTyVarErr :: PredType -> SDoc
-badPredTyErr pred = ptext (sLit "Illegal constraint") <+> pprPred pred
-eqPredTyErr pred = ptext (sLit "Illegal equational constraint") <+> pprPred pred
+badPredTyErr pred = ptext (sLit "Illegal constraint") <+> pprPredTy pred
+eqPredTyErr pred = ptext (sLit "Illegal equational constraint") <+> pprPredTy pred
$$
parens (ptext (sLit "Use -XTypeFamilies to permit this"))
predTyVarErr pred = sep [ptext (sLit "Non type-variable argument"),
- nest 2 (ptext (sLit "in the constraint:") <+> pprPred pred)]
+ nest 2 (ptext (sLit "in the constraint:") <+> pprPredTy pred)]
dupPredWarn :: [[PredType]] -> SDoc
-dupPredWarn dups = ptext (sLit "Duplicate constraint(s):") <+> pprWithCommas pprPred (map head dups)
+dupPredWarn dups = ptext (sLit "Duplicate constraint(s):") <+> pprWithCommas pprPredTy (map head dups)
arityErr :: Outputable a => String -> a -> Int -> Int -> SDoc
arityErr kind name n m
predUndecErr :: PredType -> SDoc -> SDoc
predUndecErr pred msg = sep [msg,
- nest 2 (ptext (sLit "in the constraint:") <+> pprPred pred)]
+ nest 2 (ptext (sLit "in the constraint:") <+> pprPredTy pred)]
nomoreMsg, smallerMsg, undecidableMsg :: SDoc
nomoreMsg = ptext (sLit "Variable occurs more often in a constraint than in the instance head")
projects / ghc-hetmet.git / blobdiff