[commit: ghc] master: oprhNamesOfFamInst should include the type family itself (fix Trac #8469) (b73800c)

git at git.haskell.org git at git.haskell.org
Thu Oct 24 10:39:47 UTC 2013


Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/b73800c306bd7a73b1090fb766d1860e6ab0623f/ghc

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

commit b73800c306bd7a73b1090fb766d1860e6ab0623f
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date:   Wed Oct 23 14:23:46 2013 +0100

    oprhNamesOfFamInst should include the type family itself (fix Trac #8469)
    
    Trivial fix; matches oprhNamesOfClsInst.


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

b73800c306bd7a73b1090fb766d1860e6ab0623f
 compiler/types/FamInstEnv.lhs |   15 +++++++++------
 1 file changed, 9 insertions(+), 6 deletions(-)

diff --git a/compiler/types/FamInstEnv.lhs b/compiler/types/FamInstEnv.lhs
index 7662dac..32dc766 100644
--- a/compiler/types/FamInstEnv.lhs
+++ b/compiler/types/FamInstEnv.lhs
@@ -329,15 +329,19 @@ familyInstances (pkg_fie, home_fie) fam
                 Nothing                      -> []
 
 -- | Collects the names of the concrete types and type constructors that
--- make up the LHS of a type family instance. For instance,
--- given `type family Foo a b`:
+-- make up the LHS of a type family instance, including the family
+-- name itself. 
 --
--- `type instance Foo (F (G (H a))) b = ...` would yield [F,G,H]
+-- For instance, given `type family Foo a b`:
+-- `type instance Foo (F (G (H a))) b = ...` would yield [Foo,F,G,H]
 --
 -- Used in the implementation of ":info" in GHCi.
 orphNamesOfFamInst :: FamInst -> NameSet
-orphNamesOfFamInst
-    = orphNamesOfTypes . concat . brListMap cab_lhs . coAxiomBranches . fi_axiom
+orphNamesOfFamInst fam_inst
+  = orphNamesOfTypes (concat (brListMap cab_lhs (coAxiomBranches axiom)))
+    `addOneToNameSet` getName (coAxiomTyCon axiom)
+  where
+    axiom = fi_axiom fam_inst
 
 extendFamInstEnvList :: FamInstEnv -> [FamInst] -> FamInstEnv
 extendFamInstEnvList inst_env fis = foldl extendFamInstEnv inst_env fis
@@ -376,7 +380,6 @@ identicalFamInst (FamInst { fi_axiom = ax1 }) (FamInst { fi_axiom = ax2 })
             lhs1 = coAxBranchLHS br1
             lhs2 = coAxBranchLHS br2
             rn_env = rnBndrs2 (mkRnEnv2 emptyInScopeSet) tvs1 tvs2
-
 \end{code}
 
 %************************************************************************



More information about the ghc-commits mailing list