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 <[email protected]> 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 _______________________________________________ Cvs-ghc mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-ghc
