[Git][ghc/ghc][wip/torsten.schmits/23612] use same substitution filter everywhere
Torsten Schmits (@torsten.schmits)
gitlab at gitlab.haskell.org
Wed Sep 27 23:55:17 UTC 2023
Torsten Schmits pushed to branch wip/torsten.schmits/23612 at Glasgow Haskell Compiler / GHC
Commits:
aa02b019 by Torsten Schmits at 2023-09-28T01:54:26+02:00
use same substitution filter everywhere
- - - - -
9 changed files:
- compiler/GHC/Core/Opt/Simplify/Iteration.hs
- compiler/GHC/Core/Opt/SpecConstr.hs
- compiler/GHC/Core/Opt/Specialise.hs
- compiler/GHC/Core/Subst.hs
- compiler/GHC/Core/Utils.hs
- + testsuite/tests/codeGen/should_run/T23612b.script
- + testsuite/tests/codeGen/should_run/T23612bA.hs
- + testsuite/tests/codeGen/should_run/T23612bB.hs
- testsuite/tests/codeGen/should_run/all.T
Changes:
=====================================
compiler/GHC/Core/Opt/Simplify/Iteration.hs
=====================================
@@ -1449,7 +1449,7 @@ simplTick env tickish expr cont
getDoneId (DoneId id) = Just id
getDoneId (DoneEx (Var id) _) = Just id
- getDoneId (DoneEx e _) = getIdFromTrivialExpr_maybe e -- Note [substTickish] in GHC.Core.Subst
+ getDoneId (DoneEx e _) = substitutedBreakpointId e -- Note [substTickish] in GHC.Core.Subst
getDoneId other = pprPanic "getDoneId" (ppr other)
-- Note [case-of-scc-of-case]
=====================================
compiler/GHC/Core/Opt/SpecConstr.hs
=====================================
@@ -1547,7 +1547,7 @@ scTickish :: ScEnv -> CoreTickish -> UniqSM (ScUsage, CoreTickish)
scTickish env = \case
Breakpoint ext i fv modl -> do
(usg, fv') <- unzip <$> mapM (\ v -> scExpr env (Var v)) fv
- pure (combineUsages usg, Breakpoint ext i [v | Var v <- fv'] modl)
+ pure (combineUsages usg, Breakpoint ext i (mapMaybe substitutedBreakpointId fv') modl)
t at ProfNote {} -> pure (nullUsage, t)
t at HpcTick {} -> pure (nullUsage, t)
t at SourceNote {} -> pure (nullUsage, t)
=====================================
compiler/GHC/Core/Opt/Specialise.hs
=====================================
@@ -67,6 +67,7 @@ import GHC.Core.Unfold
import Data.List( partition )
import Data.List.NonEmpty ( NonEmpty (..) )
+import GHC.Core.Subst (substTickish)
{-
************************************************************************
@@ -1267,11 +1268,8 @@ specLam env bndrs body
--------------
specTickish :: SpecEnv -> CoreTickish -> CoreTickish
-specTickish (SE { se_subst = subst }) (Breakpoint ext ix ids modl)
- = Breakpoint ext ix [ id' | id <- ids, Var id' <- [Core.lookupIdSubst subst id]] modl
- -- drop vars from the list if they have a non-variable substitution.
- -- should never happen, but it's harmless to drop them anyway.
-specTickish _ other_tickish = other_tickish
+specTickish (SE { se_subst = subst }) bp
+ = substTickish subst bp
--------------
specCase :: SpecEnv
=====================================
compiler/GHC/Core/Subst.hs
=====================================
@@ -589,23 +589,13 @@ substDVarSet subst@(Subst _ _ tv_env cv_env) fvs
= exprFVs fv_expr (const True) emptyVarSet $! acc
------------------
+-- | Drop vars from the list if they have a non-variable substitution.
+-- should never happen, but it's harmless to drop them anyway.
substTickish :: Subst -> CoreTickish -> CoreTickish
substTickish subst (Breakpoint ext n ids modl)
- = Breakpoint ext n (filter not_datacon (mapMaybe do_one ids)) modl
+ = Breakpoint ext n (mapMaybe do_one ids) modl
where
- do_one = getIdFromTrivialExpr_maybe . lookupIdSubst subst
-
- -- If a variable is substituted with a constructor, there's no point in
- -- inspecting it anymore, and it would cause problems with the dependency
- -- computation when fingerprinting iface decls, since it pulls in the name
- -- of the tycon even when it's not in the decl's OccEnv.
- not_datacon s
- | isId s
- = case idDetails s of
- DataConWorkId {} -> False
- DataConWrapId {} -> False
- _ -> True
- | otherwise = True
+ do_one v = substitutedBreakpointId (lookupIdSubst subst v)
substTickish _subst other = other
=====================================
compiler/GHC/Core/Utils.hs
=====================================
@@ -25,6 +25,7 @@ module GHC.Core.Utils (
mkLamType, mkLamTypes,
mkFunctionType,
exprIsTrivial, getIdFromTrivialExpr, getIdFromTrivialExpr_maybe,
+ substitutedBreakpointId,
trivial_expr_fold,
exprIsDupable, exprIsCheap, exprIsExpandable, exprIsCheapX, CheapAppFun,
exprIsHNF, exprOkForSpeculation, exprOkToDiscard, exprOkForSpecEval,
@@ -1114,6 +1115,26 @@ getIdFromTrivialExpr e = trivial_expr_fold id (const panic) panic panic e
getIdFromTrivialExpr_maybe :: CoreExpr -> Maybe Id
getIdFromTrivialExpr_maybe e = trivial_expr_fold Just (const Nothing) Nothing Nothing e
+substitutedBreakpointId :: CoreExpr -> Maybe Id
+substitutedBreakpointId expr
+ | Just s <- getIdFromTrivialExpr_maybe expr
+ , not_datacon s
+ = Just s
+ | otherwise
+ = Nothing
+ where
+ -- If a variable is substituted with a constructor, there's no point in
+ -- inspecting it anymore, and it would cause problems with the dependency
+ -- computation when fingerprinting iface decls, since it pulls in the name
+ -- of the tycon even when it's not in the decl's OccEnv.
+ not_datacon s
+ | isId s
+ = case idDetails s of
+ DataConWorkId {} -> False
+ DataConWrapId {} -> False
+ _ -> True
+ | otherwise = True
+
{- *********************************************************************
* *
exprIsDupable
=====================================
testsuite/tests/codeGen/should_run/T23612b.script
=====================================
@@ -0,0 +1 @@
+:load T23612bB
=====================================
testsuite/tests/codeGen/should_run/T23612bA.hs
=====================================
@@ -0,0 +1,5 @@
+module T23612bA where
+
+class C a where
+ c :: a -> a
+ c a = a
=====================================
testsuite/tests/codeGen/should_run/T23612bB.hs
=====================================
@@ -0,0 +1,5 @@
+module T23612bB where
+
+import T23612bA
+
+instance C Bool
=====================================
testsuite/tests/codeGen/should_run/all.T
=====================================
@@ -242,3 +242,4 @@ test('MulMayOflo_full',
['MulMayOflo', [('MulMayOflo_full.cmm', '')], ''])
test('T23612', only_ways(['ghci-opt']), ghci_script, ['T23612.script'])
+test('T23612b', [only_ways(['ghci-opt']), extra_files(['T23612bA.hs', 'T23612bB.hs'])], ghci_script, ['T23612b.script'])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/aa02b019ef4ad386422a106005fa7a0a5812c023
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/aa02b019ef4ad386422a106005fa7a0a5812c023
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20230927/a6201dda/attachment-0001.html>
More information about the ghc-commits
mailing list