From c4de6a7a5c6433ae8c4df8a9fa09fbd9f3bbd0bf Mon Sep 17 00:00:00 2001
From: Andreas Klebinger <klebinger.andreas@gmx.at>
Date: Tue, 23 Jun 2020 15:01:25 +0200
Subject: Give Uniq[D]FM a phantom type for its key.

This fixes #17667 and should help to avoid such issues going forward.

The changes are mostly mechanical in nature. With two notable
exceptions.

* The register allocator.

  The register allocator references registers by distinct uniques.
  However they come from the types of VirtualReg, Reg or Unique in
  various places. As a result we sometimes cast the key type of the
  map and use functions which operate on the now typed map but take
  a raw Unique as actual key. The logic itself has not changed it
  just becomes obvious where we do so now.

* <Type>Env Modules.

As an example a ClassEnv is currently queried using the types `Class`,
`Name`, and `TyCon`. This is safe since for a distinct class value all
these expressions give the same unique.

    getUnique cls
    getUnique (classTyCon cls)
    getUnique (className cls)
    getUnique (tcName $ classTyCon cls)

This is for the most part contained within the modules defining the
interface. However it requires us to play dirty when we are given a
`Name` to lookup in a `UniqFM Class a` map. But again the logic did
not change and it's for the most part hidden behind the Env Module.

Some of these cases could be avoided by refactoring but this is left
for future work.

We also bump the haddock submodule as it uses UniqFM.
---
 compiler/GHC/Unit/Module/Env.hs | 5 +++--
 compiler/GHC/Unit/State.hs      | 2 +-
 2 files changed, 4 insertions(+), 3 deletions(-)

(limited to 'compiler/GHC/Unit')

diff --git a/compiler/GHC/Unit/Module/Env.hs b/compiler/GHC/Unit/Module/Env.hs
index 3d01b21c08..cf056e2bdf 100644
--- a/compiler/GHC/Unit/Module/Env.hs
+++ b/compiler/GHC/Unit/Module/Env.hs
@@ -32,6 +32,7 @@ where
 
 import GHC.Prelude
 
+import GHC.Unit.Module.Name (ModuleName)
 import GHC.Types.Unique
 import GHC.Types.Unique.FM
 import GHC.Types.Unique.DFM
@@ -191,12 +192,12 @@ UniqFM.
 -}
 
 -- | A map keyed off of 'ModuleName's (actually, their 'Unique's)
-type ModuleNameEnv elt = UniqFM elt
+type ModuleNameEnv elt = UniqFM ModuleName elt
 
 
 -- | A map keyed off of 'ModuleName's (actually, their 'Unique's)
 -- Has deterministic folds and can be deterministically converted to a list
-type DModuleNameEnv elt = UniqDFM elt
+type DModuleNameEnv elt = UniqDFM ModuleName elt
 
 
 --------------------------------------------------------------------
diff --git a/compiler/GHC/Unit/State.hs b/compiler/GHC/Unit/State.hs
index 6bc073fc27..2efd9626e6 100644
--- a/compiler/GHC/Unit/State.hs
+++ b/compiler/GHC/Unit/State.hs
@@ -1730,7 +1730,7 @@ mkModuleNameProvidersMap ctx cfg pkg_map closure vis_map =
             in (pk', m', fromReexportedModules e pkg')
      return (m, mkModMap pk' m' origin')
 
-    esmap :: UniqFM (Map Module ModuleOrigin)
+    esmap :: UniqFM ModuleName (Map Module ModuleOrigin)
     esmap = listToUFM (es False) -- parameter here doesn't matter, orig will
                                  -- be overwritten
 
-- 
cgit v1.2.1