X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcType.lhs;h=60474b1f6ce233fc5179b45222dcaa910781dc82;hp=3eb14198457ffe3a2c0cfa7d6c402d6e5de67463;hb=2423c249f5ca7785d0ec89eb33e72662da7561c1;hpb=85de95cd55d5dcda29630b665b50c7575df6dddd diff --git a/compiler/typecheck/TcType.lhs b/compiler/typecheck/TcType.lhs index 3eb1419..60474b1 100644 --- a/compiler/typecheck/TcType.lhs +++ b/compiler/typecheck/TcType.lhs @@ -70,7 +70,7 @@ module TcType ( mkDictTy, tcSplitPredTy_maybe, isPredTy, isDictTy, tcSplitDFunTy, tcSplitDFunHead, predTyUnique, mkClassPred, isInheritablePred, isIPPred, - dataConsStupidTheta, isRefineableTy, + dataConsStupidTheta, isRefineableTy, isRefineablePred, --------------------------------- -- Foreign import and export @@ -569,15 +569,20 @@ isBoxyTy ty = any isBoxyTyVar (varSetElems (tcTyVarsOfType ty)) isRigidTy :: TcType -> Bool -- A type is rigid if it has no meta type variables in it -isRigidTy ty = all isSkolemTyVar (varSetElems (tcTyVarsOfType ty)) +isRigidTy ty = all isImmutableTyVar (varSetElems (tcTyVarsOfType ty)) isRefineableTy :: TcType -> 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 isSkolemTyVar tc_tvs +isRefineableTy ty = not (null tc_tvs) && all isImmutableTyVar tc_tvs where tc_tvs = varSetElems (tcTyVarsOfType ty) +isRefineablePred :: TcPredType -> Bool +isRefineablePred pred = not (null tc_tvs) && all isImmutableTyVar tc_tvs + where + tc_tvs = varSetElems (tcTyVarsOfPred pred) + --------------- getDFunTyKey :: Type -> OccName -- Get some string from a type, to be used to -- construct a dictionary function name