X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcUnify.lhs;h=5fcaea6cf1bc25d61f67f2ea3c50d3096a72ee25;hb=e68a891932d615590d9b1ab5752ada8142db5053;hp=e9f0301b4a6913c8b940fb400623fe2d615c0b05;hpb=9da4639011348fb6c318e3cba4b08622f811d9c4;p=ghc-hetmet.git

diff --git a/compiler/typecheck/TcUnify.lhs b/compiler/typecheck/TcUnify.lhs
index e9f0301..5fcaea6 100644
--- a/compiler/typecheck/TcUnify.lhs
+++ b/compiler/typecheck/TcUnify.lhs
@@ -1,7 +1,9 @@
 %
+% (c) The University of Glasgow 2006
 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
 %
-\section{Type subsumption and unification}
+
+Type subsumption and unification
 
 \begin{code}
 module TcUnify (
@@ -25,61 +27,29 @@ module TcUnify (
 
 #include "HsVersions.h"
 
-import HsSyn		( HsWrapper(..), idHsWrapper, isIdHsWrapper, (<.>),
-			  mkWpLams, mkWpTyLams, mkWpApps )
-import TypeRep		( Type(..), PredType(..) )
-
-import TcMType		( lookupTcTyVar, LookupTyVarResult(..),
-                          tcInstBoxyTyVar, newKindVar, newMetaTyVar,
-			  newBoxyTyVar, newBoxyTyVarTys, readFilledBox, 
-			  readMetaTyVar, writeMetaTyVar, newFlexiTyVarTy,
-			  tcInstSkolTyVars, tcInstTyVar, tcInstSkolType,
-			  zonkTcKind, zonkType, zonkTcType,  zonkTcTyVarsAndFV, 
-			  readKindVar, writeKindVar )
-import TcSimplify	( tcSimplifyCheck )
-import TcEnv		( tcGetGlobalTyVars, findGlobals )
-import TcIface		( checkWiredInTyCon )
+import HsSyn
+import TypeRep
+
+import TcMType
+import TcSimplify
+import TcEnv
+import TcIface
 import TcRnMonad         -- TcType, amongst others
-import TcType		( TcKind, TcType, TcTyVar, BoxyTyVar, TcTauType,
-			  BoxySigmaType, BoxyRhoType, BoxyType, 
-			  TcTyVarSet, TcThetaType, TcTyVarDetails(..), BoxInfo(..), 
-			  SkolemInfo( GenSkol, UnkSkol ), MetaDetails(..), isImmutableTyVar,
-			  pprSkolTvBinding, isTauTy, isTauTyCon, isSigmaTy, 
-			  mkFunTy, mkFunTys, mkTyConApp, isMetaTyVar,
-			  tcSplitForAllTys, tcSplitAppTy_maybe, tcSplitFunTys, mkTyVarTys,
-			  tcSplitSigmaTy, tyVarsOfType, mkPhiTy, mkTyVarTy, mkPredTy, 
-			  typeKind, mkForAllTys, mkAppTy, isBoxyTyVar,
-			  tcView, exactTyVarsOfType, 
-			  tidyOpenType, tidyOpenTyVar, tidyOpenTyVars,
-			  pprType, tidyKind, tidySkolemTyVar, isSkolemTyVar, isSigTyVar,
-			  TvSubst, mkTvSubst, zipTyEnv, zipOpenTvSubst, emptyTvSubst, 
-			  substTy, substTheta,
-			  lookupTyVar, extendTvSubst )
-import Type		( Kind, SimpleKind, KindVar, 
-			  openTypeKind, liftedTypeKind, unliftedTypeKind, 
-			  mkArrowKind, defaultKind,
-			  argTypeKind, isLiftedTypeKind, isUnliftedTypeKind,
-			  isSubKind, pprKind, splitKindFunTys, isSubKindCon,
-                          isOpenTypeKind, isArgTypeKind )
-import TysPrim		( alphaTy, betaTy )
-import Inst		( newDictBndrsO, instCall, instToId )
-import TyCon		( TyCon, tyConArity, tyConTyVars, isSynTyCon )
-import TysWiredIn	( listTyCon )
-import Id		( Id )
-import Var		( Var, varName, tyVarKind, isTcTyVar, tcTyVarDetails )
+import TcType
+import Type
+import TysPrim
+import Inst
+import TyCon
+import TysWiredIn
+import Var
 import VarSet
 import VarEnv
-import Name		( Name, isSystemName )
-import ErrUtils		( Message )
-import Maybes		( expectJust, isNothing )
-import BasicTypes	( Arity )
-import Util		( notNull, equalLength )
+import Name
+import ErrUtils
+import Maybes
+import BasicTypes
+import Util
 import Outputable
-
--- Assertion imports
-#ifdef DEBUG
-import TcType		( isBoxyTy, isFlexi )
-#endif
 \end{code}
 
 %************************************************************************
@@ -95,7 +65,7 @@ tcInfer tc_infer
 	; res <- tc_infer (mkTyVarTy box)
 	; res_ty <- readFilledBox box	-- Guaranteed filled-in by now
 	; return (res, res_ty) }
-\end{code}		   
+\end{code}
 
 
 %************************************************************************
@@ -786,8 +756,8 @@ tcGen expected_ty extra_tvs thing_inside	-- We expect expected_ty to be a forall
 		-- Hence the tiresome but innocuous fixM
 	  ((tvs', theta', rho'), skol_info) <- fixM (\ ~(_, skol_info) ->
 		do { (forall_tvs, theta, rho_ty) <- tcInstSkolType skol_info expected_ty
-		   ; span <- getSrcSpanM
-		   ; let skol_info = GenSkol forall_tvs (mkPhiTy theta rho_ty) span
+			-- Get loation from monad, not from expected_ty
+		   ; let skol_info = GenSkol forall_tvs (mkPhiTy theta rho_ty)
 		   ; return ((forall_tvs, theta, rho_ty), skol_info) })
 
 #ifdef DEBUG
@@ -811,8 +781,9 @@ tcGen expected_ty extra_tvs thing_inside	-- We expect expected_ty to be a forall
 	-- Conclusion: include the free vars of the expected_ty in the
 	-- list of "free vars" for the signature check.
 
-	; dicts <- newDictBndrsO (SigOrigin skol_info) theta'
-	; inst_binds <- tcSimplifyCheck sig_msg tvs' dicts lie
+	; loc <- getInstLoc (SigOrigin skol_info)
+	; dicts <- newDictBndrs loc theta'
+	; inst_binds <- tcSimplifyCheck loc tvs' dicts lie
 
 	; checkSigTyVarsWrt free_tvs tvs'
 	; traceTc (text "tcGen:done")
@@ -824,7 +795,6 @@ tcGen expected_ty extra_tvs thing_inside	-- We expect expected_ty to be a forall
 	; returnM (co_fn, result) }
   where
     free_tvs = tyVarsOfType expected_ty `unionVarSet` extra_tvs
-    sig_msg  = ptext SLIT("expected type of an expression")
 \end{code}    
 
     
@@ -995,6 +965,7 @@ u_tys outer nb1 orig_ty1 ty1 nb2 orig_ty2 ty2
     go _ ty1@(ForAllTy _ _) ty2@(ForAllTy _ _)
       | length tvs1 == length tvs2
       = do   { tvs <- tcInstSkolTyVars UnkSkol tvs1	-- Not a helpful SkolemInfo
+			-- Get location from monad, not from tvs1
 	     ; let tys      = mkTyVarTys tvs
 	           in_scope = mkInScopeSet (mkVarSet tvs)
  	           subst1   = mkTvSubst in_scope (zipTyEnv tvs1 tys)
@@ -1261,7 +1232,7 @@ uUnfilledVars outer swapped tv1 (MetaTv info1 ref1) tv2 (MetaTv info2 ref2)
     k1_sub_k2 = k1 `isSubKind` k2
     k2_sub_k1 = k2 `isSubKind` k1
 
-    nicer_to_update_tv1 = isSystemName (varName tv1)
+    nicer_to_update_tv1 = isSystemName (Var.varName tv1)
 	-- Try to update sys-y type variables in preference to ones
 	-- gotten (say) by instantiating a polymorphic function with
 	-- a user-written type sig