Commit 04d30137 authored by Ömer Sinan Ağacan's avatar Ömer Sinan Ağacan Committed by Marge Bot

Simplify IfaceIdInfo type

IfaceIdInfo type is confusing: there's practically no difference between
`NoInfo` and `HasInfo []`. The comments say NoInfo is used when
-fomit-interface-pragmas is enabled, but we don't need to distinguish
`NoInfo` from `HasInfo []` in when reading the interface so the
distinction is not important.

This patch simplifies the type by removing NoInfo. When we have no info
we use an empty list.

With this change we no longer read the info list lazily when reading an
IfaceInfoItem, but when reading an IfaceId the ifIdInfo field is
read lazily, so I doubt this is going to be a problem.
parent 34c7d230
Pipeline #16356 failed with stages
in 293 minutes and 28 seconds
......@@ -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
......
......@@ -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)
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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
{- 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)]
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment