X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Ftypecheck%2FTcBinds.lhs;h=f308e330eefc7afeb6f48f087a87b155d01be95b;hb=1c3601593186639f1086bc402582ff56fd3fe9f8;hp=93f43261f783ff301a295384ae2de1fb40a9d392;hpb=1bba522f5ec82c43abd2ba4e84127b9c915dd020;p=ghc-hetmet.git

diff --git a/ghc/compiler/typecheck/TcBinds.lhs b/ghc/compiler/typecheck/TcBinds.lhs
index 93f4326..f308e33 100644
--- a/ghc/compiler/typecheck/TcBinds.lhs
+++ b/ghc/compiler/typecheck/TcBinds.lhs
@@ -25,7 +25,7 @@ import Inst		( LIE, emptyLIE, mkLIE, plusLIE, InstOrigin(..),
 			)
 import TcEnv		( tcExtendLocalValEnv,
 			  newSpecPragmaId, newLocalId,
-			  tcLookupTyConByKey, 
+			  tcLookupTyCon, 
 			  tcGetGlobalTyVars, tcExtendGlobalTyVars
 			)
 import TcSimplify	( tcSimplify, tcSimplifyAndCheck, tcSimplifyToDicts )
@@ -58,7 +58,7 @@ import Util		( isIn )
 import Maybes		( maybeToBool )
 import BasicTypes	( TopLevelFlag(..), RecFlag(..), isNotTopLevel )
 import FiniteMap	( listToFM, lookupFM )
-import Unique		( ioTyConKey, mainKey, hasKey )
+import PrelNames	( ioTyConKey, mainKey, hasKey )
 import Outputable
 \end{code}
 
@@ -98,8 +98,8 @@ dictionaries, which we resolve at the module level.
 tcTopBindsAndThen, tcBindsAndThen
 	:: (RecFlag -> TcMonoBinds -> thing -> thing)		-- Combinator
 	-> RenamedHsBinds
-	-> TcM s (thing, LIE)
-	-> TcM s (thing, LIE)
+	-> TcM (thing, LIE)
+	-> TcM (thing, LIE)
 
 tcTopBindsAndThen = tc_binds_and_then TopLevel
 tcBindsAndThen    = tc_binds_and_then NotTopLevel
@@ -182,8 +182,8 @@ examples of this, which is why I thought it worth preserving! [SLPJ]
 \begin{pseudocode}
 % tcBindsAndThen
 % 	:: RenamedHsBinds
-% 	-> TcM s (thing, LIE, thing_ty))
-% 	-> TcM s ((TcHsBinds, thing), LIE, thing_ty)
+% 	-> TcM (thing, LIE, thing_ty))
+% 	-> TcM ((TcHsBinds, thing), LIE, thing_ty)
 % 
 % tcBindsAndThen EmptyBinds do_next
 %   = do_next 		`thenTc` \ (thing, lie, thing_ty) ->
@@ -223,7 +223,7 @@ tcBindWithSigs
 	-> [TcSigInfo]
 	-> [RenamedSig]		-- Used solely to get INLINE, NOINLINE sigs
 	-> RecFlag
-	-> TcM s (TcMonoBinds, LIE, [TcId])
+	-> TcM (TcMonoBinds, LIE, [TcId])
 
 tcBindWithSigs top_lvl mbind tc_ty_sigs inline_sigs is_rec
   = recoverTc (
@@ -233,7 +233,7 @@ tcBindWithSigs top_lvl mbind tc_ty_sigs inline_sigs is_rec
 	newTyVar boxedTypeKind		`thenNF_Tc` \ alpha_tv ->
 	let
 	  forall_a_a    = mkForAllTy alpha_tv (mkTyVarTy alpha_tv)
-          binder_names  = map fst (bagToList (collectMonoBinders mbind))
+          binder_names  = collectMonoBinders mbind
 	  poly_ids      = map mk_dummy binder_names
 	  mk_dummy name = case maybeSig tc_ty_sigs name of
 			    Just (TySigInfo _ poly_id _ _ _ _ _ _) -> poly_id	-- Signature
@@ -398,8 +398,7 @@ tcBindWithSigs top_lvl mbind tc_ty_sigs inline_sigs is_rec
 		-- at all.
 	
 	pat_binders :: [Name]
-	pat_binders = map fst $ bagToList $ collectMonoBinders $ 
-		      (justPatBindings mbind EmptyMonoBinds)
+	pat_binders = collectMonoBinders (justPatBindings mbind EmptyMonoBinds)
     in
 	-- CHECK FOR UNBOXED BINDERS IN PATTERN BINDINGS
     mapTc (\id -> checkTc (not (idName id `elem` pat_binders
@@ -602,7 +601,7 @@ The signatures have been dealt with already.
 tcMonoBinds :: RenamedMonoBinds 
 	    -> [TcSigInfo]
 	    -> RecFlag
-	    -> TcM s (TcMonoBinds, 
+	    -> TcM (TcMonoBinds, 
 		      LIE,		-- LIE required
 		      [Name],		-- Bound names
 		      [TcId])	-- Corresponding monomorphic bound things
@@ -732,12 +731,12 @@ The error message here is somewhat unsatisfactory, but it'll do for
 now (ToDo).
 
 \begin{code}
-checkSigMatch :: TopLevelFlag -> [Name] -> [TcId] -> [TcSigInfo] -> TcM s (Maybe (TcThetaType, LIE))
+checkSigMatch :: TopLevelFlag -> [Name] -> [TcId] -> [TcSigInfo] -> TcM (Maybe (TcThetaType, LIE))
 checkSigMatch top_lvl binder_names mono_ids sigs
   | main_bound_here
   =	-- First unify the main_id with IO t, for any old t
     tcSetErrCtxt mainTyCheckCtxt (
-	tcLookupTyConByKey ioTyConKey		`thenTc`    \ ioTyCon ->
+	tcLookupTyCon ioTyConName		`thenTc`    \ ioTyCon ->
 	newTyVarTy boxedTypeKind		`thenNF_Tc` \ t_tv ->
 	unifyTauTy ((mkTyConApp ioTyCon [t_tv]))
 		   (idType main_mono_id)
@@ -858,7 +857,7 @@ a RULE now:
 	{-# SPECIALISE (f::<type) = g #-}
 
 \begin{code}
-tcSpecSigs :: [RenamedSig] -> TcM s (TcMonoBinds, LIE)
+tcSpecSigs :: [RenamedSig] -> TcM (TcMonoBinds, LIE)
 tcSpecSigs (SpecSig name poly_ty src_loc : sigs)
   = 	-- SPECIALISE f :: forall b. theta => tau  =  g
     tcAddSrcLoc src_loc		 		$