import {-# SOURCE #-} TcMatches ( tcGRHSs, tcMatchesFun )
import {-# SOURCE #-} TcExpr ( tcExpr )
-import HsSyn ( HsExpr(..), HsBinds(..), MonoBinds(..), Sig(..), InPat(..), StmtCtxt(..),
- Match(..), collectMonoBinders, andMonoBindList, andMonoBinds
+import HsSyn ( HsExpr(..), HsBinds(..), MonoBinds(..), Sig(..), StmtCtxt(..),
+ Match(..), collectMonoBinders, andMonoBinds
)
import RnHsSyn ( RenamedHsBinds, RenamedSig, RenamedMonoBinds )
-import TcHsSyn ( TcHsBinds, TcMonoBinds, TcId, zonkId, mkHsLet )
+import TcHsSyn ( TcMonoBinds, TcId, zonkId, mkHsLet )
import TcMonad
-import Inst ( Inst, LIE, emptyLIE, mkLIE, plusLIE, plusLIEs, InstOrigin(..),
+import Inst ( LIE, emptyLIE, mkLIE, plusLIE, InstOrigin(..),
newDicts, tyVarsOfInst, instToId,
getAllFunDepsOfLIE, getIPsOfLIE, zonkFunDeps
)
)
import TcPat ( tcPat )
import TcSimplify ( bindInstsOfLocalFuns )
-import TcType ( TcType, TcThetaType,
- TcTyVar,
- newTyVarTy, newTyVar, newTyVarTy_OpenKind, tcInstTcType,
- zonkTcType, zonkTcTypes, zonkTcThetaType, zonkTcTyVarToTyVar
+import TcType ( TcThetaType, newTyVarTy, newTyVar,
+ zonkTcTypes, zonkTcThetaType, zonkTcTyVarToTyVar
)
import TcUnify ( unifyTauTy, unifyTauTyLists )
-import Id ( Id, mkVanillaId, setInlinePragma, idFreeTyVars )
+import Id ( mkVanillaId, setInlinePragma, idFreeTyVars )
import Var ( idType, idName )
-import IdInfo ( setInlinePragInfo, InlinePragInfo(..) )
-import Name ( Name, getName, getOccName, getSrcLoc )
+import IdInfo ( InlinePragInfo(..) )
+import Name ( Name, getOccName, getSrcLoc )
import NameSet
import Type ( mkTyVarTy, tyVarsOfTypes, mkTyConApp,
- splitSigmaTy, mkForAllTys, mkFunTys, getTyVar,
- mkPredTy, splitRhoTy, mkForAllTy, isUnLiftedType,
- isUnboxedType, unboxedTypeKind, boxedTypeKind
+ mkForAllTys, mkFunTys,
+ mkPredTy, mkForAllTy, isUnLiftedType,
+ isUnboxedType, unboxedTypeKind, boxedTypeKind, openTypeKind
)
import FunDeps ( tyVarFunDep, oclose )
-import Var ( TyVar, tyVarKind )
+import Var ( tyVarKind )
import VarSet
import Bag
import Util ( isIn )
import Maybes ( maybeToBool )
import BasicTypes ( TopLevelFlag(..), RecFlag(..), isNotTopLevel )
import FiniteMap ( listToFM, lookupFM )
-import Unique ( ioTyConKey, mainKey, hasKey, Uniquable(..) )
+import PrelNames ( ioTyConKey, mainKey, hasKey )
import Outputable
\end{code}
tcMonoBinds mbinds tc_ty_sigs is_rec
= tc_mb_pats mbinds `thenTc` \ (complete_it, lie_req_pat, tvs, ids, lie_avail) ->
let
- tv_list = bagToList tvs
id_list = bagToList ids
(names, mono_ids) = unzip id_list
lie_avail1 `plusLIE` lie_avail2)
tc_mb_pats (FunMonoBind name inf matches locn)
- = new_lhs_ty `thenNF_Tc` \ bndr_ty ->
+ = newTyVarTy kind `thenNF_Tc` \ bndr_ty ->
tc_pat_bndr name bndr_ty `thenTc` \ bndr_id ->
let
complete_it xve = tcAddSrcLoc locn $
tc_mb_pats bind@(PatMonoBind pat grhss locn)
= tcAddSrcLoc locn $
- new_lhs_ty `thenNF_Tc` \ pat_ty ->
+ newTyVarTy kind `thenNF_Tc` \ pat_ty ->
-- Now typecheck the pattern
-- We don't support binding fresh type variables in the
-- Figure out the appropriate kind for the pattern,
-- and generate a suitable type variable
- new_lhs_ty = case is_rec of
- Recursive -> newTyVarTy boxedTypeKind -- Recursive, so no unboxed types
- NonRecursive -> newTyVarTy_OpenKind -- Non-recursive, so we permit unboxed types
+ kind = case is_rec of
+ Recursive -> boxedTypeKind -- Recursive, so no unboxed types
+ NonRecursive -> openTypeKind -- Non-recursive, so we permit unboxed types
\end{code}
%************************************************************************
nest 4 (ppr v <+> dcolon <+> ppr ty)]
-----------------------------------------------
-notAsPolyAsSigErr sig_tau mono_tyvars
- = hang (ptext SLIT("A type signature is more polymorphic than the inferred type"))
- 4 (vcat [text "Can't for-all the type variable(s)" <+>
- pprQuotedList mono_tyvars,
- text "in the type" <+> quotes (ppr sig_tau)
- ])
-
------------------------------------------------
-badMatchErr sig_ty inferred_ty
- = hang (ptext SLIT("Type signature doesn't match inferred type"))
- 4 (vcat [hang (ptext SLIT("Signature:")) 4 (ppr sig_ty),
- hang (ptext SLIT("Inferred :")) 4 (ppr inferred_ty)
- ])
-
------------------------------------------------
unboxedPatBindErr id
= ptext SLIT("variable in a lazy pattern binding has unboxed type: ")
<+> quotes (ppr id)