Give the inferred type when warning of a missing type-signature (Trac #1256)

[ghc-hetmet.git] / compiler / typecheck / TcType.lhs

diff --git a/compiler/typecheck/TcType.lhs b/compiler/typecheck/TcType.lhs
index db151f1..728f58b 100644 (file)
--- 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, 
 
@@ -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
@@ -478,11 +479,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
@@ -560,8 +576,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
@@ -874,11 +890,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}