Store a SrcSpan instead of a SrcLoc inside a Name

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

diff --git a/compiler/typecheck/TcType.lhs b/compiler/typecheck/TcType.lhs
index e7083ac..5928630 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, 
 
@@ -54,7 +55,7 @@ module TcType (
   eqKind, 
   isSigmaTy, isOverloadedTy, isRigidTy, isBoxyTy,
   isDoubleTy, isFloatTy, isIntTy, isStringTy,
-  isIntegerTy, isBoolTy, isUnitTy,
+  isIntegerTy, isBoolTy, isUnitTy, isCharTy,
   isTauTy, isTauTyCon, tcIsTyVarTy, tcIsForAllTy, 
 
   ---------------------------------
@@ -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
@@ -874,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}
@@ -921,6 +942,12 @@ isIntegerTy    = is_tc integerTyConKey
 isIntTy        = is_tc intTyConKey
 isBoolTy       = is_tc boolTyConKey
 isUnitTy       = is_tc unitTyConKey
+isCharTy       = is_tc charTyConKey
+
+isStringTy ty
+  = case tcSplitTyConApp_maybe ty of
+      Just (tc, [arg_ty]) -> tc == listTyCon && isCharTy arg_ty
+      other              -> False
 
 is_tc :: Unique -> Type -> Bool
 -- Newtypes are opaque to this
@@ -1114,18 +1141,10 @@ isFFIDotnetTy :: DynFlags -> Type -> Bool
 isFFIDotnetTy dflags ty
   = checkRepTyCon (\ tc -> (legalFIResultTyCon dflags tc || 
                           isFFIDotnetObjTy ty || isStringTy ty)) ty
+       -- NB: isStringTy used to look through newtypes, but
+       --     it no longer does so.  May need to adjust isFFIDotNetTy
+       --     if we do want to look through newtypes.
 
--- Support String as an argument or result from a .NET FFI call.
-isStringTy ty = 
-  case tcSplitTyConApp_maybe (repType ty) of
-    Just (tc, [arg_ty])
-      | tc == listTyCon ->
-        case tcSplitTyConApp_maybe (repType arg_ty) of
-         Just (cc,[]) -> cc == charTyCon
-         _ -> False
-    _ -> False
-
--- Support String as an argument or result from a .NET FFI call.
 isFFIDotnetObjTy ty = 
   let
    (_, t_ty) = tcSplitForAllTys ty