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.

3 files changed, 6 insertions, 6 deletions

diff --git a/compiler/GHC/Cmm/LayoutStack.hs b/compiler/GHC/Cmm/LayoutStack.hs
index b8cf2c4900..689e5a0e46 100644
--- a/compiler/GHC/Cmm/LayoutStack.hs
+++ b/compiler/GHC/Cmm/LayoutStack.hs
@@ -224,7 +224,7 @@ data StackMap = StackMap
  ,  sm_ret_off :: ByteOff
        -- ^ Number of words of stack that we do not describe with an info
        -- table, because it contains an update frame.
- ,  sm_regs :: UniqFM (LocalReg,StackLoc)
+ ,  sm_regs :: UniqFM LocalReg (LocalReg,StackLoc)
        -- ^ regs on the stack
  }
 
diff --git a/compiler/GHC/Cmm/Parser.y b/compiler/GHC/Cmm/Parser.y
index cadda66b11..eeab41df7b 100644
--- a/compiler/GHC/Cmm/Parser.y
+++ b/compiler/GHC/Cmm/Parser.y
@@ -907,7 +907,7 @@ exprOp name args_code = do
         mo <- nameToMachOp name
         return $ mkMachOp mo args_code
 
-exprMacros :: DynFlags -> UniqFM ([CmmExpr] -> CmmExpr)
+exprMacros :: DynFlags -> UniqFM FastString ([CmmExpr] -> CmmExpr)
 exprMacros dflags = listToUFM [
   ( fsLit "ENTRY_CODE",   \ [x] -> entryCode platform x ),
   ( fsLit "INFO_PTR",     \ [x] -> closureInfoPtr dflags x ),
@@ -990,7 +990,7 @@ machOps = listToUFM $
         ( "i2f64",    flip MO_SF_Conv W64 )
         ]
 
-callishMachOps :: UniqFM ([CmmExpr] -> (CallishMachOp, [CmmExpr]))
+callishMachOps :: UniqFM FastString ([CmmExpr] -> (CallishMachOp, [CmmExpr]))
 callishMachOps = listToUFM $
         map (\(x, y) -> (mkFastString x, y)) [
         ( "read_barrier", (MO_ReadBarrier,)),
@@ -1090,7 +1090,7 @@ stmtMacro fun args_code = do
         args <- sequence args_code
         code (fcode args)
 
-stmtMacros :: UniqFM ([CmmExpr] -> FCode ())
+stmtMacros :: UniqFM FastString ([CmmExpr] -> FCode ())
 stmtMacros = listToUFM [
   ( fsLit "CCS_ALLOC",             \[words,ccs]  -> profAlloc words ccs ),
   ( fsLit "ENTER_CCS_THUNK",       \[e] -> enterCostCentreThunk e ),
diff --git a/compiler/GHC/Cmm/Sink.hs b/compiler/GHC/Cmm/Sink.hs
index 8c32ab01aa..bd8c19d2d3 100644
--- a/compiler/GHC/Cmm/Sink.hs
+++ b/compiler/GHC/Cmm/Sink.hs
@@ -420,7 +420,7 @@ tryToInline
 
 tryToInline dflags live node assigs = go usages node emptyLRegSet assigs
  where
-  usages :: UniqFM Int -- Maps each LocalReg to a count of how often it is used
+  usages :: UniqFM LocalReg Int -- Maps each LocalReg to a count of how often it is used
   usages = foldLocalRegsUsed dflags addUsage emptyUFM node
 
   go _usages node _skipped [] = (node, [])
@@ -553,7 +553,7 @@ improveConditional other = other
 -- inline y, and we have a dead assignment to x.  If we don't notice
 -- that x is dead in tryToInline, we end up retaining it.
 
-addUsage :: UniqFM Int -> LocalReg -> UniqFM Int
+addUsage :: UniqFM LocalReg Int -> LocalReg -> UniqFM LocalReg Int
 addUsage m r = addToUFM_C (+) m r 1
 
 regsUsedIn :: LRegSet -> CmmExpr -> Bool