X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Ftypecheck%2FFamInst.lhs;h=89dffbf8c5111fdf1786ffb8d69cc677ac68d3d0;hp=eed79ca2c7c121a31f9f18528bcc24d1292e02f3;hb=bb7ffa1642e2110e26e1243c42a8a24adafa985d;hpb=edaf4b7be527a8c029f4f3855b57d538d764b500 diff --git a/compiler/typecheck/FamInst.lhs b/compiler/typecheck/FamInst.lhs index eed79ca..89dffbf 100644 --- a/compiler/typecheck/FamInst.lhs +++ b/compiler/typecheck/FamInst.lhs @@ -1,13 +1,6 @@ The @FamInst@ type: family instance heads \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 FamInst ( checkFamInstConsistency, tcExtendLocalFamInstEnv ) where @@ -180,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' @@ -194,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. @@ -208,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:")) 2 (pprFamInsts [famInst, conflictingFamInst])) +addFamInstLoc :: FamInst -> TcRn a -> TcRn a addFamInstLoc famInst thing_inside = setSrcSpan (mkSrcSpan loc loc) thing_inside where