X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;ds=inline;f=ghc%2Fcompiler%2Ftypecheck%2FTcType.lhs;h=c7af9ee146c7083d79e578c59022fd4f65f84f3c;hb=dd8235367cd61e6811eee42b78c6514e77428c7c;hp=eee1f20b858c0e1923842348c8d331f755f8fa14;hpb=b0604aad2c311d8713c2497afa6373bd938d501b;p=ghc-hetmet.git

diff --git a/ghc/compiler/typecheck/TcType.lhs b/ghc/compiler/typecheck/TcType.lhs
index eee1f20..c7af9ee 100644
--- a/ghc/compiler/typecheck/TcType.lhs
+++ b/ghc/compiler/typecheck/TcType.lhs
@@ -17,7 +17,12 @@ is the principal client.
 module TcType (
   --------------------------------
   -- Types 
-  TauType, RhoType, SigmaType, 
+  TcType, TcTauType, TcPredType, TcThetaType, TcRhoType,
+  TcTyVar, TcTyVarSet, TcKind,
+
+  --------------------------------
+  -- TyVarDetails
+  TyVarDetails(..), isUserTyVar, isSkolemTyVar,
 
   --------------------------------
   -- Builders
@@ -53,7 +58,7 @@ module TcType (
   isPredTy, isClassPred, isTyVarClassPred, predHasFDs,
   mkDictTy, tcSplitPredTy_maybe, predTyUnique,
   isDictTy, tcSplitDFunTy, predTyUnique, 
-  mkClassPred, predMentionsIPs, inheritablePred, isIPPred, mkPredName,
+  mkClassPred, inheritablePred, isIPPred, mkPredName,
 
   ---------------------------------
   -- Foreign import and export
@@ -89,7 +94,7 @@ module TcType (
   isPrimitiveType,
 
   tidyTopType, tidyType, tidyPred, tidyTypes, tidyFreeTyVars, tidyOpenType, tidyOpenTypes,
-  tidyTyVar, tidyTyVars,
+  tidyTyVarBndr, tidyOpenTyVar, tidyOpenTyVars,
   typeKind, eqKind, eqUsage,
 
   tyVarsOfType, tyVarsOfTypes, tyVarsOfPred, tyVarsOfTheta
@@ -115,11 +120,11 @@ import Type		(	-- Re-exports
 			  isUnLiftedType, isUnboxedTupleType, isPrimitiveType,
 			  splitNewType_maybe, splitTyConApp_maybe,
 			  tidyTopType, tidyType, tidyPred, tidyTypes, tidyFreeTyVars, tidyOpenType, tidyOpenTypes,
-			  tidyTyVar, tidyTyVars, eqKind, eqUsage,
+			  tidyTyVarBndr, tidyOpenTyVar, tidyOpenTyVars, eqKind, eqUsage,
 			  hasMoreBoxityInfo, liftedBoxity, superBoxity, typeKind, superKind
 			)
-import TyCon		( TyCon, isPrimTyCon, tyConArity, isNewTyCon, isUnLiftedTyCon )
-import Class		( classTyCon, classHasFDs, Class )
+import TyCon		( TyCon, isUnLiftedTyCon )
+import Class		( classHasFDs, Class )
 import Var		( TyVar, tyVarKind )
 import ForeignCall	( Safety, playSafe )
 import VarEnv
@@ -130,27 +135,97 @@ import CmdLineOpts	( DynFlags, DynFlag( Opt_GlasgowExts ), dopt )
 import Name		( Name, NamedThing(..), mkLocalName )
 import OccName		( OccName, mkDictOcc )
 import NameSet
-import PrelNames	-- Lots (e.g. in isFFIArgumentTy
+import PrelNames	-- Lots (e.g. in isFFIArgumentTy)
 import TysWiredIn	( ptrTyCon, funPtrTyCon, addrTyCon, unitTyCon )
-import Unique		( Unique, Uniquable(..), mkTupleTyConUnique )
+import Unique		( Unique, Uniquable(..) )
 import SrcLoc		( SrcLoc )
-import Util		( cmpList, thenCmp )
+import Util		( cmpList, thenCmp, equalLength )
 import Maybes		( maybeToBool, expectJust )
-import BasicTypes	( Boxity(..) )
 import Outputable
 \end{code}
 
 
 %************************************************************************
 %*									*
-\subsection{Tau, sigma and rho}
+\subsection{Types}
 %*									*
 %************************************************************************
 
 \begin{code}
-type SigmaType    = Type
-type RhoType   	  = Type
+type TcTyVar    = TyVar		-- Might be a mutable tyvar
+type TcTyVarSet = TyVarSet
+
+type TcType = Type 		-- A TcType can have mutable type variables
+	-- Invariant on ForAllTy in TcTypes:
+	-- 	forall a. T
+	-- a cannot occur inside a MutTyVar in T; that is,
+	-- T is "flattened" before quantifying over a
+
+type TcPredType     = PredType
+type TcThetaType    = ThetaType
+type TcRhoType      = Type
+type TcTauType      = TauType
+type TcKind         = TcType
+\end{code}
+
+
+%************************************************************************
+%*									*
+\subsection{TyVarDetails}
+%*									*
+%************************************************************************
+
+TyVarDetails gives extra info about type variables, used during type
+checking.  It's attached to mutable type variables only.
+It's knot-tied back to Var.lhs.  There is no reason in principle
+why Var.lhs shouldn't actually have the definition, but it "belongs" here.
 
+\begin{code}
+data TyVarDetails
+  = SigTv	-- Introduced when instantiating a type signature,
+		-- prior to checking that the defn of a fn does 
+		-- have the expected type.  Should not be instantiated.
+		--
+		-- 	f :: forall a. a -> a
+		-- 	f = e
+		-- When checking e, with expected type (a->a), we 
+		-- should not instantiate a
+
+   | ClsTv	-- Scoped type variable introduced by a class decl
+		--	class C a where ...
+
+   | InstTv	-- Ditto, but instance decl
+
+   | PatSigTv	-- Scoped type variable, introduced by a pattern
+		-- type signature
+		--	\ x::a -> e
+
+   | VanillaTv	-- Everything else
+
+isUserTyVar :: TyVarDetails -> Bool	-- Avoid unifying these if possible
+isUserTyVar VanillaTv = False
+isUserTyVar other     = True
+
+isSkolemTyVar :: TyVarDetails -> Bool
+isSkolemTyVar SigTv = True
+isSkolemTyVar other = False
+
+instance Outputable TyVarDetails where
+  ppr SigTv	= ptext SLIT("type signature")
+  ppr ClsTv     = ptext SLIT("class declaration")
+  ppr InstTv    = ptext SLIT("instance declaration")
+  ppr PatSigTv  = ptext SLIT("pattern type signature")
+  ppr VanillaTv = ptext SLIT("???")
+\end{code}
+
+
+%************************************************************************
+%*									*
+\subsection{Tau, sigma and rho}
+%*									*
+%************************************************************************
+
+\begin{code}
 mkSigmaTy tyvars theta tau = mkForAllTys tyvars (mkRhoTy theta tau)
 
 mkRhoTy :: [SourceType] -> Type -> Type
@@ -424,10 +499,6 @@ inheritablePred :: PredType -> Bool
 -- which can be free in g's rhs, and shared by both calls to g
 inheritablePred (ClassP _ _) = True
 inheritablePred other	     = False
-
-predMentionsIPs :: SourceType -> NameSet -> Bool
-predMentionsIPs (IParam n _) ns = n `elemNameSet` ns
-predMentionsIPs other	     ns = False
 \end{code}
 
 
@@ -559,7 +630,7 @@ isIntegerTy    = is_tc integerTyConKey
 isIntTy        = is_tc intTyConKey
 isAddrTy       = is_tc addrTyConKey
 isBoolTy       = is_tc boolTyConKey
-isUnitTy       = is_tc (mkTupleTyConUnique Boxed 0)
+isUnitTy       = is_tc unitTyConKey
 
 is_tc :: Unique -> Type -> Bool
 -- Newtypes are opaque to this
@@ -858,7 +929,7 @@ uTysX (FunTy fun1 arg1) (FunTy fun2 arg2) k subst
 
 	-- Type constructors must match
 uTysX (TyConApp con1 tys1) (TyConApp con2 tys2) k subst
-  | (con1 == con2 && length tys1 == length tys2)
+  | (con1 == con2 && equalLength tys1 tys2)
   = uTyListsX tys1 tys2 k subst
 
 	-- Applications need a bit of care!