[commit: ghc] overlapping-tyfams: Revert "Fixed bugs in overlapping type families caught by regression testing." (220b069)

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 <[email protected]>
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