[project @ 2005-10-06 10:40:10 by simonmar]

add dataConFieldType

From: Autrijus Tang <autrijus@autrijus.org>

diff --git a/ghc/compiler/basicTypes/DataCon.lhs b/ghc/compiler/basicTypes/DataCon.lhs
index 2cacc14..7905770 100644 (file)
--- a/ghc/compiler/basicTypes/DataCon.lhs
+++ b/ghc/compiler/basicTypes/DataCon.lhs
@@ -12,7 +12,8 @@ module DataCon (
        dataConTyVars, dataConStupidTheta, 
        dataConArgTys, dataConOrigArgTys, dataConResTy,
        dataConInstOrigArgTys, dataConRepArgTys, 
-       dataConFieldLabels, dataConStrictMarks, dataConExStricts,
+       dataConFieldLabels, dataConFieldType,
+       dataConStrictMarks, dataConExStricts,
        dataConSourceArity, dataConRepArity,
        dataConIsInfix,
        dataConWorkId, dataConWrapId, dataConWrapId_maybe, dataConImplicitIds,
@@ -40,6 +41,7 @@ import Outputable
 import Unique          ( Unique, Uniquable(..) )
 import ListSetOps      ( assoc )
 import Util            ( zipEqual, zipWithEqual )
+import Maybes           ( expectJust )
 \end{code}
 
 
@@ -454,6 +456,10 @@ dataConImplicitIds dc = case dcIds dc of
 dataConFieldLabels :: DataCon -> [FieldLabel]
 dataConFieldLabels = dcFields
 
+dataConFieldType :: DataCon -> FieldLabel -> Type
+dataConFieldType con label = expectJust "unexpected label" $
+    lookup label (dcFields con `zip` dcOrigArgTys con)
+
 dataConStrictMarks :: DataCon -> [StrictnessMark]
 dataConStrictMarks = dcStrictMarks