X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcType.lhs;h=caea74f3146f11538d2b5456131ac78a28c428fc;hb=72e37dedee9e8a109ebda4b13e49b7133b530591;hp=60474b1f6ce233fc5179b45222dcaa910781dc82;hpb=2423c249f5ca7785d0ec89eb33e72662da7561c1;p=ghc-hetmet.git

diff --git a/compiler/typecheck/TcType.lhs b/compiler/typecheck/TcType.lhs
index 60474b1..caea74f 100644
--- a/compiler/typecheck/TcType.lhs
+++ b/compiler/typecheck/TcType.lhs
@@ -28,7 +28,8 @@ module TcType (
   UserTypeCtxt(..), pprUserTypeCtxt,
   TcTyVarDetails(..), BoxInfo(..), pprTcTyVarDetails,
   MetaDetails(Flexi, Indirect), SkolemInfo(..), pprSkolTvBinding, pprSkolInfo,
-  isImmutableTyVar, isSkolemTyVar, isMetaTyVar, isBoxyTyVar, isSigTyVar, isExistentialTyVar, 
+  isImmutableTyVar, isSkolemTyVar, isMetaTyVar, isBoxyTyVar, 
+  isSigTyVar, isExistentialTyVar,  isTyConableTyVar,
   metaTvRef, 
   isFlexi, isIndirect, 
 
@@ -59,7 +60,7 @@ module TcType (
 
   ---------------------------------
   -- Misc type manipulators
-  deNoteType, classesOfTheta,
+  deNoteType,
   tyClsNamesOfType, tyClsNamesOfDFunHead, 
   getDFunTyKey,
 
@@ -108,7 +109,7 @@ module TcType (
   mkOpenTvSubst, zipOpenTvSubst, zipTopTvSubst, mkTopTvSubst, notElemTvSubst,
   getTvSubstEnv, setTvSubstEnv, getTvInScope, extendTvInScope, lookupTyVar,
   extendTvSubst, extendTvSubstList, isInScope, mkTvSubst, zipTyEnv,
-  substTy, substTys, substTyWith, substTheta, substTyVar, substTyVarBndr,
+  substTy, substTys, substTyWith, substTheta, substTyVar, substTyVars, substTyVarBndr,
 
   isUnLiftedType,	-- Source types are always lifted
   isUnboxedTupleType,	-- Ditto
@@ -122,7 +123,7 @@ module TcType (
   tcTyVarsOfType, tcTyVarsOfTypes, exactTyVarsOfType, exactTyVarsOfTypes,
 
   pprKind, pprParendKind,
-  pprType, pprParendType, pprTyThingCategory,
+  pprType, pprParendType, pprTypeApp, pprTyThingCategory,
   pprPred, pprTheta, pprThetaArrow, pprClassPred
 
   ) where
@@ -322,6 +323,9 @@ data SkolemInfo
   | GenSkol [TcTyVar]	-- Bound when doing a subsumption check for 
 	    TcType	-- 	(forall tvs. ty)
 
+  | RuntimeUnkSkol      -- a type variable used to represent an unknown
+                        -- runtime type (used in the GHCi debugger)
+
   | UnkSkol		-- Unhelpful info (until I improve it)
 
 -------------------------------------
@@ -446,6 +450,7 @@ pprSkolTvBinding tv
     ppr_details (SkolemTv info)		= ppr_skol info
 
     ppr_skol UnkSkol = empty	-- Unhelpful; omit
+    ppr_skol RuntimeUnkSkol = quotes (ppr tv) <+> ptext SLIT("is an unknown runtime type")
     ppr_skol info    = quotes (ppr tv) <+> ptext SLIT("is bound by") 
 			<+> sep [pprSkolInfo info, nest 2 (ptext SLIT("at") <+> ppr (getSrcLoc tv))]
  
@@ -464,6 +469,7 @@ pprSkolInfo (GenSkol tvs ty) = sep [ptext SLIT("the polymorphic type"),
 -- For type variables the others are dealt with by pprSkolTvBinding.  
 -- For Insts, these cases should not happen
 pprSkolInfo UnkSkol = panic "UnkSkol"
+pprSkolInfo RuntimeUnkSkol = panic "RuntimeUnkSkol"
 
 instance Outputable MetaDetails where
   ppr Flexi 	    = ptext SLIT("Flexi")
@@ -478,11 +484,26 @@ instance Outputable MetaDetails where
 %************************************************************************
 
 \begin{code}
-isImmutableTyVar, isSkolemTyVar, isExistentialTyVar, isBoxyTyVar, isMetaTyVar :: TyVar -> Bool
+isImmutableTyVar :: TyVar -> Bool
+
 isImmutableTyVar tv
   | isTcTyVar tv = isSkolemTyVar tv
   | otherwise    = True
 
+isTyConableTyVar, isSkolemTyVar, isExistentialTyVar, 
+  isBoxyTyVar, isMetaTyVar :: TcTyVar -> Bool 
+
+isTyConableTyVar tv	
+	-- True of a meta-type variable tha can be filled in 
+	-- with a type constructor application; in particular,
+	-- not a SigTv
+  = ASSERT( isTcTyVar tv) 
+    case tcTyVarDetails tv of
+	MetaTv BoxTv      _ -> True
+	MetaTv TauTv      _ -> True
+	MetaTv (SigTv {}) _ -> False
+	SkolemTv {}	    -> False
+	
 isSkolemTyVar tv 
   = ASSERT( isTcTyVar tv )
     case tcTyVarDetails tv of
@@ -540,7 +561,7 @@ mkSigmaTy :: [TyVar] -> [PredType] -> Type -> Type
 mkSigmaTy tyvars theta tau = mkForAllTys tyvars (mkPhiTy theta tau)
 
 mkPhiTy :: [PredType] -> Type -> Type
-mkPhiTy theta ty = foldr (\p r -> FunTy (mkPredTy p) r) ty theta
+mkPhiTy theta ty = foldr (\p r -> mkFunTy (mkPredTy p) r) ty theta
 \end{code}
 
 @isTauTy@ tests for nested for-alls.  It should not be called on a boxy type.
@@ -560,8 +581,8 @@ isTauTy other		  = False
 isTauTyCon :: TyCon -> Bool
 -- Returns False for type synonyms whose expansion is a polytype
 isTauTyCon tc 
-  | isSynTyCon tc && not (isOpenTyCon tc) = isTauTy (snd (synTyConDefn tc))
-  | otherwise                             = True
+  | isClosedSynTyCon tc = isTauTy (snd (synTyConDefn tc))
+  | otherwise           = True
 
 ---------------
 isBoxyTy :: TcType -> Bool
@@ -850,7 +871,8 @@ isInheritablePred :: PredType -> Bool
 -- but it doesn't need to be quantified over the Num a dictionary
 -- which can be free in g's rhs, and shared by both calls to g
 isInheritablePred (ClassP _ _) = True
-isInheritablePred other	     = False
+isInheritablePred (EqPred _ _) = True
+isInheritablePred other	       = False
 \end{code}
 
 --------------------- Equality predicates ---------------------------------
@@ -873,11 +895,11 @@ dataConsStupidTheta (con1:cons)
   = nubBy tcEqPred all_preds
   where
     all_preds 	  = dataConStupidTheta con1 ++ other_stupids
-    res_tys1  	  = dataConResTys con1
-    tvs1      	  = tyVarsOfTypes res_tys1
+    res_ty1       = dataConOrigResTy con1
     other_stupids = [ substPred subst pred
 		    | con <- cons
-		    , let Just subst = tcMatchTys tvs1 res_tys1 (dataConResTys con)
+		    , let (tvs, _, _, res_ty) = dataConSig con
+			  Just subst = tcMatchTy (mkVarSet tvs) res_ty res_ty1
 		    , pred <- dataConStupidTheta con ]
 dataConsStupidTheta [] = panic "dataConsStupidTheta"
 \end{code}
@@ -1043,10 +1065,6 @@ tyClsNamesOfDFunHead :: Type -> NameSet
 tyClsNamesOfDFunHead dfun_ty 
   = case tcSplitSigmaTy dfun_ty of
 	(tvs,_,head_ty) -> tyClsNamesOfType head_ty
-
-classesOfTheta :: ThetaType -> [Class]
--- Looks just for ClassP things; maybe it should check
-classesOfTheta preds = [ c | ClassP c _ <- preds ]
 \end{code}