[project @ 2000-11-03 17:10:57 by simonpj]

[ghc-hetmet.git] / ghc / compiler / basicTypes / DataCon.lhs

diff --git a/ghc/compiler/basicTypes/DataCon.lhs b/ghc/compiler/basicTypes/DataCon.lhs
index 39f4952..1789370 100644 (file)
--- a/ghc/compiler/basicTypes/DataCon.lhs
+++ b/ghc/compiler/basicTypes/DataCon.lhs
@@ -15,7 +15,7 @@ module DataCon (
        dataConSourceArity, dataConRepArity,
        dataConNumInstArgs, dataConId, dataConWrapId, dataConRepStrictness,
        isNullaryDataCon, isTupleCon, isUnboxedTupleCon,
-       isExistentialDataCon,
+       isExistentialDataCon, classDataCon,
 
        splitProductType_maybe, splitProductType,
 
@@ -35,7 +35,7 @@ import Type           ( Type, TauType, ClassContext,
                        )
 import TyCon           ( TyCon, tyConDataCons, tyConDataConsIfAvailable, isDataTyCon, isProductTyCon,
                          isTupleTyCon, isUnboxedTupleTyCon, isRecursiveTyCon )
-import Class           ( classTyCon )
+import Class           ( Class, classTyCon )
 import Name            ( Name, NamedThing(..), nameUnique, isLocallyDefined )
 import Var             ( TyVar, Id )
 import FieldLabel      ( FieldLabel )
@@ -395,6 +395,12 @@ isExistentialDataCon (MkData {dcExTyVars = tvs}) = not (null tvs)
 \end{code}
 
 
+\begin{code}
+classDataCon :: Class -> DataCon
+classDataCon clas = case tyConDataCons (classTyCon clas) of
+                     (dict_constr:no_more) -> ASSERT( null no_more ) dict_constr 
+\end{code}
+
 %************************************************************************
 %*                                                                     *
 \subsection{Splitting products}