Merge branch 'master' into type-nats
authorIavor S. Diatchki <iavor.diatchki@gmail.com>
Sun, 30 Jan 2011 01:19:44 +0000 (17:19 -0800)
committerIavor S. Diatchki <iavor.diatchki@gmail.com>
Sun, 30 Jan 2011 01:19:44 +0000 (17:19 -0800)
Conflicts:
compiler/typecheck/TcType.lhs

1  2 
compiler/codeGen/StgCmmClosure.hs
compiler/ghc.cabal.in
compiler/main/DynFlags.hs
compiler/typecheck/TcType.lhs
compiler/typecheck/TcUnify.lhs

Simple merge
Simple merge
Simple merge
@@@ -1169,14 -1162,13 +1169,14 @@@ exactTyVarsOfType t
    = go ty
    where
      go ty | Just ty' <- tcView ty = go ty'    -- This is the key line
-     go (TyVarTy tv)             = unitVarSet tv
-     go (TyConApp _ tys)         = exactTyVarsOfTypes tys
+     go (TyVarTy tv)         = unitVarSet tv
+     go (TyConApp _ tys)     = exactTyVarsOfTypes tys
 +    go (LiteralTy _)              = emptyVarSet
-     go (PredTy ty)              = go_pred ty
-     go (FunTy arg res)                  = go arg `unionVarSet` go res
-     go (AppTy fun arg)                  = go fun `unionVarSet` go arg
-     go (ForAllTy tyvar ty)      = delVarSet (go ty) tyvar
-                                     `unionVarSet` go_tv tyvar
+     go (PredTy ty)        = go_pred ty
+     go (FunTy arg res)            = go arg `unionVarSet` go res
+     go (AppTy fun arg)            = go fun `unionVarSet` go arg
+     go (ForAllTy tyvar ty)  = delVarSet (go ty) tyvar
+                               `unionVarSet` go_tv tyvar
  
      go_pred (IParam _ ty)    = go ty
      go_pred (ClassP _ tys)   = exactTyVarsOfTypes tys
@@@ -1193,21 -1185,25 +1193,26 @@@ Find the free tycons and classes of a t
  end of the compiler.
  
  \begin{code}
- tyClsNamesOfType :: Type -> NameSet
- tyClsNamesOfType (TyVarTy _)              = emptyNameSet
- tyClsNamesOfType (TyConApp tycon tys)     = unitNameSet (getName tycon) `unionNameSets` tyClsNamesOfTypes tys
- tyClsNamesOfType (PredTy (IParam _ ty))     = tyClsNamesOfType ty
- tyClsNamesOfType (PredTy (ClassP cl tys))   = unitNameSet (getName cl) `unionNameSets` tyClsNamesOfTypes tys
- tyClsNamesOfType (PredTy (EqPred ty1 ty2))  = tyClsNamesOfType ty1 `unionNameSets` tyClsNamesOfType ty2
- tyClsNamesOfType (FunTy arg res)          = tyClsNamesOfType arg `unionNameSets` tyClsNamesOfType res
- tyClsNamesOfType (AppTy fun arg)          = tyClsNamesOfType fun `unionNameSets` tyClsNamesOfType arg
- tyClsNamesOfType (ForAllTy _ ty)          = tyClsNamesOfType ty
- tyClsNamesOfType (LiteralTy _)              = emptyNameSet
- tyClsNamesOfTypes :: [Type] -> NameSet
- tyClsNamesOfTypes tys = foldr (unionNameSets . tyClsNamesOfType) emptyNameSet tys
- tyClsNamesOfDFunHead :: Type -> NameSet
+ orphNamesOfType :: Type -> NameSet
+ orphNamesOfType ty | Just ty' <- tcView ty = orphNamesOfType ty'
+               -- Look through type synonyms (Trac #4912)
+ orphNamesOfType (TyVarTy _)              = emptyNameSet
+ orphNamesOfType (TyConApp tycon tys)       = unitNameSet (getName tycon) 
+                                              `unionNameSets` orphNamesOfTypes tys
+ orphNamesOfType (PredTy (IParam _ ty))    = orphNamesOfType ty
+ orphNamesOfType (PredTy (ClassP cl tys))  = unitNameSet (getName cl) 
+                                             `unionNameSets` orphNamesOfTypes tys
+ orphNamesOfType (PredTy (EqPred ty1 ty2)) = orphNamesOfType ty1 
+                                             `unionNameSets` orphNamesOfType ty2
+ orphNamesOfType (FunTy arg res)           = orphNamesOfType arg `unionNameSets` orphNamesOfType res
+ orphNamesOfType (AppTy fun arg)           = orphNamesOfType fun `unionNameSets` orphNamesOfType arg
+ orphNamesOfType (ForAllTy _ ty)           = orphNamesOfType ty
++orphNamesOfType (LiteralTy _)       = emptyNameSet
+ orphNamesOfTypes :: [Type] -> NameSet
+ orphNamesOfTypes tys = foldr (unionNameSets . orphNamesOfType) emptyNameSet tys
+ orphNamesOfDFunHead :: Type -> NameSet
  -- Find the free type constructors and classes 
  -- of the head of the dfun instance type
  -- The 'dfun_head_type' is because of
Simple merge