X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcType.lhs;h=eaf2faa321401efb4bff520ac9641839a7789622;hp=728f58befd15fe86acdea3eba03ad750c4c8c30a;hb=11e80952ae15cf95b89c01466ee1970fb7161d7f;hpb=70918cf4a4d61d4752b18f29ce14c7d7f1fbce01

diff --git a/compiler/typecheck/TcType.lhs b/compiler/typecheck/TcType.lhs
index 728f58b..eaf2faa 100644
--- a/compiler/typecheck/TcType.lhs
+++ b/compiler/typecheck/TcType.lhs
@@ -45,7 +45,8 @@ module TcType (
   tcSplitFunTy_maybe, tcSplitFunTys, tcFunArgTy, tcFunResultTy, tcSplitFunTysN,
   tcSplitTyConApp, tcSplitTyConApp_maybe, tcTyConAppTyCon, tcTyConAppArgs,
   tcSplitAppTy_maybe, tcSplitAppTy, tcSplitAppTys, repSplitAppTy_maybe,
-  tcValidInstHeadTy, tcGetTyVar_maybe, tcGetTyVar,
+  tcInstHeadTyNotSynonym, tcInstHeadTyAppAllTyVars,
+  tcGetTyVar_maybe, tcGetTyVar,
   tcSplitSigmaTy, tcMultiSplitSigmaTy, 
 
   ---------------------------------
@@ -55,7 +56,7 @@ module TcType (
   eqKind, 
   isSigmaTy, isOverloadedTy, isRigidTy, isBoxyTy,
   isDoubleTy, isFloatTy, isIntTy, isStringTy,
-  isIntegerTy, isBoolTy, isUnitTy,
+  isIntegerTy, isBoolTy, isUnitTy, isCharTy,
   isTauTy, isTauTyCon, tcIsTyVarTy, tcIsForAllTy, 
 
   ---------------------------------
@@ -323,6 +324,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)
 
 -------------------------------------
@@ -439,16 +443,18 @@ pprSkolTvBinding :: TcTyVar -> SDoc
 -- or nothing if we don't have anything useful to say
 pprSkolTvBinding tv
   = ASSERT ( isTcTyVar tv )
-    ppr_details (tcTyVarDetails tv)
+    quotes (ppr tv) <+> ppr_details (tcTyVarDetails tv)
   where
-    ppr_details (MetaTv TauTv _)   = quotes (ppr tv) <+> ptext SLIT("is a meta type variable")
-    ppr_details (MetaTv BoxTv _)   = quotes (ppr tv) <+> ptext SLIT("is a boxy type variable")
+    ppr_details (MetaTv TauTv _)   	= ptext SLIT("is a meta type variable")
+    ppr_details (MetaTv BoxTv _)   	= ptext SLIT("is a boxy type variable")
     ppr_details (MetaTv (SigTv info) _) = ppr_skol info
     ppr_details (SkolemTv info)		= ppr_skol info
 
-    ppr_skol UnkSkol = empty	-- Unhelpful; omit
-    ppr_skol info    = quotes (ppr tv) <+> ptext SLIT("is bound by") 
-			<+> sep [pprSkolInfo info, nest 2 (ptext SLIT("at") <+> ppr (getSrcLoc tv))]
+    ppr_skol UnkSkol	    = empty	-- Unhelpful; omit
+    ppr_skol RuntimeUnkSkol = ptext SLIT("is an unknown runtime type")
+    ppr_skol info           = sep [ptext SLIT("is a rigid type variable bound by"),
+				   sep [pprSkolInfo info, 
+					 nest 2 (ptext SLIT("at") <+> ppr (getSrcLoc tv))]]
  
 pprSkolInfo :: SkolemInfo -> SDoc
 pprSkolInfo (SigSkol ctxt)   = pprUserTypeCtxt ctxt
@@ -465,6 +471,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")
@@ -710,9 +717,16 @@ tcSplitFunTys ty = case tcSplitFunTy_maybe ty of
 					  (args,res') = tcSplitFunTys res
 
 tcSplitFunTy_maybe :: Type -> Maybe (Type, Type)
-tcSplitFunTy_maybe ty | Just ty' <- tcView ty = tcSplitFunTy_maybe ty'
-tcSplitFunTy_maybe (FunTy arg res)  = Just (arg, res)
-tcSplitFunTy_maybe other	    = Nothing
+tcSplitFunTy_maybe ty | Just ty' <- tcView ty           = tcSplitFunTy_maybe ty'
+tcSplitFunTy_maybe (FunTy arg res) | not (isPredTy arg) = Just (arg, res)
+tcSplitFunTy_maybe other	  			= Nothing
+	-- Note the (not (isPredTy arg)) guard
+	-- Consider	(?x::Int) => Bool
+	-- We don't want to treat this as a function type!
+	-- A concrete example is test tc230:
+	--	f :: () -> (?p :: ()) => () -> ()
+	--
+	--	g = f () ()
 
 tcSplitFunTysN
 	:: TcRhoType 
@@ -777,14 +791,23 @@ tcSplitDFunHead tau
 	Just (ClassP clas tys) -> (clas, tys)
 	other -> panic "tcSplitDFunHead"
 
-tcValidInstHeadTy :: Type -> Bool
+tcInstHeadTyNotSynonym :: Type -> Bool
 -- Used in Haskell-98 mode, for the argument types of an instance head
 -- These must not be type synonyms, but everywhere else type synonyms
 -- are transparent, so we need a special function here
-tcValidInstHeadTy ty
+tcInstHeadTyNotSynonym ty
+  = case ty of
+        NoteTy _ ty     -> tcInstHeadTyNotSynonym ty
+        TyConApp tc tys -> not (isSynTyCon tc)
+        _ -> True
+
+tcInstHeadTyAppAllTyVars :: Type -> Bool
+-- Used in Haskell-98 mode, for the argument types of an instance head
+-- These must be a constructor applied to type variable arguments
+tcInstHeadTyAppAllTyVars ty
   = case ty of
-	NoteTy _ ty     -> tcValidInstHeadTy ty
-	TyConApp tc tys -> not (isSynTyCon tc) && ok tys
+	NoteTy _ ty     -> tcInstHeadTyAppAllTyVars ty
+	TyConApp _ tys  -> ok tys
 	FunTy arg res   -> ok [arg, res]
 	other		-> False
   where
@@ -937,6 +960,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
@@ -1130,18 +1159,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
@@ -1231,7 +1252,7 @@ legalFFITyCon tc
   = isUnLiftedTyCon tc || boxedMarshalableTyCon tc || tc == unitTyCon
 
 marshalableTyCon dflags tc
-  =  (dopt Opt_GlasgowExts dflags && isUnLiftedTyCon tc)
+  =  (dopt Opt_UnliftedFFITypes dflags && isUnLiftedTyCon tc)
   || boxedMarshalableTyCon tc
 
 boxedMarshalableTyCon tc