module TcBinds ( tcBindsAndThen, tcPragmaSigs ) where
-import Ubiq
+IMP_Ubiq()
import HsSyn ( HsBinds(..), Bind(..), Sig(..), MonoBinds(..),
HsExpr, Match, PolyType, InPat, OutPat(..),
import TcHsSyn ( TcHsBinds(..), TcBind(..), TcMonoBinds(..),
TcIdOcc(..), TcIdBndr(..) )
-import TcMonad
+import TcMonad hiding ( rnMtoTcM )
import GenSpecEtc ( checkSigTyVars, genBinds, TcSigInfo(..) )
import Inst ( Inst, LIE(..), emptyLIE, plusLIE, InstOrigin(..) )
import TcEnv ( tcExtendLocalValEnv, tcLookupLocalValueOK, newMonoIds )
-import TcLoop ( tcGRHSsAndBinds )
+IMPORT_DELOOPER(TcLoop) ( tcGRHSsAndBinds )
import TcMatches ( tcMatchesFun )
import TcMonoType ( tcPolyType )
import TcPat ( tcPat )
import TcSimplify ( bindInstsOfLocalFuns )
-import TcType ( newTcTyVar, tcInstType )
+import TcType ( newTcTyVar, tcInstSigType )
import Unify ( unifyTauTy )
import Kind ( mkBoxedTypeKind, mkTypeKind )
import Id ( GenId, idType, mkUserId )
import IdInfo ( noIdInfo )
-import Maybes ( assocMaybe, catMaybes, Maybe(..) )
+import Maybes ( assocMaybe, catMaybes )
import Name ( pprNonSym )
import PragmaInfo ( PragmaInfo(..) )
import Pretty
import Type ( mkTyVarTy, mkTyVarTys, isTyVarTy,
mkSigmaTy, splitSigmaTy,
splitRhoTy, mkForAllTy, splitForAllTy )
-import Util ( isIn, panic )
+import Util ( isIn, zipEqual, panic )
\end{code}
%************************************************************************
genBinds binder_names mono_ids bind' lie sig_info prag_info_fn
where
kind = case bind of
- NonRecBind _ -> mkBoxedTypeKind -- Recursive, so no unboxed types
- RecBind _ -> mkTypeKind -- Non-recursive, so we permit unboxed types
+ NonRecBind _ -> mkTypeKind -- Recursive, so no unboxed types
+ RecBind _ -> mkBoxedTypeKind -- Non-recursive, so we permit unboxed types
\end{code}
more_sig_infos = [ SigInfo binder (mk_poly binder local_id)
local_id tys_to_gen dicts_to_gen lie_to_gen
- | (binder, local_id) <- nosig_binders `zipEqual` nosig_local_ids
+ | (binder, local_id) <- zipEqual "???" nosig_binders nosig_local_ids
]
all_sig_infos = sig_infos ++ more_sig_infos -- Contains a "signature" for each binder
`thenTc` \ (lie_free, dict_binds) ->
returnTc (AbsBind tyvars_to_gen_here
dicts
- (local_ids `zipEqual` poly_ids)
+ (zipEqual "gen_bind" local_ids poly_ids)
(dict_binds ++ local_binds)
bind,
lie_free)
tcTySigs (Sig v ty _ src_loc : other_sigs)
= tcAddSrcLoc src_loc (
tcPolyType ty `thenTc` \ sigma_ty ->
- tcInstType [] sigma_ty `thenNF_Tc` \ sigma_ty' ->
+ tcInstSigType sigma_ty `thenNF_Tc` \ sigma_ty' ->
let
(tyvars', theta', tau') = splitSigmaTy sigma_ty'
in
-- Get and instantiate its alleged specialised type
tcPolyType poly_ty `thenTc` \ sig_sigma ->
- tcInstType [] sig_sigma `thenNF_Tc` \ sig_ty ->
+ tcInstSigType sig_sigma `thenNF_Tc` \ sig_ty ->
let
(sig_tyvars, sig_theta, sig_tau) = splitSigmaTy sig_ty
origin = ValSpecOrigin name
-- Get and instantiate the type of the id mentioned
tcLookupLocalValueOK "tcPragmaSig" name `thenNF_Tc` \ main_id ->
- tcInstType [] (idType main_id) `thenNF_Tc` \ main_ty ->
+ tcInstSigType [] (idType main_id) `thenNF_Tc` \ main_ty ->
let
(main_tyvars, main_rho) = splitForAllTy main_ty
(main_theta,main_tau) = splitRhoTy main_rho