X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcType.lhs;h=47bb554e867d4760659079f8bd8bfbe3c6f89813;hb=14a496fd0b3aa821b69eb02736d5f41086576761;hp=dcc51efaa3036f30d9ad753c67d016792df6e72a;hpb=a6f2d598e1e7760d334d1b5ea0b7745e66835e11;p=ghc-hetmet.git

diff --git a/compiler/typecheck/TcType.lhs b/compiler/typecheck/TcType.lhs
index dcc51ef..47bb554 100644
--- a/compiler/typecheck/TcType.lhs
+++ b/compiler/typecheck/TcType.lhs
@@ -30,7 +30,7 @@ module TcType (
   isImmutableTyVar, isSkolemTyVar, isMetaTyVar,  isMetaTyVarTy,
   isSigTyVar, isExistentialTyVar,  isTyConableTyVar,
   metaTvRef, 
-  isFlexi, isIndirect, isRuntimeUnk, isUnk,
+  isFlexi, isIndirect, isUnkSkol, isRuntimeUnkSkol,
 
   --------------------------------
   -- Builders
@@ -123,7 +123,8 @@ module TcType (
   -- Type substitutions
   TvSubst(..), 	-- Representation visible to a few friends
   TvSubstEnv, emptyTvSubst, substEqSpec,
-  mkOpenTvSubst, zipOpenTvSubst, zipTopTvSubst, mkTopTvSubst, notElemTvSubst,
+  mkOpenTvSubst, zipOpenTvSubst, zipTopTvSubst, 
+  mkTopTvSubst, notElemTvSubst, unionTvSubst,
   getTvSubstEnv, setTvSubstEnv, getTvInScope, extendTvInScope, lookupTyVar,
   extendTvSubst, extendTvSubstList, isInScope, mkTvSubst, zipTyEnv,
   substTy, substTys, substTyWith, substTheta, substTyVar, substTyVars, substTyVarBndr,
@@ -274,17 +275,18 @@ TcBinds.tcInstSig, and its use_skols parameter.
 data TcTyVarDetails
   = SkolemTv SkolemInfo	  -- A skolem constant
 
-  | FlatSkol TcType	  -- The "skolem" obtained by flattening during
-    	                  -- constraint simplification
+  | FlatSkol TcType	  
+           -- The "skolem" obtained by flattening during
+    	   -- constraint simplification
     
-                          -- In comments we will use the notation alpha[flat = ty]
-                          -- to represent a flattening skolem variable alpha
-                          -- identified with type ty.
-
+           -- In comments we will use the notation alpha[flat = ty]
+           -- to represent a flattening skolem variable alpha
+           -- identified with type ty.
+          
   | MetaTv MetaInfo (IORef MetaDetails)
 
 data MetaDetails
-  = Flexi	-- Flexi type variables unify to become Indirects  
+  = Flexi  -- Flexi type variables unify to become Indirects  
   | Indirect TcType
 
 data MetaInfo 
@@ -301,6 +303,11 @@ data MetaInfo
 		   -- The Name is the name of the function from whose
 		   -- type signature we got this skolem
 
+   | TcsTv	   -- A MetaTv allocated by the constraint solver
+     		   -- Its particular property is that it is always "touchable"
+		   -- Nevertheless, the constraint solver has to try to guess
+		   -- what type to instantiate it to
+
 ----------------------------------
 -- SkolemInfo describes a site where 
 --   a) type variables are skolemised
@@ -328,6 +335,7 @@ data SkolemInfo
 
   | RuleSkol RuleName	-- The LHS of a RULE
   | GenSkol TcType	-- Bound when doing a subsumption check for ty
+
   | RuntimeUnkSkol      -- a type variable used to represent an unknown
                         -- runtime type (used in the GHCi debugger)
 
@@ -405,8 +413,9 @@ kind_var_occ = mkOccName tvName "k"
 pprTcTyVarDetails :: TcTyVarDetails -> SDoc
 -- For debugging
 pprTcTyVarDetails (SkolemTv _)         = ptext (sLit "sk")
-pprTcTyVarDetails (FlatSkol _)         = ptext (sLit "fsk")
+pprTcTyVarDetails (FlatSkol {})        = ptext (sLit "fsk")
 pprTcTyVarDetails (MetaTv TauTv _)     = ptext (sLit "tau")
+pprTcTyVarDetails (MetaTv TcsTv _)     = ptext (sLit "tcs")
 pprTcTyVarDetails (MetaTv (SigTv _) _) = ptext (sLit "sig")
 
 pprUserTypeCtxt :: UserTypeCtxt -> SDoc
@@ -431,9 +440,10 @@ pprSkolTvBinding tv
     quotes (ppr tv) <+> ppr_details (tcTyVarDetails tv)
   where
     ppr_details (SkolemTv info)      = ppr_skol info
-    ppr_details (FlatSkol _) 	     = ptext (sLit "is a flattening type variable")
-    ppr_details (MetaTv TauTv _)     = ptext (sLit "is a meta type variable")
-    ppr_details (MetaTv (SigTv n) _) = ptext (sLit "is bound by the type signature for") <+> quotes (ppr n)
+    ppr_details (FlatSkol {}) 	     = ptext (sLit "is a flattening type variable")
+    ppr_details (MetaTv (SigTv n) _) = ptext (sLit "is bound by the type signature for")
+                                       <+> quotes (ppr n)
+    ppr_details (MetaTv _ _)         = ptext (sLit "is a meta type variable")
 
     ppr_skol UnkSkol	    = ptext (sLit "is an unknown type variable")	-- Unhelpful
     ppr_skol RuntimeUnkSkol = ptext (sLit "is an unknown runtime type")
@@ -614,8 +624,8 @@ isTyConableTyVar tv
 	-- not a SigTv
   = ASSERT( isTcTyVar tv) 
     case tcTyVarDetails tv of
-	MetaTv TauTv _ -> True
-	_              -> False
+	MetaTv (SigTv _) _ -> False
+	_                  -> True
 	
 isSkolemTyVar tv 
   = ASSERT2( isTcTyVar tv, ppr tv )
@@ -661,15 +671,17 @@ isFlexi _     = False
 isIndirect (Indirect _) = True
 isIndirect _            = False
 
-isRuntimeUnk :: TyVar -> Bool
-isRuntimeUnk x | isTcTyVar x
-               , SkolemTv RuntimeUnkSkol <- tcTyVarDetails x = True
-               | otherwise = False
-
-isUnk :: TyVar -> Bool
-isUnk x | isTcTyVar x
-        , SkolemTv UnkSkol <- tcTyVarDetails x = True
-        | otherwise = False
+isRuntimeUnkSkol :: TyVar -> Bool
+-- Called only in TcErrors; see Note [Runtime skolems] there
+isRuntimeUnkSkol x | isTcTyVar x
+  		   , SkolemTv RuntimeUnkSkol <- tcTyVarDetails x 
+  		   = True
+  		   | otherwise = False
+
+isUnkSkol :: TyVar -> Bool
+isUnkSkol x | isTcTyVar x
+            , SkolemTv UnkSkol <- tcTyVarDetails x = True
+            | otherwise = False
 \end{code}