[Git][ghc/ghc][wip/T24868] Wibbles

[Simon Peyton Jones (@simonpj)]

Simon Peyton Jones pushed to branch wip/T24868 at Glasgow Haskell Compiler / GHC


Commits:
72d47066 by Simon Peyton Jones at 2024-05-30T17:40:44+01:00
Wibbles

- - - - -


2 changed files:

- compiler/GHC/Core/TyCo/Tidy.hs
- compiler/GHC/Types/Name/Occurrence.hs


Changes:

=====================================
compiler/GHC/Core/TyCo/Tidy.hs
=====================================
@@ -19,7 +19,6 @@ import GHC.Data.FastString
 
 import GHC.Core.TyCo.Rep
 import GHC.Core.TyCo.FVs (tyCoVarsOfTypesWellScoped, tyCoVarsOfTypeList)
-
 import GHC.Data.Maybe (orElse)
 import GHC.Types.Name hiding (varName)
 import GHC.Types.Var
@@ -220,22 +219,40 @@ This is done by `tidyAvoiding`.
 
 The last step is very important; if we leave "a" in the TidyOccEnv, when
 we get to the (forall a. blah) we'll rename `a` to "a2", avoiding "a".
+
+Note [Tidying open types]
+~~~~~~~~~~~~~~~~~~~~~~~~~
+When tidying some open types [t1,..,tn]`, we find their free vars, and tidy them first.
+
+But (tricky point) we restrict the occ_env part of inner_env to just the /free/
+vars of [t1..tn], so that we don't gratuitously rename the /bound/ variables.
+
+Example: [a_1, forall a_2. Maybe a_2, forall a_3. (a_3,a_1)]
+All the a's have the same OccName, but different uniques.
+We'd like to tidy this to:
+    [a, forall a. Maybe a, forall a1. (a1, a)]
+We can see:
+ * The first forall re-uses `a` as its bound variable. Renaming it because
+   there is another `a` somewhere else entirely makes the typechecker's error
+   messages significantly worse.
+ * The second forall must use a new name (here "a1") because `a` already
+   occurs free in the body.
+
+Ideally we'd like to do this at every forall, but we make do with doing it
+once at the top level of `tidyOpenTypes`, and that turns out quite well.
 -}
 ---------------
 -- | Grabs the free type variables, tidies them
 -- and then uses 'tidyType' to work over the type itself
 tidyOpenTypes :: TidyEnv -> [Type] -> (TidyEnv, [Type])
 tidyOpenTypes env tys
-  = (env', tidyTypes env' tys)
+  = (env', tidyTypes inner_env tys)
   where
-    (env'@(_, _var_env), _tvs') = tidyOpenTyCoVars env $
-                                  tyCoVarsOfTypesWellScoped tys
--- Does not look right
---    trimmed_env = (trimmed_occ_env, var_env)
---    trimmed_occ_env = initTidyOccEnv (map getOccName tvs')
-      -- The idea here was that we restrict the new TidyEnv to the
-      -- _free_ vars of the types, so that we don't gratuitously rename
-      -- the _bound_ variables of the types.
+    free_tvs = tyCoVarsOfTypesWellScoped tys
+    (env'@(occ_env, var_env), _) = tidyOpenTyCoVars env free_tvs
+    trimmed_occ_env = trimTidyOccEnv occ_env (map getOccName free_tvs)
+    inner_env = (trimmed_occ_env, var_env)
+    -- inner_env: see Note [Tidying open types]
 
 ---------------
 tidyOpenType :: TidyEnv -> Type -> (TidyEnv, Type)


=====================================
compiler/GHC/Types/Name/Occurrence.hs
=====================================
@@ -106,7 +106,7 @@ module GHC.Types.Name.Occurrence (
         mainOcc, ppMainFn,
 
         -- * Tidying up
-        TidyOccEnv, emptyTidyOccEnv, initTidyOccEnv,
+        TidyOccEnv, emptyTidyOccEnv, initTidyOccEnv, trimTidyOccEnv,
         tidyOccName, avoidClashesOccEnv, delTidyOccEnvList,
 
         -- FsEnv
@@ -1142,7 +1142,7 @@ tack on the '1', if necessary.
 
 Note [TidyOccEnv]
 ~~~~~~~~~~~~~~~~~
-type TidyOccEnv = UniqFM Int
+type TidyOccEnv = UniqFM FastString Int
 
 * Domain = The OccName's FastString. These FastStrings are "taken";
            make sure that we don't re-use
@@ -1262,6 +1262,16 @@ tidyOccName env occ@(OccName occ_sp fs)
                      -- If they are the same (n==1), the former wins
                      -- See Note [TidyOccEnv]
 
+trimTidyOccEnv :: TidyOccEnv -> [OccName] -> TidyOccEnv
+-- Restrict the env to just the [OccName]
+trimTidyOccEnv env vs
+  = foldl' add emptyUFM vs
+  where
+    add :: TidyOccEnv -> OccName -> TidyOccEnv
+    add so_far (OccName _ fs)
+      = case lookupUFM env fs of
+          Just n  -> addToUFM so_far fs n
+          Nothing -> so_far
 
 {-
 ************************************************************************



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

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/72d4706620fd8c74c43924fb5f2fac49d591230e
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/20240530/f62ae8f1/attachment-0001.html>