Refactor HsDecls again, to put family instances in InstDecl

This continues the clean up of the front end.  Since they
were first invented, type and data family *instance* decls
have been in the TyClDecl data type, even though they always
treated separately.

This patch takes a step in the right direction
  * The InstDecl type now includes both class instances and
    type/data family instances

  * The hs_tyclds field of HsGroup now never has any family
    instance declarations in it

However a family instance is still a TyClDecl.  It should really
be a separate type, but that's the next step.

All this was provoked by fixing Trac #5792 in the HEAD.
(I did a less invasive fix on the branch.)

1 files changed, 15 insertions, 14 deletions

diff --git a/compiler/rename/RnNames.lhs b/compiler/rename/RnNames.lhs
index 68e6d027e6..b3a3f8347a 100644
--- a/compiler/rename/RnNames.lhs
+++ b/compiler/rename/RnNames.lhs
@@ -486,12 +486,8 @@ getLocalNonValBinders fixity_env
                 hs_tyclds = tycl_decls,
                 hs_instds = inst_decls,
                 hs_fords  = foreign_decls })
-  = do  { -- Separate out the family instance declarations
-          let (tyinst_decls, tycl_decls_noinsts)
-                   = partition (isFamInstDecl . unLoc) (concat tycl_decls)
-
-          -- Process all type/class decls *except* family instances
-        ; tc_avails <- mapM new_tc tycl_decls_noinsts
+  = do  { -- Process all type/class decls *except* family instances
+        ; tc_avails <- mapM new_tc (concat tycl_decls)
         ; envs <- extendGlobalRdrEnvRn tc_avails fixity_env
         ; setEnvs envs $ do {
             -- Bring these things into scope first
@@ -499,7 +495,6 @@ getLocalNonValBinders fixity_env
 
           -- Process all family instances
           -- to bring new data constructors into scope
-        ; ti_avails  <- mapM (new_ti Nothing) tyinst_decls
         ; nti_avails <- concatMapM new_assoc inst_decls
 
           -- Finish off with value binders:
@@ -510,7 +505,7 @@ getLocalNonValBinders fixity_env
                         | otherwise = for_hs_bndrs
         ; val_avails <- mapM new_simple val_bndrs
 
-        ; let avails    = ti_avails ++ nti_avails ++ val_avails
+        ; let avails    = nti_avails ++ val_avails
               new_bndrs = availsToNameSet avails `unionNameSets` 
                           availsToNameSet tc_avails
         ; envs <- extendGlobalRdrEnvRn avails fixity_env 
@@ -529,20 +524,25 @@ getLocalNonValBinders fixity_env
                             ; return (Avail nm) }
 
     new_tc tc_decl              -- NOT for type/data instances
-        = do { names@(main_name : _) <- mapM newTopSrcBinder (hsTyClDeclBinders tc_decl)
+        = do { let bndrs = hsTyClDeclBinders (unLoc tc_decl)
+             ; names@(main_name : _) <- mapM newTopSrcBinder bndrs
              ; return (AvailTC main_name names) }
 
-    new_ti :: Maybe Name -> LTyClDecl RdrName -> RnM AvailInfo
+    new_ti :: Maybe Name -> FamInstDecl RdrName -> RnM AvailInfo
     new_ti mb_cls ti_decl  -- ONLY for type/data instances
-        = do { main_name <- lookupTcdName mb_cls (unLoc ti_decl)
+        = ASSERT( isFamInstDecl ti_decl ) 
+          do { main_name <- lookupTcdName mb_cls ti_decl
              ; sub_names <- mapM newTopSrcBinder (hsTyClDeclBinders ti_decl)
              ; return (AvailTC (unLoc main_name) sub_names) }
                         -- main_name is not bound here!
 
     new_assoc :: LInstDecl RdrName -> RnM [AvailInfo]
-    new_assoc (L _ (InstDecl inst_ty _ _ ats))
+    new_assoc (L _ (FamInstDecl d)) 
+      = do { avail <- new_ti Nothing d
+           ; return [avail] }
+    new_assoc (L _ (ClsInstDecl inst_ty _ _ ats))
       = do { mb_cls_nm <- get_cls_parent inst_ty 
-           ; mapM (new_ti mb_cls_nm) ats }
+           ; mapM (new_ti mb_cls_nm . unLoc) ats }
       where
         get_cls_parent inst_ty
           | Just (_, _, L loc cls_rdr, _) <- splitLHsInstDeclTy_maybe inst_ty
@@ -551,7 +551,8 @@ getLocalNonValBinders fixity_env
           = return Nothing
 
 lookupTcdName :: Maybe Name -> TyClDecl RdrName -> RnM (Located Name)
--- Used for TyData and TySynonym only
+-- Used for TyData and TySynonym only, 
+-- both ordinary ones and family instances
 -- See Note [Family instance binders]
 lookupTcdName mb_cls tc_decl
   | not (isFamInstDecl tc_decl)   -- The normal case