{-# LANGUAGE DeriveFoldable #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}

module Hoopl.Label
    ( Label
    , LabelMap
    , LabelSet
    , FactBase
    , lookupFact
    , mkHooplLabel
    ) where

import GhcPrelude

import Outputable

-- TODO: This should really just use GHC's Unique and Uniq{Set,FM}
import Hoopl.Collections

import Unique (Uniquable(..))
import TrieMap


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

newtype Label = Label { Label -> Int
lblToUnique :: Int }
  deriving (Label -> Label -> Bool
(Label -> Label -> Bool) -> (Label -> Label -> Bool) -> Eq Label
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Label -> Label -> Bool
$c/= :: Label -> Label -> Bool
== :: Label -> Label -> Bool
$c== :: 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
min :: Label -> Label -> Label
$cmin :: Label -> Label -> Label
max :: Label -> Label -> Label
$cmax :: Label -> Label -> Label
>= :: Label -> Label -> Bool
$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
compare :: Label -> Label -> Ordering
$ccompare :: Label -> Label -> Ordering
$cp1Ord :: Eq Label
Ord)

mkHooplLabel :: Int -> Label
mkHooplLabel :: Int -> Label
mkHooplLabel = Int -> Label
Label

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

instance Uniquable Label where
  getUnique :: Label -> Unique
getUnique Label
label = Int -> Unique
forall a. Uniquable a => a -> Unique
getUnique (Label -> Int
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)

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

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

instance IsSet LabelSet where
  type ElemOf LabelSet = Label

  setNull :: LabelSet -> Bool
setNull (LS UniqueSet
s) = UniqueSet -> Bool
forall set. IsSet set => set -> Bool
setNull UniqueSet
s
  setSize :: LabelSet -> Int
setSize (LS UniqueSet
s) = UniqueSet -> Int
forall set. IsSet set => set -> Int
setSize UniqueSet
s
  setMember :: ElemOf LabelSet -> LabelSet -> Bool
setMember (Label k) (LS UniqueSet
s) = ElemOf UniqueSet -> UniqueSet -> Bool
forall set. IsSet set => ElemOf set -> set -> Bool
setMember Int
ElemOf UniqueSet
k UniqueSet
s

  setEmpty :: LabelSet
setEmpty = UniqueSet -> LabelSet
LS UniqueSet
forall set. IsSet set => set
setEmpty
  setSingleton :: ElemOf LabelSet -> LabelSet
setSingleton (Label k) = UniqueSet -> LabelSet
LS (ElemOf UniqueSet -> UniqueSet
forall set. IsSet set => ElemOf set -> set
setSingleton Int
ElemOf UniqueSet
k)
  setInsert :: ElemOf LabelSet -> LabelSet -> LabelSet
setInsert (Label k) (LS UniqueSet
s) = UniqueSet -> LabelSet
LS (ElemOf UniqueSet -> UniqueSet -> UniqueSet
forall set. IsSet set => ElemOf set -> set -> set
setInsert Int
ElemOf UniqueSet
k UniqueSet
s)
  setDelete :: ElemOf LabelSet -> LabelSet -> LabelSet
setDelete (Label k) (LS UniqueSet
s) = UniqueSet -> LabelSet
LS (ElemOf UniqueSet -> UniqueSet -> UniqueSet
forall set. IsSet set => ElemOf set -> set -> set
setDelete Int
ElemOf UniqueSet
k UniqueSet
s)

  setUnion :: LabelSet -> LabelSet -> LabelSet
setUnion (LS UniqueSet
x) (LS UniqueSet
y) = UniqueSet -> LabelSet
LS (UniqueSet -> UniqueSet -> UniqueSet
forall set. IsSet set => set -> set -> set
setUnion UniqueSet
x UniqueSet
y)
  setDifference :: LabelSet -> LabelSet -> LabelSet
setDifference (LS UniqueSet
x) (LS UniqueSet
y) = UniqueSet -> LabelSet
LS (UniqueSet -> UniqueSet -> UniqueSet
forall set. IsSet set => set -> set -> set
setDifference UniqueSet
x UniqueSet
y)
  setIntersection :: LabelSet -> LabelSet -> LabelSet
setIntersection (LS UniqueSet
x) (LS UniqueSet
y) = UniqueSet -> LabelSet
LS (UniqueSet -> UniqueSet -> UniqueSet
forall set. IsSet set => set -> set -> set
setIntersection UniqueSet
x UniqueSet
y)
  setIsSubsetOf :: LabelSet -> LabelSet -> Bool
setIsSubsetOf (LS UniqueSet
x) (LS UniqueSet
y) = UniqueSet -> UniqueSet -> Bool
forall set. IsSet set => set -> set -> Bool
setIsSubsetOf UniqueSet
x UniqueSet
y
  setFilter :: (ElemOf LabelSet -> Bool) -> LabelSet -> LabelSet
setFilter ElemOf LabelSet -> Bool
f (LS UniqueSet
s) = UniqueSet -> LabelSet
LS ((ElemOf UniqueSet -> Bool) -> UniqueSet -> UniqueSet
forall set. IsSet set => (ElemOf set -> Bool) -> set -> set
setFilter (ElemOf LabelSet -> Bool
Label -> Bool
f (Label -> Bool) -> (Int -> Label) -> Int -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Label
mkHooplLabel) UniqueSet
s)
  setFoldl :: (b -> ElemOf LabelSet -> b) -> b -> LabelSet -> b
setFoldl b -> ElemOf LabelSet -> b
k b
z (LS UniqueSet
s) = (b -> ElemOf UniqueSet -> b) -> b -> UniqueSet -> b
forall set b. IsSet set => (b -> ElemOf set -> b) -> b -> set -> b
setFoldl (\b
a ElemOf UniqueSet
v -> b -> ElemOf LabelSet -> b
k b
a (Int -> Label
mkHooplLabel Int
ElemOf UniqueSet
v)) b
z UniqueSet
s
  setFoldr :: (ElemOf LabelSet -> b -> b) -> b -> LabelSet -> b
setFoldr ElemOf LabelSet -> b -> b
k b
z (LS UniqueSet
s) = (ElemOf UniqueSet -> b -> b) -> b -> UniqueSet -> b
forall set b. IsSet set => (ElemOf set -> b -> b) -> b -> set -> b
setFoldr (\ElemOf UniqueSet
v b
a -> ElemOf LabelSet -> b -> b
k (Int -> Label
mkHooplLabel Int
ElemOf UniqueSet
v) b
a) b
z UniqueSet
s

  setElems :: LabelSet -> [ElemOf LabelSet]
setElems (LS UniqueSet
s) = (Int -> Label) -> [Int] -> [Label]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Label
mkHooplLabel (UniqueSet -> [ElemOf UniqueSet]
forall set. IsSet set => set -> [ElemOf set]
setElems UniqueSet
s)
  setFromList :: [ElemOf LabelSet] -> LabelSet
setFromList [ElemOf LabelSet]
ks = UniqueSet -> LabelSet
LS ([ElemOf UniqueSet] -> UniqueSet
forall set. IsSet set => [ElemOf set] -> set
setFromList ((Label -> Int) -> [Label] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Label -> Int
lblToUnique [ElemOf LabelSet]
[Label]
ks))

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

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

instance IsMap LabelMap where
  type KeyOf LabelMap = Label

  mapNull :: LabelMap a -> Bool
mapNull (LM UniqueMap a
m) = UniqueMap a -> Bool
forall (map :: * -> *) a. IsMap map => map a -> Bool
mapNull UniqueMap a
m
  mapSize :: LabelMap a -> Int
mapSize (LM UniqueMap a
m) = UniqueMap a -> Int
forall (map :: * -> *) a. IsMap map => map a -> Int
mapSize UniqueMap a
m
  mapMember :: KeyOf LabelMap -> LabelMap a -> Bool
mapMember (Label k) (LM UniqueMap a
m) = KeyOf UniqueMap -> UniqueMap a -> Bool
forall (map :: * -> *) a. IsMap map => KeyOf map -> map a -> Bool
mapMember Int
KeyOf UniqueMap
k UniqueMap a
m
  mapLookup :: KeyOf LabelMap -> LabelMap a -> Maybe a
mapLookup (Label k) (LM UniqueMap a
m) = KeyOf UniqueMap -> UniqueMap a -> Maybe a
forall (map :: * -> *) a.
IsMap map =>
KeyOf map -> map a -> Maybe a
mapLookup Int
KeyOf UniqueMap
k UniqueMap a
m
  mapFindWithDefault :: a -> KeyOf LabelMap -> LabelMap a -> a
mapFindWithDefault a
def (Label k) (LM UniqueMap a
m) = a -> KeyOf UniqueMap -> UniqueMap a -> a
forall (map :: * -> *) a. IsMap map => a -> KeyOf map -> map a -> a
mapFindWithDefault a
def Int
KeyOf UniqueMap
k UniqueMap a
m

  mapEmpty :: LabelMap a
mapEmpty = UniqueMap a -> LabelMap a
forall v. UniqueMap v -> LabelMap v
LM UniqueMap a
forall (map :: * -> *) a. IsMap map => map a
mapEmpty
  mapSingleton :: KeyOf LabelMap -> a -> LabelMap a
mapSingleton (Label k) a
v = UniqueMap a -> LabelMap a
forall v. UniqueMap v -> LabelMap v
LM (KeyOf UniqueMap -> a -> UniqueMap a
forall (map :: * -> *) a. IsMap map => KeyOf map -> a -> map a
mapSingleton Int
KeyOf UniqueMap
k a
v)
  mapInsert :: KeyOf LabelMap -> a -> LabelMap a -> LabelMap a
mapInsert (Label k) a
v (LM UniqueMap a
m) = UniqueMap a -> LabelMap a
forall v. UniqueMap v -> LabelMap v
LM (KeyOf UniqueMap -> a -> UniqueMap a -> UniqueMap a
forall (map :: * -> *) a.
IsMap map =>
KeyOf map -> a -> map a -> map a
mapInsert Int
KeyOf UniqueMap
k a
v UniqueMap a
m)
  mapInsertWith :: (a -> a -> a) -> KeyOf LabelMap -> a -> LabelMap a -> LabelMap a
mapInsertWith a -> a -> a
f (Label k) a
v (LM UniqueMap a
m) = UniqueMap a -> LabelMap a
forall v. UniqueMap v -> LabelMap v
LM ((a -> a -> a) -> KeyOf UniqueMap -> a -> UniqueMap a -> UniqueMap a
forall (map :: * -> *) a.
IsMap map =>
(a -> a -> a) -> KeyOf map -> a -> map a -> map a
mapInsertWith a -> a -> a
f Int
KeyOf UniqueMap
k a
v UniqueMap a
m)
  mapDelete :: KeyOf LabelMap -> LabelMap a -> LabelMap a
mapDelete (Label k) (LM UniqueMap a
m) = UniqueMap a -> LabelMap a
forall v. UniqueMap v -> LabelMap v
LM (KeyOf UniqueMap -> UniqueMap a -> UniqueMap a
forall (map :: * -> *) a. IsMap map => KeyOf map -> map a -> map a
mapDelete Int
KeyOf UniqueMap
k UniqueMap a
m)
  mapAlter :: (Maybe a -> Maybe a) -> KeyOf LabelMap -> LabelMap a -> LabelMap a
mapAlter Maybe a -> Maybe a
f (Label k) (LM UniqueMap a
m) = UniqueMap a -> LabelMap a
forall v. UniqueMap v -> LabelMap v
LM ((Maybe a -> Maybe a)
-> KeyOf UniqueMap -> UniqueMap a -> UniqueMap a
forall (map :: * -> *) a.
IsMap map =>
(Maybe a -> Maybe a) -> KeyOf map -> map a -> map a
mapAlter Maybe a -> Maybe a
f Int
KeyOf UniqueMap
k UniqueMap a
m)
  mapAdjust :: (a -> a) -> KeyOf LabelMap -> LabelMap a -> LabelMap a
mapAdjust a -> a
f (Label k) (LM UniqueMap a
m) = UniqueMap a -> LabelMap a
forall v. UniqueMap v -> LabelMap v
LM ((a -> a) -> KeyOf UniqueMap -> UniqueMap a -> UniqueMap a
forall (map :: * -> *) a.
IsMap map =>
(a -> a) -> KeyOf map -> map a -> map a
mapAdjust a -> a
f Int
KeyOf UniqueMap
k UniqueMap a
m)

  mapUnion :: LabelMap a -> LabelMap a -> LabelMap a
mapUnion (LM UniqueMap a
x) (LM UniqueMap a
y) = UniqueMap a -> LabelMap a
forall v. UniqueMap v -> LabelMap v
LM (UniqueMap a -> UniqueMap a -> UniqueMap a
forall (map :: * -> *) a. IsMap map => map a -> map a -> map a
mapUnion UniqueMap a
x UniqueMap a
y)
  mapUnionWithKey :: (KeyOf LabelMap -> a -> a -> a)
-> LabelMap a -> LabelMap a -> LabelMap a
mapUnionWithKey KeyOf LabelMap -> a -> a -> a
f (LM UniqueMap a
x) (LM UniqueMap a
y) = UniqueMap a -> LabelMap a
forall v. UniqueMap v -> LabelMap v
LM ((KeyOf UniqueMap -> a -> a -> a)
-> UniqueMap a -> UniqueMap a -> UniqueMap a
forall (map :: * -> *) a.
IsMap map =>
(KeyOf map -> a -> a -> a) -> map a -> map a -> map a
mapUnionWithKey (KeyOf LabelMap -> a -> a -> a
Label -> a -> a -> a
f (Label -> a -> a -> a) -> (Int -> Label) -> Int -> a -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Label
mkHooplLabel) UniqueMap a
x UniqueMap a
y)
  mapDifference :: LabelMap a -> LabelMap a -> LabelMap a
mapDifference (LM UniqueMap a
x) (LM UniqueMap a
y) = UniqueMap a -> LabelMap a
forall v. UniqueMap v -> LabelMap v
LM (UniqueMap a -> UniqueMap a -> UniqueMap a
forall (map :: * -> *) a. IsMap map => map a -> map a -> map a
mapDifference UniqueMap a
x UniqueMap a
y)
  mapIntersection :: LabelMap a -> LabelMap a -> LabelMap a
mapIntersection (LM UniqueMap a
x) (LM UniqueMap a
y) = UniqueMap a -> LabelMap a
forall v. UniqueMap v -> LabelMap v
LM (UniqueMap a -> UniqueMap a -> UniqueMap a
forall (map :: * -> *) a. IsMap map => map a -> map a -> map a
mapIntersection UniqueMap a
x UniqueMap a
y)
  mapIsSubmapOf :: LabelMap a -> LabelMap a -> Bool
mapIsSubmapOf (LM UniqueMap a
x) (LM UniqueMap a
y) = UniqueMap a -> UniqueMap a -> Bool
forall (map :: * -> *) a.
(IsMap map, Eq a) =>
map a -> map a -> Bool
mapIsSubmapOf UniqueMap a
x UniqueMap a
y

  mapMap :: (a -> b) -> LabelMap a -> LabelMap b
mapMap a -> b
f (LM UniqueMap a
m) = UniqueMap b -> LabelMap b
forall v. UniqueMap v -> LabelMap v
LM ((a -> b) -> UniqueMap a -> UniqueMap b
forall (map :: * -> *) a b. IsMap map => (a -> b) -> map a -> map b
mapMap a -> b
f UniqueMap a
m)
  mapMapWithKey :: (KeyOf LabelMap -> a -> b) -> LabelMap a -> LabelMap b
mapMapWithKey KeyOf LabelMap -> a -> b
f (LM UniqueMap a
m) = UniqueMap b -> LabelMap b
forall v. UniqueMap v -> LabelMap v
LM ((KeyOf UniqueMap -> a -> b) -> UniqueMap a -> UniqueMap b
forall (map :: * -> *) a b.
IsMap map =>
(KeyOf map -> a -> b) -> map a -> map b
mapMapWithKey (KeyOf LabelMap -> a -> b
Label -> a -> b
f (Label -> a -> b) -> (Int -> Label) -> Int -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Label
mkHooplLabel) UniqueMap a
m)
  mapFoldl :: (b -> a -> b) -> b -> LabelMap a -> b
mapFoldl b -> a -> b
k b
z (LM UniqueMap a
m) = (b -> a -> b) -> b -> UniqueMap a -> b
forall (map :: * -> *) b a.
IsMap map =>
(b -> a -> b) -> b -> map a -> b
mapFoldl b -> a -> b
k b
z UniqueMap a
m
  mapFoldr :: (a -> b -> b) -> b -> LabelMap a -> b
mapFoldr a -> b -> b
k b
z (LM UniqueMap a
m) = (a -> b -> b) -> b -> UniqueMap a -> b
forall (map :: * -> *) a b.
IsMap map =>
(a -> b -> b) -> b -> map a -> b
mapFoldr a -> b -> b
k b
z UniqueMap a
m
  mapFoldlWithKey :: (b -> KeyOf LabelMap -> a -> b) -> b -> LabelMap a -> b
mapFoldlWithKey b -> KeyOf LabelMap -> a -> b
k b
z (LM UniqueMap a
m) =
      (b -> KeyOf UniqueMap -> a -> b) -> b -> UniqueMap a -> b
forall (map :: * -> *) b a.
IsMap map =>
(b -> KeyOf map -> a -> b) -> b -> map a -> b
mapFoldlWithKey (\b
a KeyOf UniqueMap
v -> b -> KeyOf LabelMap -> a -> b
k b
a (Int -> Label
mkHooplLabel Int
KeyOf UniqueMap
v)) b
z UniqueMap a
m
  mapFoldMapWithKey :: (KeyOf LabelMap -> a -> m) -> LabelMap a -> m
mapFoldMapWithKey KeyOf LabelMap -> a -> m
f (LM UniqueMap a
m) = (KeyOf UniqueMap -> a -> m) -> UniqueMap a -> m
forall (map :: * -> *) m a.
(IsMap map, Monoid m) =>
(KeyOf map -> a -> m) -> map a -> m
mapFoldMapWithKey (\KeyOf UniqueMap
k a
v -> KeyOf LabelMap -> a -> m
f (Int -> Label
mkHooplLabel Int
KeyOf UniqueMap
k) a
v) UniqueMap a
m
  mapFilter :: (a -> Bool) -> LabelMap a -> LabelMap a
mapFilter a -> Bool
f (LM UniqueMap a
m) = UniqueMap a -> LabelMap a
forall v. UniqueMap v -> LabelMap v
LM ((a -> Bool) -> UniqueMap a -> UniqueMap a
forall (map :: * -> *) a.
IsMap map =>
(a -> Bool) -> map a -> map a
mapFilter a -> Bool
f UniqueMap a
m)
  mapFilterWithKey :: (KeyOf LabelMap -> a -> Bool) -> LabelMap a -> LabelMap a
mapFilterWithKey KeyOf LabelMap -> a -> Bool
f (LM UniqueMap a
m) = UniqueMap a -> LabelMap a
forall v. UniqueMap v -> LabelMap v
LM ((KeyOf UniqueMap -> a -> Bool) -> UniqueMap a -> UniqueMap a
forall (map :: * -> *) a.
IsMap map =>
(KeyOf map -> a -> Bool) -> map a -> map a
mapFilterWithKey (KeyOf LabelMap -> a -> Bool
Label -> a -> Bool
f (Label -> a -> Bool) -> (Int -> Label) -> Int -> a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Label
mkHooplLabel) UniqueMap a
m)

  mapElems :: LabelMap a -> [a]
mapElems (LM UniqueMap a
m) = UniqueMap a -> [a]
forall (map :: * -> *) a. IsMap map => map a -> [a]
mapElems UniqueMap a
m
  mapKeys :: LabelMap a -> [KeyOf LabelMap]
mapKeys (LM UniqueMap a
m) = (Int -> Label) -> [Int] -> [Label]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Label
mkHooplLabel (UniqueMap a -> [KeyOf UniqueMap]
forall (map :: * -> *) a. IsMap map => map a -> [KeyOf map]
mapKeys UniqueMap a
m)
  mapToList :: LabelMap a -> [(KeyOf LabelMap, a)]
mapToList (LM UniqueMap a
m) = [(Int -> Label
mkHooplLabel Int
k, a
v) | (Int
k, a
v) <- UniqueMap a -> [(KeyOf UniqueMap, a)]
forall (map :: * -> *) a. IsMap map => map a -> [(KeyOf map, a)]
mapToList UniqueMap a
m]
  mapFromList :: [(KeyOf LabelMap, a)] -> LabelMap a
mapFromList [(KeyOf LabelMap, a)]
assocs = UniqueMap a -> LabelMap a
forall v. UniqueMap v -> LabelMap v
LM ([(KeyOf UniqueMap, a)] -> UniqueMap a
forall (map :: * -> *) a. IsMap map => [(KeyOf map, a)] -> map a
mapFromList [(Label -> Int
lblToUnique Label
k, a
v) | (Label
k, a
v) <- [(KeyOf LabelMap, a)]
[(Label, a)]
assocs])
  mapFromListWith :: (a -> a -> a) -> [(KeyOf LabelMap, a)] -> LabelMap a
mapFromListWith a -> a -> a
f [(KeyOf LabelMap, a)]
assocs = UniqueMap a -> LabelMap a
forall v. UniqueMap v -> LabelMap v
LM ((a -> a -> a) -> [(KeyOf UniqueMap, a)] -> UniqueMap a
forall (map :: * -> *) a.
IsMap map =>
(a -> a -> a) -> [(KeyOf map, a)] -> map a
mapFromListWith a -> a -> a
f [(Label -> Int
lblToUnique Label
k, a
v) | (Label
k, a
v) <- [(KeyOf LabelMap, a)]
[(Label, a)]
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]
forall set. IsSet set => set -> [ElemOf set]
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 (map :: * -> *) a. IsMap map => map a -> [(KeyOf map, a)]
mapToList

instance TrieMap LabelMap where
  type Key LabelMap = Label
  emptyTM :: LabelMap a
emptyTM = LabelMap a
forall (map :: * -> *) a. IsMap map => map a
mapEmpty
  lookupTM :: Key LabelMap -> LabelMap b -> Maybe b
lookupTM Key LabelMap
k LabelMap b
m = KeyOf LabelMap -> LabelMap b -> Maybe b
forall (map :: * -> *) a.
IsMap map =>
KeyOf map -> map a -> Maybe a
mapLookup KeyOf LabelMap
Key LabelMap
k LabelMap b
m
  alterTM :: Key LabelMap -> XT b -> LabelMap b -> LabelMap b
alterTM Key LabelMap
k XT b
f LabelMap b
m = XT b -> KeyOf LabelMap -> LabelMap b -> LabelMap b
forall (map :: * -> *) a.
IsMap map =>
(Maybe a -> Maybe a) -> KeyOf map -> map a -> map a
mapAlter XT b
f KeyOf LabelMap
Key LabelMap
k LabelMap b
m
  foldTM :: (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 (map :: * -> *) a b.
IsMap map =>
(a -> b -> b) -> b -> map a -> b
mapFoldr a -> b -> b
k b
z LabelMap a
m
  mapTM :: (a -> b) -> LabelMap a -> LabelMap b
mapTM a -> b
f LabelMap a
m = (a -> b) -> LabelMap a -> LabelMap b
forall (map :: * -> *) a b. IsMap map => (a -> b) -> map a -> map b
mapMap a -> b
f LabelMap a
m

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

type FactBase f = LabelMap f

lookupFact :: Label -> FactBase f -> Maybe f
lookupFact :: Label -> FactBase f -> Maybe f
lookupFact = Label -> FactBase f -> Maybe f
forall (map :: * -> *) a.
IsMap map =>
KeyOf map -> map a -> Maybe a
mapLookup