{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE BangPatterns #-}
module GHC.Core.RoughMap
(
RoughMatchTc(..)
, isRoughWildcard
, typeToRoughMatchTc
, RoughMatchLookupTc(..)
, typeToRoughMatchLookupTc
, roughMatchTcToLookup
, RoughMap
, emptyRM
, lookupRM
, lookupRM'
, insertRM
, filterRM
, filterMatchingRM
, elemsRM
, sizeRM
, foldRM
, unionRM
) where
import GHC.Prelude
import GHC.Data.Bag
import GHC.Core.TyCon
import GHC.Core.TyCo.Rep
import GHC.Core.Type
import GHC.Utils.Outputable
import GHC.Types.Name
import GHC.Types.Name.Env
import Control.Monad (join)
import Data.Data (Data)
import GHC.Utils.Misc
import Data.Bifunctor
import GHC.Utils.Panic
data RoughMatchTc
= RM_KnownTc Name
| RM_WildCard
deriving( Typeable RoughMatchTc
Typeable RoughMatchTc
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RoughMatchTc -> c RoughMatchTc)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RoughMatchTc)
-> (RoughMatchTc -> Constr)
-> (RoughMatchTc -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RoughMatchTc))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RoughMatchTc))
-> ((forall b. Data b => b -> b) -> RoughMatchTc -> RoughMatchTc)
-> (forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RoughMatchTc -> r)
-> (forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RoughMatchTc -> r)
-> (forall u. (forall d. Data d => d -> u) -> RoughMatchTc -> [u])
-> (forall u.
Int -> (forall d. Data d => d -> u) -> RoughMatchTc -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> RoughMatchTc -> m RoughMatchTc)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RoughMatchTc -> m RoughMatchTc)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RoughMatchTc -> m RoughMatchTc)
-> Data RoughMatchTc
RoughMatchTc -> Constr
RoughMatchTc -> DataType
(forall b. Data b => b -> b) -> RoughMatchTc -> RoughMatchTc
forall a.
Typeable a
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> RoughMatchTc -> u
forall u. (forall d. Data d => d -> u) -> RoughMatchTc -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RoughMatchTc -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RoughMatchTc -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> RoughMatchTc -> m RoughMatchTc
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RoughMatchTc -> m RoughMatchTc
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RoughMatchTc
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RoughMatchTc -> c RoughMatchTc
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RoughMatchTc)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RoughMatchTc)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RoughMatchTc -> c RoughMatchTc
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RoughMatchTc -> c RoughMatchTc
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RoughMatchTc
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RoughMatchTc
$ctoConstr :: RoughMatchTc -> Constr
toConstr :: RoughMatchTc -> Constr
$cdataTypeOf :: RoughMatchTc -> DataType
dataTypeOf :: RoughMatchTc -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RoughMatchTc)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RoughMatchTc)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RoughMatchTc)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RoughMatchTc)
$cgmapT :: (forall b. Data b => b -> b) -> RoughMatchTc -> RoughMatchTc
gmapT :: (forall b. Data b => b -> b) -> RoughMatchTc -> RoughMatchTc
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RoughMatchTc -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RoughMatchTc -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RoughMatchTc -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RoughMatchTc -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> RoughMatchTc -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> RoughMatchTc -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> RoughMatchTc -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> RoughMatchTc -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> RoughMatchTc -> m RoughMatchTc
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> RoughMatchTc -> m RoughMatchTc
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RoughMatchTc -> m RoughMatchTc
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RoughMatchTc -> m RoughMatchTc
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RoughMatchTc -> m RoughMatchTc
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RoughMatchTc -> m RoughMatchTc
Data )
data RoughMatchLookupTc
= RML_KnownTc Name
| RML_NoKnownTc
| RML_WildCard
deriving ( Typeable RoughMatchLookupTc
Typeable RoughMatchLookupTc
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> RoughMatchLookupTc
-> c RoughMatchLookupTc)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RoughMatchLookupTc)
-> (RoughMatchLookupTc -> Constr)
-> (RoughMatchLookupTc -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RoughMatchLookupTc))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RoughMatchLookupTc))
-> ((forall b. Data b => b -> b)
-> RoughMatchLookupTc -> RoughMatchLookupTc)
-> (forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RoughMatchLookupTc -> r)
-> (forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RoughMatchLookupTc -> r)
-> (forall u.
(forall d. Data d => d -> u) -> RoughMatchLookupTc -> [u])
-> (forall u.
Int -> (forall d. Data d => d -> u) -> RoughMatchLookupTc -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> RoughMatchLookupTc -> m RoughMatchLookupTc)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RoughMatchLookupTc -> m RoughMatchLookupTc)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RoughMatchLookupTc -> m RoughMatchLookupTc)
-> Data RoughMatchLookupTc
RoughMatchLookupTc -> Constr
RoughMatchLookupTc -> DataType
(forall b. Data b => b -> b)
-> RoughMatchLookupTc -> RoughMatchLookupTc
forall a.
Typeable a
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> RoughMatchLookupTc -> u
forall u. (forall d. Data d => d -> u) -> RoughMatchLookupTc -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RoughMatchLookupTc -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RoughMatchLookupTc -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> RoughMatchLookupTc -> m RoughMatchLookupTc
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RoughMatchLookupTc -> m RoughMatchLookupTc
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RoughMatchLookupTc
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> RoughMatchLookupTc
-> c RoughMatchLookupTc
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RoughMatchLookupTc)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RoughMatchLookupTc)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> RoughMatchLookupTc
-> c RoughMatchLookupTc
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> RoughMatchLookupTc
-> c RoughMatchLookupTc
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RoughMatchLookupTc
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RoughMatchLookupTc
$ctoConstr :: RoughMatchLookupTc -> Constr
toConstr :: RoughMatchLookupTc -> Constr
$cdataTypeOf :: RoughMatchLookupTc -> DataType
dataTypeOf :: RoughMatchLookupTc -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RoughMatchLookupTc)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RoughMatchLookupTc)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RoughMatchLookupTc)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RoughMatchLookupTc)
$cgmapT :: (forall b. Data b => b -> b)
-> RoughMatchLookupTc -> RoughMatchLookupTc
gmapT :: (forall b. Data b => b -> b)
-> RoughMatchLookupTc -> RoughMatchLookupTc
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RoughMatchLookupTc -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RoughMatchLookupTc -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RoughMatchLookupTc -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RoughMatchLookupTc -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> RoughMatchLookupTc -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> RoughMatchLookupTc -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> RoughMatchLookupTc -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> RoughMatchLookupTc -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> RoughMatchLookupTc -> m RoughMatchLookupTc
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> RoughMatchLookupTc -> m RoughMatchLookupTc
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RoughMatchLookupTc -> m RoughMatchLookupTc
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RoughMatchLookupTc -> m RoughMatchLookupTc
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RoughMatchLookupTc -> m RoughMatchLookupTc
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RoughMatchLookupTc -> m RoughMatchLookupTc
Data )
instance Outputable RoughMatchLookupTc where
ppr :: RoughMatchLookupTc -> SDoc
ppr (RML_KnownTc Name
nm) = String -> SDoc
text String
"RML_KnownTc" SDoc -> SDoc -> SDoc
<+> Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
nm
ppr RoughMatchLookupTc
RML_NoKnownTc = String -> SDoc
text String
"RML_NoKnownTC"
ppr RoughMatchLookupTc
RML_WildCard = String -> SDoc
text String
"_"
roughMatchTcToLookup :: RoughMatchTc -> RoughMatchLookupTc
roughMatchTcToLookup :: RoughMatchTc -> RoughMatchLookupTc
roughMatchTcToLookup (RM_KnownTc Name
n) = Name -> RoughMatchLookupTc
RML_KnownTc Name
n
roughMatchTcToLookup RoughMatchTc
RM_WildCard = RoughMatchLookupTc
RML_WildCard
instance Outputable RoughMatchTc where
ppr :: RoughMatchTc -> SDoc
ppr (RM_KnownTc Name
nm) = String -> SDoc
text String
"KnownTc" SDoc -> SDoc -> SDoc
<+> Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
nm
ppr RoughMatchTc
RM_WildCard = String -> SDoc
text String
"OtherTc"
isRoughWildcard :: RoughMatchTc -> Bool
isRoughWildcard :: RoughMatchTc -> Bool
isRoughWildcard RoughMatchTc
RM_WildCard = Bool
True
isRoughWildcard (RM_KnownTc {}) = Bool
False
typeToRoughMatchLookupTc :: Type -> RoughMatchLookupTc
typeToRoughMatchLookupTc :: Type -> RoughMatchLookupTc
typeToRoughMatchLookupTc Type
ty
| Just (Type
ty', Coercion
_) <- Type -> Maybe (Type, Coercion)
splitCastTy_maybe Type
ty = Type -> RoughMatchLookupTc
typeToRoughMatchLookupTc Type
ty'
| Bool
otherwise =
case Type -> (Type, [Type])
splitAppTys Type
ty of
(TyVarTy {}, [Type]
_) -> RoughMatchLookupTc
RML_NoKnownTc
(TyConApp TyCon
tc [Type]
_, [Type]
_)
| Bool -> Bool
not (TyCon -> Bool
isTypeFamilyTyCon TyCon
tc) -> Name -> RoughMatchLookupTc
RML_KnownTc (Name -> RoughMatchLookupTc) -> Name -> RoughMatchLookupTc
forall a b. (a -> b) -> a -> b
$! TyCon -> Name
tyConName TyCon
tc
| TyCon -> Bool
isTypeFamilyTyCon TyCon
tc -> RoughMatchLookupTc
RML_NoKnownTc
(Type, [Type])
_ -> RoughMatchLookupTc
RML_WildCard
typeToRoughMatchTc :: Type -> RoughMatchTc
typeToRoughMatchTc :: Type -> RoughMatchTc
typeToRoughMatchTc Type
ty
| Just (Type
ty', Coercion
_) <- Type -> Maybe (Type, Coercion)
splitCastTy_maybe Type
ty = Type -> RoughMatchTc
typeToRoughMatchTc Type
ty'
| Just (TyCon
tc,[Type]
_) <- (() :: Constraint) => Type -> Maybe (TyCon, [Type])
Type -> Maybe (TyCon, [Type])
splitTyConApp_maybe Type
ty
, Bool -> Bool
not (TyCon -> Bool
isTypeFamilyTyCon TyCon
tc) = Bool -> SDoc -> (Name -> RoughMatchTc) -> Name -> RoughMatchTc
forall a. HasCallStack => Bool -> SDoc -> a -> a
assertPpr (TyCon -> Role -> Bool
isGenerativeTyCon TyCon
tc Role
Nominal) (TyCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyCon
tc)
Name -> RoughMatchTc
RM_KnownTc (Name -> RoughMatchTc) -> Name -> RoughMatchTc
forall a b. (a -> b) -> a -> b
$! TyCon -> Name
tyConName TyCon
tc
| Bool
otherwise = RoughMatchTc
RM_WildCard
data RoughMap a = RM { forall a. RoughMap a -> Bag a
rm_empty :: Bag a
, forall a. RoughMap a -> DNameEnv (RoughMap a)
rm_known :: DNameEnv (RoughMap a)
, forall a. RoughMap a -> RoughMap a
rm_unknown :: RoughMap a }
| RMEmpty
deriving ((forall a b. (a -> b) -> RoughMap a -> RoughMap b)
-> (forall a b. a -> RoughMap b -> RoughMap a) -> Functor RoughMap
forall a b. a -> RoughMap b -> RoughMap a
forall a b. (a -> b) -> RoughMap a -> RoughMap 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) -> RoughMap a -> RoughMap b
fmap :: forall a b. (a -> b) -> RoughMap a -> RoughMap b
$c<$ :: forall a b. a -> RoughMap b -> RoughMap a
<$ :: forall a b. a -> RoughMap b -> RoughMap a
Functor)
instance Outputable a => Outputable (RoughMap a) where
ppr :: RoughMap a -> SDoc
ppr (RM Bag a
empty DNameEnv (RoughMap a)
known RoughMap a
unknown) =
[SDoc] -> SDoc
vcat [String -> SDoc
text String
"RM"
, Int -> SDoc -> SDoc
nest Int
2 ([SDoc] -> SDoc
vcat [ String -> SDoc
text String
"Empty:" SDoc -> SDoc -> SDoc
<+> Bag a -> SDoc
forall a. Outputable a => a -> SDoc
ppr Bag a
empty
, String -> SDoc
text String
"Known:" SDoc -> SDoc -> SDoc
<+> DNameEnv (RoughMap a) -> SDoc
forall a. Outputable a => a -> SDoc
ppr DNameEnv (RoughMap a)
known
, String -> SDoc
text String
"Unknown:" SDoc -> SDoc -> SDoc
<+> RoughMap a -> SDoc
forall a. Outputable a => a -> SDoc
ppr RoughMap a
unknown])]
ppr RoughMap a
RMEmpty = String -> SDoc
text String
"{}"
emptyRM :: RoughMap a
emptyRM :: forall a. RoughMap a
emptyRM = RoughMap a
forall a. RoughMap a
RMEmpty
lookupRM :: [RoughMatchLookupTc] -> RoughMap a -> [a]
lookupRM :: forall a. [RoughMatchLookupTc] -> RoughMap a -> [a]
lookupRM [RoughMatchLookupTc]
tcs RoughMap a
rm = Bag a -> [a]
forall a. Bag a -> [a]
bagToList ((Bag a, [a]) -> Bag a
forall a b. (a, b) -> a
fst ((Bag a, [a]) -> Bag a) -> (Bag a, [a]) -> Bag a
forall a b. (a -> b) -> a -> b
$ [RoughMatchLookupTc] -> RoughMap a -> (Bag a, [a])
forall a. [RoughMatchLookupTc] -> RoughMap a -> (Bag a, [a])
lookupRM' [RoughMatchLookupTc]
tcs RoughMap a
rm)
lookupRM' :: [RoughMatchLookupTc] -> RoughMap a -> (Bag a
, [a])
lookupRM' :: forall a. [RoughMatchLookupTc] -> RoughMap a -> (Bag a, [a])
lookupRM' [RoughMatchLookupTc]
_ RoughMap a
RMEmpty = (Bag a
forall a. Bag a
emptyBag, [])
lookupRM' [] RoughMap a
rm = let m :: [a]
m = RoughMap a -> [a]
forall a. RoughMap a -> [a]
elemsRM RoughMap a
rm
in ([a] -> Bag a
forall a. [a] -> Bag a
listToBag [a]
m, [a]
m)
lookupRM' (RML_KnownTc Name
tc : [RoughMatchLookupTc]
tcs) RoughMap a
rm =
let (Bag a
common_m, [a]
common_u) = [RoughMatchLookupTc] -> RoughMap a -> (Bag a, [a])
forall a. [RoughMatchLookupTc] -> RoughMap a -> (Bag a, [a])
lookupRM' [RoughMatchLookupTc]
tcs (RoughMap a -> RoughMap a
forall a. RoughMap a -> RoughMap a
rm_unknown RoughMap a
rm)
(Bag a
m, [a]
u) = (Bag a, [a])
-> (RoughMap a -> (Bag a, [a]))
-> Maybe (RoughMap a)
-> (Bag a, [a])
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Bag a
forall a. Bag a
emptyBag, []) ([RoughMatchLookupTc] -> RoughMap a -> (Bag a, [a])
forall a. [RoughMatchLookupTc] -> RoughMap a -> (Bag a, [a])
lookupRM' [RoughMatchLookupTc]
tcs) (DNameEnv (RoughMap a) -> Name -> Maybe (RoughMap a)
forall a. DNameEnv a -> Name -> Maybe a
lookupDNameEnv (RoughMap a -> DNameEnv (RoughMap a)
forall a. RoughMap a -> DNameEnv (RoughMap a)
rm_known RoughMap a
rm) Name
tc)
in (RoughMap a -> Bag a
forall a. RoughMap a -> Bag a
rm_empty RoughMap a
rm Bag a -> Bag a -> Bag a
forall a. Bag a -> Bag a -> Bag a
`unionBags` Bag a
common_m Bag a -> Bag a -> Bag a
forall a. Bag a -> Bag a -> Bag a
`unionBags` Bag a
m
, Bag a -> [a]
forall a. Bag a -> [a]
bagToList (RoughMap a -> Bag a
forall a. RoughMap a -> Bag a
rm_empty RoughMap a
rm) [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
common_u [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
u)
lookupRM' (RoughMatchLookupTc
RML_NoKnownTc : [RoughMatchLookupTc]
tcs) RoughMap a
rm =
let (Bag a
u_m, [a]
_u_u) = [RoughMatchLookupTc] -> RoughMap a -> (Bag a, [a])
forall a. [RoughMatchLookupTc] -> RoughMap a -> (Bag a, [a])
lookupRM' [RoughMatchLookupTc]
tcs (RoughMap a -> RoughMap a
forall a. RoughMap a -> RoughMap a
rm_unknown RoughMap a
rm)
in (RoughMap a -> Bag a
forall a. RoughMap a -> Bag a
rm_empty RoughMap a
rm Bag a -> Bag a -> Bag a
forall a. Bag a -> Bag a -> Bag a
`unionBags` Bag a
u_m
, (Bag a, [a]) -> [a]
forall a b. (a, b) -> b
snd ((Bag a, [a]) -> [a]) -> (Bag a, [a]) -> [a]
forall a b. (a -> b) -> a -> b
$ [RoughMatchLookupTc] -> RoughMap a -> (Bag a, [a])
forall a. [RoughMatchLookupTc] -> RoughMap a -> (Bag a, [a])
lookupRM' (RoughMatchLookupTc
RML_WildCard RoughMatchLookupTc -> [RoughMatchLookupTc] -> [RoughMatchLookupTc]
forall a. a -> [a] -> [a]
: [RoughMatchLookupTc]
tcs) RoughMap a
rm)
lookupRM' (RoughMatchLookupTc
RML_WildCard : [RoughMatchLookupTc]
tcs) RoughMap a
rm =
let (Bag a
m, [a]
u) = ([Bag a] -> Bag a)
-> ([[a]] -> [a]) -> ([Bag a], [[a]]) -> (Bag a, [a])
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap [Bag a] -> Bag a
forall a. [Bag a] -> Bag a
unionManyBags [[a]] -> [a]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ((RoughMap a -> (Bag a, [a])) -> [RoughMap a] -> ([Bag a], [[a]])
forall a b c. (a -> (b, c)) -> [a] -> ([b], [c])
mapAndUnzip ([RoughMatchLookupTc] -> RoughMap a -> (Bag a, [a])
forall a. [RoughMatchLookupTc] -> RoughMap a -> (Bag a, [a])
lookupRM' [RoughMatchLookupTc]
tcs) (DNameEnv (RoughMap a) -> [RoughMap a]
forall a. DNameEnv a -> [a]
eltsDNameEnv (DNameEnv (RoughMap a) -> [RoughMap a])
-> DNameEnv (RoughMap a) -> [RoughMap a]
forall a b. (a -> b) -> a -> b
$ RoughMap a -> DNameEnv (RoughMap a)
forall a. RoughMap a -> DNameEnv (RoughMap a)
rm_known RoughMap a
rm))
(Bag a
u_m, [a]
u_u) = [RoughMatchLookupTc] -> RoughMap a -> (Bag a, [a])
forall a. [RoughMatchLookupTc] -> RoughMap a -> (Bag a, [a])
lookupRM' [RoughMatchLookupTc]
tcs (RoughMap a -> RoughMap a
forall a. RoughMap a -> RoughMap a
rm_unknown RoughMap a
rm)
in (RoughMap a -> Bag a
forall a. RoughMap a -> Bag a
rm_empty RoughMap a
rm Bag a -> Bag a -> Bag a
forall a. Bag a -> Bag a -> Bag a
`unionBags` Bag a
u_m Bag a -> Bag a -> Bag a
forall a. Bag a -> Bag a -> Bag a
`unionBags` Bag a
m
, Bag a -> [a]
forall a. Bag a -> [a]
bagToList (RoughMap a -> Bag a
forall a. RoughMap a -> Bag a
rm_empty RoughMap a
rm) [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
u_u [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
u)
unionRM :: RoughMap a -> RoughMap a -> RoughMap a
unionRM :: forall a. RoughMap a -> RoughMap a -> RoughMap a
unionRM RoughMap a
RMEmpty RoughMap a
a = RoughMap a
a
unionRM RoughMap a
a RoughMap a
RMEmpty = RoughMap a
a
unionRM RoughMap a
a RoughMap a
b =
RM { rm_empty :: Bag a
rm_empty = RoughMap a -> Bag a
forall a. RoughMap a -> Bag a
rm_empty RoughMap a
a Bag a -> Bag a -> Bag a
forall a. Bag a -> Bag a -> Bag a
`unionBags` RoughMap a -> Bag a
forall a. RoughMap a -> Bag a
rm_empty RoughMap a
b
, rm_known :: DNameEnv (RoughMap a)
rm_known = (RoughMap a -> RoughMap a -> RoughMap a)
-> DNameEnv (RoughMap a)
-> DNameEnv (RoughMap a)
-> DNameEnv (RoughMap a)
forall elt.
(elt -> elt -> elt) -> DNameEnv elt -> DNameEnv elt -> DNameEnv elt
plusDNameEnv_C RoughMap a -> RoughMap a -> RoughMap a
forall a. RoughMap a -> RoughMap a -> RoughMap a
unionRM (RoughMap a -> DNameEnv (RoughMap a)
forall a. RoughMap a -> DNameEnv (RoughMap a)
rm_known RoughMap a
a) (RoughMap a -> DNameEnv (RoughMap a)
forall a. RoughMap a -> DNameEnv (RoughMap a)
rm_known RoughMap a
b)
, rm_unknown :: RoughMap a
rm_unknown = RoughMap a -> RoughMap a
forall a. RoughMap a -> RoughMap a
rm_unknown RoughMap a
a RoughMap a -> RoughMap a -> RoughMap a
forall a. RoughMap a -> RoughMap a -> RoughMap a
`unionRM` RoughMap a -> RoughMap a
forall a. RoughMap a -> RoughMap a
rm_unknown RoughMap a
b
}
insertRM :: [RoughMatchTc] -> a -> RoughMap a -> RoughMap a
insertRM :: forall a. [RoughMatchTc] -> a -> RoughMap a -> RoughMap a
insertRM [RoughMatchTc]
k a
v RoughMap a
RMEmpty =
[RoughMatchTc] -> a -> RoughMap a -> RoughMap a
forall a. [RoughMatchTc] -> a -> RoughMap a -> RoughMap a
insertRM [RoughMatchTc]
k a
v (RoughMap a -> RoughMap a) -> RoughMap a -> RoughMap a
forall a b. (a -> b) -> a -> b
$ RM { rm_empty :: Bag a
rm_empty = Bag a
forall a. Bag a
emptyBag
, rm_known :: DNameEnv (RoughMap a)
rm_known = DNameEnv (RoughMap a)
forall a. DNameEnv a
emptyDNameEnv
, rm_unknown :: RoughMap a
rm_unknown = RoughMap a
forall a. RoughMap a
emptyRM }
insertRM [] a
v rm :: RoughMap a
rm@(RM {}) =
RoughMap a
rm { rm_empty :: Bag a
rm_empty = a
v a -> Bag a -> Bag a
forall a. a -> Bag a -> Bag a
`consBag` RoughMap a -> Bag a
forall a. RoughMap a -> Bag a
rm_empty RoughMap a
rm }
insertRM (RM_KnownTc Name
k : [RoughMatchTc]
ks) a
v rm :: RoughMap a
rm@(RM {}) =
RoughMap a
rm { rm_known :: DNameEnv (RoughMap a)
rm_known = (Maybe (RoughMap a) -> Maybe (RoughMap a))
-> DNameEnv (RoughMap a) -> Name -> DNameEnv (RoughMap a)
forall a. (Maybe a -> Maybe a) -> DNameEnv a -> Name -> DNameEnv a
alterDNameEnv Maybe (RoughMap a) -> Maybe (RoughMap a)
f (RoughMap a -> DNameEnv (RoughMap a)
forall a. RoughMap a -> DNameEnv (RoughMap a)
rm_known RoughMap a
rm) Name
k }
where
f :: Maybe (RoughMap a) -> Maybe (RoughMap a)
f Maybe (RoughMap a)
Nothing = RoughMap a -> Maybe (RoughMap a)
forall a. a -> Maybe a
Just (RoughMap a -> Maybe (RoughMap a))
-> RoughMap a -> Maybe (RoughMap a)
forall a b. (a -> b) -> a -> b
$ ([RoughMatchTc] -> a -> RoughMap a -> RoughMap a
forall a. [RoughMatchTc] -> a -> RoughMap a -> RoughMap a
insertRM [RoughMatchTc]
ks a
v RoughMap a
forall a. RoughMap a
emptyRM)
f (Just RoughMap a
m) = RoughMap a -> Maybe (RoughMap a)
forall a. a -> Maybe a
Just (RoughMap a -> Maybe (RoughMap a))
-> RoughMap a -> Maybe (RoughMap a)
forall a b. (a -> b) -> a -> b
$ ([RoughMatchTc] -> a -> RoughMap a -> RoughMap a
forall a. [RoughMatchTc] -> a -> RoughMap a -> RoughMap a
insertRM [RoughMatchTc]
ks a
v RoughMap a
m)
insertRM (RoughMatchTc
RM_WildCard : [RoughMatchTc]
ks) a
v rm :: RoughMap a
rm@(RM {}) =
RoughMap a
rm { rm_unknown :: RoughMap a
rm_unknown = [RoughMatchTc] -> a -> RoughMap a -> RoughMap a
forall a. [RoughMatchTc] -> a -> RoughMap a -> RoughMap a
insertRM [RoughMatchTc]
ks a
v (RoughMap a -> RoughMap a
forall a. RoughMap a -> RoughMap a
rm_unknown RoughMap a
rm) }
filterRM :: (a -> Bool) -> RoughMap a -> RoughMap a
filterRM :: forall a. (a -> Bool) -> RoughMap a -> RoughMap a
filterRM a -> Bool
_ RoughMap a
RMEmpty = RoughMap a
forall a. RoughMap a
RMEmpty
filterRM a -> Bool
pred RoughMap a
rm =
RoughMap a -> RoughMap a
forall a. RoughMap a -> RoughMap a
normalise (RoughMap a -> RoughMap a) -> RoughMap a -> RoughMap a
forall a b. (a -> b) -> a -> b
$ RM {
rm_empty :: Bag a
rm_empty = (a -> Bool) -> Bag a -> Bag a
forall a. (a -> Bool) -> Bag a -> Bag a
filterBag a -> Bool
pred (RoughMap a -> Bag a
forall a. RoughMap a -> Bag a
rm_empty RoughMap a
rm),
rm_known :: DNameEnv (RoughMap a)
rm_known = (RoughMap a -> RoughMap a)
-> DNameEnv (RoughMap a) -> DNameEnv (RoughMap a)
forall a b. (a -> b) -> DNameEnv a -> DNameEnv b
mapDNameEnv ((a -> Bool) -> RoughMap a -> RoughMap a
forall a. (a -> Bool) -> RoughMap a -> RoughMap a
filterRM a -> Bool
pred) (RoughMap a -> DNameEnv (RoughMap a)
forall a. RoughMap a -> DNameEnv (RoughMap a)
rm_known RoughMap a
rm),
rm_unknown :: RoughMap a
rm_unknown = (a -> Bool) -> RoughMap a -> RoughMap a
forall a. (a -> Bool) -> RoughMap a -> RoughMap a
filterRM a -> Bool
pred (RoughMap a -> RoughMap a
forall a. RoughMap a -> RoughMap a
rm_unknown RoughMap a
rm)
}
normalise :: RoughMap a -> RoughMap a
normalise :: forall a. RoughMap a -> RoughMap a
normalise RoughMap a
RMEmpty = RoughMap a
forall a. RoughMap a
RMEmpty
normalise (RM Bag a
empty DNameEnv (RoughMap a)
known RoughMap a
RMEmpty)
| Bag a -> Bool
forall a. Bag a -> Bool
isEmptyBag Bag a
empty
, DNameEnv (RoughMap a) -> Bool
forall a. DNameEnv a -> Bool
isEmptyDNameEnv DNameEnv (RoughMap a)
known = RoughMap a
forall a. RoughMap a
RMEmpty
normalise RoughMap a
rm = RoughMap a
rm
filterMatchingRM :: (a -> Bool) -> [RoughMatchTc] -> RoughMap a -> RoughMap a
filterMatchingRM :: forall a. (a -> Bool) -> [RoughMatchTc] -> RoughMap a -> RoughMap a
filterMatchingRM a -> Bool
_ [RoughMatchTc]
_ RoughMap a
RMEmpty = RoughMap a
forall a. RoughMap a
RMEmpty
filterMatchingRM a -> Bool
pred [] RoughMap a
rm = (a -> Bool) -> RoughMap a -> RoughMap a
forall a. (a -> Bool) -> RoughMap a -> RoughMap a
filterRM a -> Bool
pred RoughMap a
rm
filterMatchingRM a -> Bool
pred (RM_KnownTc Name
tc : [RoughMatchTc]
tcs) RoughMap a
rm =
RoughMap a -> RoughMap a
forall a. RoughMap a -> RoughMap a
normalise (RoughMap a -> RoughMap a) -> RoughMap a -> RoughMap a
forall a b. (a -> b) -> a -> b
$ RM {
rm_empty :: Bag a
rm_empty = (a -> Bool) -> Bag a -> Bag a
forall a. (a -> Bool) -> Bag a -> Bag a
filterBag a -> Bool
pred (RoughMap a -> Bag a
forall a. RoughMap a -> Bag a
rm_empty RoughMap a
rm),
rm_known :: DNameEnv (RoughMap a)
rm_known = (Maybe (RoughMap a) -> Maybe (RoughMap a))
-> DNameEnv (RoughMap a) -> Name -> DNameEnv (RoughMap a)
forall a. (Maybe a -> Maybe a) -> DNameEnv a -> Name -> DNameEnv a
alterDNameEnv (Maybe (Maybe (RoughMap a)) -> Maybe (RoughMap a)
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Maybe (Maybe (RoughMap a)) -> Maybe (RoughMap a))
-> (Maybe (RoughMap a) -> Maybe (Maybe (RoughMap a)))
-> Maybe (RoughMap a)
-> Maybe (RoughMap a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RoughMap a -> Maybe (RoughMap a))
-> Maybe (RoughMap a) -> Maybe (Maybe (RoughMap a))
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (RoughMap a -> Maybe (RoughMap a)
forall a. RoughMap a -> Maybe (RoughMap a)
dropEmpty (RoughMap a -> Maybe (RoughMap a))
-> (RoughMap a -> RoughMap a) -> RoughMap a -> Maybe (RoughMap a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Bool) -> [RoughMatchTc] -> RoughMap a -> RoughMap a
forall a. (a -> Bool) -> [RoughMatchTc] -> RoughMap a -> RoughMap a
filterMatchingRM a -> Bool
pred [RoughMatchTc]
tcs)) (RoughMap a -> DNameEnv (RoughMap a)
forall a. RoughMap a -> DNameEnv (RoughMap a)
rm_known RoughMap a
rm) Name
tc,
rm_unknown :: RoughMap a
rm_unknown = (a -> Bool) -> [RoughMatchTc] -> RoughMap a -> RoughMap a
forall a. (a -> Bool) -> [RoughMatchTc] -> RoughMap a -> RoughMap a
filterMatchingRM a -> Bool
pred [RoughMatchTc]
tcs (RoughMap a -> RoughMap a
forall a. RoughMap a -> RoughMap a
rm_unknown RoughMap a
rm)
}
filterMatchingRM a -> Bool
pred (RoughMatchTc
RM_WildCard : [RoughMatchTc]
tcs) RoughMap a
rm =
RoughMap a -> RoughMap a
forall a. RoughMap a -> RoughMap a
normalise (RoughMap a -> RoughMap a) -> RoughMap a -> RoughMap a
forall a b. (a -> b) -> a -> b
$ RM {
rm_empty :: Bag a
rm_empty = (a -> Bool) -> Bag a -> Bag a
forall a. (a -> Bool) -> Bag a -> Bag a
filterBag a -> Bool
pred (RoughMap a -> Bag a
forall a. RoughMap a -> Bag a
rm_empty RoughMap a
rm),
rm_known :: DNameEnv (RoughMap a)
rm_known = (RoughMap a -> RoughMap a)
-> DNameEnv (RoughMap a) -> DNameEnv (RoughMap a)
forall a b. (a -> b) -> DNameEnv a -> DNameEnv b
mapDNameEnv ((a -> Bool) -> [RoughMatchTc] -> RoughMap a -> RoughMap a
forall a. (a -> Bool) -> [RoughMatchTc] -> RoughMap a -> RoughMap a
filterMatchingRM a -> Bool
pred [RoughMatchTc]
tcs) (RoughMap a -> DNameEnv (RoughMap a)
forall a. RoughMap a -> DNameEnv (RoughMap a)
rm_known RoughMap a
rm),
rm_unknown :: RoughMap a
rm_unknown = (a -> Bool) -> [RoughMatchTc] -> RoughMap a -> RoughMap a
forall a. (a -> Bool) -> [RoughMatchTc] -> RoughMap a -> RoughMap a
filterMatchingRM a -> Bool
pred [RoughMatchTc]
tcs (RoughMap a -> RoughMap a
forall a. RoughMap a -> RoughMap a
rm_unknown RoughMap a
rm)
}
dropEmpty :: RoughMap a -> Maybe (RoughMap a)
dropEmpty :: forall a. RoughMap a -> Maybe (RoughMap a)
dropEmpty RoughMap a
RMEmpty = Maybe (RoughMap a)
forall a. Maybe a
Nothing
dropEmpty RoughMap a
rm = RoughMap a -> Maybe (RoughMap a)
forall a. a -> Maybe a
Just RoughMap a
rm
elemsRM :: RoughMap a -> [a]
elemsRM :: forall a. RoughMap a -> [a]
elemsRM = (a -> [a] -> [a]) -> [a] -> RoughMap a -> [a]
forall a b. (a -> b -> b) -> b -> RoughMap a -> b
foldRM (:) []
foldRM :: (a -> b -> b) -> b -> RoughMap a -> b
foldRM :: forall a b. (a -> b -> b) -> b -> RoughMap a -> b
foldRM a -> b -> b
f = b -> RoughMap a -> b
go
where
go :: b -> RoughMap a -> b
go b
z RoughMap a
RMEmpty = b
z
go b
z (RM{ rm_unknown :: forall a. RoughMap a -> RoughMap a
rm_unknown = RoughMap a
unk, rm_known :: forall a. RoughMap a -> DNameEnv (RoughMap a)
rm_known = DNameEnv (RoughMap a)
known, rm_empty :: forall a. RoughMap a -> Bag a
rm_empty = Bag a
empty}) =
(a -> b -> b) -> b -> Bag a -> b
forall a b. (a -> b -> b) -> b -> Bag a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
a -> b -> b
f
((RoughMap a -> b -> b) -> b -> DNameEnv (RoughMap a) -> b
forall a b. (a -> b -> b) -> b -> DNameEnv a -> b
foldDNameEnv
((b -> RoughMap a -> b) -> RoughMap a -> b -> b
forall a b c. (a -> b -> c) -> b -> a -> c
flip b -> RoughMap a -> b
go)
(b -> RoughMap a -> b
go b
z RoughMap a
unk)
DNameEnv (RoughMap a)
known
)
Bag a
empty
nonDetStrictFoldRM :: (b -> a -> b) -> b -> RoughMap a -> b
nonDetStrictFoldRM :: forall b a. (b -> a -> b) -> b -> RoughMap a -> b
nonDetStrictFoldRM b -> a -> b
f = b -> RoughMap a -> b
go
where
go :: b -> RoughMap a -> b
go !b
z RoughMap a
RMEmpty = b
z
go b
z rm :: RoughMap a
rm@(RM{}) =
(b -> a -> b) -> b -> Bag a -> b
forall b a. (b -> a -> b) -> b -> Bag a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl'
b -> a -> b
f
((RoughMap a -> b -> b) -> b -> DNameEnv (RoughMap a) -> b
forall a b. (a -> b -> b) -> b -> DNameEnv a -> b
nonDetStrictFoldDNameEnv
((b -> RoughMap a -> b) -> RoughMap a -> b -> b
forall a b c. (a -> b -> c) -> b -> a -> c
flip b -> RoughMap a -> b
go)
(b -> RoughMap a -> b
go b
z (RoughMap a -> RoughMap a
forall a. RoughMap a -> RoughMap a
rm_unknown RoughMap a
rm))
(RoughMap a -> DNameEnv (RoughMap a)
forall a. RoughMap a -> DNameEnv (RoughMap a)
rm_known RoughMap a
rm)
)
(RoughMap a -> Bag a
forall a. RoughMap a -> Bag a
rm_empty RoughMap a
rm)
sizeRM :: RoughMap a -> Int
sizeRM :: forall a. RoughMap a -> Int
sizeRM = (Int -> a -> Int) -> Int -> RoughMap a -> Int
forall b a. (b -> a -> b) -> b -> RoughMap a -> b
nonDetStrictFoldRM (\Int
acc a
_ -> Int
acc Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
0