--------------------------------
-- Instantiation
- tcInstTyVar, tcInstType, tcInstTyVars, tcInstBoxy, tcInstBoxyTyVar,
+ tcInstTyVar, tcInstType, tcInstTyVars, tcInstBoxyTyVar,
tcInstSigTyVars, zonkSigTyVar,
tcInstSkolTyVar, tcInstSkolTyVars, tcInstSkolType,
tcSkolSigType, tcSkolSigTyVars,
import TcType ( TcType, TcThetaType, TcTauType, TcPredType,
TcTyVarSet, TcKind, TcTyVar, TcTyVarDetails(..),
MetaDetails(..), SkolemInfo(..), BoxInfo(..),
- BoxyTyVar, BoxyType, BoxyThetaType, BoxySigmaType,
- UserTypeCtxt(..),
+ BoxyTyVar, BoxyType, UserTypeCtxt(..),
isMetaTyVar, isSigTyVar, metaTvRef,
tcCmpPred, isClassPred, tcGetTyVar,
tcSplitPhiTy, tcSplitPredTy_maybe, tcSplitAppTy_maybe,
; ref <- newMutVar Flexi ;
; let name = mkSysTvName uniq fs
fs = case box_info of
- BoxTv -> FSLIT("bx")
+ BoxTv -> FSLIT("t")
TauTv -> FSLIT("t")
SigTv _ -> FSLIT("a")
+ -- We give BoxTv and TauTv the same string, because
+ -- otherwise we get user-visible differences in error
+ -- messages, which are confusing. If you want to see
+ -- the box_info of each tyvar, use -dppr-debug
; return (mkTcTyVar name kind (MetaTv box_info ref)) }
instMetaTyVar :: BoxInfo -> TyVar -> TcM TcTyVar
tcInstBoxyTyVar :: TyVar -> TcM BoxyTyVar
-- Instantiate with a BOXY type variable
tcInstBoxyTyVar tyvar = instMetaTyVar BoxTv tyvar
-
-tcInstBoxy :: TcType -> TcM ([BoxyTyVar], BoxyThetaType, BoxySigmaType)
--- tcInstType instantiates the outer-level for-alls of a TcType with
--- fresh BOXY type variables, splits off the dictionary part,
--- and returns the pieces.
-tcInstBoxy ty = tcInstType (mapM tcInstBoxyTyVar) ty
\end{code}
= check_tau_type (Rank 0) ubx_tup ty
check_poly_type rank ubx_tup ty
- = let
- (tvs, theta, tau) = tcSplitSigmaTy ty
- in
- check_valid_theta SigmaCtxt theta `thenM_`
- check_tau_type (decRank rank) ubx_tup tau `thenM_`
- checkFreeness tvs theta `thenM_`
- checkAmbiguity tvs theta (tyVarsOfType tau)
-
+ | null tvs && null theta
+ = check_tau_type rank ubx_tup ty
+ | otherwise
+ = do { check_valid_theta SigmaCtxt theta
+ ; check_poly_type rank ubx_tup tau -- Allow foralls to right of arrow
+ ; checkFreeness tvs theta
+ ; checkAmbiguity tvs theta (tyVarsOfType tau) }
+ where
+ (tvs, theta, tau) = tcSplitSigmaTy ty
+
----------------------------------------
check_arg_type :: Type -> TcM ()
-- The sort of type that can instantiate a type variable,
check_tau_type rank ubx_tup (TyVarTy _) = returnM ()
check_tau_type rank ubx_tup ty@(FunTy arg_ty res_ty)
- = check_poly_type rank UT_NotOk arg_ty `thenM_`
- check_poly_type rank UT_Ok res_ty
+ = check_poly_type (decRank rank) UT_NotOk arg_ty `thenM_`
+ check_poly_type rank UT_Ok res_ty
check_tau_type rank ubx_tup (AppTy ty1 ty2)
= check_arg_type ty1 `thenM_` check_arg_type ty2