[Git][ghc/ghc][wip/mixed-uniqfm] Fixfixfix

[Sebastian Graf (@sgraf812)]

Sebastian Graf pushed to branch wip/mixed-uniqfm at Glasgow Haskell Compiler / GHC


Commits:
8e122c96 by Sebastian Graf at 2023-10-18T22:26:58+02:00
Fixfixfix

- - - - -


3 changed files:

- compiler/GHC/Types/Unique/DFM.hs
- compiler/GHC/Types/Unique/FM.hs
- compiler/GHC/Types/Var/Env.hs


Changes:

=====================================
compiler/GHC/Types/Unique/DFM.hs
=====================================
@@ -398,7 +398,7 @@ listToUDFM_Directly = foldl' (\m (u, v) -> addToUDFM_Directly m u v) emptyUDFM
 
 -- | Apply a function to a particular element
 adjustUDFM :: Uniquable key => (elt -> elt) -> UniqDFM key elt -> key -> UniqDFM key elt
-adjustUDFM f (UDFM m i) k = UDFM (M.adjust (fmap f) (getMixedKey $ getUnique k) m) i
+adjustUDFM f m k = adjustUDFM_Directly f m (getUnique k)
 
 -- | Apply a function to a particular element
 adjustUDFM_Directly :: (elt -> elt) -> UniqDFM key elt -> Unique -> UniqDFM key elt


=====================================
compiler/GHC/Types/Unique/FM.hs
=====================================
@@ -27,6 +27,7 @@ of arguments of combining function.
 {-# LANGUAGE ScopedTypeVariables #-}
 
 {-# OPTIONS_GHC -Wall #-}
+{-# OPTIONS_GHC -ddump-simpl -ddump-asm -ddump-cmm -ddump-prep -ddump-to-file #-}
 
 module GHC.Types.Unique.FM (
         -- * Unique-keyed mappings
@@ -124,7 +125,7 @@ type role UniqFM representational representational -- Don't allow coerces over t
 -- | https://gist.github.com/degski/6e2069d6035ae04d5d6f64981c995ec2
 mix :: MS.Key -> MS.Key -> MS.Key
 {-# INLINE mix #-}
-mix k x = fromIntegral $ f $ g $ f $ g $ f $ fromIntegral x
+mix k = fromIntegral . f . g . f . g . f . fromIntegral
   where
     f y = (y `shiftR` s) `xor` y
     g z = z * k
@@ -137,15 +138,15 @@ kBACKWARD = 0xCFEE444D8B59A89B
 enc, dec :: MS.Key -> MS.Key
 enc = mix kFORWARD
 dec = mix kBACKWARD
-{-# INLINE enc #-}
-{-# INLINE dec #-}
+{-# NOINLINE enc #-}
+{-# NOINLINE dec #-}
 
 getMixedKey :: Unique -> MS.Key
-{-# NOINLINE getMixedKey #-}
+{-# INLINE getMixedKey #-}
 getMixedKey = enc . getKey
 
 getUnmixedUnique :: MS.Key -> Unique
-{-# NOINLINE getUnmixedUnique #-}
+{-# INLINE getUnmixedUnique #-}
 getUnmixedUnique = mkUniqueGrimily . dec
 
 emptyUFM :: UniqFM key elt
@@ -239,7 +240,7 @@ addToUFM_L f k v (UFM m) =
   coerce $
     M.insertLookupWithKey
       (\_ _n _o -> f k _o _n)
-      (getKey $ getUnique k)
+      (getMixedKey $ getUnique k)
       v
       m
 
@@ -256,7 +257,7 @@ alterUFM_Directly
   -> UniqFM key elt            -- ^ old
   -> Unique                    -- ^ new
   -> UniqFM key elt            -- ^ result
-alterUFM_Directly f (UFM m) k = UFM (M.alter f (getKey k) m)
+alterUFM_Directly f (UFM m) k = UFM (M.alter f (getMixedKey k) m)
 
 -- | Add elements to the map, combining existing values with inserted ones using
 -- the given function.


=====================================
compiler/GHC/Types/Var/Env.hs
=====================================
@@ -78,7 +78,6 @@ module GHC.Types.Var.Env (
     ) where
 
 import GHC.Prelude
-import qualified GHC.Data.Word64Map.Strict as Word64Map -- TODO: Move this to UniqFM
 
 import GHC.Types.Name.Occurrence
 import GHC.Types.Name
@@ -227,14 +226,14 @@ uniqAway' in_scope var
 -- given 'InScopeSet'. This must be used very carefully since one can very easily
 -- introduce non-unique 'Unique's this way. See Note [Local uniques].
 unsafeGetFreshLocalUnique :: InScopeSet -> Unique
-unsafeGetFreshLocalUnique (InScope set) = go (getMixedKey (mkUniqueGrimily (fromIntegral (sizeUniqSet set))))
+unsafeGetFreshLocalUnique (InScope set) = go (fromIntegral (sizeUniqSet set))
   where
     go n
       | let uniq = mkLocalUnique n
-      , Nothing <- Word64Map.lookup (getMixedKey $ uniq) (ufmToIntMap $ getUniqSet set)
+      , Nothing <- lookupUFM_Directly (getUniqSet set) uniq
       = uniq
       | otherwise
-      = go (getMixedKey $ mkUniqueGrimily (n+1))
+      = go (n+1)
 
 {-
 ************************************************************************



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

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8e122c96e692ef7be3138b1be0afc478825265bd
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/20231018/365111b5/attachment-0001.html>