1 files changed, 15 insertions, 6 deletions
diff --git a/compiler/basicTypes/DataCon.lhs b/compiler/basicTypes/DataCon.lhs
index fa9e2e9a97..9e8c6826a4 100644
--- a/compiler/basicTypes/DataCon.lhs
+++ b/compiler/basicTypes/DataCon.lhs
@@ -12,6 +12,9 @@ module DataCon (
         DataCon, DataConRep(..), HsBang(..), StrictnessMark(..),
         ConTag,
 
+        -- ** Field labels
+        FieldLbl(..), FieldLabel, FieldLabelString,
+
         -- ** Type construction
         mkDataCon, fIRST_TAG,
         buildAlgTyCon,
@@ -25,7 +28,7 @@ module DataCon (
         dataConStupidTheta,
         dataConInstArgTys, dataConOrigArgTys, dataConOrigResTy,
         dataConInstOrigArgTys, dataConRepArgTys,
-        dataConFieldLabels, dataConFieldType,
+        dataConFieldLabels, dataConFieldLabel, dataConFieldType,
         dataConStrictMarks,
         dataConSourceArity, dataConRepArity, dataConRepRepArity,
         dataConIsInfix,
@@ -56,6 +59,7 @@ import Coercion
 import Kind
 import Unify
 import TyCon
+import FieldLabel
 import Class
 import Name
 import Var
@@ -71,6 +75,7 @@ import NameEnv
 
 import qualified Data.Data as Data
 import qualified Data.Typeable
+import Data.List
 import Data.Maybe
 import Data.Char
 import Data.Word
@@ -759,12 +764,16 @@ dataConImplicitIds (MkData { dcWorkId = work, dcRep = rep})
 dataConFieldLabels :: DataCon -> [FieldLabel]
 dataConFieldLabels = dcFields
 
+-- | Extract the 'FieldLabel' and type for any given field of the 'DataCon'
+dataConFieldLabel :: DataCon -> FieldLabelString -> (FieldLabel, Type)
+dataConFieldLabel con lbl
+  = case find ((== lbl) . flLabel . fst) (dcFields con `zip` dcOrigArgTys con) of
+      Just x  -> x
+      Nothing -> pprPanic "dataConFieldLabel" (ppr con <+> ppr lbl)
+
 -- | Extract the type for any given labelled field of the 'DataCon'
-dataConFieldType :: DataCon -> FieldLabel -> Type
-dataConFieldType con label
-  = case lookup label (dcFields con `zip` dcOrigArgTys con) of
-      Just ty -> ty
-      Nothing -> pprPanic "dataConFieldType" (ppr con <+> ppr label)
+dataConFieldType :: DataCon -> FieldLabelString -> Type
+dataConFieldType con lbl = snd $ dataConFieldLabel con lbl
 
 -- | The strictness markings decided on by the compiler.  Does not include those for
 -- existential dictionaries.  The list is in one-to-one correspondence with the arity of the 'DataCon'