[Git][ghc/ghc][wip/sjakobi/nondetfolds] 2 commits: Rename intMapToUFM

Simon Jakobi gitlab at gitlab.haskell.org
Thu Apr 2 12:09:18 UTC 2020



Simon Jakobi pushed to branch wip/sjakobi/nondetfolds at Glasgow Haskell Compiler / GHC


Commits:
560caaf0 by Simon Jakobi at 2020-04-02T14:01:45+02:00
Rename intMapToUFM

- - - - -
e3e80611 by Simon Jakobi at 2020-04-02T14:08:58+02:00
Move varSetMinEvBindmap to a better location

- - - - -


4 changed files:

- compiler/GHC/Types/Unique/DFM.hs
- compiler/GHC/Types/Unique/FM.hs
- compiler/typecheck/TcEvidence.hs
- compiler/typecheck/TcSimplify.hs


Changes:

=====================================
compiler/GHC/Types/Unique/DFM.hs
=====================================
@@ -72,7 +72,7 @@ import Data.Functor.Classes (Eq1 (..))
 import Data.List (sortBy)
 import Data.Function (on)
 import qualified Data.Semigroup as Semi
-import GHC.Types.Unique.FM (UniqFM, nonDetUFMToList, ufmToIntMap, intMapToUFM)
+import GHC.Types.Unique.FM (UniqFM, nonDetUFMToList, ufmToIntMap, unsafeIntMapToUFM)
 
 -- Note [Deterministic UniqFM]
 -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -340,7 +340,7 @@ udfmMinusUFM (UDFM x i) y = UDFM (M.difference x (ufmToIntMap y)) i
   -- bound.
 
 ufmMinusUDFM :: UniqFM elt1 -> UniqDFM elt2 -> UniqFM elt1
-ufmMinusUDFM x (UDFM y _i) = intMapToUFM (M.difference (ufmToIntMap x) y)
+ufmMinusUDFM x (UDFM y _i) = unsafeIntMapToUFM (M.difference (ufmToIntMap x) y)
 
 -- | Partition UniqDFM into two UniqDFMs according to the predicate
 partitionUDFM :: (elt -> Bool) -> UniqDFM elt -> (UniqDFM elt, UniqDFM elt)
@@ -354,7 +354,7 @@ delListFromUDFM = foldl' delFromUDFM
 
 -- | This allows for lossy conversion from UniqDFM to UniqFM
 udfmToUfm :: UniqDFM elt -> UniqFM elt
-udfmToUfm (UDFM m _i) = intMapToUFM (M.map taggedFst m)
+udfmToUfm (UDFM m _i) = unsafeIntMapToUFM (M.map taggedFst m)
 
 listToUDFM :: Uniquable key => [(key,elt)] -> UniqDFM elt
 listToUDFM = foldl' (\m (k, v) -> addToUDFM m k v) emptyUDFM


=====================================
compiler/GHC/Types/Unique/FM.hs
=====================================
@@ -67,7 +67,7 @@ module GHC.Types.Unique.FM (
         lookupWithDefaultUFM, lookupWithDefaultUFM_Directly,
         nonDetEltsUFM, eltsUFM, nonDetKeysUFM,
         ufmToSet_Directly,
-        nonDetUFMToList, ufmToIntMap, intMapToUFM,
+        nonDetUFMToList, ufmToIntMap, unsafeIntMapToUFM,
         pprUniqFM, pprUFM, pprUFMWithKeys, pluralUFM
     ) where
 
@@ -359,8 +359,8 @@ instance Traversable NonDetUniqFM where
 ufmToIntMap :: UniqFM elt -> M.IntMap elt
 ufmToIntMap (UFM m) = m
 
-intMapToUFM :: M.IntMap elt -> UniqFM elt
-intMapToUFM = UFM
+unsafeIntMapToUFM :: M.IntMap elt -> UniqFM elt
+unsafeIntMapToUFM = UFM
 
 -- Determines whether two 'UniqFM's contain the same keys.
 equalKeysUFM :: UniqFM a -> UniqFM b -> Bool


=====================================
compiler/typecheck/TcEvidence.hs
=====================================
@@ -20,6 +20,7 @@ module TcEvidence (
   filterEvBindMap,
   isEmptyEvBindMap,
   evBindMapToVarSet,
+  varSetMinusEvBindMap,
   EvBind(..), emptyTcEvBinds, isEmptyTcEvBinds, mkGivenEvBind, mkWantedEvBind,
   evBindVar, isCoEvBindsVar,
 
@@ -514,6 +515,9 @@ filterEvBindMap k (EvBindMap { ev_bind_varenv = env })
 evBindMapToVarSet :: EvBindMap -> VarSet
 evBindMapToVarSet (EvBindMap dve) = unsafeUFMToUniqSet (mapUFM evBindVar (udfmToUfm dve))
 
+varSetMinusEvBindMap :: VarSet -> EvBindMap -> VarSet
+varSetMinusEvBindMap vs (EvBindMap dve) = vs `uniqSetMinusUDFM` dve
+
 instance Outputable EvBindMap where
   ppr (EvBindMap m) = ppr m
 


=====================================
compiler/typecheck/TcSimplify.hs
=====================================
@@ -1892,9 +1892,6 @@ neededEvVars implic@(Implic { ic_given = givens
      | is_given  = ev_var `elemVarSet` needed
      | otherwise = True   -- Keep all wanted bindings
 
-   varSetMinusEvBindMap :: VarSet -> EvBindMap -> VarSet
-   varSetMinusEvBindMap vs ebm = uniqSetMinusUDFM vs (ev_bind_varenv ebm)
-
    add_wanted :: EvBind -> VarSet -> VarSet
    add_wanted (EvBind { eb_is_given = is_given, eb_rhs = rhs }) needs
      | is_given  = needs  -- Add the rhs vars of the Wanted bindings only



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3e0f14115156921c5bb21e239542e0ad6646e701...e3e80611a705aad258c4da9cc200caee66f063c9

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3e0f14115156921c5bb21e239542e0ad6646e701...e3e80611a705aad258c4da9cc200caee66f063c9
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/20200402/e37ea5c5/attachment-0001.html>


More information about the ghc-commits mailing list