[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