[commit: ghc] master: Include funTyCon in oprhNamesOfType (fixes Trac #8535) (26c9d59)
git at git.haskell.org
git at git.haskell.org
Fri Nov 15 18:49:40 UTC 2013
Repository : ssh://git@git.haskell.org/ghc
On branch : master
Link : http://ghc.haskell.org/trac/ghc/changeset/26c9d5912c47a34fef197a6c917f673aeb2dc119/ghc
>---------------------------------------------------------------
commit 26c9d5912c47a34fef197a6c917f673aeb2dc119
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date: Fri Nov 15 18:49:07 2013 +0000
Include funTyCon in oprhNamesOfType (fixes Trac #8535)
Thanks to parcs for identifying both the bug and the right solution.
>---------------------------------------------------------------
26c9d5912c47a34fef197a6c917f673aeb2dc119
compiler/typecheck/TcType.lhs | 16 +++++++++-------
1 file changed, 9 insertions(+), 7 deletions(-)
diff --git a/compiler/typecheck/TcType.lhs b/compiler/typecheck/TcType.lhs
index 9ccb08a..0ca8e16 100644
--- a/compiler/typecheck/TcType.lhs
+++ b/compiler/typecheck/TcType.lhs
@@ -1312,13 +1312,15 @@ orphNamesOfTyCon tycon = unitNameSet (getName tycon) `unionNameSets` case tyConC
orphNamesOfType :: Type -> NameSet
orphNamesOfType ty | Just ty' <- tcView ty = orphNamesOfType ty'
-- Look through type synonyms (Trac #4912)
-orphNamesOfType (TyVarTy _) = emptyNameSet
-orphNamesOfType (TyConApp tycon tys) = orphNamesOfTyCon tycon
- `unionNameSets` orphNamesOfTypes tys
-orphNamesOfType (LitTy {}) = emptyNameSet
-orphNamesOfType (FunTy arg res) = orphNamesOfType arg `unionNameSets` orphNamesOfType res
-orphNamesOfType (AppTy fun arg) = orphNamesOfType fun `unionNameSets` orphNamesOfType arg
-orphNamesOfType (ForAllTy _ ty) = orphNamesOfType ty
+orphNamesOfType (TyVarTy _) = emptyNameSet
+orphNamesOfType (LitTy {}) = emptyNameSet
+orphNamesOfType (TyConApp tycon tys) = orphNamesOfTyCon tycon
+ `unionNameSets` orphNamesOfTypes tys
+orphNamesOfType (FunTy arg res) = orphNamesOfTyCon funTyCon -- NB! See Trac #8535
+ `unionNameSets` orphNamesOfType arg
+ `unionNameSets` orphNamesOfType res
+orphNamesOfType (AppTy fun arg) = orphNamesOfType fun `unionNameSets` orphNamesOfType arg
+orphNamesOfType (ForAllTy _ ty) = orphNamesOfType ty
orphNamesOfThings :: (a -> NameSet) -> [a] -> NameSet
orphNamesOfThings f = foldr (unionNameSets . f) emptyNameSet
More information about the ghc-commits
mailing list