projects
/
ghc-hetmet.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Fix Trac #2985: generating superclasses and recursive dictionaries
[ghc-hetmet.git]
/
compiler
/
typecheck
/
TcType.lhs
diff --git
a/compiler/typecheck/TcType.lhs
b/compiler/typecheck/TcType.lhs
index
6ff9732
..
e0e7649
100644
(file)
--- a/
compiler/typecheck/TcType.lhs
+++ b/
compiler/typecheck/TcType.lhs
@@
-421,7
+421,7
@@
pprUserTypeCtxt SpecInstCtxt = ptext (sLit "a SPECIALISE instance pragma")
tidySkolemTyVar :: TidyEnv -> TcTyVar -> (TidyEnv, TcTyVar)
-- Tidy the type inside a GenSkol, preparatory to printing it
tidySkolemTyVar env tv
tidySkolemTyVar :: TidyEnv -> TcTyVar -> (TidyEnv, TcTyVar)
-- Tidy the type inside a GenSkol, preparatory to printing it
tidySkolemTyVar env tv
- = ASSERT( isSkolemTyVar tv || isSigTyVar tv )
+ = ASSERT( isTcTyVar tv && (isSkolemTyVar tv || isSigTyVar tv ) )
(env1, mkTcTyVar (tyVarName tv) (tyVarKind tv) info1)
where
(env1, info1) = case tcTyVarDetails tv of
(env1, mkTcTyVar (tyVarName tv) (tyVarKind tv) info1)
where
(env1, info1) = case tcTyVarDetails tv of
@@
-508,7
+508,7
@@
isTyConableTyVar tv
SkolemTv {} -> False
isSkolemTyVar tv
SkolemTv {} -> False
isSkolemTyVar tv
- = ASSERT( isTcTyVar tv )
+ = ASSERT2( isTcTyVar tv, ppr tv )
case tcTyVarDetails tv of
SkolemTv _ -> True
MetaTv _ _ -> False
case tcTyVarDetails tv of
SkolemTv _ -> True
MetaTv _ _ -> False
@@
-965,10
+965,13
@@
isSigmaTy (FunTy a _) = isPredTy a
isSigmaTy _ = False
isOverloadedTy :: Type -> Bool
isSigmaTy _ = False
isOverloadedTy :: Type -> Bool
+-- Yes for a type of a function that might require evidence-passing
+-- Used only by bindInstsOfLocalFuns/Pats
+-- NB: be sure to check for type with an equality predicate; hence isCoVar
isOverloadedTy ty | Just ty' <- tcView ty = isOverloadedTy ty'
isOverloadedTy ty | Just ty' <- tcView ty = isOverloadedTy ty'
-isOverloadedTy (ForAllTy _ ty) = isOverloadedTy ty
-isOverloadedTy (FunTy a _) = isPredTy a
-isOverloadedTy _ = False
+isOverloadedTy (ForAllTy tv ty) = isCoVar tv || isOverloadedTy ty
+isOverloadedTy (FunTy a _) = isPredTy a
+isOverloadedTy _ = False
isPredTy :: Type -> Bool -- Belongs in TcType because it does
-- not look through newtypes, or predtypes (of course)
isPredTy :: Type -> Bool -- Belongs in TcType because it does
-- not look through newtypes, or predtypes (of course)
@@
-1007,8
+1010,9
@@
is_tc uniq ty = case tcSplitTyConApp_maybe ty of
-- hence no 'coreView'. This could, however, be changed without breaking
-- any code.
isOpenSynTyConApp :: TcTauType -> Bool
-- hence no 'coreView'. This could, however, be changed without breaking
-- any code.
isOpenSynTyConApp :: TcTauType -> Bool
-isOpenSynTyConApp (TyConApp tc _) = isOpenSynTyCon tc
-isOpenSynTyConApp _other = False
+isOpenSynTyConApp (TyConApp tc tys) = isOpenSynTyCon tc &&
+ length tys == tyConArity tc
+isOpenSynTyConApp _other = False
\end{code}
\end{code}