[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