[project @ 2001-03-20 12:30:46 by simonpj]

[ghc-hetmet.git] / ghc / compiler / types / Type.lhs

diff --git a/ghc/compiler/types/Type.lhs b/ghc/compiler/types/Type.lhs
index d4c14a9..643d558 100644 (file)
--- a/ghc/compiler/types/Type.lhs
+++ b/ghc/compiler/types/Type.lhs
@@ -68,6 +68,7 @@ module Type (
        -- Free variables
        tyVarsOfType, tyVarsOfTypes, tyVarsOfPred, tyVarsOfTheta,
        namesOfType, usageAnnOfType, typeKind, addFreeTyVars,
+       namesOfDFunHead,
 
        -- Tidying up for printing
        tidyType,     tidyTypes,
@@ -767,6 +768,17 @@ splitDFunTy ty
     case splitDictTy tau of { (clas, tys) ->
     (tvs, theta, clas, tys) }}
 
+namesOfDFunHead :: Type -> NameSet
+-- Find the free type constructors and classes 
+-- of the head of the dfun instance type
+-- The 'dfun_head_type' is because of
+--     instance Foo a => Baz T where ...
+-- The decl is an orphan if Baz and T are both not locally defined,
+--     even if Foo *is* locally defined
+namesOfDFunHead dfun_ty = case splitSigmaTy dfun_ty of
+                               (tvs,_,head_ty) -> delListFromNameSet (namesOfType head_ty)
+                                                                     (map getName tvs)
+
 mkPredName :: Unique -> SrcLoc -> PredType -> Name
 mkPredName uniq loc (ClassP cls tys) = mkLocalName uniq (mkDictOcc (getOccName cls)) loc
 mkPredName uniq loc (IParam name ty) = name