[commit: ghc] wip/hasfield: Add dataConFieldType_maybe (35cd301)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : wip/hasfield
Link       : http://ghc.haskell.org/trac/ghc/changeset/35cd30152f88508f4c171596d93e87f81a7c0b14/ghc

>---------------------------------------------------------------

commit 35cd30152f88508f4c171596d93e87f81a7c0b14
Author: Adam Gundry <adam at well-typed.com>
Date:   Tue Dec 22 16:07:26 2015 +0000

    Add dataConFieldType_maybe


>---------------------------------------------------------------

35cd30152f88508f4c171596d93e87f81a7c0b14
 compiler/basicTypes/DataCon.hs | 15 ++++++++++-----
 1 file changed, 10 insertions(+), 5 deletions(-)

diff --git a/compiler/basicTypes/DataCon.hs b/compiler/basicTypes/DataCon.hs
index 712a9b2..ec7c9a7 100644
--- a/compiler/basicTypes/DataCon.hs
+++ b/compiler/basicTypes/DataCon.hs
@@ -35,7 +35,7 @@ module DataCon (
         dataConStupidTheta,
         dataConInstArgTys, dataConOrigArgTys, dataConOrigResTy,
         dataConInstOrigArgTys, dataConRepArgTys,
-        dataConFieldLabels, dataConFieldType,
+        dataConFieldLabels, dataConFieldType, dataConFieldType_maybe,
         dataConSrcBangs,
         dataConSourceArity, dataConRepArity, dataConRepRepArity,
         dataConIsInfix,
@@ -81,7 +81,7 @@ import qualified Data.Data as Data
 import qualified Data.Typeable
 import Data.Char
 import Data.Word
-import Data.List( mapAccumL, find )
+import Data.List( mapAccumL )
 
 {-
 Data constructor representation
@@ -889,11 +889,16 @@ dataConFieldLabels = dcFields
 
 -- | Extract the type for any given labelled field of the 'DataCon'
 dataConFieldType :: DataCon -> FieldLabelString -> Type
-dataConFieldType con label
-  = case find ((== label) . flLabel . fst) (dcFields con `zip` dcOrigArgTys con) of
-      Just (_, ty) -> ty
+dataConFieldType con label = case dataConFieldType_maybe con label of
+      Just ty -> ty
       Nothing -> pprPanic "dataConFieldType" (ppr con <+> ppr label)
 
+-- | Extract the type for any given labelled field of the 'DataCon',
+-- or return 'Nothing' if the field does not belong to it
+dataConFieldType_maybe :: DataCon -> FieldLabelString -> Maybe Type
+dataConFieldType_maybe con label
+  = lookup label (map flLabel (dcFields con) `zip` dcOrigArgTys con)
+
 -- | Strictness/unpack annotations, from user; or, for imported
 -- DataCons, from the interface file
 -- The list is in one-to-one correspondence with the arity of the 'DataCon'