[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