X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Ftypecheck%2FFamInst.lhs;h=89dffbf8c5111fdf1786ffb8d69cc677ac68d3d0;hp=46df395052994048b47c7f0b372677c08d636795;hb=bb7ffa1642e2110e26e1243c42a8a24adafa985d;hpb=ad94d40948668032189ad22a0ad741ac1f645f50 diff --git a/compiler/typecheck/FamInst.lhs b/compiler/typecheck/FamInst.lhs index 46df395..89dffbf 100644 --- a/compiler/typecheck/FamInst.lhs +++ b/compiler/typecheck/FamInst.lhs @@ -1,19 +1,10 @@ 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/CodingStyle#Warnings --- for details - module FamInst ( checkFamInstConsistency, tcExtendLocalFamInstEnv ) where -#include "HsVersions.h" - import HscTypes import FamInstEnv import TcMType @@ -25,8 +16,9 @@ import Name import Module import SrcLoc import Outputable -import UniqFM +import LazyUniqFM import FiniteMap +import FastString import Maybe import Monad @@ -181,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' @@ -195,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. @@ -209,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