[commit: ghc] wip/orf-reboot: Remove some redundant code in DataCon (2d5d3cf)

git at git.haskell.org git at git.haskell.org
Thu Oct 15 19:05:25 UTC 2015


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

On branch  : wip/orf-reboot
Link       : http://ghc.haskell.org/trac/ghc/changeset/2d5d3cfcde74b84192f713e58442b74f38c93919/ghc

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

commit 2d5d3cfcde74b84192f713e58442b74f38c93919
Author: Adam Gundry <adam at well-typed.com>
Date:   Thu Oct 15 17:29:33 2015 +0100

    Remove some redundant code in DataCon


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

2d5d3cfcde74b84192f713e58442b74f38c93919
 compiler/basicTypes/DataCon.hs  | 17 ++++++-----------
 compiler/typecheck/TcRnTypes.hs |  3 ++-
 2 files changed, 8 insertions(+), 12 deletions(-)

diff --git a/compiler/basicTypes/DataCon.hs b/compiler/basicTypes/DataCon.hs
index f2c10d1..b4aaaa7 100644
--- a/compiler/basicTypes/DataCon.hs
+++ b/compiler/basicTypes/DataCon.hs
@@ -31,7 +31,7 @@ module DataCon (
         dataConStupidTheta,
         dataConInstArgTys, dataConOrigArgTys, dataConOrigResTy,
         dataConInstOrigArgTys, dataConRepArgTys,
-        dataConFieldLabels, dataConFieldLabel, dataConFieldType,
+        dataConFieldLabels, dataConFieldType,
         dataConSrcBangs,
         dataConSourceArity, dataConRepArity, dataConRepRepArity,
         dataConIsInfix,
@@ -76,11 +76,10 @@ import Binary
 
 import qualified Data.Data as Data
 import qualified Data.Typeable
-import Data.List
 import Data.Maybe
 import Data.Char
 import Data.Word
-import Data.List( mapAccumL )
+import Data.List( mapAccumL, find )
 
 {-
 Data constructor representation
@@ -835,16 +834,12 @@ 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 -> FieldLabelString -> Type
-dataConFieldType con lbl = snd $ dataConFieldLabel con lbl
+dataConFieldType con label
+  = case find ((== label) . flLabel . fst) (dcFields con `zip` dcOrigArgTys con) of
+      Just (_, ty) -> ty
+      Nothing -> pprPanic "dataConFieldType" (ppr con <+> ppr label)
 
 -- | Strictness/unpack annotations, from user; or, for imported
 -- DataCons, from the interface file
diff --git a/compiler/typecheck/TcRnTypes.hs b/compiler/typecheck/TcRnTypes.hs
index 2df7fdd..dec6fce 100644
--- a/compiler/typecheck/TcRnTypes.hs
+++ b/compiler/typecheck/TcRnTypes.hs
@@ -112,8 +112,9 @@ import CoAxiom  ( Role )
 import Class    ( Class )
 import TyCon    ( TyCon )
 import ConLike  ( ConLike(..) )
-import DataCon  ( DataCon, FieldLabel, dataConUserType, dataConOrigArgTys )
+import DataCon  ( DataCon, dataConUserType, dataConOrigArgTys )
 import PatSyn   ( PatSyn, patSynType )
+import FieldLabel ( FieldLabel )
 import TcType
 import Annotations
 import InstEnv



More information about the ghc-commits mailing list