X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Ftypecheck%2FFamInst.lhs;h=89dffbf8c5111fdf1786ffb8d69cc677ac68d3d0;hp=2da396653413ace0d91e6952cb1414a60a3cbf22;hb=bb7ffa1642e2110e26e1243c42a8a24adafa985d;hpb=7fc749a43b4b6b85d234fa95d4928648259584f4 diff --git a/compiler/typecheck/FamInst.lhs b/compiler/typecheck/FamInst.lhs index 2da3966..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/Commentary/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