{-# LANGUAGE DeriveTraversable  #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleInstances  #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_GHC -Wno-unused-top-binds #-}

module GHC.Cmm.Dataflow.Label
    ( Label
    , LabelMap
    , LabelSet
    , FactBase
    , lookupFact
    , mkHooplLabel
    -- * Set
    , setEmpty
    , setNull
    , setSize
    , setMember
    , setSingleton
    , setInsert
    , setDelete
    , setUnion
    , setUnions
    , setDifference
    , setIntersection
    , setIsSubsetOf
    , setFilter
    , setFoldl
    , setFoldr
    , setFromList
    , setElems
    -- * Map
    , mapNull
    , mapSize
    , mapMember
    , mapLookup
    , mapFindWithDefault
    , mapEmpty
    , mapSingleton
    , mapInsert
    , mapInsertWith
    , mapDelete
    , mapAlter
    , mapAdjust
    , mapUnion
    , mapUnions
    , mapUnionWithKey
    , mapDifference
    , mapIntersection
    , mapIsSubmapOf
    , mapMap
    , mapMapWithKey
    , mapFoldl
    , mapFoldr
    , mapFoldlWithKey
    , mapFoldMapWithKey
    , mapFilter
    , mapFilterWithKey
    , mapElems
    , mapKeys
    , mapToList
    , mapFromList
    , mapFromListWith
    ) where

import GHC.Prelude

import GHC.Utils.Outputable

import GHC.Types.Unique (Uniquable(..), mkUniqueGrimily)

-- The code generator will eventually be using all the labels stored in a
-- LabelSet and LabelMap. For these reasons we use the strict variants of these
-- data structures. We inline selectively to enable the RULES in Word64Map/Set
-- to fire.
import GHC.Data.Word64Set (Word64Set)
import qualified GHC.Data.Word64Set as S
import GHC.Data.Word64Map.Strict (Word64Map)
import qualified GHC.Data.Word64Map.Strict as M
import GHC.Data.TrieMap

import Data.Word (Word64)
import Data.List (foldl1')


-----------------------------------------------------------------------------
--              Label
-----------------------------------------------------------------------------

newtype Label = Label { Label -> Word64
lblToUnique :: Word64 }
  deriving newtype (Label -> Label -> Bool
(Label -> Label -> Bool) -> (Label -> Label -> Bool) -> Eq Label
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Label -> Label -> Bool
== :: Label -> Label -> Bool
$c/= :: Label -> Label -> Bool
/= :: Label -> Label -> Bool
Eq, Eq Label
Eq Label =>
(Label -> Label -> Ordering)
-> (Label -> Label -> Bool)
-> (Label -> Label -> Bool)
-> (Label -> Label -> Bool)
-> (Label -> Label -> Bool)
-> (Label -> Label -> Label)
-> (Label -> Label -> Label)
-> Ord Label
Label -> Label -> Bool
Label -> Label -> Ordering
Label -> Label -> Label
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Label -> Label -> Ordering
compare :: Label -> Label -> Ordering
$c< :: Label -> Label -> Bool
< :: Label -> Label -> Bool
$c<= :: Label -> Label -> Bool
<= :: Label -> Label -> Bool
$c> :: Label -> Label -> Bool
> :: Label -> Label -> Bool
$c>= :: Label -> Label -> Bool
>= :: Label -> Label -> Bool
$cmax :: Label -> Label -> Label
max :: Label -> Label -> Label
$cmin :: Label -> Label -> Label
min :: Label -> Label -> Label
Ord)

mkHooplLabel :: Word64 -> Label
mkHooplLabel :: Word64 -> Label
mkHooplLabel = Word64 -> Label
Label

instance Show Label where
  show :: Label -> String
show (Label Word64
n) = String
"L" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word64 -> String
forall a. Show a => a -> String
show Word64
n

instance Uniquable Label where
  getUnique :: Label -> Unique
getUnique Label
label = Word64 -> Unique
mkUniqueGrimily (Label -> Word64
lblToUnique Label
label)

instance Outputable Label where
  ppr :: Label -> SDoc
ppr Label
label = Unique -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Label -> Unique
forall a. Uniquable a => a -> Unique
getUnique Label
label)

instance OutputableP env Label where
  pdoc :: env -> Label -> SDoc
pdoc env
_ Label
l = Label -> SDoc
forall a. Outputable a => a -> SDoc
ppr Label
l

-----------------------------------------------------------------------------
-- LabelSet

newtype LabelSet = LS Word64Set
  deriving newtype (LabelSet -> LabelSet -> Bool
(LabelSet -> LabelSet -> Bool)
-> (LabelSet -> LabelSet -> Bool) -> Eq LabelSet
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LabelSet -> LabelSet -> Bool
== :: LabelSet -> LabelSet -> Bool
$c/= :: LabelSet -> LabelSet -> Bool
/= :: LabelSet -> LabelSet -> Bool
Eq, Eq LabelSet
Eq LabelSet =>
(LabelSet -> LabelSet -> Ordering)
-> (LabelSet -> LabelSet -> Bool)
-> (LabelSet -> LabelSet -> Bool)
-> (LabelSet -> LabelSet -> Bool)
-> (LabelSet -> LabelSet -> Bool)
-> (LabelSet -> LabelSet -> LabelSet)
-> (LabelSet -> LabelSet -> LabelSet)
-> Ord LabelSet
LabelSet -> LabelSet -> Bool
LabelSet -> LabelSet -> Ordering
LabelSet -> LabelSet -> LabelSet
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: LabelSet -> LabelSet -> Ordering
compare :: LabelSet -> LabelSet -> Ordering
$c< :: LabelSet -> LabelSet -> Bool
< :: LabelSet -> LabelSet -> Bool
$c<= :: LabelSet -> LabelSet -> Bool
<= :: LabelSet -> LabelSet -> Bool
$c> :: LabelSet -> LabelSet -> Bool
> :: LabelSet -> LabelSet -> Bool
$c>= :: LabelSet -> LabelSet -> Bool
>= :: LabelSet -> LabelSet -> Bool
$cmax :: LabelSet -> LabelSet -> LabelSet
max :: LabelSet -> LabelSet -> LabelSet
$cmin :: LabelSet -> LabelSet -> LabelSet
min :: LabelSet -> LabelSet -> LabelSet
Ord, Int -> LabelSet -> ShowS
[LabelSet] -> ShowS
LabelSet -> String
(Int -> LabelSet -> ShowS)
-> (LabelSet -> String) -> ([LabelSet] -> ShowS) -> Show LabelSet
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LabelSet -> ShowS
showsPrec :: Int -> LabelSet -> ShowS
$cshow :: LabelSet -> String
show :: LabelSet -> String
$cshowList :: [LabelSet] -> ShowS
showList :: [LabelSet] -> ShowS
Show, Semigroup LabelSet
LabelSet
Semigroup LabelSet =>
LabelSet
-> (LabelSet -> LabelSet -> LabelSet)
-> ([LabelSet] -> LabelSet)
-> Monoid LabelSet
[LabelSet] -> LabelSet
LabelSet -> LabelSet -> LabelSet
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
$cmempty :: LabelSet
mempty :: LabelSet
$cmappend :: LabelSet -> LabelSet -> LabelSet
mappend :: LabelSet -> LabelSet -> LabelSet
$cmconcat :: [LabelSet] -> LabelSet
mconcat :: [LabelSet] -> LabelSet
Monoid, NonEmpty LabelSet -> LabelSet
LabelSet -> LabelSet -> LabelSet
(LabelSet -> LabelSet -> LabelSet)
-> (NonEmpty LabelSet -> LabelSet)
-> (forall b. Integral b => b -> LabelSet -> LabelSet)
-> Semigroup LabelSet
forall b. Integral b => b -> LabelSet -> LabelSet
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: LabelSet -> LabelSet -> LabelSet
<> :: LabelSet -> LabelSet -> LabelSet
$csconcat :: NonEmpty LabelSet -> LabelSet
sconcat :: NonEmpty LabelSet -> LabelSet
$cstimes :: forall b. Integral b => b -> LabelSet -> LabelSet
stimes :: forall b. Integral b => b -> LabelSet -> LabelSet
Semigroup)

setNull :: LabelSet -> Bool
setNull :: LabelSet -> Bool
setNull (LS Word64Set
s) = Word64Set -> Bool
S.null Word64Set
s

setSize :: LabelSet -> Int
setSize :: LabelSet -> Int
setSize (LS Word64Set
s) = Word64Set -> Int
S.size Word64Set
s

setMember :: Label -> LabelSet -> Bool
setMember :: Label -> LabelSet -> Bool
setMember (Label Word64
k) (LS Word64Set
s) = Word64 -> Word64Set -> Bool
S.member Word64
k Word64Set
s

setEmpty :: LabelSet
setEmpty :: LabelSet
setEmpty = Word64Set -> LabelSet
LS Word64Set
S.empty

setSingleton :: Label -> LabelSet
setSingleton :: Label -> LabelSet
setSingleton (Label Word64
k) = Word64Set -> LabelSet
LS (Word64 -> Word64Set
S.singleton Word64
k)

setInsert :: Label -> LabelSet -> LabelSet
setInsert :: Label -> LabelSet -> LabelSet
setInsert (Label Word64
k) (LS Word64Set
s) = Word64Set -> LabelSet
LS (Word64 -> Word64Set -> Word64Set
S.insert Word64
k Word64Set
s)

setDelete :: Label -> LabelSet -> LabelSet
setDelete :: Label -> LabelSet -> LabelSet
setDelete (Label Word64
k) (LS Word64Set
s) = Word64Set -> LabelSet
LS (Word64 -> Word64Set -> Word64Set
S.delete Word64
k Word64Set
s)

setUnion :: LabelSet -> LabelSet -> LabelSet
setUnion :: LabelSet -> LabelSet -> LabelSet
setUnion (LS Word64Set
x) (LS Word64Set
y) = Word64Set -> LabelSet
LS (Word64Set -> Word64Set -> Word64Set
S.union Word64Set
x Word64Set
y)

{-# INLINE setUnions #-}
setUnions :: [LabelSet] -> LabelSet
setUnions :: [LabelSet] -> LabelSet
setUnions [] = LabelSet
setEmpty
setUnions [LabelSet]
sets = (LabelSet -> LabelSet -> LabelSet) -> [LabelSet] -> LabelSet
forall a. HasCallStack => (a -> a -> a) -> [a] -> a
foldl1' LabelSet -> LabelSet -> LabelSet
setUnion [LabelSet]
sets

setDifference :: LabelSet -> LabelSet -> LabelSet
setDifference :: LabelSet -> LabelSet -> LabelSet
setDifference (LS Word64Set
x) (LS Word64Set
y) = Word64Set -> LabelSet
LS (Word64Set -> Word64Set -> Word64Set
S.difference Word64Set
x Word64Set
y)

setIntersection :: LabelSet -> LabelSet -> LabelSet
setIntersection :: LabelSet -> LabelSet -> LabelSet
setIntersection (LS Word64Set
x) (LS Word64Set
y) = Word64Set -> LabelSet
LS (Word64Set -> Word64Set -> Word64Set
S.intersection Word64Set
x Word64Set
y)

setIsSubsetOf :: LabelSet -> LabelSet -> Bool
setIsSubsetOf :: LabelSet -> LabelSet -> Bool
setIsSubsetOf (LS Word64Set
x) (LS Word64Set
y) = Word64Set -> Word64Set -> Bool
S.isSubsetOf Word64Set
x Word64Set
y

setFilter :: (Label -> Bool) -> LabelSet -> LabelSet
setFilter :: (Label -> Bool) -> LabelSet -> LabelSet
setFilter Label -> Bool
f (LS Word64Set
s) = Word64Set -> LabelSet
LS ((Word64 -> Bool) -> Word64Set -> Word64Set
S.filter (Label -> Bool
f (Label -> Bool) -> (Word64 -> Label) -> Word64 -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Label
mkHooplLabel) Word64Set
s)

{-# INLINE setFoldl #-}
setFoldl :: (t -> Label -> t) -> t -> LabelSet -> t
setFoldl :: forall t. (t -> Label -> t) -> t -> LabelSet -> t
setFoldl t -> Label -> t
k t
z (LS Word64Set
s) = (t -> Word64 -> t) -> t -> Word64Set -> t
forall a. (a -> Word64 -> a) -> a -> Word64Set -> a
S.foldl (\t
a Word64
v -> t -> Label -> t
k t
a (Word64 -> Label
mkHooplLabel Word64
v)) t
z Word64Set
s

{-# INLINE setFoldr #-}
setFoldr :: (Label -> t -> t) -> t -> LabelSet -> t
setFoldr :: forall t. (Label -> t -> t) -> t -> LabelSet -> t
setFoldr Label -> t -> t
k t
z (LS Word64Set
s) = (Word64 -> t -> t) -> t -> Word64Set -> t
forall b. (Word64 -> b -> b) -> b -> Word64Set -> b
S.foldr (\Word64
v t
a -> Label -> t -> t
k (Word64 -> Label
mkHooplLabel Word64
v) t
a) t
z Word64Set
s

{-# INLINE setElems #-}
setElems :: LabelSet -> [Label]
setElems :: LabelSet -> [Label]
setElems (LS Word64Set
s) = (Word64 -> Label) -> [Word64] -> [Label]
forall a b. (a -> b) -> [a] -> [b]
map Word64 -> Label
mkHooplLabel (Word64Set -> [Word64]
S.elems Word64Set
s)

{-# INLINE setFromList #-}
setFromList :: [Label] -> LabelSet
setFromList :: [Label] -> LabelSet
setFromList [Label]
ks  = Word64Set -> LabelSet
LS ([Word64] -> Word64Set
S.fromList ((Label -> Word64) -> [Label] -> [Word64]
forall a b. (a -> b) -> [a] -> [b]
map Label -> Word64
lblToUnique [Label]
ks))

-----------------------------------------------------------------------------
-- LabelMap

newtype LabelMap v = LM (Word64Map v)
  deriving newtype (LabelMap v -> LabelMap v -> Bool
(LabelMap v -> LabelMap v -> Bool)
-> (LabelMap v -> LabelMap v -> Bool) -> Eq (LabelMap v)
forall v. Eq v => LabelMap v -> LabelMap v -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall v. Eq v => LabelMap v -> LabelMap v -> Bool
== :: LabelMap v -> LabelMap v -> Bool
$c/= :: forall v. Eq v => LabelMap v -> LabelMap v -> Bool
/= :: LabelMap v -> LabelMap v -> Bool
Eq, Eq (LabelMap v)
Eq (LabelMap v) =>
(LabelMap v -> LabelMap v -> Ordering)
-> (LabelMap v -> LabelMap v -> Bool)
-> (LabelMap v -> LabelMap v -> Bool)
-> (LabelMap v -> LabelMap v -> Bool)
-> (LabelMap v -> LabelMap v -> Bool)
-> (LabelMap v -> LabelMap v -> LabelMap v)
-> (LabelMap v -> LabelMap v -> LabelMap v)
-> Ord (LabelMap v)
LabelMap v -> LabelMap v -> Bool
LabelMap v -> LabelMap v -> Ordering
LabelMap v -> LabelMap v -> LabelMap v
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall v. Ord v => Eq (LabelMap v)
forall v. Ord v => LabelMap v -> LabelMap v -> Bool
forall v. Ord v => LabelMap v -> LabelMap v -> Ordering
forall v. Ord v => LabelMap v -> LabelMap v -> LabelMap v
$ccompare :: forall v. Ord v => LabelMap v -> LabelMap v -> Ordering
compare :: LabelMap v -> LabelMap v -> Ordering
$c< :: forall v. Ord v => LabelMap v -> LabelMap v -> Bool
< :: LabelMap v -> LabelMap v -> Bool
$c<= :: forall v. Ord v => LabelMap v -> LabelMap v -> Bool
<= :: LabelMap v -> LabelMap v -> Bool
$c> :: forall v. Ord v => LabelMap v -> LabelMap v -> Bool
> :: LabelMap v -> LabelMap v -> Bool
$c>= :: forall v. Ord v => LabelMap v -> LabelMap v -> Bool
>= :: LabelMap v -> LabelMap v -> Bool
$cmax :: forall v. Ord v => LabelMap v -> LabelMap v -> LabelMap v
max :: LabelMap v -> LabelMap v -> LabelMap v
$cmin :: forall v. Ord v => LabelMap v -> LabelMap v -> LabelMap v
min :: LabelMap v -> LabelMap v -> LabelMap v
Ord, Int -> LabelMap v -> ShowS
[LabelMap v] -> ShowS
LabelMap v -> String
(Int -> LabelMap v -> ShowS)
-> (LabelMap v -> String)
-> ([LabelMap v] -> ShowS)
-> Show (LabelMap v)
forall v. Show v => Int -> LabelMap v -> ShowS
forall v. Show v => [LabelMap v] -> ShowS
forall v. Show v => LabelMap v -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall v. Show v => Int -> LabelMap v -> ShowS
showsPrec :: Int -> LabelMap v -> ShowS
$cshow :: forall v. Show v => LabelMap v -> String
show :: LabelMap v -> String
$cshowList :: forall v. Show v => [LabelMap v] -> ShowS
showList :: [LabelMap v] -> ShowS
Show, (forall a b. (a -> b) -> LabelMap a -> LabelMap b)
-> (forall a b. a -> LabelMap b -> LabelMap a) -> Functor LabelMap
forall a b. a -> LabelMap b -> LabelMap a
forall a b. (a -> b) -> LabelMap a -> LabelMap b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> LabelMap a -> LabelMap b
fmap :: forall a b. (a -> b) -> LabelMap a -> LabelMap b
$c<$ :: forall a b. a -> LabelMap b -> LabelMap a
<$ :: forall a b. a -> LabelMap b -> LabelMap a
Functor, (forall m. Monoid m => LabelMap m -> m)
-> (forall m a. Monoid m => (a -> m) -> LabelMap a -> m)
-> (forall m a. Monoid m => (a -> m) -> LabelMap a -> m)
-> (forall a b. (a -> b -> b) -> b -> LabelMap a -> b)
-> (forall a b. (a -> b -> b) -> b -> LabelMap a -> b)
-> (forall b a. (b -> a -> b) -> b -> LabelMap a -> b)
-> (forall b a. (b -> a -> b) -> b -> LabelMap a -> b)
-> (forall a. (a -> a -> a) -> LabelMap a -> a)
-> (forall a. (a -> a -> a) -> LabelMap a -> a)
-> (forall a. LabelMap a -> [a])
-> (forall a. LabelMap a -> Bool)
-> (forall a. LabelMap a -> Int)
-> (forall a. Eq a => a -> LabelMap a -> Bool)
-> (forall a. Ord a => LabelMap a -> a)
-> (forall a. Ord a => LabelMap a -> a)
-> (forall a. Num a => LabelMap a -> a)
-> (forall a. Num a => LabelMap a -> a)
-> Foldable LabelMap
forall a. Eq a => a -> LabelMap a -> Bool
forall a. Num a => LabelMap a -> a
forall a. Ord a => LabelMap a -> a
forall m. Monoid m => LabelMap m -> m
forall a. LabelMap a -> Bool
forall a. LabelMap a -> Int
forall a. LabelMap a -> [a]
forall a. (a -> a -> a) -> LabelMap a -> a
forall m a. Monoid m => (a -> m) -> LabelMap a -> m
forall b a. (b -> a -> b) -> b -> LabelMap a -> b
forall a b. (a -> b -> b) -> b -> LabelMap a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => LabelMap m -> m
fold :: forall m. Monoid m => LabelMap m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> LabelMap a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> LabelMap a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> LabelMap a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> LabelMap a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> LabelMap a -> b
foldr :: forall a b. (a -> b -> b) -> b -> LabelMap a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> LabelMap a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> LabelMap a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> LabelMap a -> b
foldl :: forall b a. (b -> a -> b) -> b -> LabelMap a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> LabelMap a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> LabelMap a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> LabelMap a -> a
foldr1 :: forall a. (a -> a -> a) -> LabelMap a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> LabelMap a -> a
foldl1 :: forall a. (a -> a -> a) -> LabelMap a -> a
$ctoList :: forall a. LabelMap a -> [a]
toList :: forall a. LabelMap a -> [a]
$cnull :: forall a. LabelMap a -> Bool
null :: forall a. LabelMap a -> Bool
$clength :: forall a. LabelMap a -> Int
length :: forall a. LabelMap a -> Int
$celem :: forall a. Eq a => a -> LabelMap a -> Bool
elem :: forall a. Eq a => a -> LabelMap a -> Bool
$cmaximum :: forall a. Ord a => LabelMap a -> a
maximum :: forall a. Ord a => LabelMap a -> a
$cminimum :: forall a. Ord a => LabelMap a -> a
minimum :: forall a. Ord a => LabelMap a -> a
$csum :: forall a. Num a => LabelMap a -> a
sum :: forall a. Num a => LabelMap a -> a
$cproduct :: forall a. Num a => LabelMap a -> a
product :: forall a. Num a => LabelMap a -> a
Foldable)
  deriving stock   Functor LabelMap
Foldable LabelMap
(Functor LabelMap, Foldable LabelMap) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> LabelMap a -> f (LabelMap b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    LabelMap (f a) -> f (LabelMap a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> LabelMap a -> m (LabelMap b))
-> (forall (m :: * -> *) a.
    Monad m =>
    LabelMap (m a) -> m (LabelMap a))
-> Traversable LabelMap
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => LabelMap (m a) -> m (LabelMap a)
forall (f :: * -> *) a.
Applicative f =>
LabelMap (f a) -> f (LabelMap a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> LabelMap a -> m (LabelMap b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> LabelMap a -> f (LabelMap b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> LabelMap a -> f (LabelMap b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> LabelMap a -> f (LabelMap b)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
LabelMap (f a) -> f (LabelMap a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
LabelMap (f a) -> f (LabelMap a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> LabelMap a -> m (LabelMap b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> LabelMap a -> m (LabelMap b)
$csequence :: forall (m :: * -> *) a. Monad m => LabelMap (m a) -> m (LabelMap a)
sequence :: forall (m :: * -> *) a. Monad m => LabelMap (m a) -> m (LabelMap a)
Traversable

mapNull :: LabelMap a -> Bool
mapNull :: forall a. LabelMap a -> Bool
mapNull (LM Word64Map a
m) = Word64Map a -> Bool
forall a. Word64Map a -> Bool
M.null Word64Map a
m

{-# INLINE mapSize #-}
mapSize :: LabelMap a -> Int
mapSize :: forall a. LabelMap a -> Int
mapSize (LM Word64Map a
m) = Word64Map a -> Int
forall a. Word64Map a -> Int
M.size Word64Map a
m

mapMember :: Label -> LabelMap a -> Bool
mapMember :: forall a. Label -> LabelMap a -> Bool
mapMember (Label Word64
k) (LM Word64Map a
m) = Word64 -> Word64Map a -> Bool
forall a. Word64 -> Word64Map a -> Bool
M.member Word64
k Word64Map a
m

mapLookup :: Label -> LabelMap a -> Maybe a
mapLookup :: forall a. Label -> LabelMap a -> Maybe a
mapLookup (Label Word64
k) (LM Word64Map a
m) = Word64 -> Word64Map a -> Maybe a
forall a. Word64 -> Word64Map a -> Maybe a
M.lookup Word64
k Word64Map a
m

mapFindWithDefault :: a -> Label -> LabelMap a -> a
mapFindWithDefault :: forall a. a -> Label -> LabelMap a -> a
mapFindWithDefault a
def (Label Word64
k) (LM Word64Map a
m) = a -> Word64 -> Word64Map a -> a
forall a. a -> Word64 -> Word64Map a -> a
M.findWithDefault a
def Word64
k Word64Map a
m

mapEmpty :: LabelMap v
mapEmpty :: forall v. LabelMap v
mapEmpty = Word64Map v -> LabelMap v
forall v. Word64Map v -> LabelMap v
LM Word64Map v
forall a. Word64Map a
M.empty

mapSingleton :: Label -> v -> LabelMap v
mapSingleton :: forall v. Label -> v -> LabelMap v
mapSingleton (Label Word64
k) v
v = Word64Map v -> LabelMap v
forall v. Word64Map v -> LabelMap v
LM (Word64 -> v -> Word64Map v
forall a. Word64 -> a -> Word64Map a
M.singleton Word64
k v
v)

mapInsert :: Label -> v -> LabelMap v -> LabelMap v
mapInsert :: forall v. Label -> v -> LabelMap v -> LabelMap v
mapInsert (Label Word64
k) v
v (LM Word64Map v
m) = Word64Map v -> LabelMap v
forall v. Word64Map v -> LabelMap v
LM (Word64 -> v -> Word64Map v -> Word64Map v
forall a. Word64 -> a -> Word64Map a -> Word64Map a
M.insert Word64
k v
v Word64Map v
m)

mapInsertWith :: (v -> v -> v) -> Label -> v -> LabelMap v -> LabelMap v
mapInsertWith :: forall v. (v -> v -> v) -> Label -> v -> LabelMap v -> LabelMap v
mapInsertWith v -> v -> v
f (Label Word64
k) v
v (LM Word64Map v
m) = Word64Map v -> LabelMap v
forall v. Word64Map v -> LabelMap v
LM ((v -> v -> v) -> Word64 -> v -> Word64Map v -> Word64Map v
forall a.
(a -> a -> a) -> Word64 -> a -> Word64Map a -> Word64Map a
M.insertWith v -> v -> v
f Word64
k v
v Word64Map v
m)

mapDelete :: Label -> LabelMap v -> LabelMap v
mapDelete :: forall v. Label -> LabelMap v -> LabelMap v
mapDelete (Label Word64
k) (LM Word64Map v
m) = Word64Map v -> LabelMap v
forall v. Word64Map v -> LabelMap v
LM (Word64 -> Word64Map v -> Word64Map v
forall a. Word64 -> Word64Map a -> Word64Map a
M.delete Word64
k Word64Map v
m)

mapAlter :: (Maybe v -> Maybe v) -> Label -> LabelMap v -> LabelMap v
mapAlter :: forall v. (Maybe v -> Maybe v) -> Label -> LabelMap v -> LabelMap v
mapAlter Maybe v -> Maybe v
f (Label Word64
k) (LM Word64Map v
m) = Word64Map v -> LabelMap v
forall v. Word64Map v -> LabelMap v
LM ((Maybe v -> Maybe v) -> Word64 -> Word64Map v -> Word64Map v
forall a.
(Maybe a -> Maybe a) -> Word64 -> Word64Map a -> Word64Map a
M.alter Maybe v -> Maybe v
f Word64
k Word64Map v
m)

mapAdjust :: (v -> v) -> Label -> LabelMap v -> LabelMap v
mapAdjust :: forall v. (v -> v) -> Label -> LabelMap v -> LabelMap v
mapAdjust v -> v
f (Label Word64
k) (LM Word64Map v
m) = Word64Map v -> LabelMap v
forall v. Word64Map v -> LabelMap v
LM ((v -> v) -> Word64 -> Word64Map v -> Word64Map v
forall a. (a -> a) -> Word64 -> Word64Map a -> Word64Map a
M.adjust v -> v
f Word64
k Word64Map v
m)

mapUnion :: LabelMap v -> LabelMap v -> LabelMap v
mapUnion :: forall v. LabelMap v -> LabelMap v -> LabelMap v
mapUnion (LM Word64Map v
x) (LM Word64Map v
y) = Word64Map v -> LabelMap v
forall v. Word64Map v -> LabelMap v
LM (Word64Map v -> Word64Map v -> Word64Map v
forall a. Word64Map a -> Word64Map a -> Word64Map a
M.union Word64Map v
x Word64Map v
y)

{-# INLINE mapUnions #-}
mapUnions :: [LabelMap a] -> LabelMap a
mapUnions :: forall a. [LabelMap a] -> LabelMap a
mapUnions [] = LabelMap a
forall v. LabelMap v
mapEmpty
mapUnions [LabelMap a]
maps = (LabelMap a -> LabelMap a -> LabelMap a)
-> [LabelMap a] -> LabelMap a
forall a. HasCallStack => (a -> a -> a) -> [a] -> a
foldl1' LabelMap a -> LabelMap a -> LabelMap a
forall v. LabelMap v -> LabelMap v -> LabelMap v
mapUnion [LabelMap a]
maps

mapUnionWithKey :: (Label -> v -> v -> v) -> LabelMap v -> LabelMap v -> LabelMap v
mapUnionWithKey :: forall v.
(Label -> v -> v -> v) -> LabelMap v -> LabelMap v -> LabelMap v
mapUnionWithKey Label -> v -> v -> v
f (LM Word64Map v
x) (LM Word64Map v
y) = Word64Map v -> LabelMap v
forall v. Word64Map v -> LabelMap v
LM ((Word64 -> v -> v -> v)
-> Word64Map v -> Word64Map v -> Word64Map v
forall a.
(Word64 -> a -> a -> a)
-> Word64Map a -> Word64Map a -> Word64Map a
M.unionWithKey (Label -> v -> v -> v
f (Label -> v -> v -> v)
-> (Word64 -> Label) -> Word64 -> v -> v -> v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Label
mkHooplLabel) Word64Map v
x Word64Map v
y)

mapDifference :: LabelMap v -> LabelMap b -> LabelMap v
mapDifference :: forall v b. LabelMap v -> LabelMap b -> LabelMap v
mapDifference (LM Word64Map v
x) (LM Word64Map b
y) = Word64Map v -> LabelMap v
forall v. Word64Map v -> LabelMap v
LM (Word64Map v -> Word64Map b -> Word64Map v
forall a b. Word64Map a -> Word64Map b -> Word64Map a
M.difference Word64Map v
x Word64Map b
y)

mapIntersection :: LabelMap v -> LabelMap b -> LabelMap v
mapIntersection :: forall v b. LabelMap v -> LabelMap b -> LabelMap v
mapIntersection (LM Word64Map v
x) (LM Word64Map b
y) = Word64Map v -> LabelMap v
forall v. Word64Map v -> LabelMap v
LM (Word64Map v -> Word64Map b -> Word64Map v
forall a b. Word64Map a -> Word64Map b -> Word64Map a
M.intersection Word64Map v
x Word64Map b
y)

mapIsSubmapOf :: Eq a => LabelMap a -> LabelMap a -> Bool
mapIsSubmapOf :: forall v. Eq v => LabelMap v -> LabelMap v -> Bool
mapIsSubmapOf (LM Word64Map a
x) (LM Word64Map a
y) = Word64Map a -> Word64Map a -> Bool
forall a. Eq a => Word64Map a -> Word64Map a -> Bool
M.isSubmapOf Word64Map a
x Word64Map a
y

mapMap :: (a -> v) -> LabelMap a -> LabelMap v
mapMap :: forall a b. (a -> b) -> LabelMap a -> LabelMap b
mapMap a -> v
f (LM Word64Map a
m) = Word64Map v -> LabelMap v
forall v. Word64Map v -> LabelMap v
LM ((a -> v) -> Word64Map a -> Word64Map v
forall a b. (a -> b) -> Word64Map a -> Word64Map b
M.map a -> v
f Word64Map a
m)

mapMapWithKey :: (Label -> a -> v) -> LabelMap a -> LabelMap v
mapMapWithKey :: forall a v. (Label -> a -> v) -> LabelMap a -> LabelMap v
mapMapWithKey Label -> a -> v
f (LM Word64Map a
m) = Word64Map v -> LabelMap v
forall v. Word64Map v -> LabelMap v
LM ((Word64 -> a -> v) -> Word64Map a -> Word64Map v
forall a b. (Word64 -> a -> b) -> Word64Map a -> Word64Map b
M.mapWithKey (Label -> a -> v
f (Label -> a -> v) -> (Word64 -> Label) -> Word64 -> a -> v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Label
mkHooplLabel) Word64Map a
m)

{-# INLINE mapFoldl #-}
mapFoldl :: (a -> b -> a) -> a -> LabelMap b -> a
mapFoldl :: forall b a. (b -> a -> b) -> b -> LabelMap a -> b
mapFoldl a -> b -> a
k a
z (LM Word64Map b
m) = (a -> b -> a) -> a -> Word64Map b -> a
forall a b. (a -> b -> a) -> a -> Word64Map b -> a
M.foldl a -> b -> a
k a
z Word64Map b
m

{-# INLINE mapFoldr #-}
mapFoldr :: (a -> b -> b) -> b -> LabelMap a -> b
mapFoldr :: forall a b. (a -> b -> b) -> b -> LabelMap a -> b
mapFoldr a -> b -> b
k b
z (LM Word64Map a
m) = (a -> b -> b) -> b -> Word64Map a -> b
forall a b. (a -> b -> b) -> b -> Word64Map a -> b
M.foldr a -> b -> b
k b
z Word64Map a
m

{-# INLINE mapFoldlWithKey #-}
mapFoldlWithKey :: (t -> Label -> b -> t) -> t -> LabelMap b -> t
mapFoldlWithKey :: forall t b. (t -> Label -> b -> t) -> t -> LabelMap b -> t
mapFoldlWithKey t -> Label -> b -> t
k t
z (LM Word64Map b
m) = (t -> Word64 -> b -> t) -> t -> Word64Map b -> t
forall a b. (a -> Word64 -> b -> a) -> a -> Word64Map b -> a
M.foldlWithKey (\t
a Word64
v -> t -> Label -> b -> t
k t
a (Word64 -> Label
mkHooplLabel Word64
v)) t
z Word64Map b
m

mapFoldMapWithKey :: Monoid m => (Label -> t -> m) -> LabelMap t -> m
mapFoldMapWithKey :: forall m t. Monoid m => (Label -> t -> m) -> LabelMap t -> m
mapFoldMapWithKey Label -> t -> m
f (LM Word64Map t
m) = (Word64 -> t -> m) -> Word64Map t -> m
forall m a. Monoid m => (Word64 -> a -> m) -> Word64Map a -> m
M.foldMapWithKey (\Word64
k t
v -> Label -> t -> m
f (Word64 -> Label
mkHooplLabel Word64
k) t
v) Word64Map t
m

{-# INLINEABLE mapFilter #-}
mapFilter :: (v -> Bool) -> LabelMap v -> LabelMap v
mapFilter :: forall v. (v -> Bool) -> LabelMap v -> LabelMap v
mapFilter v -> Bool
f (LM Word64Map v
m) = Word64Map v -> LabelMap v
forall v. Word64Map v -> LabelMap v
LM ((v -> Bool) -> Word64Map v -> Word64Map v
forall a. (a -> Bool) -> Word64Map a -> Word64Map a
M.filter v -> Bool
f Word64Map v
m)

{-# INLINEABLE mapFilterWithKey #-}
mapFilterWithKey :: (Label -> v -> Bool) -> LabelMap v -> LabelMap v
mapFilterWithKey :: forall v. (Label -> v -> Bool) -> LabelMap v -> LabelMap v
mapFilterWithKey Label -> v -> Bool
f (LM Word64Map v
m)  = Word64Map v -> LabelMap v
forall v. Word64Map v -> LabelMap v
LM ((Word64 -> v -> Bool) -> Word64Map v -> Word64Map v
forall a. (Word64 -> a -> Bool) -> Word64Map a -> Word64Map a
M.filterWithKey (Label -> v -> Bool
f (Label -> v -> Bool) -> (Word64 -> Label) -> Word64 -> v -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Label
mkHooplLabel) Word64Map v
m)

{-# INLINE mapElems #-}
mapElems :: LabelMap a -> [a]
mapElems :: forall a. LabelMap a -> [a]
mapElems (LM Word64Map a
m) = Word64Map a -> [a]
forall a. Word64Map a -> [a]
M.elems Word64Map a
m

{-# INLINE mapKeys #-}
mapKeys :: LabelMap a -> [Label]
mapKeys :: forall a. LabelMap a -> [Label]
mapKeys (LM Word64Map a
m) = ((Word64, a) -> Label) -> [(Word64, a)] -> [Label]
forall a b. (a -> b) -> [a] -> [b]
map (Word64 -> Label
mkHooplLabel (Word64 -> Label)
-> ((Word64, a) -> Word64) -> (Word64, a) -> Label
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word64, a) -> Word64
forall a b. (a, b) -> a
fst) (Word64Map a -> [(Word64, a)]
forall a. Word64Map a -> [(Word64, a)]
M.toList Word64Map a
m)

{-# INLINE mapToList #-}
mapToList :: LabelMap b -> [(Label, b)]
mapToList :: forall b. LabelMap b -> [(Label, b)]
mapToList (LM Word64Map b
m) = [(Word64 -> Label
mkHooplLabel Word64
k, b
v) | (Word64
k, b
v) <- Word64Map b -> [(Word64, b)]
forall a. Word64Map a -> [(Word64, a)]
M.toList Word64Map b
m]

{-# INLINE mapFromList #-}
mapFromList :: [(Label, v)] -> LabelMap v
mapFromList :: forall v. [(Label, v)] -> LabelMap v
mapFromList [(Label, v)]
assocs = Word64Map v -> LabelMap v
forall v. Word64Map v -> LabelMap v
LM ([(Word64, v)] -> Word64Map v
forall a. [(Word64, a)] -> Word64Map a
M.fromList [(Label -> Word64
lblToUnique Label
k, v
v) | (Label
k, v
v) <- [(Label, v)]
assocs])

mapFromListWith :: (v -> v -> v) -> [(Label, v)] -> LabelMap v
mapFromListWith :: forall v. (v -> v -> v) -> [(Label, v)] -> LabelMap v
mapFromListWith v -> v -> v
f [(Label, v)]
assocs = Word64Map v -> LabelMap v
forall v. Word64Map v -> LabelMap v
LM ((v -> v -> v) -> [(Word64, v)] -> Word64Map v
forall a. (a -> a -> a) -> [(Word64, a)] -> Word64Map a
M.fromListWith v -> v -> v
f [(Label -> Word64
lblToUnique Label
k, v
v) | (Label
k, v
v) <- [(Label, v)]
assocs])

-----------------------------------------------------------------------------
-- Instances

instance Outputable LabelSet where
  ppr :: LabelSet -> SDoc
ppr = [Label] -> SDoc
forall a. Outputable a => a -> SDoc
ppr ([Label] -> SDoc) -> (LabelSet -> [Label]) -> LabelSet -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LabelSet -> [Label]
setElems

instance Outputable a => Outputable (LabelMap a) where
  ppr :: LabelMap a -> SDoc
ppr = [(Label, a)] -> SDoc
forall a. Outputable a => a -> SDoc
ppr ([(Label, a)] -> SDoc)
-> (LabelMap a -> [(Label, a)]) -> LabelMap a -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LabelMap a -> [(Label, a)]
forall b. LabelMap b -> [(Label, b)]
mapToList

instance OutputableP env a => OutputableP env (LabelMap a) where
  pdoc :: env -> LabelMap a -> SDoc
pdoc env
env = env -> [(Label, a)] -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc env
env ([(Label, a)] -> SDoc)
-> (LabelMap a -> [(Label, a)]) -> LabelMap a -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LabelMap a -> [(Label, a)]
forall b. LabelMap b -> [(Label, b)]
mapToList

instance TrieMap LabelMap where
  type Key LabelMap = Label
  emptyTM :: forall v. LabelMap v
emptyTM       = LabelMap a
forall v. LabelMap v
mapEmpty
  lookupTM :: forall b. Key LabelMap -> LabelMap b -> Maybe b
lookupTM Key LabelMap
k LabelMap b
m  = Label -> LabelMap b -> Maybe b
forall a. Label -> LabelMap a -> Maybe a
mapLookup Key LabelMap
Label
k LabelMap b
m
  alterTM :: forall b. Key LabelMap -> XT b -> LabelMap b -> LabelMap b
alterTM Key LabelMap
k XT b
f LabelMap b
m = XT b -> Label -> LabelMap b -> LabelMap b
forall v. (Maybe v -> Maybe v) -> Label -> LabelMap v -> LabelMap v
mapAlter XT b
f Key LabelMap
Label
k LabelMap b
m
  foldTM :: forall a b. (a -> b -> b) -> LabelMap a -> b -> b
foldTM a -> b -> b
k LabelMap a
m b
z  = (a -> b -> b) -> b -> LabelMap a -> b
forall a b. (a -> b -> b) -> b -> LabelMap a -> b
mapFoldr a -> b -> b
k b
z LabelMap a
m
  filterTM :: forall v. (v -> Bool) -> LabelMap v -> LabelMap v
filterTM a -> Bool
f LabelMap a
m  = (a -> Bool) -> LabelMap a -> LabelMap a
forall v. (v -> Bool) -> LabelMap v -> LabelMap v
mapFilter a -> Bool
f LabelMap a
m

-----------------------------------------------------------------------------
-- FactBase

type FactBase f = LabelMap f

lookupFact :: Label -> FactBase f -> Maybe f
lookupFact :: forall a. Label -> LabelMap a -> Maybe a
lookupFact = Label -> LabelMap f -> Maybe f
forall a. Label -> LabelMap a -> Maybe a
mapLookup