[Git][ghc/ghc][wip/T23923-mikolaj-take-2] Use explicit recursion in mapTyCo

[Simon Peyton Jones (@simonpj)]

Simon Peyton Jones pushed to branch wip/T23923-mikolaj-take-2 at Glasgow Haskell Compiler / GHC


Commits:
e6cea91c by Simon Peyton Jones at 2024-04-15T17:22:35+01:00
Use explicit recursion in mapTyCo

See Note [Use explicit recursion in mapTyCo]

- - - - -


1 changed file:

- compiler/GHC/Core/Type.hs


Changes:

=====================================
compiler/GHC/Core/Type.hs
=====================================
@@ -925,6 +925,7 @@ mapTyCoX (TyCoMapper { tcm_tyvar = tyvar
                      , tcm_hole = cohole })
   = (go_ty, go_tys, go_co, go_cos)
   where
+    -- See Note [Use explicit recursion in mapTyCo]
     go_tys !_   []       = return []
     go_tys !env (ty:tys) = (:) <$> go_ty env ty <*> go_tys env tys
 
@@ -955,6 +956,7 @@ mapTyCoX (TyCoMapper { tcm_tyvar = tyvar
            ; inner' <- go_ty env' inner
            ; return $ ForAllTy (Bndr tv' vis) inner' }
 
+    -- See Note [Use explicit recursion in mapTyCo]
     go_cos !_   []       = return []
     go_cos !env (co:cos) = (:) <$> go_co env co <*> go_cos env cos
 
@@ -1001,15 +1003,28 @@ mapTyCoX (TyCoMapper { tcm_tyvar = tyvar
 
     go_prov !env (PhantomProv co)    = PhantomProv <$> go_co env co
     go_prov !env (ProofIrrelProv co) = ProofIrrelProv <$> go_co env co
-    go_prov !env (PluginProv s cvs)  = PluginProv s <$> strictFoldDVarSet (do_cv env)
-                                                          (return emptyDVarSet) cvs
-
-    do_cv :: env -> CoVar -> m DTyCoVarSet -> m DTyCoVarSet
-    do_cv env v mfvs = do { fvs <- mfvs
-                          ; co  <- covar env v
-                          ; return (tyCoVarsOfCoDSet co `unionDVarSet` fvs) }
-
-
+    go_prov !env (PluginProv s cvs)  = PluginProv s <$> go_fcvs env (dVarSetElems cvs)
+
+    -- See Note [Use explicit recursion in mapTyCo]
+    go_fcvs :: env -> [CoVar] -> m DTyCoVarSet
+    go_fcvs env []       = return emptyDVarSet
+    go_fcvs env (cv:cvs) = do { co   <- covar env cv
+                              ; cvs' <- go_fcvs env cvs
+                              ; return (tyCoVarsOfCoDSet co `unionDVarSet` cvs') }
+
+{- Note [Use explicit recursion in mapTyCo]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+We use explicit recursion in `mapTyCo`, rather than calling, say, `strictFoldDVarSet`,
+for exactly the same reason as in Note [Use explicit recursion in foldTyCo] in
+GHC.Core.TyCo.Rep. We are in a monadic context, and using too-clever higher order
+functions makes the strictness analyser produce worse results.
+
+We could probably use `foldr`, since it is inlined bodily, fairly early; but
+I'm doing the simple thing and inlining it by hand.
+
+See !12037 for performance glitches caused by using `strictFoldDVarSet` (which is
+definitely not inlined bodily).
+-}
 
 {- *********************************************************************
 *                                                                      *



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

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e6cea91c42360fbd36366cd9f5e1081266109593
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/20240415/1576fd0f/attachment-0001.html>