Add 123## literals for Word#
[ghc-hetmet.git] / compiler / typecheck / TcType.lhs
index db151f1..f68d949 100644 (file)
@@ -15,6 +15,13 @@ The "tc" prefix is for "TypeChecker", because the type checker
 is the principal client.
 
 \begin{code}
+{-# OPTIONS -w #-}
+-- The above warning supression flag is a temporary kludge.
+-- While working on this module you are encouraged to remove it and fix
+-- any warnings in the module. See
+--     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
+-- for details
+
 module TcType (
   --------------------------------
   -- Types 
@@ -28,9 +35,10 @@ 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, 
+  isFlexi, isIndirect, isRuntimeUnk, isUnk,
 
   --------------------------------
   -- Builders
@@ -44,7 +52,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, 
 
   ---------------------------------
@@ -53,9 +62,10 @@ module TcType (
   tcEqType, tcEqTypes, tcEqPred, tcCmpType, tcCmpTypes, tcCmpPred, tcEqTypeX,
   eqKind, 
   isSigmaTy, isOverloadedTy, isRigidTy, isBoxyTy,
-  isDoubleTy, isFloatTy, isIntTy, isStringTy,
-  isIntegerTy, isBoolTy, isUnitTy,
+  isDoubleTy, isFloatTy, isIntTy, isWordTy, isStringTy,
+  isIntegerTy, isBoolTy, isUnitTy, isCharTy,
   isTauTy, isTauTyCon, tcIsTyVarTy, tcIsForAllTy, 
+  isOpenSynTyConApp,
 
   ---------------------------------
   -- Misc type manipulators
@@ -108,7 +118,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 +132,7 @@ module TcType (
   tcTyVarsOfType, tcTyVarsOfTypes, exactTyVarsOfType, exactTyVarsOfTypes,
 
   pprKind, pprParendKind,
-  pprType, pprParendType, pprTyThingCategory,
+  pprType, pprParendType, pprTypeApp, pprTyThingCategory,
   pprPred, pprTheta, pprThetaArrow, pprClassPred
 
   ) where
@@ -138,6 +148,7 @@ import ForeignCall
 import Unify
 import VarSet
 import Type
+import Coercion
 import TyCon
 
 -- others:
@@ -154,12 +165,12 @@ import Util
 import Maybes
 import ListSetOps
 import Outputable
+import FastString
 
 import Data.List
 import Data.IORef
 \end{code}
 
-
 %************************************************************************
 %*                                                                     *
 \subsection{Types}
@@ -292,12 +303,12 @@ data BoxInfo
 --     b2 is another (currently empty) box.
 
 data MetaDetails
-  = Flexi          -- Flexi type variables unify to become 
-                   -- Indirects.  
+  = Flexi              -- Flexi type variables unify to become 
+                       -- Indirects.  
 
-  | Indirect TcType  -- INVARIANT:
-                    --   For a BoxTv, this type must be non-boxy
-                     --   For a TauTv, this type must be a tau-type
+  | Indirect TcType    -- INVARIANT:
+                       --   For a BoxTv, this type must be non-boxy
+                       --   For a TauTv, this type must be a tau-type
 
 -- Generally speaking, SkolemInfo should not contain location info
 -- that is contained in the Name of the tyvar with this SkolemInfo
@@ -322,6 +333,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)
 
 -------------------------------------
@@ -381,7 +395,6 @@ kind_var_occ :: OccName     -- Just one for all KindVars
                        -- They may be jiggled by tidying
 kind_var_occ = mkOccName tvName "k"
 \end{code}
-\end{code}
 
 %************************************************************************
 %*                                                                     *
@@ -392,23 +405,23 @@ kind_var_occ = mkOccName tvName "k"
 \begin{code}
 pprTcTyVarDetails :: TcTyVarDetails -> SDoc
 -- For debugging
-pprTcTyVarDetails (SkolemTv _)         = ptext SLIT("sk")
-pprTcTyVarDetails (MetaTv BoxTv _)     = ptext SLIT("box")
-pprTcTyVarDetails (MetaTv TauTv _)     = ptext SLIT("tau")
-pprTcTyVarDetails (MetaTv (SigTv _) _) = ptext SLIT("sig")
+pprTcTyVarDetails (SkolemTv _)         = ptext (sLit "sk")
+pprTcTyVarDetails (MetaTv BoxTv _)     = ptext (sLit "box")
+pprTcTyVarDetails (MetaTv TauTv _)     = ptext (sLit "tau")
+pprTcTyVarDetails (MetaTv (SigTv _) _) = ptext (sLit "sig")
 
 pprUserTypeCtxt :: UserTypeCtxt -> SDoc
-pprUserTypeCtxt (FunSigCtxt n)  = ptext SLIT("the type signature for") <+> quotes (ppr n)
-pprUserTypeCtxt ExprSigCtxt     = ptext SLIT("an expression type signature")
-pprUserTypeCtxt (ConArgCtxt c)  = ptext SLIT("the type of the constructor") <+> quotes (ppr c)
-pprUserTypeCtxt (TySynCtxt c)   = ptext SLIT("the RHS of the type synonym") <+> quotes (ppr c)
-pprUserTypeCtxt GenPatCtxt      = ptext SLIT("the type pattern of a generic definition")
-pprUserTypeCtxt LamPatSigCtxt   = ptext SLIT("a pattern type signature")
-pprUserTypeCtxt BindPatSigCtxt  = ptext SLIT("a pattern type signature")
-pprUserTypeCtxt ResSigCtxt      = ptext SLIT("a result type signature")
-pprUserTypeCtxt (ForSigCtxt n)  = ptext SLIT("the foreign declaration for") <+> quotes (ppr n)
-pprUserTypeCtxt DefaultDeclCtxt = ptext SLIT("a type in a `default' declaration")
-pprUserTypeCtxt SpecInstCtxt    = ptext SLIT("a SPECIALISE instance pragma")
+pprUserTypeCtxt (FunSigCtxt n)  = ptext (sLit "the type signature for") <+> quotes (ppr n)
+pprUserTypeCtxt ExprSigCtxt     = ptext (sLit "an expression type signature")
+pprUserTypeCtxt (ConArgCtxt c)  = ptext (sLit "the type of the constructor") <+> quotes (ppr c)
+pprUserTypeCtxt (TySynCtxt c)   = ptext (sLit "the RHS of the type synonym") <+> quotes (ppr c)
+pprUserTypeCtxt GenPatCtxt      = ptext (sLit "the type pattern of a generic definition")
+pprUserTypeCtxt LamPatSigCtxt   = ptext (sLit "a pattern type signature")
+pprUserTypeCtxt BindPatSigCtxt  = ptext (sLit "a pattern type signature")
+pprUserTypeCtxt ResSigCtxt      = ptext (sLit "a result type signature")
+pprUserTypeCtxt (ForSigCtxt n)  = ptext (sLit "the foreign declaration for") <+> quotes (ppr n)
+pprUserTypeCtxt DefaultDeclCtxt = ptext (sLit "a type in a `default' declaration")
+pprUserTypeCtxt SpecInstCtxt    = ptext (sLit "a SPECIALISE instance pragma")
 
 
 --------------------------------
@@ -438,36 +451,39 @@ 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       = ptext (sLit "is an unknown type variable")        -- Unhelpful
+    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
-pprSkolInfo (ClsSkol cls)    = ptext SLIT("the class declaration for") <+> quotes (ppr cls)
-pprSkolInfo InstSkol         = ptext SLIT("the instance declaration")
-pprSkolInfo FamInstSkol      = ptext SLIT("the family instance declaration")
-pprSkolInfo (RuleSkol name)  = ptext SLIT("the RULE") <+> doubleQuotes (ftext name)
-pprSkolInfo ArrowSkol        = ptext SLIT("the arrow form")
-pprSkolInfo (PatSkol dc)     = sep [ptext SLIT("the constructor") <+> quotes (ppr dc)]
-pprSkolInfo (GenSkol tvs ty) = sep [ptext SLIT("the polymorphic type"), 
+pprSkolInfo (ClsSkol cls)    = ptext (sLit "the class declaration for") <+> quotes (ppr cls)
+pprSkolInfo InstSkol         = ptext (sLit "the instance declaration")
+pprSkolInfo FamInstSkol      = ptext (sLit "the family instance declaration")
+pprSkolInfo (RuleSkol name)  = ptext (sLit "the RULE") <+> doubleQuotes (ftext name)
+pprSkolInfo ArrowSkol        = ptext (sLit "the arrow form")
+pprSkolInfo (PatSkol dc)     = sep [ptext (sLit "the constructor") <+> quotes (ppr dc)]
+pprSkolInfo (GenSkol tvs ty) = sep [ptext (sLit "the polymorphic type"), 
                                    nest 2 (quotes (ppr (mkForAllTys tvs ty)))]
 
 -- UnkSkol
 -- 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")
-  ppr (Indirect ty) = ptext SLIT("Indirect") <+> ppr ty
+  ppr Flexi         = ptext (sLit "Flexi")
+  ppr (Indirect ty) = ptext (sLit "Indirect") <+> ppr ty
 \end{code}
 
 
@@ -478,11 +494,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 that 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
@@ -515,17 +546,27 @@ isSigTyVar tv
 
 metaTvRef :: TyVar -> IORef MetaDetails
 metaTvRef tv 
-  = ASSERT( isTcTyVar tv )
+  = ASSERT2( isTcTyVar tv, ppr tv )
     case tcTyVarDetails tv of
        MetaTv _ ref -> ref
        other      -> pprPanic "metaTvRef" (ppr tv)
 
 isFlexi, isIndirect :: MetaDetails -> Bool
-isFlexi Flexi = True
-isFlexi other = False
+isFlexi Flexi    = True
+isFlexi other     = False
 
 isIndirect (Indirect _) = True
 isIndirect other        = 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
 \end{code}
 
 
@@ -560,8 +601,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
@@ -571,10 +612,10 @@ isRigidTy :: TcType -> Bool
 -- A type is rigid if it has no meta type variables in it
 isRigidTy ty = all isImmutableTyVar (varSetElems (tcTyVarsOfType ty))
 
-isRefineableTy :: TcType -> Bool
+isRefineableTy :: TcType -> (Bool,Bool)
 -- A type should have type refinements applied to it if it has
 -- free type variables, and they are all rigid
-isRefineableTy ty = not (null tc_tvs) && all isImmutableTyVar tc_tvs
+isRefineableTy ty = (null tc_tvs,  all isImmutableTyVar tc_tvs)
                    where
                      tc_tvs = varSetElems (tcTyVarsOfType ty)
 
@@ -630,9 +671,7 @@ tcSplitPhiTy ty = split ty ty []
   split orig_ty ty tvs | Just ty' <- tcView ty = split orig_ty ty' tvs
 
   split orig_ty (ForAllTy tv ty) ts
-        | isCoVar tv = split ty ty (eq_pred:ts)
-        where
-           PredTy eq_pred = tyVarKind tv
+        | isCoVar tv = split ty ty (coVarPred tv : ts)
   split orig_ty (FunTy arg res) ts 
        | Just p <- tcSplitPredTy_maybe arg = split res res (p:ts)
   split orig_ty ty             ts = (reverse ts, orig_ty)
@@ -694,9 +733,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 
@@ -761,14 +807,21 @@ 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     -> tcValidInstHeadTy ty
-       TyConApp tc tys -> not (isSynTyCon tc) && ok tys
+        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
+       TyConApp _ tys  -> ok tys
        FunTy arg res   -> ok [arg, res]
        other           -> False
   where
@@ -778,7 +831,6 @@ tcValidInstHeadTy ty
           where
             tvs = mapCatMaybes get_tv tys
 
-    get_tv (NoteTy _ ty) = get_tv ty   -- Again, do not look
     get_tv (TyVarTy tv)  = Just tv     -- through synonyms
     get_tv other        = Nothing
 \end{code}
@@ -801,6 +853,7 @@ tcSplitPredTy_maybe other     = Nothing
 predTyUnique :: PredType -> Unique
 predTyUnique (IParam n _)      = getUnique (ipNameName n)
 predTyUnique (ClassP clas tys) = getUnique clas
+predTyUnique (EqPred a b)      = pprPanic "predTyUnique" (ppr (EqPred a b))
 \end{code}
 
 
@@ -874,11 +927,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}
@@ -919,8 +972,15 @@ isFloatTy      = is_tc floatTyConKey
 isDoubleTy     = is_tc doubleTyConKey
 isIntegerTy    = is_tc integerTyConKey
 isIntTy        = is_tc intTyConKey
+isWordTy       = is_tc wordTyConKey
 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
@@ -929,6 +989,15 @@ is_tc uniq ty = case tcSplitTyConApp_maybe ty of
                        Nothing      -> False
 \end{code}
 
+\begin{code}
+-- NB: Currently used in places where we have already expanded type synonyms;
+--     hence no 'coreView'.  This could, however, be changed without breaking
+--     any code.
+isOpenSynTyConApp :: TcTauType -> Bool
+isOpenSynTyConApp (TyConApp tc _) = isOpenSynTyCon tc
+isOpenSynTyConApp _other          = False
+\end{code}
+
 
 %************************************************************************
 %*                                                                     *
@@ -950,7 +1019,6 @@ tcTyVarsOfType :: Type -> TcTyVarSet
 tcTyVarsOfType (TyVarTy tv)        = if isTcTyVar tv then unitVarSet tv
                                                      else emptyVarSet
 tcTyVarsOfType (TyConApp tycon tys) = tcTyVarsOfTypes tys
-tcTyVarsOfType (NoteTy _ ty)       = tcTyVarsOfType ty
 tcTyVarsOfType (PredTy sty)        = tcTyVarsOfPred sty
 tcTyVarsOfType (FunTy arg res)     = tcTyVarsOfType arg `unionVarSet` tcTyVarsOfType res
 tcTyVarsOfType (AppTy fun arg)     = tcTyVarsOfType fun `unionVarSet` tcTyVarsOfType arg
@@ -990,6 +1058,15 @@ exactTyVarsOfType is used by the type checker to figure out exactly
 which type variables are mentioned in a type.  It's also used in the
 smart-app checking code --- see TcExpr.tcIdApp
 
+On the other hand, consider a *top-level* definition
+       f = (\x -> x) :: T a -> T a
+If we don't abstract over 'a' it'll get fixed to GHC.Prim.Any, and then
+if we have an application like (f "x") we get a confusing error message 
+involving Any.  So the conclusion is this: when generalising
+  - at top level use tyVarsOfType
+  - in nested bindings use exactTyVarsOfType
+See Trac #1813 for example.
+
 \begin{code}
 exactTyVarsOfType :: TcType -> TyVarSet
 -- Find the free type variables (of any kind)
@@ -1024,7 +1101,6 @@ end of the compiler.
 tyClsNamesOfType :: Type -> NameSet
 tyClsNamesOfType (TyVarTy tv)              = emptyNameSet
 tyClsNamesOfType (TyConApp tycon tys)      = unitNameSet (getName tycon) `unionNameSets` tyClsNamesOfTypes tys
-tyClsNamesOfType (NoteTy _ ty2)            = tyClsNamesOfType ty2
 tyClsNamesOfType (PredTy (IParam n ty))     = tyClsNamesOfType ty
 tyClsNamesOfType (PredTy (ClassP cl tys))   = unitNameSet (getName cl) `unionNameSets` tyClsNamesOfTypes tys
 tyClsNamesOfType (PredTy (EqPred ty1 ty2))  = tyClsNamesOfType ty1 `unionNameSets` tyClsNamesOfType ty2
@@ -1058,22 +1134,28 @@ restricted set of types as arguments and results (the restricting factor
 being the )
 
 \begin{code}
-tcSplitIOType_maybe :: Type -> Maybe (TyCon, Type)
--- (isIOType t) returns (Just (IO,t')) if t is of the form (IO t'), or
---                                    some newtype wrapping thereof
+tcSplitIOType_maybe :: Type -> Maybe (TyCon, Type, CoercionI)
+-- (isIOType t) returns Just (IO,t',co)
+--                             if co : t ~ IO t'
 --             returns Nothing otherwise
 tcSplitIOType_maybe ty 
-  | Just (io_tycon, [io_res_ty]) <- tcSplitTyConApp_maybe ty,
+  = case tcSplitTyConApp_maybe ty of
        -- This split absolutely has to be a tcSplit, because we must
        -- see the IO type; and it's a newtype which is transparent to splitTyConApp.
-    io_tycon `hasKey` ioTyConKey
-  = Just (io_tycon, io_res_ty)
 
-  | Just ty' <- coreView ty    -- Look through non-recursive newtypes
-  = tcSplitIOType_maybe ty'
+       Just (io_tycon, [io_res_ty]) 
+          |  io_tycon `hasKey` ioTyConKey 
+          -> Just (io_tycon, io_res_ty, IdCo)
 
-  | otherwise
-  = Nothing
+       Just (tc, tys)
+          | not (isRecursiveTyCon tc)
+          , Just (ty, co1) <- instNewTyCon_maybe tc tys
+                 -- Newtypes that require a coercion are ok
+          -> case tcSplitIOType_maybe ty of
+               Nothing             -> Nothing
+               Just (tc, ty', co2) -> Just (tc, ty', co1 `mkTransCoI` co2)
+
+       other -> Nothing
 
 isFFITy :: Type -> Bool
 -- True for any TyCon that can possibly be an arg or result of an FFI call
@@ -1114,25 +1196,15 @@ 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
+isFFIDotnetObjTy ty
+  = checkRepTyCon check_tc t_ty
+  where
    (_, t_ty) = tcSplitForAllTys ty
-  in
-  case tcSplitTyConApp_maybe (repType t_ty) of
-    Just (tc, [arg_ty]) | getName tc == objectTyConName -> True
-    _ -> False
+   check_tc tc = getName tc == objectTyConName
 
 toDNType :: Type -> DNType
 toDNType ty
@@ -1215,7 +1287,12 @@ legalFFITyCon tc
   = isUnLiftedTyCon tc || boxedMarshalableTyCon tc || tc == unitTyCon
 
 marshalableTyCon dflags tc
-  =  (dopt Opt_GlasgowExts dflags && isUnLiftedTyCon tc)
+  =  (dopt Opt_UnliftedFFITypes dflags 
+      && isUnLiftedTyCon tc
+      && not (isUnboxedTupleTyCon tc)
+      && case tyConPrimRep tc of       -- Note [Marshalling VoidRep]
+          VoidRep -> False
+          other   -> True)
   || boxedMarshalableTyCon tc
 
 boxedMarshalableTyCon tc
@@ -1230,3 +1307,12 @@ boxedMarshalableTyCon tc
                         , boolTyConKey
                         ]
 \end{code}
+
+Note [Marshalling VoidRep]
+~~~~~~~~~~~~~~~~~~~~~~~~~~
+We don't treat State# (whose PrimRep is VoidRep) as marshalable.
+In turn that means you can't write
+       foreign import foo :: Int -> State# RealWorld
+
+Reason: the back end falls over with panic "primRepHint:VoidRep";
+       and there is no compelling reason to permit it