[Git][ghc/ghc][wip/romes/25170] WIP #25170

Rodrigo Mesquita (@alt-romes) gitlab at gitlab.haskell.org
Mon Aug 19 14:00:26 UTC 2024



Rodrigo Mesquita pushed to branch wip/romes/25170 at Glasgow Haskell Compiler / GHC


Commits:
346f8a69 by Rodrigo Mesquita at 2024-08-19T15:00:02+01:00
WIP #25170

- - - - -


2 changed files:

- compiler/GHC/Core/Opt/Simplify/Iteration.hs
- compiler/GHC/Core/Opt/Simplify/Utils.hs


Changes:

=====================================
compiler/GHC/Core/Opt/Simplify/Iteration.hs
=====================================
@@ -2306,14 +2306,19 @@ rebuildCall env info@(ArgInfo { ai_fun = fun, ai_args = rev_args
 -- See Note [Rewrite rules and inlining]
 -- See also Note [Trying rewrite rules]
 rebuildCall env info@(ArgInfo { ai_fun = fun, ai_args = rev_args
-                              , ai_rewrite = TryRules nr_wanted rules }) cont
-  | nr_wanted == 0 || no_more_args
-  = -- We've accumulated a simplified call in <fun,rev_args>
-    -- so try rewrite rules; see Note [RULES apply to simplified arguments]
+                              , ai_dmds = dms, ai_rewrite = TryRules rules }) cont
+  -- romes:todo: note on trying rules twice: one on unsimplified args, the other on simplified args.
+  | null rev_args || no_more_args
+  = -- We try rules twice: once on unsimplified args and once after
+    -- we've accumulated a simplified call in <fun,rev_args>
+    -- See Note [RULES apply to simplified arguments] (TODO: EDIT NOTE AND TITLE)
     -- See also Note [Rules for recursive functions]
-    do { mb_match <- tryRules env rules fun (reverse rev_args) cont
+    do { let (rules_args, cont')
+              | null rev_args = contArgsSpec dms cont -- Unsimplified args
+              | otherwise = (reverse rev_args, cont) -- Simplified args
+       ; mb_match <- tryRules env rules fun rules_args cont'
        ; case mb_match of
-             Just (env', rhs, cont') -> simplExprF env' rhs cont'
+             Just (env', rhs, cont'') -> simplExprF env' rhs cont''
              Nothing -> rebuildCall env (info { ai_rewrite = TryInlining }) cont }
   where
     -- If we have run out of arguments, just try the rules; there might
@@ -2425,7 +2430,7 @@ tryInlining env logger var cont
   = return Nothing
 
   where
-    (lone_variable, arg_infos, call_cont) = contArgs cont
+    (lone_variable, arg_infos, call_cont) = contArgsSummary cont
     interesting_cont = interestingCallContext env call_cont
 
     log_inlining doc
@@ -2467,6 +2472,7 @@ So we try to apply rules if either
   (a) no_more_args: we've run out of argument that the rules can "see"
   (b) nr_wanted: none of the rules wants any more arguments
 
+romes:TODO: Update this note after nr_wanted is gone
 
 Note [RULES apply to simplified arguments]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -2481,6 +2487,8 @@ makes a particularly big difference when superclass selectors are involved:
         op ($p1 ($p2 (df d)))
 We want all this to unravel in one sweep.
 
+ROMES:TODO: RULES now twice per pass, to unsimplified args and to simplified args
+
 Note [Rewrite rules and inlining]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 In general we try to arrange that inlining is disabled (via a pragma) if


=====================================
compiler/GHC/Core/Opt/Simplify/Utils.hs
=====================================
@@ -24,7 +24,7 @@ module GHC.Core.Opt.Simplify.Utils (
         SimplCont(..), DupFlag(..), FromWhat(..), StaticEnv,
         isSimplified, contIsStop,
         contIsDupable, contResultType, contHoleType, contHoleScaling,
-        contIsTrivial, contArgs, contIsRhs,
+        contIsTrivial, contArgsSpec, contArgsSummary, contIsRhs,
         countArgs,
         mkBoringStop, mkRhsStop, mkLazyArgStop,
         interestingCallContext,
@@ -83,6 +83,7 @@ import GHC.Utils.Outputable
 import GHC.Utils.Panic
 
 import Control.Monad    ( when )
+import Data.Bifunctor   ( first )
 import Data.List        ( sortBy )
 import GHC.Types.Name.Env
 import Data.Graph
@@ -344,7 +345,7 @@ data ArgInfo
 
 data RewriteCall  -- What rewriting to try next for this call
                   -- See Note [Rewrite rules and inlining] in GHC.Core.Opt.Simplify.Iteration
-  = TryRules FullArgCount [CoreRule]
+  = TryRules [CoreRule]
   | TryInlining
   | TryNothing
 
@@ -379,14 +380,14 @@ addValArgTo ai arg hole_ty
   = ai { ai_args    = arg_spec : ai_args ai
        , ai_dmds    = dmds
        , ai_discs   = discs
-       , ai_rewrite = decArgCount rew }
+       , ai_rewrite = rew }
   | otherwise
   = pprPanic "addValArgTo" (ppr ai $$ ppr arg)
     -- There should always be enough demands and discounts
 
 addTyArgTo :: ArgInfo -> OutType -> OutType -> ArgInfo
 addTyArgTo ai arg_ty hole_ty = ai { ai_args    = arg_spec : ai_args ai
-                                  , ai_rewrite = decArgCount (ai_rewrite ai) }
+                                  , ai_rewrite = ai_rewrite ai }
   where
     arg_spec = TyArg { as_arg_ty = arg_ty, as_hole_ty = hole_ty }
 
@@ -434,10 +435,6 @@ argInfoExpr fun rev_args
     go (TyArg { as_arg_ty = ty } : as) = go as `App` Type ty
     go (CastBy co                : as) = mkCast (go as) co
 
-decArgCount :: RewriteCall -> RewriteCall
-decArgCount (TryRules n rules) = TryRules (n-1) rules
-decArgCount rew                = rew
-
 mkRewriteCall :: Id -> RuleEnv -> RewriteCall
 -- See Note [Rewrite rules and inlining] in GHC.Core.Opt.Simplify.Iteration
 -- We try to skip any unnecessary stages:
@@ -447,11 +444,10 @@ mkRewriteCall :: Id -> RuleEnv -> RewriteCall
 -- quite a heavy hammer, so skipping stages is a good plan.
 -- And it's extremely simple to do.
 mkRewriteCall fun rule_env
-  | not (null rules) = TryRules n_required rules
+  | not (null rules) = TryRules rules
   | canUnfold unf    = TryInlining
   | otherwise        = TryNothing
   where
-    n_required = maximum (map ruleArity rules)
     rules = getRules rule_env fun
     unf   = idUnfolding fun
 
@@ -569,11 +565,25 @@ countValArgs (CastIt     { sc_cont = cont }) = countValArgs cont
 countValArgs _                               = 0
 
 -------------------
-contArgs :: SimplCont -> (Bool, [ArgSummary], SimplCont)
+
+-- | Get the ArgSpecs of the continuation arguments given the function demands.
+-- The returned continuation is stripped of the args.
+contArgsSpec :: [Demand] -> SimplCont -> ([ArgSpec], SimplCont)
+contArgsSpec ds (ApplyToTy  { sc_arg_ty = arg
+                            , sc_hole_ty = hole
+                            , sc_cont = cont }) = first (TyArg arg hole :) (contArgsSpec ds cont)
+contArgsSpec (d:ds) (ApplyToVal
+                            { sc_arg = arg
+                            , sc_hole_ty = hole
+                            , sc_cont = cont }) = first (ValArg d arg hole :) (contArgsSpec ds cont)
+contArgsSpec ds (CastIt     { sc_cont = cont }) = contArgsSpec ds cont
+contArgsSpec _ cont                            = ([], cont)
+
+contArgsSummary :: SimplCont -> (Bool, [ArgSummary], SimplCont)
 -- Summarises value args, discards type args and coercions
 -- The returned continuation of the call is only used to
 -- answer questions like "are you interesting?"
-contArgs cont
+contArgsSummary cont
   | lone cont = (True, [], cont)
   | otherwise = go [] cont
   where



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/346f8a6912f4b5702b987cbb20f08fc87e6f5a46

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/346f8a6912f4b5702b987cbb20f08fc87e6f5a46
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/20240819/94695dc3/attachment-0001.html>


More information about the ghc-commits mailing list