[commit: ghc] ghc-7.4: Fix dependency-analysis of type/class decls (bd0ce7d)

[Simon Peyton Jones]

Repository : ssh://darcs.haskell.org//srv/darcs/ghc

On branch  : ghc-7.4

http://hackage.haskell.org/trac/ghc/changeset/bd0ce7d72a62100157355e3bab50bee3c953ee62

>---------------------------------------------------------------

commit bd0ce7d72a62100157355e3bab50bee3c953ee62
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date:   Thu Feb 2 13:21:46 2012 +0000

    Fix dependency-analysis of type/class decls
    
    Family instances don't define a new type, but we were bogusly
    pretending they bound the family tycon.  The led to incorrect
    dependencies with strange results; it showed up as Trac #5792.
    
    This slightly hacky fix is on the branch only; I am doing a more
    substantial refactoring on HEAD.

>---------------------------------------------------------------

 compiler/rename/RnSource.lhs |   16 ++++++++++++----
 1 files changed, 12 insertions(+), 4 deletions(-)

diff --git a/compiler/rename/RnSource.lhs b/compiler/rename/RnSource.lhs
index 7440a3b..935b8e4 100644
--- a/compiler/rename/RnSource.lhs
+++ b/compiler/rename/RnSource.lhs
@@ -53,6 +53,7 @@ import Digraph		( SCC, flattenSCC, stronglyConnCompFromEdgedVertices )
 
 import Control.Monad
 import Maybes( orElse )
+import Data.List( partition )
 import Data.Maybe( isNothing )
 \end{code}
 
@@ -742,21 +743,28 @@ rnTyClDecls :: [Name] -> [[LTyClDecl RdrName]]
 rnTyClDecls extra_deps tycl_ds
   = do { ds_w_fvs <- mapM (wrapLocFstM (rnTyClDecl Nothing)) (concat tycl_ds)
        ; thisPkg  <- fmap thisPackage getDOpts
-       ; let add_boot_deps :: FreeVars -> FreeVars
+       ; let (fam_insts, non_fam_insts) = partition (isFamInstDecl . unLoc . fst) ds_w_fvs
+                  -- Ignore family instances when doing this dependency analysis
+                  -- because they don't have a binder
+
+             add_boot_deps :: FreeVars -> FreeVars
              -- See Note [Extra dependencies from .hs-boot files]
              add_boot_deps fvs | any (isInPackage thisPkg) (nameSetToList fvs)
                                = fvs `plusFV` mkFVs extra_deps
                                | otherwise
                                = fvs
 
-             ds_w_fvs' = map (\(ds, fvs) -> (ds, add_boot_deps fvs)) ds_w_fvs
+             ds_w_fvs' = map (\(ds, fvs) -> (ds, add_boot_deps fvs)) non_fam_insts
 
              sccs :: [SCC (LTyClDecl Name)]
              sccs = depAnalTyClDecls ds_w_fvs'
 
-             all_fvs = foldr (plusFV . snd) emptyFVs ds_w_fvs'
+             all_fvs = foldr (plusFV . snd) emptyFVs ds_w_fvs
+
 
-       ; return (map flattenSCC sccs, all_fvs) }
+       ; return (map fst fam_insts : map flattenSCC sccs, all_fvs) }
+            -- Just put the family-instance group first;
+            -- it is treated separately anyway
 
 
 rnTyClDecl :: Maybe Name  -- Just cls => this TyClDecl is nested