X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcType.lhs;h=b49dbffe280714a9226d63873c814168950e40fd;hb=67ed735fab12c12a1d48878d7bda33588c67fb78;hp=0025a5e685cca15dca7f08012dbdbd3f0d1f173d;hpb=d2ce0f52d42edf32bb9f13796e6ba6edba8bd516;p=ghc-hetmet.git diff --git a/compiler/typecheck/TcType.lhs b/compiler/typecheck/TcType.lhs index 0025a5e..b49dbff 100644 --- a/compiler/typecheck/TcType.lhs +++ b/compiler/typecheck/TcType.lhs @@ -274,17 +274,18 @@ TcBinds.tcInstSig, and its use_skols parameter. data TcTyVarDetails = SkolemTv SkolemInfo -- A skolem constant - | FlatSkol TcType -- The "skolem" obtained by flattening during - -- constraint simplification + | FlatSkol TcType + -- The "skolem" obtained by flattening during + -- constraint simplification - -- In comments we will use the notation alpha[flat = ty] - -- to represent a flattening skolem variable alpha - -- identified with type ty. - + -- In comments we will use the notation alpha[flat = ty] + -- to represent a flattening skolem variable alpha + -- identified with type ty. + | MetaTv MetaInfo (IORef MetaDetails) data MetaDetails - = Flexi -- Flexi type variables unify to become Indirects + = Flexi -- Flexi type variables unify to become Indirects | Indirect TcType data MetaInfo @@ -405,7 +406,7 @@ kind_var_occ = mkOccName tvName "k" pprTcTyVarDetails :: TcTyVarDetails -> SDoc -- For debugging pprTcTyVarDetails (SkolemTv _) = ptext (sLit "sk") -pprTcTyVarDetails (FlatSkol _) = ptext (sLit "fsk") +pprTcTyVarDetails (FlatSkol {}) = ptext (sLit "fsk") pprTcTyVarDetails (MetaTv TauTv _) = ptext (sLit "tau") pprTcTyVarDetails (MetaTv (SigTv _) _) = ptext (sLit "sig") @@ -431,7 +432,7 @@ pprSkolTvBinding tv quotes (ppr tv) <+> ppr_details (tcTyVarDetails tv) where ppr_details (SkolemTv info) = ppr_skol info - ppr_details (FlatSkol _) = ptext (sLit "is a flattening type variable") + ppr_details (FlatSkol {}) = ptext (sLit "is a flattening type variable") ppr_details (MetaTv TauTv _) = ptext (sLit "is a meta type variable") ppr_details (MetaTv (SigTv n) _) = ptext (sLit "is bound by the type signature for") <+> quotes (ppr n) @@ -1416,7 +1417,7 @@ legalFFITyCon tc marshalableTyCon :: DynFlags -> TyCon -> Bool marshalableTyCon dflags tc - = (dopt Opt_UnliftedFFITypes dflags + = (xopt Opt_UnliftedFFITypes dflags && isUnLiftedTyCon tc && not (isUnboxedTupleTyCon tc) && case tyConPrimRep tc of -- Note [Marshalling VoidRep] @@ -1442,7 +1443,7 @@ legalFIPrimArgTyCon :: DynFlags -> TyCon -> Bool -- Strictly speaking it is unnecessary to ban unboxed tuples here since -- currently they're of the wrong kind to use in function args anyway. legalFIPrimArgTyCon dflags tc - = dopt Opt_UnliftedFFITypes dflags + = xopt Opt_UnliftedFFITypes dflags && isUnLiftedTyCon tc && not (isUnboxedTupleTyCon tc) @@ -1450,7 +1451,7 @@ legalFIPrimResultTyCon :: DynFlags -> TyCon -> Bool -- Check result type of 'foreign import prim'. Allow simple unlifted -- types and also unboxed tuple result types '... -> (# , , #)' legalFIPrimResultTyCon dflags tc - = dopt Opt_UnliftedFFITypes dflags + = xopt Opt_UnliftedFFITypes dflags && isUnLiftedTyCon tc && (isUnboxedTupleTyCon tc || case tyConPrimRep tc of -- Note [Marshalling VoidRep]