[Git][ghc/ghc][wip/cfuneqcan-refactor] 3 commits: inline finish

[Richard Eisenberg]

Richard Eisenberg pushed to branch wip/cfuneqcan-refactor at Glasgow Haskell Compiler / GHC


Commits:
47433e63 by Richard Eisenberg at 2020-11-24T14:32:10+00:00
inline finish

- - - - -
5300222f by Richard Eisenberg at 2020-11-24T14:49:55+00:00
Use a flag on `finish`

- - - - -
6079d4e0 by Richard Eisenberg at 2020-11-24T15:05:29+00:00
Don't avoid adding inerts to cache

- - - - -


1 changed file:

- compiler/GHC/Tc/Solver/Rewrite.hs


Changes:

=====================================
compiler/GHC/Tc/Solver/Rewrite.hs
=====================================
@@ -781,10 +781,9 @@ rewrite_exact_fam_app tc tys
        -- STEP 1/2. Try to reduce without reducing arguments first.
        ; result1 <- try_to_reduce tc tys
        ; case result1 of
-             -- Don't use `finish`;
+             -- Don't use the cache;
              -- See Note [rewrite_exact_fam_app performance]
-         { Just (co, xi) -> do { (xi2, co2) <- bumpDepth $ rewrite_one xi
-                               ; return (xi2, co2 `mkTcTransCo` co) }
+         { Just (co, xi) -> finish False (xi, co)
          ; Nothing ->
 
         -- That didn't work. So reduce the arguments, in STEP 3.
@@ -817,7 +816,10 @@ rewrite_exact_fam_app tc tys
              | fr `eqCanRewriteFR` (flavour, eq_rel) ->
                  do { traceRewriteM "rewrite family application with inert"
                                 (ppr tc <+> ppr xis $$ ppr xi)
-                    ; finish (homogenise xi downgraded_co) }
+                    ; finish True (homogenise xi downgraded_co) }
+               -- this will sometimes duplicate an inert in the cache,
+               -- but avoiding doing so had no impact on performance, and
+               -- it seems easier not to weed out that special case
              where
                inert_role    = eqRelRole inert_eq_rel
                role          = eqRelRole eq_rel
@@ -829,7 +831,7 @@ rewrite_exact_fam_app tc tys
          -- inert didn't work. Try to reduce again, in STEP 5/6.
     do { result3 <- try_to_reduce tc xis
        ; case result3 of
-           Just (co, xi) -> finish (homogenise xi co)
+           Just (co, xi) -> finish True (homogenise xi co)
            Nothing       -> -- we have made no progress at all: STEP 7.
                             return (homogenise reduced (mkTcReflCo role reduced))
              where
@@ -837,20 +839,23 @@ rewrite_exact_fam_app tc tys
   where
       -- call this if the above attempts made progress.
       -- This recursively rewrites the result and then adds to the cache
-    finish :: (Xi, Coercion) -> RewriteM (Xi, Coercion)
-    finish (xi, co) = do { -- rewrite the result: FINISH 1
-                           (fully, fully_co) <- bumpDepth $ rewrite_one xi
-                         ; let final_co = fully_co `mkTcTransCo` co
-                         ; eq_rel <- getEqRel
-                         ; flavour <- getFlavour
-
-                           -- extend the cache: FINISH 2
-                         ; when (eq_rel == NomEq && flavour /= Derived) $
-                             -- the cache only wants Nominal eqs
-                             -- and Wanteds can rewrite Deriveds; the cache
-                             -- has only Givens
-                           liftTcS $ extendFamAppCache tc tys (final_co, fully)
-                         ; return (fully, final_co) }
+    finish :: Bool  -- add to the cache?
+           -> (Xi, Coercion) -> RewriteM (Xi, Coercion)
+    finish use_cache (xi, co)
+      = do { -- rewrite the result: FINISH 1
+             (fully, fully_co) <- bumpDepth $ rewrite_one xi
+           ; let final_co = fully_co `mkTcTransCo` co
+           ; eq_rel <- getEqRel
+           ; flavour <- getFlavour
+
+             -- extend the cache: FINISH 2
+           ; when (use_cache && eq_rel == NomEq && flavour /= Derived) $
+             -- the cache only wants Nominal eqs
+             -- and Wanteds can rewrite Deriveds; the cache
+             -- has only Givens
+             liftTcS $ extendFamAppCache tc tys (final_co, fully)
+           ; return (fully, final_co) }
+    {-# INLINE finish #-}
 
 -- Returned coercion is output ~r input, where r is the role in the RewriteM monad
 -- See Note [How to normalise a family application]



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a18f2dddfbb68800c8ce2fa18488d2d2e5eca983...6079d4e093d5c41a0f1bfb637578fa1977eb8d3b

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a18f2dddfbb68800c8ce2fa18488d2d2e5eca983...6079d4e093d5c41a0f1bfb637578fa1977eb8d3b
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/20201124/f7d41759/attachment-0001.html>