X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypecheck%2FFamInst.lhs;h=89dffbf8c5111fdf1786ffb8d69cc677ac68d3d0;hb=ebec49fed627b7dd17e297ddc79a9c677a2ce538;hp=712ac39524e40e99f8c40a5dcd1f3c4c7ed4ac5a;hpb=5a3ada9ce8887154faf81954b8b45dbb882fe264;p=ghc-hetmet.git diff --git a/compiler/typecheck/FamInst.lhs b/compiler/typecheck/FamInst.lhs index 712ac39..89dffbf 100644 --- a/compiler/typecheck/FamInst.lhs +++ b/compiler/typecheck/FamInst.lhs @@ -5,8 +5,6 @@ module FamInst ( checkFamInstConsistency, tcExtendLocalFamInstEnv ) where -#include "HsVersions.h" - import HscTypes import FamInstEnv import TcMType @@ -18,8 +16,9 @@ import Name import Module import SrcLoc import Outputable -import UniqFM +import LazyUniqFM import FiniteMap +import FastString import Maybe import Monad @@ -174,7 +173,7 @@ checkForConflicts inst_envs famInst Nothing -> panic "FamInst.checkForConflicts" Just (tc, tys) -> tc `mkTyConApp` tys } - ; (tvs', _, tau') <- tcInstSkolType FamInstSkol ty + ; (_, _, tau') <- tcInstSkolType FamInstSkol ty ; let (fam, tys') = tcSplitTyConApp tau' @@ -188,9 +187,9 @@ checkForConflicts inst_envs famInst conflictInstErr famInst (head conflicts) } where - -- * In the case of data family instances, any overlap is fundamentally a + -- - In the case of data family instances, any overlap is fundamentally a -- conflict (as these instances imply injective type mappings). - -- * In the case of type family instances, overlap is admitted as long as + -- - In the case of type family instances, overlap is admitted as long as -- the right-hand sides of the overlapping rules coincide under the -- overlap substitution. We require that they are syntactically equal; -- anything else would be difficult to test for at this stage. @@ -202,11 +201,13 @@ checkForConflicts inst_envs famInst rhs1 = substTy subst $ synTyConType tycon1 rhs2 = substTy subst $ synTyConType tycon2 +conflictInstErr :: FamInst -> FamInst -> TcRn () conflictInstErr famInst conflictingFamInst = addFamInstLoc famInst $ - addErr (hang (ptext SLIT("Conflicting family instance declarations:")) + addErr (hang (ptext (sLit "Conflicting family instance declarations:")) 2 (pprFamInsts [famInst, conflictingFamInst])) +addFamInstLoc :: FamInst -> TcRn a -> TcRn a addFamInstLoc famInst thing_inside = setSrcSpan (mkSrcSpan loc loc) thing_inside where