Repository : ssh://darcs.haskell.org//srv/darcs/ghc On branch : overlapping-tyfams
http://hackage.haskell.org/trac/ghc/changeset/220b069a4179005f66c502d13d7d25265664aa38 >--------------------------------------------------------------- commit 220b069a4179005f66c502d13d7d25265664aa38 Author: Richard Eisenberg <e...@cis.upenn.edu> Date: Tue Oct 2 21:47:49 2012 -0400 Revert "Fixed bugs in overlapping type families caught by regression testing." Part of reverting old (bad) implementation of overlapping type families. This reverts commit 07483e4cc2ce2bc632c759520d7167d735846be7. >--------------------------------------------------------------- compiler/typecheck/TcInstDcls.lhs | 20 ++++++++++---------- compiler/types/FamInstEnv.lhs | 16 ++++++---------- 2 files changed, 16 insertions(+), 20 deletions(-) diff --git a/compiler/typecheck/TcInstDcls.lhs b/compiler/typecheck/TcInstDcls.lhs index c749d54..325e897 100644 --- a/compiler/typecheck/TcInstDcls.lhs +++ b/compiler/typecheck/TcInstDcls.lhs @@ -684,13 +684,16 @@ tcAssocFamInst :: Class -- ^ Class of associated type -> VarEnv Type -- ^ Instantiation of class TyVars -> FamInstGroup -- ^ RHS -> TcM () -tcAssocFamInst clas mini_env (FamInstGroup { fig_fis = [fam_inst] - , fig_flavor = flav - , fig_fam_tc = fam_tc - , fig_fam = fam }) - = setSrcSpan (getSrcSpan fam_inst) $ - tcAddFamInstCtxt (pprFamFlavor flav <+> (ptext (sLit "instance"))) fam $ - do { let at_tys = famInstTys fam_inst +tcAssocFamInst clas mini_env fam_inst_grp + = setSrcSpan (getSrcSpan fam_inst_grp) $ + tcAddFamInstCtxt (pprFamInstGroupFlavor fam_inst_grp) + (famInstGroupName fam_inst_grp) $ + do { let { fam_tc = famInstGroupTyCon fam_inst_grp + ; at_tys + | [fam_inst] <- famInstGroupInsts fam_inst_grp + = famInstTys fam_inst + | otherwise -- associated instances cannot be instance groups + = pprPanic "tcAssocFamInst" (ppr fam_inst_grp) } -- Check that the associated type comes from this class ; checkTc (Just clas == tyConAssoc_maybe fam_tc) @@ -709,9 +712,6 @@ tcAssocFamInst clas mini_env (FamInstGroup { fig_fis = [fam_inst] = return () -- Allow non-type-variable instantiation -- See Note [Associated type instances] --- for when there is either 0 or 2+ FamInsts in the instance group -tcAssocFamInst _ _ fig = pprPanic "tcAssocFamInst" (ppr fig) - tcAssocTyDecl :: LTyFamInstDecl Name -> TcM FamInstGroup tcAssocTyDecl (L loc decl) diff --git a/compiler/types/FamInstEnv.lhs b/compiler/types/FamInstEnv.lhs index cb52274..7b5dd54 100644 --- a/compiler/types/FamInstEnv.lhs +++ b/compiler/types/FamInstEnv.lhs @@ -192,12 +192,8 @@ dataFamInstRepTyCon fi instance NamedThing FamInst where getName = coAxiomName . fi_axiom --- We do NOT want an instance of NamedThing for FamInstGroup. Having one --- would make it easy to apply getSrcSpan to a FamInstGroup. The only --- reasonable behavior of getName would be to return the family name, which --- has the SrcSpan of the family declaration, not the instance declaration. --- If a chunk of code wants a SrcSpan from a FamInstGroup, it will have --- to work for it or refactor some of the code in this file. +instance NamedThing FamInstGroup where + getName = famInstGroupName instance Outputable FamInst where ppr = pprFamInst @@ -268,12 +264,11 @@ mkSynFamInstGroup fam_tc fis mkDataFamInstGroup :: TyCon -- ^ Family tycon (@F@) -> FamInst -- ^ The one family instance in this group -> FamInstGroup -mkDataFamInstGroup fam_tc fi@(FamInst { fi_rep_tc = Just rep_tc }) +mkDataFamInstGroup fam_tc fi = FamInstGroup { fig_fis = [fi] - , fig_flavor = DataFamilyInst (mk_new_or_data rep_tc) + , fig_flavor = DataFamilyInst (mk_new_or_data fam_tc) , fig_fam_tc = fam_tc , fig_fam = tyConName fam_tc } -mkDataFamInstGroup _ fi = pprPanic "mkDataFamInstGroup" (ppr fi) -- | Create a coercion identifying a @type@ family instance. -- It has the form @Co tvs :: F ts ~ R@, where @Co@ is @@ -368,7 +363,8 @@ mk_new_or_data tc | isDataTyCon tc = FamInstDataType | isNewTyCon tc = FamInstNewType | isAbstractTyCon tc = FamInstDataType - | otherwise = pprPanic "mk_new_or_data" (ppr tc) + | otherwise = pprPanic "mkDataFamInstGroup" (ppr tc) + mkImportedFamInst :: [Maybe Name] -- Rough match info -> CoAxiom -- Axiom introduced _______________________________________________ Cvs-ghc mailing list Cvs-ghc@haskell.org http://www.haskell.org/mailman/listinfo/cvs-ghc
