[project @ 2000-08-01 09:08:25 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 f20ef3d..e57e125 100644 (file)
--- a/ghc/compiler/types/Type.lhs
+++ b/ghc/compiler/types/Type.lhs
@@ -47,6 +47,7 @@ module Type (
        getClassTys_maybe, ipName_maybe, classesToPreds, classesOfPreds,
        isTauTy, mkRhoTy, splitRhoTy,
        mkSigmaTy, isSigmaTy, splitSigmaTy,
+       getDFunTyKey,
 
        -- Lifting and boxity
        isUnLiftedType, isUnboxedType, isUnboxedTupleType, isAlgType, isDataType, isNewType,
@@ -86,8 +87,7 @@ import Var    ( TyVar, Var, UVar,
 import VarEnv
 import VarSet
 
-import Name    ( Name, NamedThing(..), mkLocalName, tidyOccName
-               )
+import Name    ( Name, NamedThing(..), OccName, mkLocalName, tidyOccName )
 import NameSet
 import Class   ( classTyCon, Class, ClassPred, ClassContext )
 import TyCon   ( TyCon,
@@ -762,6 +762,17 @@ splitSigmaTy ty =
   (theta,tau)  = splitRhoTy rho
 \end{code}
 
+\begin{code}
+getDFunTyKey :: Type -> OccName        -- Get some string from a type, to be used to 
+                               -- construct a dictionary function name
+getDFunTyKey (TyVarTy tv)    = getOccName tv
+getDFunTyKey (TyConApp tc _) = getOccName tc
+getDFunTyKey (AppTy fun _)   = getDFunTyKey fun
+getDFunTyKey (NoteTy _ t)    = getDFunTyKey t
+getDFunTyKey (FunTy arg _)   = getOccName funTyCon
+getDFunTyKey (ForAllTy _ t)  = getDFunTyKey t
+\end{code}
+
 
 %************************************************************************
 %*                                                                     *