summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--compiler/GHC/CoreToIface.hs6
-rw-r--r--compiler/GHC/Iface/Rename.hs3
-rw-r--r--compiler/GHC/Iface/Syntax.hs29
-rw-r--r--compiler/GHC/Iface/Utils.hs10
-rw-r--r--compiler/GHC/IfaceToCore.hs6
-rw-r--r--testsuite/tests/codeGen/should_compile/Makefile4
-rw-r--r--testsuite/tests/simplCore/should_compile/T4201.stdout6
7 files changed, 16 insertions, 48 deletions
diff --git a/compiler/GHC/CoreToIface.hs b/compiler/GHC/CoreToIface.hs
index 370a569d98..3aad60b025 100644
--- a/compiler/GHC/CoreToIface.hs
+++ b/compiler/GHC/CoreToIface.hs
@@ -442,10 +442,8 @@ toIfaceIdDetails other = pprTrace "toIfaceIdDetails" (ppr other)
toIfaceIdInfo :: IdInfo -> IfaceIdInfo
toIfaceIdInfo id_info
- = case catMaybes [arity_hsinfo, caf_hsinfo, strict_hsinfo, cpr_hsinfo,
- inline_hsinfo, unfold_hsinfo, levity_hsinfo] of
- [] -> NoInfo
- infos -> HasInfo infos
+ = catMaybes [arity_hsinfo, caf_hsinfo, strict_hsinfo, cpr_hsinfo,
+ inline_hsinfo, unfold_hsinfo, levity_hsinfo]
-- NB: strictness and arity must appear in the list before unfolding
-- See GHC.IfaceToCore.tcUnfolding
where
diff --git a/compiler/GHC/Iface/Rename.hs b/compiler/GHC/Iface/Rename.hs
index 3cadf15e80..83632434bd 100644
--- a/compiler/GHC/Iface/Rename.hs
+++ b/compiler/GHC/Iface/Rename.hs
@@ -592,8 +592,7 @@ rnIfaceAxBranch d = do
, ifaxbRHS = rhs }
rnIfaceIdInfo :: Rename IfaceIdInfo
-rnIfaceIdInfo NoInfo = pure NoInfo
-rnIfaceIdInfo (HasInfo is) = HasInfo <$> mapM rnIfaceInfoItem is
+rnIfaceIdInfo = mapM rnIfaceInfoItem
rnIfaceInfoItem :: Rename IfaceInfoItem
rnIfaceInfoItem (HsUnfold lb if_unf)
diff --git a/compiler/GHC/Iface/Syntax.hs b/compiler/GHC/Iface/Syntax.hs
index 5067204b8b..719c8bbb48 100644
--- a/compiler/GHC/Iface/Syntax.hs
+++ b/compiler/GHC/Iface/Syntax.hs
@@ -13,7 +13,7 @@ module GHC.Iface.Syntax (
IfaceConDecl(..), IfaceConDecls(..), IfaceEqSpec,
IfaceExpr(..), IfaceAlt, IfaceLetBndr(..), IfaceJoinInfo(..),
IfaceBinding(..), IfaceConAlt(..),
- IfaceIdInfo(..), IfaceIdDetails(..), IfaceUnfolding(..),
+ IfaceIdInfo, IfaceIdDetails(..), IfaceUnfolding(..),
IfaceInfoItem(..), IfaceRule(..), IfaceAnnotation(..), IfaceAnnTarget,
IfaceClsInst(..), IfaceFamInst(..), IfaceTickish(..),
IfaceClassBody(..),
@@ -337,9 +337,7 @@ instance Outputable IfaceCompleteMatch where
-- * The version comparison sees that new (=NoInfo) differs from old (=HasInfo *)
-- and so gives a new version.
-data IfaceIdInfo
- = NoInfo -- When writing interface file without -O
- | HasInfo [IfaceInfoItem] -- Has info, and here it is
+type IfaceIdInfo = [IfaceInfoItem]
data IfaceInfoItem
= HsArity Arity
@@ -1385,11 +1383,6 @@ instance Outputable IfaceIdDetails where
else Outputable.empty
ppr IfDFunId = text "DFunId"
-instance Outputable IfaceIdInfo where
- ppr NoInfo = Outputable.empty
- ppr (HasInfo is) = text "{-" <+> pprWithCommas ppr is
- <+> text "-}"
-
instance Outputable IfaceInfoItem where
ppr (HsUnfold lb unf) = text "Unfolding"
<> ppWhen lb (text "(loop-breaker)")
@@ -1650,8 +1643,7 @@ freeNamesIfIdBndr :: IfaceIdBndr -> NameSet
freeNamesIfIdBndr (_fs,k) = freeNamesIfKind k
freeNamesIfIdInfo :: IfaceIdInfo -> NameSet
-freeNamesIfIdInfo NoInfo = emptyNameSet
-freeNamesIfIdInfo (HasInfo i) = fnList freeNamesItem i
+freeNamesIfIdInfo = fnList freeNamesItem
freeNamesItem :: IfaceInfoItem -> NameSet
freeNamesItem (HsUnfold _ u) = freeNamesIfUnfold u
@@ -2153,16 +2145,6 @@ instance Binary IfaceIdDetails where
1 -> do { a <- get bh; b <- get bh; return (IfRecSelId a b) }
_ -> return IfDFunId
-instance Binary IfaceIdInfo where
- put_ bh NoInfo = putByte bh 0
- put_ bh (HasInfo i) = putByte bh 1 >> lazyPut bh i -- NB lazyPut
-
- get bh = do
- h <- getByte bh
- case h of
- 0 -> return NoInfo
- _ -> liftM HasInfo $ lazyGet bh -- NB lazyGet
-
instance Binary IfaceInfoItem where
put_ bh (HsArity aa) = putByte bh 0 >> put_ bh aa
put_ bh (HsStrictness ab) = putByte bh 1 >> put_ bh ab
@@ -2504,11 +2486,6 @@ instance NFData IfaceIdDetails where
IfRecSelId (Right decl) b -> rnf decl `seq` rnf b
IfDFunId -> ()
-instance NFData IfaceIdInfo where
- rnf = \case
- NoInfo -> ()
- HasInfo f1 -> rnf f1
-
instance NFData IfaceInfoItem where
rnf = \case
HsArity a -> rnf a
diff --git a/compiler/GHC/Iface/Utils.hs b/compiler/GHC/Iface/Utils.hs
index 927897edf8..663a963688 100644
--- a/compiler/GHC/Iface/Utils.hs
+++ b/compiler/GHC/Iface/Utils.hs
@@ -182,13 +182,9 @@ updateDeclCafInfos decls Nothing = decls
updateDeclCafInfos decls (Just non_cafs) = map update_decl decls
where
update_decl decl
- | IfaceId nm ty details id_info <- decl
+ | IfaceId nm ty details infos <- decl
, elemNameSet nm non_cafs
- = IfaceId nm ty details $
- case id_info of
- NoInfo -> HasInfo [HsNoCafRefs]
- HasInfo infos -> HasInfo (HsNoCafRefs : infos)
-
+ = IfaceId nm ty details (HsNoCafRefs : infos)
| otherwise
= decl
@@ -1772,7 +1768,7 @@ dataConToIfaceDecl dataCon
= IfaceId { ifName = getName dataCon,
ifType = toIfaceType (dataConUserType dataCon),
ifIdDetails = IfVanillaId,
- ifIdInfo = NoInfo }
+ ifIdInfo = [] }
--------------------------
coAxiomToIfaceDecl :: CoAxiom br -> IfaceDecl
diff --git a/compiler/GHC/IfaceToCore.hs b/compiler/GHC/IfaceToCore.hs
index a6fa7408b2..700d830c9d 100644
--- a/compiler/GHC/IfaceToCore.hs
+++ b/compiler/GHC/IfaceToCore.hs
@@ -1465,10 +1465,8 @@ tcIdInfo ignore_prags toplvl name ty info = do
let init_info | if_boot lcl_env = vanillaIdInfo `setUnfoldingInfo` BootUnfolding
| otherwise = vanillaIdInfo
- case info of
- NoInfo -> return init_info
- HasInfo info -> let needed = needed_prags info in
- foldlM tcPrag init_info needed
+ let needed = needed_prags info
+ foldlM tcPrag init_info needed
where
needed_prags :: [IfaceInfoItem] -> [IfaceInfoItem]
needed_prags items
diff --git a/testsuite/tests/codeGen/should_compile/Makefile b/testsuite/tests/codeGen/should_compile/Makefile
index 203111f55e..45d1b605a0 100644
--- a/testsuite/tests/codeGen/should_compile/Makefile
+++ b/testsuite/tests/codeGen/should_compile/Makefile
@@ -64,10 +64,10 @@ T17648:
# NoCafRefs) to the interface files.
'$(TEST_HC)' $(TEST_HC_OPTS) -dno-typeable-binds -O T17648.hs -v0
'$(TEST_HC)' --show-iface T17648.hi | tr -d '\n' | \
- grep -F 'f :: T GHC.Types.Int -> () {- HasNoCafRefs, Arity' >/dev/null
+ grep -F 'f :: T GHC.Types.Int -> () [HasNoCafRefs, Arity' >/dev/null
# Second compilation with -fcatch-bottoms, f should be CAFFY
'$(TEST_HC)' $(TEST_HC_OPTS) -dno-typeable-binds -O \
-fcatch-bottoms T17648.hs -v0 -fforce-recomp
'$(TEST_HC)' --show-iface T17648.hi | tr -d '\n' | \
- grep -F 'f :: T GHC.Types.Int -> () {- Arity: 1, Strictness' >/dev/null
+ grep -F 'f :: T GHC.Types.Int -> () [Arity: 1, Strictness' >/dev/null
diff --git a/testsuite/tests/simplCore/should_compile/T4201.stdout b/testsuite/tests/simplCore/should_compile/T4201.stdout
index 0ee2f5c7e9..e12c9f1584 100644
--- a/testsuite/tests/simplCore/should_compile/T4201.stdout
+++ b/testsuite/tests/simplCore/should_compile/T4201.stdout
@@ -1,3 +1,3 @@
- {- HasNoCafRefs, Arity: 1, Strictness: <S,1*H>, CPR: m1,
- Unfolding: InlineRule (0, True, True)
- bof `cast` (Sym (N:Foo[0]) ->_R <T>_R) -}
+ [HasNoCafRefs, Arity: 1, Strictness: <S,1*H>, CPR: m1,
+ Unfolding: InlineRule (0, True, True)
+ bof `cast` (Sym (N:Foo[0]) ->_R <T>_R)]
View Lorry Controller Status