diff options
author | Ömer Sinan Ağacan <omeragacan@gmail.com> | 2020-02-28 09:52:04 +0300 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2020-02-29 05:12:06 -0500 |
commit | 04d30137771a6cf8a18fda1ced25f78d0b2eb204 (patch) | |
tree | a69c36e0827b1374d3cb66bafd518a2c54df0876 | |
parent | 34c7d23074f47c720b5722ca14d78a34213eabb6 (diff) | |
download | haskell-04d30137771a6cf8a18fda1ced25f78d0b2eb204.tar.gz |
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.
-rw-r--r-- | compiler/GHC/CoreToIface.hs | 6 | ||||
-rw-r--r-- | compiler/GHC/Iface/Rename.hs | 3 | ||||
-rw-r--r-- | compiler/GHC/Iface/Syntax.hs | 29 | ||||
-rw-r--r-- | compiler/GHC/Iface/Utils.hs | 10 | ||||
-rw-r--r-- | compiler/GHC/IfaceToCore.hs | 6 | ||||
-rw-r--r-- | testsuite/tests/codeGen/should_compile/Makefile | 4 | ||||
-rw-r--r-- | testsuite/tests/simplCore/should_compile/T4201.stdout | 6 |
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)] |