4 files changed, 15 insertions, 7 deletions
diff --git a/compiler/GHC/HsToCore/Monad.hs b/compiler/GHC/HsToCore/Monad.hs
index 0cd715634a..f803939da6 100644
--- a/compiler/GHC/HsToCore/Monad.hs
+++ b/compiler/GHC/HsToCore/Monad.hs
@@ -86,7 +86,7 @@ import GHC.Types.Name.Env
 import GHC.Driver.Session
 import GHC.Utils.Error
 import GHC.Data.FastString
-import GHC.Types.Unique.FM ( lookupWithDefaultUFM )
+import GHC.Types.Unique.FM ( lookupWithDefaultUFM_Directly )
 import GHC.Types.Literal ( mkLitString )
 import GHC.Types.CostCentre.State
 
@@ -533,7 +533,10 @@ dsGetCompleteMatches :: TyCon -> DsM [CompleteMatch]
 dsGetCompleteMatches tc = do
   eps <- getEps
   env <- getGblEnv
-  let lookup_completes ufm = lookupWithDefaultUFM ufm [] tc
+      -- We index into a UniqFM from Name -> elt, for tyCon it holds that
+      -- getUnique (tyConName tc) == getUnique tc. So we lookup using the
+      -- unique directly instead.
+  let lookup_completes ufm = lookupWithDefaultUFM_Directly ufm [] (getUnique tc)
       eps_matches_list = lookup_completes $ eps_complete_matches eps
       env_matches_list = lookup_completes $ ds_complete_matches env
   return $ eps_matches_list ++ env_matches_list
diff --git a/compiler/GHC/HsToCore/PmCheck/Oracle.hs b/compiler/GHC/HsToCore/PmCheck/Oracle.hs
index 7a213ce7ef..361ea04971 100644
--- a/compiler/GHC/HsToCore/PmCheck/Oracle.hs
+++ b/compiler/GHC/HsToCore/PmCheck/Oracle.hs
@@ -781,7 +781,7 @@ lookupRefuts :: Uniquable k => Delta -> k -> [PmAltCon]
 -- Unfortunately we need the extra bit of polymorphism and the unfortunate
 -- duplication of lookupVarInfo here.
 lookupRefuts MkDelta{ delta_tm_st = ts@(TmSt (SDIE env) _) } k =
-  case lookupUDFM env k of
+  case lookupUDFM_Directly env (getUnique k) of
     Nothing -> []
     Just (Indirect y) -> pmAltConSetElems (vi_neg (lookupVarInfo ts y))
     Just (Entry vi)   -> pmAltConSetElems (vi_neg vi)
diff --git a/compiler/GHC/HsToCore/PmCheck/Ppr.hs b/compiler/GHC/HsToCore/PmCheck/Ppr.hs
index 5b1fe16ba1..e4358e78b6 100644
--- a/compiler/GHC/HsToCore/PmCheck/Ppr.hs
+++ b/compiler/GHC/HsToCore/PmCheck/Ppr.hs
@@ -98,7 +98,7 @@ substitution to the vectors before printing them out (see function `pprOne' in
 -- | Extract and assigns pretty names to constraint variables with refutable
 -- shapes.
 prettifyRefuts :: Delta -> DIdEnv SDoc -> DIdEnv (SDoc, [PmAltCon])
-prettifyRefuts delta = listToUDFM . map attach_refuts . udfmToList
+prettifyRefuts delta = listToUDFM_Directly . map attach_refuts . udfmToList
   where
     attach_refuts (u, sdoc) = (u, (sdoc, lookupRefuts delta u))
 
diff --git a/compiler/GHC/HsToCore/PmCheck/Types.hs b/compiler/GHC/HsToCore/PmCheck/Types.hs
index 9267555380..2d551fc1aa 100644
--- a/compiler/GHC/HsToCore/PmCheck/Types.hs
+++ b/compiler/GHC/HsToCore/PmCheck/Types.hs
@@ -6,6 +6,8 @@ Author: George Karachalias <george.karachalias@cs.kuleuven.be>
 {-# LANGUAGE CPP #-}
 {-# LANGUAGE ViewPatterns #-}
 {-# LANGUAGE TupleSections #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE ApplicativeDo #-}
 
 -- | Types used through-out pattern match checking. This module is mostly there
 -- to be imported from "GHC.Tc.Types". The exposed API is that of
@@ -458,11 +460,14 @@ setEntrySDIE :: SharedDIdEnv a -> Id -> a -> SharedDIdEnv a
 setEntrySDIE sdie@(SDIE env) x a =
   SDIE $ extendDVarEnv env (fst (lookupReprAndEntrySDIE sdie x)) (Entry a)
 
-traverseSDIE :: Applicative f => (a -> f b) -> SharedDIdEnv a -> f (SharedDIdEnv b)
-traverseSDIE f = fmap (SDIE . listToUDFM) . traverse g . udfmToList . unSDIE
+traverseSDIE :: forall a b f. Applicative f => (a -> f b) -> SharedDIdEnv a -> f (SharedDIdEnv b)
+traverseSDIE f = fmap (SDIE . listToUDFM_Directly) . traverse g . udfmToList . unSDIE
   where
+    g :: (Unique, Shared a) -> f (Unique, Shared b)
     g (u, Indirect y) = pure (u,Indirect y)
-    g (u, Entry a)    = (u,) . Entry <$> f a
+    g (u, Entry a)    = do
+        a' <- f a
+        pure (u,Entry a')
 
 instance Outputable a => Outputable (Shared a) where
   ppr (Indirect x) = ppr x