diff options
Diffstat (limited to 'compiler/utils')
| -rw-r--r-- | compiler/utils/Binary.hs | 8 | ||||
| -rw-r--r-- | compiler/utils/BooleanFormula.hs | 6 | ||||
| -rw-r--r-- | compiler/utils/Digraph.hs | 4 | ||||
| -rw-r--r-- | compiler/utils/FV.hs | 8 | ||||
| -rw-r--r-- | compiler/utils/FastStringEnv.hs | 8 | ||||
| -rw-r--r-- | compiler/utils/GraphBase.hs | 4 | ||||
| -rw-r--r-- | compiler/utils/GraphColor.hs | 6 | ||||
| -rw-r--r-- | compiler/utils/GraphOps.hs | 6 | ||||
| -rw-r--r-- | compiler/utils/GraphPpr.hs | 6 | ||||
| -rw-r--r-- | compiler/utils/IOEnv.hs | 2 | ||||
| -rw-r--r-- | compiler/utils/Outputable.hs | 4 | ||||
| -rw-r--r-- | compiler/utils/TrieMap.hs | 8 | ||||
| -rw-r--r-- | compiler/utils/UnVarGraph.hs | 8 | ||||
| -rw-r--r-- | compiler/utils/UniqDFM.hs | 420 | ||||
| -rw-r--r-- | compiler/utils/UniqDSet.hs | 141 | ||||
| -rw-r--r-- | compiler/utils/UniqFM.hs | 416 | ||||
| -rw-r--r-- | compiler/utils/UniqMap.hs | 206 | ||||
| -rw-r--r-- | compiler/utils/UniqSet.hs | 195 |
18 files changed, 39 insertions, 1417 deletions
diff --git a/compiler/utils/Binary.hs b/compiler/utils/Binary.hs index 16d7ccf37d..bedf380d29 100644 --- a/compiler/utils/Binary.hs +++ b/compiler/utils/Binary.hs @@ -64,14 +64,14 @@ module Binary import GhcPrelude -import {-# SOURCE #-} Name (Name) +import {-# SOURCE #-} GHC.Types.Name (Name) import FastString import PlainPanic -import UniqFM +import GHC.Types.Unique.FM import FastMutInt import Fingerprint -import BasicTypes -import SrcLoc +import GHC.Types.Basic +import GHC.Types.SrcLoc import Foreign import Data.Array diff --git a/compiler/utils/BooleanFormula.hs b/compiler/utils/BooleanFormula.hs index a42bb90a1c..76d80eb305 100644 --- a/compiler/utils/BooleanFormula.hs +++ b/compiler/utils/BooleanFormula.hs @@ -24,9 +24,9 @@ import Data.Data import MonadUtils import Outputable import Binary -import SrcLoc -import Unique -import UniqSet +import GHC.Types.SrcLoc +import GHC.Types.Unique +import GHC.Types.Unique.Set ---------------------------------------------------------------------- -- Boolean formula type and smart constructors diff --git a/compiler/utils/Digraph.hs b/compiler/utils/Digraph.hs index e7c838508c..ad5fbf53c3 100644 --- a/compiler/utils/Digraph.hs +++ b/compiler/utils/Digraph.hs @@ -58,8 +58,8 @@ import qualified Data.Set as Set import qualified Data.Graph as G import Data.Graph hiding (Graph, Edge, transposeG, reachable) import Data.Tree -import Unique -import UniqFM +import GHC.Types.Unique +import GHC.Types.Unique.FM {- ************************************************************************ diff --git a/compiler/utils/FV.hs b/compiler/utils/FV.hs index 667d2a3966..f0a35d4100 100644 --- a/compiler/utils/FV.hs +++ b/compiler/utils/FV.hs @@ -28,8 +28,8 @@ module FV ( import GhcPrelude -import Var -import VarSet +import GHC.Types.Var +import GHC.Types.Var.Set -- | Predicate on possible free variables: returns @True@ iff the variable is -- interesting @@ -40,7 +40,7 @@ type InterestingVarFun = Var -> Bool -- When computing free variables, the order in which you get them affects -- the results of floating and specialization. If you use UniqFM to collect -- them and then turn that into a list, you get them in nondeterministic --- order as described in Note [Deterministic UniqFM] in UniqDFM. +-- order as described in Note [Deterministic UniqFM] in GHC.Types.Unique.DFM. -- A naive algorithm for free variables relies on merging sets of variables. -- Merging costs O(n+m) for UniqFM and for UniqDFM there's an additional log @@ -54,7 +54,7 @@ type FV = InterestingVarFun -- Used for filtering sets as we build them type VarAcc = ([Var], VarSet) -- List to preserve ordering and set to check for membership, -- so that the list doesn't have duplicates -- For explanation of why using `VarSet` is not deterministic see - -- Note [Deterministic UniqFM] in UniqDFM. + -- Note [Deterministic UniqFM] in GHC.Types.Unique.DFM. -- Note [FV naming conventions] -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ diff --git a/compiler/utils/FastStringEnv.hs b/compiler/utils/FastStringEnv.hs index 1b4af6cee7..bc151f736b 100644 --- a/compiler/utils/FastStringEnv.hs +++ b/compiler/utils/FastStringEnv.hs @@ -29,14 +29,14 @@ module FastStringEnv ( import GhcPrelude -import UniqFM -import UniqDFM +import GHC.Types.Unique.FM +import GHC.Types.Unique.DFM import Maybes import FastString -- | A non-deterministic set of FastStrings. --- See Note [Deterministic UniqFM] in UniqDFM for explanation why it's not +-- See Note [Deterministic UniqFM] in GHC.Types.Unique.DFM for explanation why it's not -- deterministic and why it matters. Use DFastStringEnv if the set eventually -- gets converted into a list or folded over in a way where the order -- changes the generated code. @@ -82,7 +82,7 @@ filterFsEnv x y = filterUFM x y lookupFsEnv_NF env n = expectJust "lookupFsEnv_NF" (lookupFsEnv env n) -- Deterministic FastStringEnv --- See Note [Deterministic UniqFM] in UniqDFM for explanation why we need +-- See Note [Deterministic UniqFM] in GHC.Types.Unique.DFM for explanation why we need -- DFastStringEnv. type DFastStringEnv a = UniqDFM a -- Domain is FastString diff --git a/compiler/utils/GraphBase.hs b/compiler/utils/GraphBase.hs index a165b003ba..67c362ff00 100644 --- a/compiler/utils/GraphBase.hs +++ b/compiler/utils/GraphBase.hs @@ -14,8 +14,8 @@ where import GhcPrelude -import UniqSet -import UniqFM +import GHC.Types.Unique.Set +import GHC.Types.Unique.FM -- | A fn to check if a node is trivially colorable diff --git a/compiler/utils/GraphColor.hs b/compiler/utils/GraphColor.hs index 70c3f7a7b3..d10b28175c 100644 --- a/compiler/utils/GraphColor.hs +++ b/compiler/utils/GraphColor.hs @@ -20,9 +20,9 @@ import GraphBase import GraphOps import GraphPpr -import Unique -import UniqFM -import UniqSet +import GHC.Types.Unique +import GHC.Types.Unique.FM +import GHC.Types.Unique.Set import Outputable import Data.Maybe diff --git a/compiler/utils/GraphOps.hs b/compiler/utils/GraphOps.hs index c7161f0e32..a1693c6a5a 100644 --- a/compiler/utils/GraphOps.hs +++ b/compiler/utils/GraphOps.hs @@ -25,9 +25,9 @@ import GhcPrelude import GraphBase import Outputable -import Unique -import UniqSet -import UniqFM +import GHC.Types.Unique +import GHC.Types.Unique.Set +import GHC.Types.Unique.FM import Data.List hiding (union) import Data.Maybe diff --git a/compiler/utils/GraphPpr.hs b/compiler/utils/GraphPpr.hs index 2210d07273..4327ec881c 100644 --- a/compiler/utils/GraphPpr.hs +++ b/compiler/utils/GraphPpr.hs @@ -12,9 +12,9 @@ import GhcPrelude import GraphBase import Outputable -import Unique -import UniqSet -import UniqFM +import GHC.Types.Unique +import GHC.Types.Unique.Set +import GHC.Types.Unique.FM import Data.List (mapAccumL) import Data.Maybe diff --git a/compiler/utils/IOEnv.hs b/compiler/utils/IOEnv.hs index 8067123211..fd6f6722cd 100644 --- a/compiler/utils/IOEnv.hs +++ b/compiler/utils/IOEnv.hs @@ -35,7 +35,7 @@ import GhcPrelude import GHC.Driver.Session import Exception -import Module +import GHC.Types.Module import Panic import Data.IORef ( IORef, newIORef, readIORef, writeIORef, modifyIORef, diff --git a/compiler/utils/Outputable.hs b/compiler/utils/Outputable.hs index 6f6a335ed7..c23f6ed180 100644 --- a/compiler/utils/Outputable.hs +++ b/compiler/utils/Outputable.hs @@ -99,8 +99,8 @@ import {-# SOURCE #-} GHC.Driver.Session , pprUserLength, pprCols , unsafeGlobalDynFlags, initSDocContext ) -import {-# SOURCE #-} Module( UnitId, Module, ModuleName, moduleName ) -import {-# SOURCE #-} OccName( OccName ) +import {-# SOURCE #-} GHC.Types.Module( UnitId, Module, ModuleName, moduleName ) +import {-# SOURCE #-} GHC.Types.Name.Occurrence( OccName ) import BufWrite (BufHandle) import FastString diff --git a/compiler/utils/TrieMap.hs b/compiler/utils/TrieMap.hs index 53bb06c4f9..815a060a0c 100644 --- a/compiler/utils/TrieMap.hs +++ b/compiler/utils/TrieMap.hs @@ -31,9 +31,9 @@ module TrieMap( import GhcPrelude -import Literal -import UniqDFM -import Unique( Unique ) +import GHC.Types.Literal +import GHC.Types.Unique.DFM +import GHC.Types.Unique( Unique ) import qualified Data.Map as Map import qualified Data.IntMap as IntMap @@ -198,7 +198,7 @@ solve_simple_wanteds it's merged with other WantedConstraints. We want the conversion to a bag to be deterministic. For that purpose we use UniqDFM instead of UniqFM to implement the TrieMap. -See Note [Deterministic UniqFM] in UniqDFM for more details on how it's made +See Note [Deterministic UniqFM] in GHC.Types.Unique.DFM for more details on how it's made deterministic. -} diff --git a/compiler/utils/UnVarGraph.hs b/compiler/utils/UnVarGraph.hs index a2f3c687bb..20eff96c2c 100644 --- a/compiler/utils/UnVarGraph.hs +++ b/compiler/utils/UnVarGraph.hs @@ -30,12 +30,12 @@ module UnVarGraph import GhcPrelude -import Id -import VarEnv -import UniqFM +import GHC.Types.Id +import GHC.Types.Var.Env +import GHC.Types.Unique.FM import Outputable import Bag -import Unique +import GHC.Types.Unique import qualified Data.IntSet as S diff --git a/compiler/utils/UniqDFM.hs b/compiler/utils/UniqDFM.hs deleted file mode 100644 index f9588e9b0b..0000000000 --- a/compiler/utils/UniqDFM.hs +++ /dev/null @@ -1,420 +0,0 @@ -{- -(c) Bartosz Nitka, Facebook, 2015 - -UniqDFM: Specialised deterministic finite maps, for things with @Uniques@. - -Basically, the things need to be in class @Uniquable@, and we use the -@getUnique@ method to grab their @Uniques@. - -This is very similar to @UniqFM@, the major difference being that the order of -folding is not dependent on @Unique@ ordering, giving determinism. -Currently the ordering is determined by insertion order. - -See Note [Unique Determinism] in Unique for explanation why @Unique@ ordering -is not deterministic. --} - -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE DeriveFunctor #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE TupleSections #-} -{-# OPTIONS_GHC -Wall #-} - -module UniqDFM ( - -- * Unique-keyed deterministic mappings - UniqDFM, -- abstract type - - -- ** Manipulating those mappings - emptyUDFM, - unitUDFM, - addToUDFM, - addToUDFM_C, - addListToUDFM, - delFromUDFM, - delListFromUDFM, - adjustUDFM, - alterUDFM, - mapUDFM, - plusUDFM, - plusUDFM_C, - lookupUDFM, lookupUDFM_Directly, - elemUDFM, - foldUDFM, - eltsUDFM, - filterUDFM, filterUDFM_Directly, - isNullUDFM, - sizeUDFM, - intersectUDFM, udfmIntersectUFM, - intersectsUDFM, - disjointUDFM, disjointUdfmUfm, - equalKeysUDFM, - minusUDFM, - listToUDFM, - udfmMinusUFM, - partitionUDFM, - anyUDFM, allUDFM, - pprUniqDFM, pprUDFM, - - udfmToList, - udfmToUfm, - nonDetFoldUDFM, - alwaysUnsafeUfmToUdfm, - ) where - -import GhcPrelude - -import Unique ( Uniquable(..), Unique, getKey ) -import Outputable - -import qualified Data.IntMap as M -import Data.Data -import Data.Functor.Classes (Eq1 (..)) -import Data.List (sortBy) -import Data.Function (on) -import qualified Data.Semigroup as Semi -import UniqFM (UniqFM, listToUFM_Directly, nonDetUFMToList, ufmToIntMap) - --- Note [Deterministic UniqFM] --- ~~~~~~~~~~~~~~~~~~~~~~~~~~~ --- A @UniqDFM@ is just like @UniqFM@ with the following additional --- property: the function `udfmToList` returns the elements in some --- deterministic order not depending on the Unique key for those elements. --- --- If the client of the map performs operations on the map in deterministic --- order then `udfmToList` returns them in deterministic order. --- --- There is an implementation cost: each element is given a serial number --- as it is added, and `udfmToList` sorts it's result by this serial --- number. So you should only use `UniqDFM` if you need the deterministic --- property. --- --- `foldUDFM` also preserves determinism. --- --- Normal @UniqFM@ when you turn it into a list will use --- Data.IntMap.toList function that returns the elements in the order of --- the keys. The keys in @UniqFM@ are always @Uniques@, so you end up with --- with a list ordered by @Uniques@. --- The order of @Uniques@ is known to be not stable across rebuilds. --- See Note [Unique Determinism] in Unique. --- --- --- There's more than one way to implement this. The implementation here tags --- every value with the insertion time that can later be used to sort the --- values when asked to convert to a list. --- --- An alternative would be to have --- --- data UniqDFM ele = UDFM (M.IntMap ele) [ele] --- --- where the list determines the order. This makes deletion tricky as we'd --- only accumulate elements in that list, but makes merging easier as you --- can just merge both structures independently. --- Deletion can probably be done in amortized fashion when the size of the --- list is twice the size of the set. - --- | A type of values tagged with insertion time -data TaggedVal val = - TaggedVal - val - {-# UNPACK #-} !Int -- ^ insertion time - deriving (Data, Functor) - -taggedFst :: TaggedVal val -> val -taggedFst (TaggedVal v _) = v - -taggedSnd :: TaggedVal val -> Int -taggedSnd (TaggedVal _ i) = i - -instance Eq val => Eq (TaggedVal val) where - (TaggedVal v1 _) == (TaggedVal v2 _) = v1 == v2 - --- | Type of unique deterministic finite maps -data UniqDFM ele = - UDFM - !(M.IntMap (TaggedVal ele)) -- A map where keys are Unique's values and - -- values are tagged with insertion time. - -- The invariant is that all the tags will - -- be distinct within a single map - {-# UNPACK #-} !Int -- Upper bound on the values' insertion - -- time. See Note [Overflow on plusUDFM] - deriving (Data, Functor) - --- | Deterministic, in O(n log n). -instance Foldable UniqDFM where - foldr = foldUDFM - --- | Deterministic, in O(n log n). -instance Traversable UniqDFM where - traverse f = fmap listToUDFM_Directly - . traverse (\(u,a) -> (u,) <$> f a) - . udfmToList - -emptyUDFM :: UniqDFM elt -emptyUDFM = UDFM M.empty 0 - -unitUDFM :: Uniquable key => key -> elt -> UniqDFM elt -unitUDFM k v = UDFM (M.singleton (getKey $ getUnique k) (TaggedVal v 0)) 1 - --- The new binding always goes to the right of existing ones -addToUDFM :: Uniquable key => UniqDFM elt -> key -> elt -> UniqDFM elt -addToUDFM m k v = addToUDFM_Directly m (getUnique k) v - --- The new binding always goes to the right of existing ones -addToUDFM_Directly :: UniqDFM elt -> Unique -> elt -> UniqDFM elt -addToUDFM_Directly (UDFM m i) u v - = UDFM (M.insertWith tf (getKey u) (TaggedVal v i) m) (i + 1) - where - tf (TaggedVal new_v _) (TaggedVal _ old_i) = TaggedVal new_v old_i - -- Keep the old tag, but insert the new value - -- This means that udfmToList typically returns elements - -- in the order of insertion, rather than the reverse - -addToUDFM_Directly_C - :: (elt -> elt -> elt) -- old -> new -> result - -> UniqDFM elt - -> Unique -> elt - -> UniqDFM elt -addToUDFM_Directly_C f (UDFM m i) u v - = UDFM (M.insertWith tf (getKey u) (TaggedVal v i) m) (i + 1) - where - tf (TaggedVal new_v _) (TaggedVal old_v old_i) - = TaggedVal (f old_v new_v) old_i - -- Flip the arguments, because M.insertWith uses (new->old->result) - -- but f needs (old->new->result) - -- Like addToUDFM_Directly, keep the old tag - -addToUDFM_C - :: Uniquable key => (elt -> elt -> elt) -- old -> new -> result - -> UniqDFM elt -- old - -> key -> elt -- new - -> UniqDFM elt -- result -addToUDFM_C f m k v = addToUDFM_Directly_C f m (getUnique k) v - -addListToUDFM :: Uniquable key => UniqDFM elt -> [(key,elt)] -> UniqDFM elt -addListToUDFM = foldl' (\m (k, v) -> addToUDFM m k v) - -addListToUDFM_Directly :: UniqDFM elt -> [(Unique,elt)] -> UniqDFM elt -addListToUDFM_Directly = foldl' (\m (k, v) -> addToUDFM_Directly m k v) - -addListToUDFM_Directly_C - :: (elt -> elt -> elt) -> UniqDFM elt -> [(Unique,elt)] -> UniqDFM elt -addListToUDFM_Directly_C f = foldl' (\m (k, v) -> addToUDFM_Directly_C f m k v) - -delFromUDFM :: Uniquable key => UniqDFM elt -> key -> UniqDFM elt -delFromUDFM (UDFM m i) k = UDFM (M.delete (getKey $ getUnique k) m) i - -plusUDFM_C :: (elt -> elt -> elt) -> UniqDFM elt -> UniqDFM elt -> UniqDFM elt -plusUDFM_C f udfml@(UDFM _ i) udfmr@(UDFM _ j) - -- we will use the upper bound on the tag as a proxy for the set size, - -- to insert the smaller one into the bigger one - | i > j = insertUDFMIntoLeft_C f udfml udfmr - | otherwise = insertUDFMIntoLeft_C f udfmr udfml - --- Note [Overflow on plusUDFM] --- ~~~~~~~~~~~~~~~~~~~~~~~~~~~ --- There are multiple ways of implementing plusUDFM. --- The main problem that needs to be solved is overlap on times of --- insertion between different keys in two maps. --- Consider: --- --- A = fromList [(a, (x, 1))] --- B = fromList [(b, (y, 1))] --- --- If you merge them naively you end up with: --- --- C = fromList [(a, (x, 1)), (b, (y, 1))] --- --- Which loses information about ordering and brings us back into --- non-deterministic world. --- --- The solution I considered before would increment the tags on one of the --- sets by the upper bound of the other set. The problem with this approach --- is that you'll run out of tags for some merge patterns. --- Say you start with A with upper bound 1, you merge A with A to get A' and --- the upper bound becomes 2. You merge A' with A' and the upper bound --- doubles again. After 64 merges you overflow. --- This solution would have the same time complexity as plusUFM, namely O(n+m). --- --- The solution I ended up with has time complexity of --- O(m log m + m * min (n+m, W)) where m is the smaller set. --- It simply inserts the elements of the smaller set into the larger --- set in the order that they were inserted into the smaller set. That's --- O(m log m) for extracting the elements from the smaller set in the --- insertion order and O(m * min(n+m, W)) to insert them into the bigger --- set. - -plusUDFM :: UniqDFM elt -> UniqDFM elt -> UniqDFM elt -plusUDFM udfml@(UDFM _ i) udfmr@(UDFM _ j) - -- we will use the upper bound on the tag as a proxy for the set size, - -- to insert the smaller one into the bigger one - | i > j = insertUDFMIntoLeft udfml udfmr - | otherwise = insertUDFMIntoLeft udfmr udfml - -insertUDFMIntoLeft :: UniqDFM elt -> UniqDFM elt -> UniqDFM elt -insertUDFMIntoLeft udfml udfmr = addListToUDFM_Directly udfml $ udfmToList udfmr - -insertUDFMIntoLeft_C - :: (elt -> elt -> elt) -> UniqDFM elt -> UniqDFM elt -> UniqDFM elt -insertUDFMIntoLeft_C f udfml udfmr = - addListToUDFM_Directly_C f udfml $ udfmToList udfmr - -lookupUDFM :: Uniquable key => UniqDFM elt -> key -> Maybe elt -lookupUDFM (UDFM m _i) k = taggedFst `fmap` M.lookup (getKey $ getUnique k) m - -lookupUDFM_Directly :: UniqDFM elt -> Unique -> Maybe elt -lookupUDFM_Directly (UDFM m _i) k = taggedFst `fmap` M.lookup (getKey k) m - -elemUDFM :: Uniquable key => key -> UniqDFM elt -> Bool -elemUDFM k (UDFM m _i) = M.member (getKey $ getUnique k) m - --- | Performs a deterministic fold over the UniqDFM. --- It's O(n log n) while the corresponding function on `UniqFM` is O(n). -foldUDFM :: (elt -> a -> a) -> a -> UniqDFM elt -> a -foldUDFM k z m = foldr k z (eltsUDFM m) - --- | Performs a nondeterministic fold over the UniqDFM. --- It's O(n), same as the corresponding function on `UniqFM`. --- If you use this please provide a justification why it doesn't introduce --- nondeterminism. -nonDetFoldUDFM :: (elt -> a -> a) -> a -> UniqDFM elt -> a -nonDetFoldUDFM k z (UDFM m _i) = foldr k z $ map taggedFst $ M.elems m - -eltsUDFM :: UniqDFM elt -> [elt] -eltsUDFM (UDFM m _i) = - map taggedFst $ sortBy (compare `on` taggedSnd) $ M.elems m - -filterUDFM :: (elt -> Bool) -> UniqDFM elt -> UniqDFM elt -filterUDFM p (UDFM m i) = UDFM (M.filter (\(TaggedVal v _) -> p v) m) i - -filterUDFM_Directly :: (Unique -> elt -> Bool) -> UniqDFM elt -> UniqDFM elt -filterUDFM_Directly p (UDFM m i) = UDFM (M.filterWithKey p' m) i - where - p' k (TaggedVal v _) = p (getUnique k) v - --- | Converts `UniqDFM` to a list, with elements in deterministic order. --- It's O(n log n) while the corresponding function on `UniqFM` is O(n). -udfmToList :: UniqDFM elt -> [(Unique, elt)] -udfmToList (UDFM m _i) = - [ (getUnique k, taggedFst v) - | (k, v) <- sortBy (compare `on` (taggedSnd . snd)) $ M.toList m ] - --- Determines whether two 'UniqDFM's contain the same keys. -equalKeysUDFM :: UniqDFM a -> UniqDFM b -> Bool -equalKeysUDFM (UDFM m1 _) (UDFM m2 _) = liftEq (\_ _ -> True) m1 m2 - -isNullUDFM :: UniqDFM elt -> Bool -isNullUDFM (UDFM m _) = M.null m - -sizeUDFM :: UniqDFM elt -> Int -sizeUDFM (UDFM m _i) = M.size m - -intersectUDFM :: UniqDFM elt -> UniqDFM elt -> UniqDFM elt -intersectUDFM (UDFM x i) (UDFM y _j) = UDFM (M.intersection x y) i - -- M.intersection is left biased, that means the result will only have - -- a subset of elements from the left set, so `i` is a good upper bound. - -udfmIntersectUFM :: UniqDFM elt1 -> UniqFM elt2 -> UniqDFM elt1 -udfmIntersectUFM (UDFM x i) y = UDFM (M.intersection x (ufmToIntMap y)) i - -- M.intersection is left biased, that means the result will only have - -- a subset of elements from the left set, so `i` is a good upper bound. - -intersectsUDFM :: UniqDFM elt -> UniqDFM elt -> Bool -intersectsUDFM x y = isNullUDFM (x `intersectUDFM` y) - -disjointUDFM :: UniqDFM elt -> UniqDFM elt -> Bool -disjointUDFM (UDFM x _i) (UDFM y _j) = M.null (M.intersection x y) - -disjointUdfmUfm :: UniqDFM elt -> UniqFM elt2 -> Bool -disjointUdfmUfm (UDFM x _i) y = M.null (M.intersection x (ufmToIntMap y)) - -minusUDFM :: UniqDFM elt1 -> UniqDFM elt2 -> UniqDFM elt1 -minusUDFM (UDFM x i) (UDFM y _j) = UDFM (M.difference x y) i - -- M.difference returns a subset of a left set, so `i` is a good upper - -- bound. - -udfmMinusUFM :: UniqDFM elt1 -> UniqFM elt2 -> UniqDFM elt1 -udfmMinusUFM (UDFM x i) y = UDFM (M.difference x (ufmToIntMap y)) i - -- M.difference returns a subset of a left set, so `i` is a good upper - -- bound. - --- | Partition UniqDFM into two UniqDFMs according to the predicate -partitionUDFM :: (elt -> Bool) -> UniqDFM elt -> (UniqDFM elt, UniqDFM elt) -partitionUDFM p (UDFM m i) = - case M.partition (p . taggedFst) m of - (left, right) -> (UDFM left i, UDFM right i) - --- | Delete a list of elements from a UniqDFM -delListFromUDFM :: Uniquable key => UniqDFM elt -> [key] -> UniqDFM elt -delListFromUDFM = foldl' delFromUDFM - --- | This allows for lossy conversion from UniqDFM to UniqFM -udfmToUfm :: UniqDFM elt -> UniqFM elt -udfmToUfm (UDFM m _i) = - listToUFM_Directly [(getUnique k, taggedFst tv) | (k, tv) <- M.toList m] - -listToUDFM :: Uniquable key => [(key,elt)] -> UniqDFM elt -listToUDFM = foldl' (\m (k, v) -> addToUDFM m k v) emptyUDFM - -listToUDFM_Directly :: [(Unique, elt)] -> UniqDFM elt -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 elt -> key -> UniqDFM elt -adjustUDFM f (UDFM m i) k = UDFM (M.adjust (fmap f) (getKey $ getUnique k) m) i - --- | The expression (alterUDFM f k map) alters value x at k, or absence --- thereof. alterUDFM can be used to insert, delete, or update a value in --- UniqDFM. Use addToUDFM, delFromUDFM or adjustUDFM when possible, they are --- more efficient. -alterUDFM - :: Uniquable key - => (Maybe elt -> Maybe elt) -- How to adjust - -> UniqDFM elt -- old - -> key -- new - -> UniqDFM elt -- result -alterUDFM f (UDFM m i) k = - UDFM (M.alter alterf (getKey $ getUnique k) m) (i + 1) - where - alterf Nothing = inject $ f Nothing - alterf (Just (TaggedVal v _)) = inject $ f (Just v) - inject Nothing = Nothing - inject (Just v) = Just $ TaggedVal v i - --- | Map a function over every value in a UniqDFM -mapUDFM :: (elt1 -> elt2) -> UniqDFM elt1 -> UniqDFM elt2 -mapUDFM f (UDFM m i) = UDFM (M.map (fmap f) m) i - -anyUDFM :: (elt -> Bool) -> UniqDFM elt -> Bool -anyUDFM p (UDFM m _i) = M.foldr ((||) . p . taggedFst) False m - -allUDFM :: (elt -> Bool) -> UniqDFM elt -> Bool -allUDFM p (UDFM m _i) = M.foldr ((&&) . p . taggedFst) True m - -instance Semi.Semigroup (UniqDFM a) where - (<>) = plusUDFM - -instance Monoid (UniqDFM a) where - mempty = emptyUDFM - mappend = (Semi.<>) - --- This should not be used in committed code, provided for convenience to --- make ad-hoc conversions when developing -alwaysUnsafeUfmToUdfm :: UniqFM elt -> UniqDFM elt -alwaysUnsafeUfmToUdfm = listToUDFM_Directly . nonDetUFMToList - --- Output-ery - -instance Outputable a => Outputable (UniqDFM a) where - ppr ufm = pprUniqDFM ppr ufm - -pprUniqDFM :: (a -> SDoc) -> UniqDFM a -> SDoc -pprUniqDFM ppr_elt ufm - = brackets $ fsep $ punctuate comma $ - [ ppr uq <+> text ":->" <+> ppr_elt elt - | (uq, elt) <- udfmToList ufm ] - -pprUDFM :: UniqDFM a -- ^ The things to be pretty printed - -> ([a] -> SDoc) -- ^ The pretty printing function to use on the elements - -> SDoc -- ^ 'SDoc' where the things have been pretty - -- printed -pprUDFM ufm pp = pp (eltsUDFM ufm) diff --git a/compiler/utils/UniqDSet.hs b/compiler/utils/UniqDSet.hs deleted file mode 100644 index c2ace5787f..0000000000 --- a/compiler/utils/UniqDSet.hs +++ /dev/null @@ -1,141 +0,0 @@ --- (c) Bartosz Nitka, Facebook, 2015 - --- | --- Specialised deterministic sets, for things with @Uniques@ --- --- Based on 'UniqDFM's (as you would expect). --- See Note [Deterministic UniqFM] in UniqDFM for explanation why we need it. --- --- Basically, the things need to be in class 'Uniquable'. - -{-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE DeriveDataTypeable #-} - -module UniqDSet ( - -- * Unique set type - UniqDSet, -- type synonym for UniqFM a - getUniqDSet, - pprUniqDSet, - - -- ** Manipulating these sets - delOneFromUniqDSet, delListFromUniqDSet, - emptyUniqDSet, - unitUniqDSet, - mkUniqDSet, - addOneToUniqDSet, addListToUniqDSet, - unionUniqDSets, unionManyUniqDSets, - minusUniqDSet, uniqDSetMinusUniqSet, - intersectUniqDSets, uniqDSetIntersectUniqSet, - foldUniqDSet, - elementOfUniqDSet, - filterUniqDSet, - sizeUniqDSet, - isEmptyUniqDSet, - lookupUniqDSet, - uniqDSetToList, - partitionUniqDSet, - mapUniqDSet - ) where - -import GhcPrelude - -import Outputable -import UniqDFM -import UniqSet -import Unique - -import Data.Coerce -import Data.Data -import qualified Data.Semigroup as Semi - --- See Note [UniqSet invariant] in UniqSet.hs for why we want a newtype here. --- Beyond preserving invariants, we may also want to 'override' typeclass --- instances. - -newtype UniqDSet a = UniqDSet {getUniqDSet' :: UniqDFM a} - deriving (Data, Semi.Semigroup, Monoid) - -emptyUniqDSet :: UniqDSet a -emptyUniqDSet = UniqDSet emptyUDFM - -unitUniqDSet :: Uniquable a => a -> UniqDSet a -unitUniqDSet x = UniqDSet (unitUDFM x x) - -mkUniqDSet :: Uniquable a => [a] -> UniqDSet a -mkUniqDSet = foldl' addOneToUniqDSet emptyUniqDSet - --- The new element always goes to the right of existing ones. -addOneToUniqDSet :: Uniquable a => UniqDSet a -> a -> UniqDSet a -addOneToUniqDSet (UniqDSet set) x = UniqDSet (addToUDFM set x x) - -addListToUniqDSet :: Uniquable a => UniqDSet a -> [a] -> UniqDSet a -addListToUniqDSet = foldl' addOneToUniqDSet - -delOneFromUniqDSet :: Uniquable a => UniqDSet a -> a -> UniqDSet a -delOneFromUniqDSet (UniqDSet s) = UniqDSet . delFromUDFM s - -delListFromUniqDSet :: Uniquable a => UniqDSet a -> [a] -> UniqDSet a -delListFromUniqDSet (UniqDSet s) = UniqDSet . delListFromUDFM s - -unionUniqDSets :: UniqDSet a -> UniqDSet a -> UniqDSet a -unionUniqDSets (UniqDSet s) (UniqDSet t) = UniqDSet (plusUDFM s t) - -unionManyUniqDSets :: [UniqDSet a] -> UniqDSet a -unionManyUniqDSets [] = emptyUniqDSet -unionManyUniqDSets sets = foldr1 unionUniqDSets sets - -minusUniqDSet :: UniqDSet a -> UniqDSet a -> UniqDSet a -minusUniqDSet (UniqDSet s) (UniqDSet t) = UniqDSet (minusUDFM s t) - -uniqDSetMinusUniqSet :: UniqDSet a -> UniqSet b -> UniqDSet a -uniqDSetMinusUniqSet xs ys - = UniqDSet (udfmMinusUFM (getUniqDSet xs) (getUniqSet ys)) - -intersectUniqDSets :: UniqDSet a -> UniqDSet a -> UniqDSet a -intersectUniqDSets (UniqDSet s) (UniqDSet t) = UniqDSet (intersectUDFM s t) - -uniqDSetIntersectUniqSet :: UniqDSet a -> UniqSet b -> UniqDSet a -uniqDSetIntersectUniqSet xs ys - = UniqDSet (udfmIntersectUFM (getUniqDSet xs) (getUniqSet ys)) - -foldUniqDSet :: (a -> b -> b) -> b -> UniqDSet a -> b -foldUniqDSet c n (UniqDSet s) = foldUDFM c n s - -elementOfUniqDSet :: Uniquable a => a -> UniqDSet a -> Bool -elementOfUniqDSet k = elemUDFM k . getUniqDSet - -filterUniqDSet :: (a -> Bool) -> UniqDSet a -> UniqDSet a -filterUniqDSet p (UniqDSet s) = UniqDSet (filterUDFM p s) - -sizeUniqDSet :: UniqDSet a -> Int -sizeUniqDSet = sizeUDFM . getUniqDSet - -isEmptyUniqDSet :: UniqDSet a -> Bool -isEmptyUniqDSet = isNullUDFM . getUniqDSet - -lookupUniqDSet :: Uniquable a => UniqDSet a -> a -> Maybe a -lookupUniqDSet = lookupUDFM . getUniqDSet - -uniqDSetToList :: UniqDSet a -> [a] -uniqDSetToList = eltsUDFM . getUniqDSet - -partitionUniqDSet :: (a -> Bool) -> UniqDSet a -> (UniqDSet a, UniqDSet a) -partitionUniqDSet p = coerce . partitionUDFM p . getUniqDSet - --- See Note [UniqSet invariant] in UniqSet.hs -mapUniqDSet :: Uniquable b => (a -> b) -> UniqDSet a -> UniqDSet b -mapUniqDSet f = mkUniqDSet . map f . uniqDSetToList - --- Two 'UniqDSet's are considered equal if they contain the same --- uniques. -instance Eq (UniqDSet a) where - UniqDSet a == UniqDSet b = equalKeysUDFM a b - -getUniqDSet :: UniqDSet a -> UniqDFM a -getUniqDSet = getUniqDSet' - -instance Outputable a => Outputable (UniqDSet a) where - ppr = pprUniqDSet ppr - -pprUniqDSet :: (a -> SDoc) -> UniqDSet a -> SDoc -pprUniqDSet f = braces . pprWithCommas f . uniqDSetToList diff --git a/compiler/utils/UniqFM.hs b/compiler/utils/UniqFM.hs deleted file mode 100644 index 19b506e883..0000000000 --- a/compiler/utils/UniqFM.hs +++ /dev/null @@ -1,416 +0,0 @@ -{- -(c) The University of Glasgow 2006 -(c) The AQUA Project, Glasgow University, 1994-1998 - - -UniqFM: Specialised finite maps, for things with @Uniques@. - -Basically, the things need to be in class @Uniquable@, and we use the -@getUnique@ method to grab their @Uniques@. - -(A similar thing to @UniqSet@, as opposed to @Set@.) - -The interface is based on @FiniteMap@s, but the implementation uses -@Data.IntMap@, which is both maintained and faster than the past -implementation (see commit log). - -The @UniqFM@ interface maps directly to Data.IntMap, only -``Data.IntMap.union'' is left-biased and ``plusUFM'' right-biased -and ``addToUFM\_C'' and ``Data.IntMap.insertWith'' differ in the order -of arguments of combining function. --} - -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# OPTIONS_GHC -Wall #-} - -module UniqFM ( - -- * Unique-keyed mappings - UniqFM, -- abstract type - NonDetUniqFM(..), -- wrapper for opting into nondeterminism - - -- ** Manipulating those mappings - emptyUFM, - unitUFM, - unitDirectlyUFM, - listToUFM, - listToUFM_Directly, - listToUFM_C, - addToUFM,addToUFM_C,addToUFM_Acc, - addListToUFM,addListToUFM_C, - addToUFM_Directly, - addListToUFM_Directly, - adjustUFM, alterUFM, - adjustUFM_Directly, - delFromUFM, - delFromUFM_Directly, - delListFromUFM, - delListFromUFM_Directly, - plusUFM, - plusUFM_C, - plusUFM_CD, - plusMaybeUFM_C, - plusUFMList, - minusUFM, - intersectUFM, - intersectUFM_C, - disjointUFM, - equalKeysUFM, - nonDetFoldUFM, foldUFM, nonDetFoldUFM_Directly, - anyUFM, allUFM, seqEltsUFM, - mapUFM, mapUFM_Directly, - elemUFM, elemUFM_Directly, - filterUFM, filterUFM_Directly, partitionUFM, - sizeUFM, - isNullUFM, - lookupUFM, lookupUFM_Directly, - lookupWithDefaultUFM, lookupWithDefaultUFM_Directly, - nonDetEltsUFM, eltsUFM, nonDetKeysUFM, - ufmToSet_Directly, - nonDetUFMToList, ufmToIntMap, - pprUniqFM, pprUFM, pprUFMWithKeys, pluralUFM - ) where - -import GhcPrelude - -import Unique ( Uniquable(..), Unique, getKey ) -import Outputable - -import qualified Data.IntMap as M -import qualified Data.IntSet as S -import Data.Data -import qualified Data.Semigroup as Semi -import Data.Functor.Classes (Eq1 (..)) - - -newtype UniqFM ele = UFM (M.IntMap ele) - deriving (Data, Eq, Functor) - -- Nondeterministic Foldable and Traversable instances are accessible through - -- use of the 'NonDetUniqFM' wrapper. - -- See Note [Deterministic UniqFM] in UniqDFM to learn about determinism. - -emptyUFM :: UniqFM elt -emptyUFM = UFM M.empty - -isNullUFM :: UniqFM elt -> Bool -isNullUFM (UFM m) = M.null m - -unitUFM :: Uniquable key => key -> elt -> UniqFM elt -unitUFM k v = UFM (M.singleton (getKey $ getUnique k) v) - --- when you've got the Unique already -unitDirectlyUFM :: Unique -> elt -> UniqFM elt -unitDirectlyUFM u v = UFM (M.singleton (getKey u) v) - -listToUFM :: Uniquable key => [(key,elt)] -> UniqFM elt -listToUFM = foldl' (\m (k, v) -> addToUFM m k v) emptyUFM - -listToUFM_Directly :: [(Unique, elt)] -> UniqFM elt -listToUFM_Directly = foldl' (\m (u, v) -> addToUFM_Directly m u v) emptyUFM - -listToUFM_C - :: Uniquable key - => (elt -> elt -> elt) - -> [(key, elt)] - -> UniqFM elt -listToUFM_C f = foldl' (\m (k, v) -> addToUFM_C f m k v) emptyUFM - -addToUFM :: Uniquable key => UniqFM elt -> key -> elt -> UniqFM elt -addToUFM (UFM m) k v = UFM (M.insert (getKey $ getUnique k) v m) - -addListToUFM :: Uniquable key => UniqFM elt -> [(key,elt)] -> UniqFM elt -addListToUFM = foldl' (\m (k, v) -> addToUFM m k v) - -addListToUFM_Directly :: UniqFM elt -> [(Unique,elt)] -> UniqFM elt -addListToUFM_Directly = foldl' (\m (k, v) -> addToUFM_Directly m k v) - -addToUFM_Directly :: UniqFM elt -> Unique -> elt -> UniqFM elt -addToUFM_Directly (UFM m) u v = UFM (M.insert (getKey u) v m) - -addToUFM_C - :: Uniquable key - => (elt -> elt -> elt) -- old -> new -> result - -> UniqFM elt -- old - -> key -> elt -- new - -> UniqFM elt -- result --- Arguments of combining function of M.insertWith and addToUFM_C are flipped. -addToUFM_C f (UFM m) k v = - UFM (M.insertWith (flip f) (getKey $ getUnique k) v m) - -addToUFM_Acc - :: Uniquable key - => (elt -> elts -> elts) -- Add to existing - -> (elt -> elts) -- New element - -> UniqFM elts -- old - -> key -> elt -- new - -> UniqFM elts -- result -addToUFM_Acc exi new (UFM m) k v = - UFM (M.insertWith (\_new old -> exi v old) (getKey $ getUnique k) (new v) m) - -alterUFM - :: Uniquable key - => (Maybe elt -> Maybe elt) -- How to adjust - -> UniqFM elt -- old - -> key -- new - -> UniqFM elt -- result -alterUFM f (UFM m) k = UFM (M.alter f (getKey $ getUnique k) m) - -addListToUFM_C - :: Uniquable key - => (elt -> elt -> elt) - -> UniqFM elt -> [(key,elt)] - -> UniqFM elt -addListToUFM_C f = foldl' (\m (k, v) -> addToUFM_C f m k v) - -adjustUFM :: Uniquable key => (elt -> elt) -> UniqFM elt -> key -> UniqFM elt -adjustUFM f (UFM m) k = UFM (M.adjust f (getKey $ getUnique k) m) - -adjustUFM_Directly :: (elt -> elt) -> UniqFM elt -> Unique -> UniqFM elt -adjustUFM_Directly f (UFM m) u = UFM (M.adjust f (getKey u) m) - -delFromUFM :: Uniquable key => UniqFM elt -> key -> UniqFM elt -delFromUFM (UFM m) k = UFM (M.delete (getKey $ getUnique k) m) - -delListFromUFM :: Uniquable key => UniqFM elt -> [key] -> UniqFM elt -delListFromUFM = foldl' delFromUFM - -delListFromUFM_Directly :: UniqFM elt -> [Unique] -> UniqFM elt -delListFromUFM_Directly = foldl' delFromUFM_Directly - -delFromUFM_Directly :: UniqFM elt -> Unique -> UniqFM elt -delFromUFM_Directly (UFM m) u = UFM (M.delete (getKey u) m) - --- Bindings in right argument shadow those in the left -plusUFM :: UniqFM elt -> UniqFM elt -> UniqFM elt --- M.union is left-biased, plusUFM should be right-biased. -plusUFM (UFM x) (UFM y) = UFM (M.union y x) - -- Note (M.union y x), with arguments flipped - -- M.union is left-biased, plusUFM should be right-biased. - -plusUFM_C :: (elt -> elt -> elt) -> UniqFM elt -> UniqFM elt -> UniqFM elt -plusUFM_C f (UFM x) (UFM y) = UFM (M.unionWith f x y) - --- | `plusUFM_CD f m1 d1 m2 d2` merges the maps using `f` as the --- combinding function and `d1` resp. `d2` as the default value if --- there is no entry in `m1` reps. `m2`. The domain is the union of --- the domains of `m1` and `m2`. --- --- Representative example: --- --- @ --- plusUFM_CD f {A: 1, B: 2} 23 {B: 3, C: 4} 42 --- == {A: f 1 42, B: f 2 3, C: f 23 4 } --- @ -plusUFM_CD - :: (elt -> elt -> elt) - -> UniqFM elt -- map X - -> elt -- default for X - -> UniqFM elt -- map Y - -> elt -- default for Y - -> UniqFM elt -plusUFM_CD f (UFM xm) dx (UFM ym) dy - = UFM $ M.mergeWithKey - (\_ x y -> Just (x `f` y)) - (M.map (\x -> x `f` dy)) - (M.map (\y -> dx `f` y)) - xm ym - -plusMaybeUFM_C :: (elt -> elt -> Maybe elt) - -> UniqFM elt -> UniqFM elt -> UniqFM elt -plusMaybeUFM_C f (UFM xm) (UFM ym) - = UFM $ M.mergeWithKey - (\_ x y -> x `f` y) - id - id - xm ym - -plusUFMList :: [UniqFM elt] -> UniqFM elt -plusUFMList = foldl' plusUFM emptyUFM - -minusUFM :: UniqFM elt1 -> UniqFM elt2 -> UniqFM elt1 -minusUFM (UFM x) (UFM y) = UFM (M.difference x y) - -intersectUFM :: UniqFM elt1 -> UniqFM elt2 -> UniqFM elt1 -intersectUFM (UFM x) (UFM y) = UFM (M.intersection x y) - -intersectUFM_C - :: (elt1 -> elt2 -> elt3) - -> UniqFM elt1 - -> UniqFM elt2 - -> UniqFM elt3 -intersectUFM_C f (UFM x) (UFM y) = UFM (M.intersectionWith f x y) - -disjointUFM :: UniqFM elt1 -> UniqFM elt2 -> Bool -disjointUFM (UFM x) (UFM y) = M.null (M.intersection x y) - -foldUFM :: (elt -> a -> a) -> a -> UniqFM elt -> a -foldUFM k z (UFM m) = M.foldr k z m - -mapUFM :: (elt1 -> elt2) -> UniqFM elt1 -> UniqFM elt2 -mapUFM f (UFM m) = UFM (M.map f m) - -mapUFM_Directly :: (Unique -> elt1 -> elt2) -> UniqFM elt1 -> UniqFM elt2 -mapUFM_Directly f (UFM m) = UFM (M.mapWithKey (f . getUnique) m) - -filterUFM :: (elt -> Bool) -> UniqFM elt -> UniqFM elt -filterUFM p (UFM m) = UFM (M.filter p m) - -filterUFM_Directly :: (Unique -> elt -> Bool) -> UniqFM elt -> UniqFM elt -filterUFM_Directly p (UFM m) = UFM (M.filterWithKey (p . getUnique) m) - -partitionUFM :: (elt -> Bool) -> UniqFM elt -> (UniqFM elt, UniqFM elt) -partitionUFM p (UFM m) = - case M.partition p m of - (left, right) -> (UFM left, UFM right) - -sizeUFM :: UniqFM elt -> Int -sizeUFM (UFM m) = M.size m - -elemUFM :: Uniquable key => key -> UniqFM elt -> Bool -elemUFM k (UFM m) = M.member (getKey $ getUnique k) m - -elemUFM_Directly :: Unique -> UniqFM elt -> Bool -elemUFM_Directly u (UFM m) = M.member (getKey u) m - -lookupUFM :: Uniquable key => UniqFM elt -> key -> Maybe elt -lookupUFM (UFM m) k = M.lookup (getKey $ getUnique k) m - --- when you've got the Unique already -lookupUFM_Directly :: UniqFM elt -> Unique -> Maybe elt -lookupUFM_Directly (UFM m) u = M.lookup (getKey u) m - -lookupWithDefaultUFM :: Uniquable key => UniqFM elt -> elt -> key -> elt -lookupWithDefaultUFM (UFM m) v k = M.findWithDefault v (getKey $ getUnique k) m - -lookupWithDefaultUFM_Directly :: UniqFM elt -> elt -> Unique -> elt -lookupWithDefaultUFM_Directly (UFM m) v u = M.findWithDefault v (getKey u) m - -eltsUFM :: UniqFM elt -> [elt] -eltsUFM (UFM m) = M.elems m - -ufmToSet_Directly :: UniqFM elt -> S.IntSet -ufmToSet_Directly (UFM m) = M.keysSet m - -anyUFM :: (elt -> Bool) -> UniqFM elt -> Bool -anyUFM p (UFM m) = M.foldr ((||) . p) False m - -allUFM :: (elt -> Bool) -> UniqFM elt -> Bool -allUFM p (UFM m) = M.foldr ((&&) . p) True m - -seqEltsUFM :: ([elt] -> ()) -> UniqFM elt -> () -seqEltsUFM seqList = seqList . nonDetEltsUFM - -- It's OK to use nonDetEltsUFM here because the type guarantees that - -- the only interesting thing this function can do is to force the - -- elements. - --- See Note [Deterministic UniqFM] to learn about nondeterminism. --- If you use this please provide a justification why it doesn't introduce --- nondeterminism. -nonDetEltsUFM :: UniqFM elt -> [elt] -nonDetEltsUFM (UFM m) = M.elems m - --- See Note [Deterministic UniqFM] to learn about nondeterminism. --- If you use this please provide a justification why it doesn't introduce --- nondeterminism. -nonDetKeysUFM :: UniqFM elt -> [Unique] -nonDetKeysUFM (UFM m) = map getUnique $ M.keys m - --- See Note [Deterministic UniqFM] to learn about nondeterminism. --- If you use this please provide a justification why it doesn't introduce --- nondeterminism. -nonDetFoldUFM :: (elt -> a -> a) -> a -> UniqFM elt -> a -nonDetFoldUFM k z (UFM m) = M.foldr k z m - --- See Note [Deterministic UniqFM] to learn about nondeterminism. --- If you use this please provide a justification why it doesn't introduce --- nondeterminism. -nonDetFoldUFM_Directly:: (Unique -> elt -> a -> a) -> a -> UniqFM elt -> a -nonDetFoldUFM_Directly k z (UFM m) = M.foldrWithKey (k . getUnique) z m - --- See Note [Deterministic UniqFM] to learn about nondeterminism. --- If you use this please provide a justification why it doesn't introduce --- nondeterminism. -nonDetUFMToList :: UniqFM elt -> [(Unique, elt)] -nonDetUFMToList (UFM m) = map (\(k, v) -> (getUnique k, v)) $ M.toList m - --- | A wrapper around 'UniqFM' with the sole purpose of informing call sites --- that the provided 'Foldable' and 'Traversable' instances are --- nondeterministic. --- If you use this please provide a justification why it doesn't introduce --- nondeterminism. --- See Note [Deterministic UniqFM] in UniqDFM to learn about determinism. -newtype NonDetUniqFM ele = NonDetUniqFM { getNonDet :: UniqFM ele } - deriving (Functor) - --- | Inherently nondeterministic. --- If you use this please provide a justification why it doesn't introduce --- nondeterminism. --- See Note [Deterministic UniqFM] in UniqDFM to learn about determinism. -instance Foldable NonDetUniqFM where - foldr f z (NonDetUniqFM (UFM m)) = foldr f z m - --- | Inherently nondeterministic. --- If you use this please provide a justification why it doesn't introduce --- nondeterminism. --- See Note [Deterministic UniqFM] in UniqDFM to learn about determinism. -instance Traversable NonDetUniqFM where - traverse f (NonDetUniqFM (UFM m)) = NonDetUniqFM . UFM <$> traverse f m - -ufmToIntMap :: UniqFM elt -> M.IntMap elt -ufmToIntMap (UFM m) = m - --- Determines whether two 'UniqFM's contain the same keys. -equalKeysUFM :: UniqFM a -> UniqFM b -> Bool -equalKeysUFM (UFM m1) (UFM m2) = liftEq (\_ _ -> True) m1 m2 - --- Instances - -instance Semi.Semigroup (UniqFM a) where - (<>) = plusUFM - -instance Monoid (UniqFM a) where - mempty = emptyUFM - mappend = (Semi.<>) - --- Output-ery - -instance Outputable a => Outputable (UniqFM a) where - ppr ufm = pprUniqFM ppr ufm - -pprUniqFM :: (a -> SDoc) -> UniqFM a -> SDoc -pprUniqFM ppr_elt ufm - = brackets $ fsep $ punctuate comma $ - [ ppr uq <+> text ":->" <+> ppr_elt elt - | (uq, elt) <- nonDetUFMToList ufm ] - -- It's OK to use nonDetUFMToList here because we only use it for - -- pretty-printing. - --- | Pretty-print a non-deterministic set. --- The order of variables is non-deterministic and for pretty-printing that --- shouldn't be a problem. --- Having this function helps contain the non-determinism created with --- nonDetEltsUFM. -pprUFM :: UniqFM a -- ^ The things to be pretty printed - -> ([a] -> SDoc) -- ^ The pretty printing function to use on the elements - -> SDoc -- ^ 'SDoc' where the things have been pretty - -- printed -pprUFM ufm pp = pp (nonDetEltsUFM ufm) - --- | Pretty-print a non-deterministic set. --- The order of variables is non-deterministic and for pretty-printing that --- shouldn't be a problem. --- Having this function helps contain the non-determinism created with --- nonDetUFMToList. -pprUFMWithKeys - :: UniqFM a -- ^ The things to be pretty printed - -> ([(Unique, a)] -> SDoc) -- ^ The pretty printing function to use on the elements - -> SDoc -- ^ 'SDoc' where the things have been pretty - -- printed -pprUFMWithKeys ufm pp = pp (nonDetUFMToList ufm) - --- | Determines the pluralisation suffix appropriate for the length of a set --- in the same way that plural from Outputable does for lists. -pluralUFM :: UniqFM a -> SDoc -pluralUFM ufm - | sizeUFM ufm == 1 = empty - | otherwise = char 's' diff --git a/compiler/utils/UniqMap.hs b/compiler/utils/UniqMap.hs deleted file mode 100644 index 1bd51c2b38..0000000000 --- a/compiler/utils/UniqMap.hs +++ /dev/null @@ -1,206 +0,0 @@ -{-# LANGUAGE RoleAnnotations #-} -{-# LANGUAGE TupleSections #-} -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE DeriveFunctor #-} -{-# OPTIONS_GHC -Wall #-} - --- Like 'UniqFM', these are maps for keys which are Uniquable. --- Unlike 'UniqFM', these maps also remember their keys, which --- makes them a much better drop in replacement for 'Data.Map.Map'. --- --- Key preservation is right-biased. -module UniqMap ( - UniqMap, - emptyUniqMap, - isNullUniqMap, - unitUniqMap, - listToUniqMap, - listToUniqMap_C, - addToUniqMap, - addListToUniqMap, - addToUniqMap_C, - addToUniqMap_Acc, - alterUniqMap, - addListToUniqMap_C, - adjustUniqMap, - delFromUniqMap, - delListFromUniqMap, - plusUniqMap, - plusUniqMap_C, - plusMaybeUniqMap_C, - plusUniqMapList, - minusUniqMap, - intersectUniqMap, - disjointUniqMap, - mapUniqMap, - filterUniqMap, - partitionUniqMap, - sizeUniqMap, - elemUniqMap, - lookupUniqMap, - lookupWithDefaultUniqMap, - anyUniqMap, - allUniqMap, - -- Non-deterministic functions omitted -) where - -import GhcPrelude - -import UniqFM - -import Unique -import Outputable - -import Data.Semigroup as Semi ( Semigroup(..) ) -import Data.Coerce -import Data.Maybe -import Data.Data - --- | Maps indexed by 'Uniquable' keys -newtype UniqMap k a = UniqMap (UniqFM (k, a)) - deriving (Data, Eq, Functor) -type role UniqMap nominal representational - -instance Semigroup (UniqMap k a) where - (<>) = plusUniqMap - -instance Monoid (UniqMap k a) where - mempty = emptyUniqMap - mappend = (Semi.<>) - -instance (Outputable k, Outputable a) => Outputable (UniqMap k a) where - ppr (UniqMap m) = - brackets $ fsep $ punctuate comma $ - [ ppr k <+> text "->" <+> ppr v - | (k, v) <- eltsUFM m ] - -liftC :: (a -> a -> a) -> (k, a) -> (k, a) -> (k, a) -liftC f (_, v) (k', v') = (k', f v v') - -emptyUniqMap :: UniqMap k a -emptyUniqMap = UniqMap emptyUFM - -isNullUniqMap :: UniqMap k a -> Bool -isNullUniqMap (UniqMap m) = isNullUFM m - -unitUniqMap :: Uniquable k => k -> a -> UniqMap k a -unitUniqMap k v = UniqMap (unitUFM k (k, v)) - -listToUniqMap :: Uniquable k => [(k,a)] -> UniqMap k a -listToUniqMap kvs = UniqMap (listToUFM [ (k,(k,v)) | (k,v) <- kvs]) - -listToUniqMap_C :: Uniquable k => (a -> a -> a) -> [(k,a)] -> UniqMap k a -listToUniqMap_C f kvs = UniqMap $ - listToUFM_C (liftC f) [ (k,(k,v)) | (k,v) <- kvs] - -addToUniqMap :: Uniquable k => UniqMap k a -> k -> a -> UniqMap k a -addToUniqMap (UniqMap m) k v = UniqMap $ addToUFM m k (k, v) - -addListToUniqMap :: Uniquable k => UniqMap k a -> [(k,a)] -> UniqMap k a -addListToUniqMap (UniqMap m) kvs = UniqMap $ - addListToUFM m [(k,(k,v)) | (k,v) <- kvs] - -addToUniqMap_C :: Uniquable k - => (a -> a -> a) - -> UniqMap k a - -> k - -> a - -> UniqMap k a -addToUniqMap_C f (UniqMap m) k v = UniqMap $ - addToUFM_C (liftC f) m k (k, v) - -addToUniqMap_Acc :: Uniquable k - => (b -> a -> a) - -> (b -> a) - -> UniqMap k a - -> k - -> b - -> UniqMap k a -addToUniqMap_Acc exi new (UniqMap m) k0 v0 = UniqMap $ - addToUFM_Acc (\b (k, v) -> (k, exi b v)) - (\b -> (k0, new b)) - m k0 v0 - -alterUniqMap :: Uniquable k - => (Maybe a -> Maybe a) - -> UniqMap k a - -> k - -> UniqMap k a -alterUniqMap f (UniqMap m) k = UniqMap $ - alterUFM (fmap (k,) . f . fmap snd) m k - -addListToUniqMap_C - :: Uniquable k - => (a -> a -> a) - -> UniqMap k a - -> [(k, a)] - -> UniqMap k a -addListToUniqMap_C f (UniqMap m) kvs = UniqMap $ - addListToUFM_C (liftC f) m - [(k,(k,v)) | (k,v) <- kvs] - -adjustUniqMap - :: Uniquable k - => (a -> a) - -> UniqMap k a - -> k - -> UniqMap k a -adjustUniqMap f (UniqMap m) k = UniqMap $ - adjustUFM (\(_,v) -> (k,f v)) m k - -delFromUniqMap :: Uniquable k => UniqMap k a -> k -> UniqMap k a -delFromUniqMap (UniqMap m) k = UniqMap $ delFromUFM m k - -delListFromUniqMap :: Uniquable k => UniqMap k a -> [k] -> UniqMap k a -delListFromUniqMap (UniqMap m) ks = UniqMap $ delListFromUFM m ks - -plusUniqMap :: UniqMap k a -> UniqMap k a -> UniqMap k a -plusUniqMap (UniqMap m1) (UniqMap m2) = UniqMap $ plusUFM m1 m2 - -plusUniqMap_C :: (a -> a -> a) -> UniqMap k a -> UniqMap k a -> UniqMap k a -plusUniqMap_C f (UniqMap m1) (UniqMap m2) = UniqMap $ - plusUFM_C (liftC f) m1 m2 - -plusMaybeUniqMap_C :: (a -> a -> Maybe a) -> UniqMap k a -> UniqMap k a -> UniqMap k a -plusMaybeUniqMap_C f (UniqMap m1) (UniqMap m2) = UniqMap $ - plusMaybeUFM_C (\(_, v) (k', v') -> fmap (k',) (f v v')) m1 m2 - -plusUniqMapList :: [UniqMap k a] -> UniqMap k a -plusUniqMapList xs = UniqMap $ plusUFMList (coerce xs) - -minusUniqMap :: UniqMap k a -> UniqMap k b -> UniqMap k a -minusUniqMap (UniqMap m1) (UniqMap m2) = UniqMap $ minusUFM m1 m2 - -intersectUniqMap :: UniqMap k a -> UniqMap k b -> UniqMap k a -intersectUniqMap (UniqMap m1) (UniqMap m2) = UniqMap $ intersectUFM m1 m2 - -disjointUniqMap :: UniqMap k a -> UniqMap k b -> Bool -disjointUniqMap (UniqMap m1) (UniqMap m2) = disjointUFM m1 m2 - -mapUniqMap :: (a -> b) -> UniqMap k a -> UniqMap k b -mapUniqMap f (UniqMap m) = UniqMap $ mapUFM (fmap f) m -- (,) k instance - -filterUniqMap :: (a -> Bool) -> UniqMap k a -> UniqMap k a -filterUniqMap f (UniqMap m) = UniqMap $ filterUFM (f . snd) m - -partitionUniqMap :: (a -> Bool) -> UniqMap k a -> (UniqMap k a, UniqMap k a) -partitionUniqMap f (UniqMap m) = - coerce $ partitionUFM (f . snd) m - -sizeUniqMap :: UniqMap k a -> Int -sizeUniqMap (UniqMap m) = sizeUFM m - -elemUniqMap :: Uniquable k => k -> UniqMap k a -> Bool -elemUniqMap k (UniqMap m) = elemUFM k m - -lookupUniqMap :: Uniquable k => UniqMap k a -> k -> Maybe a -lookupUniqMap (UniqMap m) k = fmap snd (lookupUFM m k) - -lookupWithDefaultUniqMap :: Uniquable k => UniqMap k a -> a -> k -> a -lookupWithDefaultUniqMap (UniqMap m) a k = fromMaybe a (fmap snd (lookupUFM m k)) - -anyUniqMap :: (a -> Bool) -> UniqMap k a -> Bool -anyUniqMap f (UniqMap m) = anyUFM (f . snd) m - -allUniqMap :: (a -> Bool) -> UniqMap k a -> Bool -allUniqMap f (UniqMap m) = allUFM (f . snd) m diff --git a/compiler/utils/UniqSet.hs b/compiler/utils/UniqSet.hs deleted file mode 100644 index 1c45f7485f..0000000000 --- a/compiler/utils/UniqSet.hs +++ /dev/null @@ -1,195 +0,0 @@ -{- -(c) The University of Glasgow 2006 -(c) The AQUA Project, Glasgow University, 1994-1998 - -\section[UniqSet]{Specialised sets, for things with @Uniques@} - -Based on @UniqFMs@ (as you would expect). - -Basically, the things need to be in class @Uniquable@. --} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE DeriveDataTypeable #-} - -module UniqSet ( - -- * Unique set type - UniqSet, -- type synonym for UniqFM a - getUniqSet, - pprUniqSet, - - -- ** Manipulating these sets - emptyUniqSet, - unitUniqSet, - mkUniqSet, - addOneToUniqSet, addListToUniqSet, - delOneFromUniqSet, delOneFromUniqSet_Directly, delListFromUniqSet, - delListFromUniqSet_Directly, - unionUniqSets, unionManyUniqSets, - minusUniqSet, uniqSetMinusUFM, - intersectUniqSets, - restrictUniqSetToUFM, - uniqSetAny, uniqSetAll, - elementOfUniqSet, - elemUniqSet_Directly, - filterUniqSet, - filterUniqSet_Directly, - sizeUniqSet, - isEmptyUniqSet, - lookupUniqSet, - lookupUniqSet_Directly, - partitionUniqSet, - mapUniqSet, - unsafeUFMToUniqSet, - nonDetEltsUniqSet, - nonDetKeysUniqSet, - nonDetFoldUniqSet, - nonDetFoldUniqSet_Directly - ) where - -import GhcPrelude - -import UniqFM -import Unique -import Data.Coerce -import Outputable -import Data.Data -import qualified Data.Semigroup as Semi - --- Note [UniqSet invariant] --- ~~~~~~~~~~~~~~~~~~~~~~~~~ --- UniqSet has the following invariant: --- The keys in the map are the uniques of the values --- It means that to implement mapUniqSet you have to update --- both the keys and the values. - -newtype UniqSet a = UniqSet {getUniqSet' :: UniqFM a} - deriving (Data, Semi.Semigroup, Monoid) - -emptyUniqSet :: UniqSet a -emptyUniqSet = UniqSet emptyUFM - -unitUniqSet :: Uniquable a => a -> UniqSet a -unitUniqSet x = UniqSet $ unitUFM x x - -mkUniqSet :: Uniquable a => [a] -> UniqSet a -mkUniqSet = foldl' addOneToUniqSet emptyUniqSet - -addOneToUniqSet :: Uniquable a => UniqSet a -> a -> UniqSet a -addOneToUniqSet (UniqSet set) x = UniqSet (addToUFM set x x) - -addListToUniqSet :: Uniquable a => UniqSet a -> [a] -> UniqSet a -addListToUniqSet = foldl' addOneToUniqSet - -delOneFromUniqSet :: Uniquable a => UniqSet a -> a -> UniqSet a -delOneFromUniqSet (UniqSet s) a = UniqSet (delFromUFM s a) - -delOneFromUniqSet_Directly :: UniqSet a -> Unique -> UniqSet a -delOneFromUniqSet_Directly (UniqSet s) u = UniqSet (delFromUFM_Directly s u) - -delListFromUniqSet :: Uniquable a => UniqSet a -> [a] -> UniqSet a -delListFromUniqSet (UniqSet s) l = UniqSet (delListFromUFM s l) - -delListFromUniqSet_Directly :: UniqSet a -> [Unique] -> UniqSet a -delListFromUniqSet_Directly (UniqSet s) l = - UniqSet (delListFromUFM_Directly s l) - -unionUniqSets :: UniqSet a -> UniqSet a -> UniqSet a -unionUniqSets (UniqSet s) (UniqSet t) = UniqSet (plusUFM s t) - -unionManyUniqSets :: [UniqSet a] -> UniqSet a -unionManyUniqSets = foldl' (flip unionUniqSets) emptyUniqSet - -minusUniqSet :: UniqSet a -> UniqSet a -> UniqSet a -minusUniqSet (UniqSet s) (UniqSet t) = UniqSet (minusUFM s t) - -intersectUniqSets :: UniqSet a -> UniqSet a -> UniqSet a -intersectUniqSets (UniqSet s) (UniqSet t) = UniqSet (intersectUFM s t) - -restrictUniqSetToUFM :: UniqSet a -> UniqFM b -> UniqSet a -restrictUniqSetToUFM (UniqSet s) m = UniqSet (intersectUFM s m) - -uniqSetMinusUFM :: UniqSet a -> UniqFM b -> UniqSet a -uniqSetMinusUFM (UniqSet s) t = UniqSet (minusUFM s t) - -elementOfUniqSet :: Uniquable a => a -> UniqSet a -> Bool -elementOfUniqSet a (UniqSet s) = elemUFM a s - -elemUniqSet_Directly :: Unique -> UniqSet a -> Bool -elemUniqSet_Directly a (UniqSet s) = elemUFM_Directly a s - -filterUniqSet :: (a -> Bool) -> UniqSet a -> UniqSet a -filterUniqSet p (UniqSet s) = UniqSet (filterUFM p s) - -filterUniqSet_Directly :: (Unique -> elt -> Bool) -> UniqSet elt -> UniqSet elt -filterUniqSet_Directly f (UniqSet s) = UniqSet (filterUFM_Directly f s) - -partitionUniqSet :: (a -> Bool) -> UniqSet a -> (UniqSet a, UniqSet a) -partitionUniqSet p (UniqSet s) = coerce (partitionUFM p s) - -uniqSetAny :: (a -> Bool) -> UniqSet a -> Bool -uniqSetAny p (UniqSet s) = anyUFM p s - -uniqSetAll :: (a -> Bool) -> UniqSet a -> Bool -uniqSetAll p (UniqSet s) = allUFM p s - -sizeUniqSet :: UniqSet a -> Int -sizeUniqSet (UniqSet s) = sizeUFM s - -isEmptyUniqSet :: UniqSet a -> Bool -isEmptyUniqSet (UniqSet s) = isNullUFM s - -lookupUniqSet :: Uniquable a => UniqSet b -> a -> Maybe b -lookupUniqSet (UniqSet s) k = lookupUFM s k - -lookupUniqSet_Directly :: UniqSet a -> Unique -> Maybe a -lookupUniqSet_Directly (UniqSet s) k = lookupUFM_Directly s k - --- See Note [Deterministic UniqFM] to learn about nondeterminism. --- If you use this please provide a justification why it doesn't introduce --- nondeterminism. -nonDetEltsUniqSet :: UniqSet elt -> [elt] -nonDetEltsUniqSet = nonDetEltsUFM . getUniqSet' - --- See Note [Deterministic UniqFM] to learn about nondeterminism. --- If you use this please provide a justification why it doesn't introduce --- nondeterminism. -nonDetKeysUniqSet :: UniqSet elt -> [Unique] -nonDetKeysUniqSet = nonDetKeysUFM . getUniqSet' - --- See Note [Deterministic UniqFM] to learn about nondeterminism. --- If you use this please provide a justification why it doesn't introduce --- nondeterminism. -nonDetFoldUniqSet :: (elt -> a -> a) -> a -> UniqSet elt -> a -nonDetFoldUniqSet c n (UniqSet s) = nonDetFoldUFM c n s - --- See Note [Deterministic UniqFM] to learn about nondeterminism. --- If you use this please provide a justification why it doesn't introduce --- nondeterminism. -nonDetFoldUniqSet_Directly:: (Unique -> elt -> a -> a) -> a -> UniqSet elt -> a -nonDetFoldUniqSet_Directly f n (UniqSet s) = nonDetFoldUFM_Directly f n s - --- See Note [UniqSet invariant] -mapUniqSet :: Uniquable b => (a -> b) -> UniqSet a -> UniqSet b -mapUniqSet f = mkUniqSet . map f . nonDetEltsUniqSet - --- Two 'UniqSet's are considered equal if they contain the same --- uniques. -instance Eq (UniqSet a) where - UniqSet a == UniqSet b = equalKeysUFM a b - -getUniqSet :: UniqSet a -> UniqFM a -getUniqSet = getUniqSet' - --- | 'unsafeUFMToUniqSet' converts a @'UniqFM' a@ into a @'UniqSet' a@ --- assuming, without checking, that it maps each 'Unique' to a value --- that has that 'Unique'. See Note [UniqSet invariant]. -unsafeUFMToUniqSet :: UniqFM a -> UniqSet a -unsafeUFMToUniqSet = UniqSet - -instance Outputable a => Outputable (UniqSet a) where - ppr = pprUniqSet ppr - -pprUniqSet :: (a -> SDoc) -> UniqSet a -> SDoc --- It's OK to use nonDetUFMToList here because we only use it for --- pretty-printing. -pprUniqSet f = braces . pprWithCommas f . nonDetEltsUniqSet |