{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}
module GHC.Core.Map.Expr (
CoreMap, emptyCoreMap, extendCoreMap, lookupCoreMap, foldCoreMap,
eqDeBruijnExpr, eqCoreExpr,
TrieMap(..), insertTM, deleteTM,
lkDFreeVar, xtDFreeVar,
lkDNamed, xtDNamed,
(>.>), (|>), (|>>),
) where
import GHC.Prelude
import GHC.Data.TrieMap
import GHC.Core.Map.Type
import GHC.Core
import GHC.Core.Type
import GHC.Types.Tickish
import GHC.Types.Var
import GHC.Utils.Misc
import GHC.Utils.Outputable
import qualified Data.Map as Map
import GHC.Types.Name.Env
import Control.Monad( (>=>) )
{-# SPECIALIZE lkG :: Key CoreMapX -> CoreMapG a -> Maybe a #-}
{-# SPECIALIZE xtG :: Key CoreMapX -> XT a -> CoreMapG a -> CoreMapG a #-}
{-# SPECIALIZE mapG :: (a -> b) -> CoreMapG a -> CoreMapG b #-}
{-# SPECIALIZE fdG :: (a -> b -> b) -> CoreMapG a -> b -> b #-}
newtype CoreMap a = CoreMap (CoreMapG a)
instance Functor CoreMap where
fmap :: forall a b. (a -> b) -> CoreMap a -> CoreMap b
fmap a -> b
f = \ (CoreMap CoreMapG a
m) -> CoreMapG b -> CoreMap b
forall a. CoreMapG a -> CoreMap a
CoreMap ((a -> b) -> CoreMapG a -> CoreMapG b
forall a b. (a -> b) -> GenMap CoreMapX a -> GenMap CoreMapX b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f CoreMapG a
m)
{-# INLINE fmap #-}
instance TrieMap CoreMap where
type Key CoreMap = CoreExpr
emptyTM :: forall a. CoreMap a
emptyTM = CoreMapG a -> CoreMap a
forall a. CoreMapG a -> CoreMap a
CoreMap CoreMapG a
forall a. GenMap CoreMapX a
forall (m :: * -> *) a. TrieMap m => m a
emptyTM
lookupTM :: forall b. Key CoreMap -> CoreMap b -> Maybe b
lookupTM Key CoreMap
k (CoreMap CoreMapG b
m) = Key (GenMap CoreMapX) -> CoreMapG b -> Maybe b
forall b. Key (GenMap CoreMapX) -> GenMap CoreMapX b -> Maybe b
forall (m :: * -> *) b. TrieMap m => Key m -> m b -> Maybe b
lookupTM (Expr Id -> DeBruijn (Expr Id)
forall a. a -> DeBruijn a
deBruijnize Expr Id
Key CoreMap
k) CoreMapG b
m
alterTM :: forall b. Key CoreMap -> XT b -> CoreMap b -> CoreMap b
alterTM Key CoreMap
k XT b
f (CoreMap CoreMapG b
m) = CoreMapG b -> CoreMap b
forall a. CoreMapG a -> CoreMap a
CoreMap (Key (GenMap CoreMapX) -> XT b -> CoreMapG b -> CoreMapG b
forall b.
Key (GenMap CoreMapX)
-> XT b -> GenMap CoreMapX b -> GenMap CoreMapX b
forall (m :: * -> *) b. TrieMap m => Key m -> XT b -> m b -> m b
alterTM (Expr Id -> DeBruijn (Expr Id)
forall a. a -> DeBruijn a
deBruijnize Expr Id
Key CoreMap
k) XT b
f CoreMapG b
m)
foldTM :: forall a b. (a -> b -> b) -> CoreMap a -> b -> b
foldTM a -> b -> b
k (CoreMap CoreMapG a
m) = (a -> b -> b) -> CoreMapG a -> b -> b
forall a b. (a -> b -> b) -> GenMap CoreMapX a -> b -> b
forall (m :: * -> *) a b.
TrieMap m =>
(a -> b -> b) -> m a -> b -> b
foldTM a -> b -> b
k CoreMapG a
m
filterTM :: forall a. (a -> Bool) -> CoreMap a -> CoreMap a
filterTM a -> Bool
f (CoreMap CoreMapG a
m) = CoreMapG a -> CoreMap a
forall a. CoreMapG a -> CoreMap a
CoreMap ((a -> Bool) -> CoreMapG a -> CoreMapG a
forall a. (a -> Bool) -> GenMap CoreMapX a -> GenMap CoreMapX a
forall (m :: * -> *) a. TrieMap m => (a -> Bool) -> m a -> m a
filterTM a -> Bool
f CoreMapG a
m)
type CoreMapG = GenMap CoreMapX
data CoreMapX a
= CM { forall a. CoreMapX a -> VarMap a
cm_var :: VarMap a
, forall a. CoreMapX a -> LiteralMap a
cm_lit :: LiteralMap a
, forall a. CoreMapX a -> CoercionMapG a
cm_co :: CoercionMapG a
, forall a. CoreMapX a -> TypeMapG a
cm_type :: TypeMapG a
, forall a. CoreMapX a -> CoreMapG (CoercionMapG a)
cm_cast :: CoreMapG (CoercionMapG a)
, forall a. CoreMapX a -> CoreMapG (TickishMap a)
cm_tick :: CoreMapG (TickishMap a)
, forall a. CoreMapX a -> CoreMapG (CoreMapG a)
cm_app :: CoreMapG (CoreMapG a)
, forall a. CoreMapX a -> CoreMapG (BndrMap a)
cm_lam :: CoreMapG (BndrMap a)
, forall a. CoreMapX a -> CoreMapG (CoreMapG (BndrMap a))
cm_letn :: CoreMapG (CoreMapG (BndrMap a))
, forall a.
CoreMapX a
-> ListMap (GenMap CoreMapX) (CoreMapG (ListMap BndrMap a))
cm_letr :: ListMap CoreMapG (CoreMapG (ListMap BndrMap a))
, forall a. CoreMapX a -> CoreMapG (ListMap AltMap a)
cm_case :: CoreMapG (ListMap AltMap a)
, forall a. CoreMapX a -> CoreMapG (TypeMapG a)
cm_ecase :: CoreMapG (TypeMapG a)
}
instance Eq (DeBruijn CoreExpr) where
== :: DeBruijn (Expr Id) -> DeBruijn (Expr Id) -> Bool
(==) = DeBruijn (Expr Id) -> DeBruijn (Expr Id) -> Bool
eqDeBruijnExpr
eqDeBruijnExpr :: DeBruijn CoreExpr -> DeBruijn CoreExpr -> Bool
eqDeBruijnExpr :: DeBruijn (Expr Id) -> DeBruijn (Expr Id) -> Bool
eqDeBruijnExpr (D CmEnv
env1 Expr Id
e1) (D CmEnv
env2 Expr Id
e2) = Expr Id -> Expr Id -> Bool
go Expr Id
e1 Expr Id
e2 where
go :: Expr Id -> Expr Id -> Bool
go (Var Id
v1) (Var Id
v2) = DeBruijn Id -> DeBruijn Id -> Bool
eqDeBruijnVar (CmEnv -> Id -> DeBruijn Id
forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env1 Id
v1) (CmEnv -> Id -> DeBruijn Id
forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env2 Id
v2)
go (Lit Literal
lit1) (Lit Literal
lit2) = Literal
lit1 Literal -> Literal -> Bool
forall a. Eq a => a -> a -> Bool
== Literal
lit2
go (Type Mult
t1) (Type Mult
t2) = DeBruijn Mult -> DeBruijn Mult -> Bool
eqDeBruijnType (CmEnv -> Mult -> DeBruijn Mult
forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env1 Mult
t1) (CmEnv -> Mult -> DeBruijn Mult
forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env2 Mult
t2)
go (Coercion {}) (Coercion {}) = Bool
True
go (Cast Expr Id
e1 CoercionR
co1) (Cast Expr Id
e2 CoercionR
co2) = CmEnv -> CoercionR -> DeBruijn CoercionR
forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env1 CoercionR
co1 DeBruijn CoercionR -> DeBruijn CoercionR -> Bool
forall a. Eq a => a -> a -> Bool
== CmEnv -> CoercionR -> DeBruijn CoercionR
forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env2 CoercionR
co2 Bool -> Bool -> Bool
&& Expr Id -> Expr Id -> Bool
go Expr Id
e1 Expr Id
e2
go (App Expr Id
f1 Expr Id
a1) (App Expr Id
f2 Expr Id
a2) = Expr Id -> Expr Id -> Bool
go Expr Id
f1 Expr Id
f2 Bool -> Bool -> Bool
&& Expr Id -> Expr Id -> Bool
go Expr Id
a1 Expr Id
a2
go (Tick GenTickish 'TickishPassCore
n1 Expr Id
e1) (Tick GenTickish 'TickishPassCore
n2 Expr Id
e2)
= DeBruijn (GenTickish 'TickishPassCore)
-> DeBruijn (GenTickish 'TickishPassCore) -> Bool
eqDeBruijnTickish (CmEnv
-> GenTickish 'TickishPassCore
-> DeBruijn (GenTickish 'TickishPassCore)
forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env1 GenTickish 'TickishPassCore
n1) (CmEnv
-> GenTickish 'TickishPassCore
-> DeBruijn (GenTickish 'TickishPassCore)
forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env2 GenTickish 'TickishPassCore
n2)
Bool -> Bool -> Bool
&& Expr Id -> Expr Id -> Bool
go Expr Id
e1 Expr Id
e2
go (Lam Id
b1 Expr Id
e1) (Lam Id
b2 Expr Id
e2)
= DeBruijn Mult -> DeBruijn Mult -> Bool
eqDeBruijnType (CmEnv -> Mult -> DeBruijn Mult
forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env1 (Id -> Mult
varType Id
b1)) (CmEnv -> Mult -> DeBruijn Mult
forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env2 (Id -> Mult
varType Id
b2))
Bool -> Bool -> Bool
&& CmEnv -> Maybe Mult -> DeBruijn (Maybe Mult)
forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env1 (Id -> Maybe Mult
varMultMaybe Id
b1) DeBruijn (Maybe Mult) -> DeBruijn (Maybe Mult) -> Bool
forall a. Eq a => a -> a -> Bool
== CmEnv -> Maybe Mult -> DeBruijn (Maybe Mult)
forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env2 (Id -> Maybe Mult
varMultMaybe Id
b2)
Bool -> Bool -> Bool
&& DeBruijn (Expr Id) -> DeBruijn (Expr Id) -> Bool
eqDeBruijnExpr (CmEnv -> Expr Id -> DeBruijn (Expr Id)
forall a. CmEnv -> a -> DeBruijn a
D (CmEnv -> Id -> CmEnv
extendCME CmEnv
env1 Id
b1) Expr Id
e1) (CmEnv -> Expr Id -> DeBruijn (Expr Id)
forall a. CmEnv -> a -> DeBruijn a
D (CmEnv -> Id -> CmEnv
extendCME CmEnv
env2 Id
b2) Expr Id
e2)
go (Let (NonRec Id
v1 Expr Id
r1) Expr Id
e1) (Let (NonRec Id
v2 Expr Id
r2) Expr Id
e2)
= Expr Id -> Expr Id -> Bool
go Expr Id
r1 Expr Id
r2
Bool -> Bool -> Bool
&& DeBruijn (Expr Id) -> DeBruijn (Expr Id) -> Bool
eqDeBruijnExpr (CmEnv -> Expr Id -> DeBruijn (Expr Id)
forall a. CmEnv -> a -> DeBruijn a
D (CmEnv -> Id -> CmEnv
extendCME CmEnv
env1 Id
v1) Expr Id
e1) (CmEnv -> Expr Id -> DeBruijn (Expr Id)
forall a. CmEnv -> a -> DeBruijn a
D (CmEnv -> Id -> CmEnv
extendCME CmEnv
env2 Id
v2) Expr Id
e2)
go (Let (Rec [(Id, Expr Id)]
ps1) Expr Id
e1) (Let (Rec [(Id, Expr Id)]
ps2) Expr Id
e2)
= [(Id, Expr Id)] -> [(Id, Expr Id)] -> Bool
forall a b. [a] -> [b] -> Bool
equalLength [(Id, Expr Id)]
ps1 [(Id, Expr Id)]
ps2
Bool -> Bool -> Bool
&& (Id -> Id -> Bool) -> [Id] -> [Id] -> Bool
forall a b. (a -> b -> Bool) -> [a] -> [b] -> Bool
all2 (\Id
b1 Id
b2 -> DeBruijn Mult -> DeBruijn Mult -> Bool
eqDeBruijnType (CmEnv -> Mult -> DeBruijn Mult
forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env1 (Id -> Mult
varType Id
b1))
(CmEnv -> Mult -> DeBruijn Mult
forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env2 (Id -> Mult
varType Id
b2)))
[Id]
bs1 [Id]
bs2
Bool -> Bool -> Bool
&& CmEnv -> [Expr Id] -> DeBruijn [Expr Id]
forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env1' [Expr Id]
rs1 DeBruijn [Expr Id] -> DeBruijn [Expr Id] -> Bool
forall a. Eq a => a -> a -> Bool
== CmEnv -> [Expr Id] -> DeBruijn [Expr Id]
forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env2' [Expr Id]
rs2
Bool -> Bool -> Bool
&& DeBruijn (Expr Id) -> DeBruijn (Expr Id) -> Bool
eqDeBruijnExpr (CmEnv -> Expr Id -> DeBruijn (Expr Id)
forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env1' Expr Id
e1) (CmEnv -> Expr Id -> DeBruijn (Expr Id)
forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env2' Expr Id
e2)
where
([Id]
bs1,[Expr Id]
rs1) = [(Id, Expr Id)] -> ([Id], [Expr Id])
forall a b. [(a, b)] -> ([a], [b])
unzip [(Id, Expr Id)]
ps1
([Id]
bs2,[Expr Id]
rs2) = [(Id, Expr Id)] -> ([Id], [Expr Id])
forall a b. [(a, b)] -> ([a], [b])
unzip [(Id, Expr Id)]
ps2
env1' :: CmEnv
env1' = CmEnv -> [Id] -> CmEnv
extendCMEs CmEnv
env1 [Id]
bs1
env2' :: CmEnv
env2' = CmEnv -> [Id] -> CmEnv
extendCMEs CmEnv
env2 [Id]
bs2
go (Case Expr Id
e1 Id
b1 Mult
t1 [Alt Id]
a1) (Case Expr Id
e2 Id
b2 Mult
t2 [Alt Id]
a2)
| [Alt Id] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Alt Id]
a1
= [Alt Id] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Alt Id]
a2 Bool -> Bool -> Bool
&& Expr Id -> Expr Id -> Bool
go Expr Id
e1 Expr Id
e2 Bool -> Bool -> Bool
&& CmEnv -> Mult -> DeBruijn Mult
forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env1 Mult
t1 DeBruijn Mult -> DeBruijn Mult -> Bool
forall a. Eq a => a -> a -> Bool
== CmEnv -> Mult -> DeBruijn Mult
forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env2 Mult
t2
| Bool
otherwise
= Expr Id -> Expr Id -> Bool
go Expr Id
e1 Expr Id
e2 Bool -> Bool -> Bool
&& CmEnv -> [Alt Id] -> DeBruijn [Alt Id]
forall a. CmEnv -> a -> DeBruijn a
D (CmEnv -> Id -> CmEnv
extendCME CmEnv
env1 Id
b1) [Alt Id]
a1 DeBruijn [Alt Id] -> DeBruijn [Alt Id] -> Bool
forall a. Eq a => a -> a -> Bool
== CmEnv -> [Alt Id] -> DeBruijn [Alt Id]
forall a. CmEnv -> a -> DeBruijn a
D (CmEnv -> Id -> CmEnv
extendCME CmEnv
env2 Id
b2) [Alt Id]
a2
go Expr Id
_ Expr Id
_ = Bool
False
eqDeBruijnTickish :: DeBruijn CoreTickish -> DeBruijn CoreTickish -> Bool
eqDeBruijnTickish :: DeBruijn (GenTickish 'TickishPassCore)
-> DeBruijn (GenTickish 'TickishPassCore) -> Bool
eqDeBruijnTickish (D CmEnv
env1 GenTickish 'TickishPassCore
t1) (D CmEnv
env2 GenTickish 'TickishPassCore
t2) = GenTickish 'TickishPassCore -> GenTickish 'TickishPassCore -> Bool
go GenTickish 'TickishPassCore
t1 GenTickish 'TickishPassCore
t2 where
go :: GenTickish 'TickishPassCore -> GenTickish 'TickishPassCore -> Bool
go (Breakpoint XBreakpoint 'TickishPassCore
lext Int
lid [XTickishId 'TickishPassCore]
lids) (Breakpoint XBreakpoint 'TickishPassCore
rext Int
rid [XTickishId 'TickishPassCore]
rids)
= Int
lid Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
rid
Bool -> Bool -> Bool
&& CmEnv -> [Id] -> DeBruijn [Id]
forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env1 [Id]
[XTickishId 'TickishPassCore]
lids DeBruijn [Id] -> DeBruijn [Id] -> Bool
forall a. Eq a => a -> a -> Bool
== CmEnv -> [Id] -> DeBruijn [Id]
forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env2 [Id]
[XTickishId 'TickishPassCore]
rids
Bool -> Bool -> Bool
&& NoExtField
XBreakpoint 'TickishPassCore
lext NoExtField -> NoExtField -> Bool
forall a. Eq a => a -> a -> Bool
== NoExtField
XBreakpoint 'TickishPassCore
rext
go GenTickish 'TickishPassCore
l GenTickish 'TickishPassCore
r = GenTickish 'TickishPassCore
l GenTickish 'TickishPassCore -> GenTickish 'TickishPassCore -> Bool
forall a. Eq a => a -> a -> Bool
== GenTickish 'TickishPassCore
r
eqCoreExpr :: CoreExpr -> CoreExpr -> Bool
eqCoreExpr :: Expr Id -> Expr Id -> Bool
eqCoreExpr Expr Id
e1 Expr Id
e2 = DeBruijn (Expr Id) -> DeBruijn (Expr Id) -> Bool
eqDeBruijnExpr (Expr Id -> DeBruijn (Expr Id)
forall a. a -> DeBruijn a
deBruijnize Expr Id
e1) (Expr Id -> DeBruijn (Expr Id)
forall a. a -> DeBruijn a
deBruijnize Expr Id
e2)
emptyE :: CoreMapX a
emptyE :: forall a. CoreMapX a
emptyE = CM { cm_var :: VarMap a
cm_var = VarMap a
forall a. VarMap a
forall (m :: * -> *) a. TrieMap m => m a
emptyTM, cm_lit :: LiteralMap a
cm_lit = LiteralMap a
forall a. Map Literal a
forall (m :: * -> *) a. TrieMap m => m a
emptyTM
, cm_co :: CoercionMapG a
cm_co = CoercionMapG a
forall a. GenMap CoercionMapX a
forall (m :: * -> *) a. TrieMap m => m a
emptyTM, cm_type :: TypeMapG a
cm_type = TypeMapG a
forall a. GenMap TypeMapX a
forall (m :: * -> *) a. TrieMap m => m a
emptyTM
, cm_cast :: CoreMapG (CoercionMapG a)
cm_cast = CoreMapG (CoercionMapG a)
forall a. GenMap CoreMapX a
forall (m :: * -> *) a. TrieMap m => m a
emptyTM, cm_app :: CoreMapG (CoreMapG a)
cm_app = CoreMapG (CoreMapG a)
forall a. GenMap CoreMapX a
forall (m :: * -> *) a. TrieMap m => m a
emptyTM
, cm_lam :: CoreMapG (BndrMap a)
cm_lam = CoreMapG (BndrMap a)
forall a. GenMap CoreMapX a
forall (m :: * -> *) a. TrieMap m => m a
emptyTM, cm_letn :: CoreMapG (CoreMapG (BndrMap a))
cm_letn = CoreMapG (CoreMapG (BndrMap a))
forall a. GenMap CoreMapX a
forall (m :: * -> *) a. TrieMap m => m a
emptyTM
, cm_letr :: ListMap (GenMap CoreMapX) (CoreMapG (ListMap BndrMap a))
cm_letr = ListMap (GenMap CoreMapX) (CoreMapG (ListMap BndrMap a))
forall a. ListMap (GenMap CoreMapX) a
forall (m :: * -> *) a. TrieMap m => m a
emptyTM, cm_case :: CoreMapG (ListMap AltMap a)
cm_case = CoreMapG (ListMap AltMap a)
forall a. GenMap CoreMapX a
forall (m :: * -> *) a. TrieMap m => m a
emptyTM
, cm_ecase :: CoreMapG (TypeMapG a)
cm_ecase = CoreMapG (TypeMapG a)
forall a. GenMap CoreMapX a
forall (m :: * -> *) a. TrieMap m => m a
emptyTM, cm_tick :: CoreMapG (TickishMap a)
cm_tick = CoreMapG (TickishMap a)
forall a. GenMap CoreMapX a
forall (m :: * -> *) a. TrieMap m => m a
emptyTM }
instance Functor CoreMapX where
fmap :: forall a b. (a -> b) -> CoreMapX a -> CoreMapX b
fmap a -> b
f CM
{ cm_var :: forall a. CoreMapX a -> VarMap a
cm_var = VarMap a
cvar, cm_lit :: forall a. CoreMapX a -> LiteralMap a
cm_lit = LiteralMap a
clit, cm_co :: forall a. CoreMapX a -> CoercionMapG a
cm_co = CoercionMapG a
cco, cm_type :: forall a. CoreMapX a -> TypeMapG a
cm_type = TypeMapG a
ctype, cm_cast :: forall a. CoreMapX a -> CoreMapG (CoercionMapG a)
cm_cast = CoreMapG (CoercionMapG a)
ccast
, cm_app :: forall a. CoreMapX a -> CoreMapG (CoreMapG a)
cm_app = CoreMapG (CoreMapG a)
capp, cm_lam :: forall a. CoreMapX a -> CoreMapG (BndrMap a)
cm_lam = CoreMapG (BndrMap a)
clam, cm_letn :: forall a. CoreMapX a -> CoreMapG (CoreMapG (BndrMap a))
cm_letn = CoreMapG (CoreMapG (BndrMap a))
cletn, cm_letr :: forall a.
CoreMapX a
-> ListMap (GenMap CoreMapX) (CoreMapG (ListMap BndrMap a))
cm_letr = ListMap (GenMap CoreMapX) (CoreMapG (ListMap BndrMap a))
cletr, cm_case :: forall a. CoreMapX a -> CoreMapG (ListMap AltMap a)
cm_case = CoreMapG (ListMap AltMap a)
ccase
, cm_ecase :: forall a. CoreMapX a -> CoreMapG (TypeMapG a)
cm_ecase = CoreMapG (TypeMapG a)
cecase, cm_tick :: forall a. CoreMapX a -> CoreMapG (TickishMap a)
cm_tick = CoreMapG (TickishMap a)
ctick } = CM
{ cm_var :: VarMap b
cm_var = (a -> b) -> VarMap a -> VarMap b
forall a b. (a -> b) -> VarMap a -> VarMap b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f VarMap a
cvar, cm_lit :: LiteralMap b
cm_lit = (a -> b) -> LiteralMap a -> LiteralMap b
forall a b. (a -> b) -> Map Literal a -> Map Literal b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f LiteralMap a
clit, cm_co :: CoercionMapG b
cm_co = (a -> b) -> CoercionMapG a -> CoercionMapG b
forall a b.
(a -> b) -> GenMap CoercionMapX a -> GenMap CoercionMapX b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f CoercionMapG a
cco, cm_type :: TypeMapG b
cm_type = (a -> b) -> TypeMapG a -> TypeMapG b
forall a b. (a -> b) -> GenMap TypeMapX a -> GenMap TypeMapX b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f TypeMapG a
ctype
, cm_cast :: CoreMapG (CoercionMapG b)
cm_cast = (CoercionMapG a -> CoercionMapG b)
-> CoreMapG (CoercionMapG a) -> CoreMapG (CoercionMapG b)
forall a b. (a -> b) -> GenMap CoreMapX a -> GenMap CoreMapX b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> CoercionMapG a -> CoercionMapG b
forall a b.
(a -> b) -> GenMap CoercionMapX a -> GenMap CoercionMapX b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) CoreMapG (CoercionMapG a)
ccast, cm_app :: CoreMapG (CoreMapG b)
cm_app = (CoreMapG a -> CoreMapG b)
-> CoreMapG (CoreMapG a) -> CoreMapG (CoreMapG b)
forall a b. (a -> b) -> GenMap CoreMapX a -> GenMap CoreMapX b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> CoreMapG a -> CoreMapG b
forall a b. (a -> b) -> GenMap CoreMapX a -> GenMap CoreMapX b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) CoreMapG (CoreMapG a)
capp, cm_lam :: CoreMapG (BndrMap b)
cm_lam = (BndrMap a -> BndrMap b)
-> CoreMapG (BndrMap a) -> CoreMapG (BndrMap b)
forall a b. (a -> b) -> GenMap CoreMapX a -> GenMap CoreMapX b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> BndrMap a -> BndrMap b
forall a b. (a -> b) -> BndrMap a -> BndrMap b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) CoreMapG (BndrMap a)
clam
, cm_letn :: CoreMapG (CoreMapG (BndrMap b))
cm_letn = (CoreMapG (BndrMap a) -> CoreMapG (BndrMap b))
-> CoreMapG (CoreMapG (BndrMap a))
-> CoreMapG (CoreMapG (BndrMap b))
forall a b. (a -> b) -> GenMap CoreMapX a -> GenMap CoreMapX b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((BndrMap a -> BndrMap b)
-> CoreMapG (BndrMap a) -> CoreMapG (BndrMap b)
forall a b. (a -> b) -> GenMap CoreMapX a -> GenMap CoreMapX b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> BndrMap a -> BndrMap b
forall a b. (a -> b) -> BndrMap a -> BndrMap b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f)) CoreMapG (CoreMapG (BndrMap a))
cletn, cm_letr :: ListMap (GenMap CoreMapX) (CoreMapG (ListMap BndrMap b))
cm_letr = (CoreMapG (ListMap BndrMap a) -> CoreMapG (ListMap BndrMap b))
-> ListMap (GenMap CoreMapX) (CoreMapG (ListMap BndrMap a))
-> ListMap (GenMap CoreMapX) (CoreMapG (ListMap BndrMap b))
forall a b.
(a -> b)
-> ListMap (GenMap CoreMapX) a -> ListMap (GenMap CoreMapX) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((ListMap BndrMap a -> ListMap BndrMap b)
-> CoreMapG (ListMap BndrMap a) -> CoreMapG (ListMap BndrMap b)
forall a b. (a -> b) -> GenMap CoreMapX a -> GenMap CoreMapX b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> ListMap BndrMap a -> ListMap BndrMap b
forall a b. (a -> b) -> ListMap BndrMap a -> ListMap BndrMap b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f)) ListMap (GenMap CoreMapX) (CoreMapG (ListMap BndrMap a))
cletr
, cm_case :: CoreMapG (ListMap AltMap b)
cm_case = (ListMap AltMap a -> ListMap AltMap b)
-> CoreMapG (ListMap AltMap a) -> CoreMapG (ListMap AltMap b)
forall a b. (a -> b) -> GenMap CoreMapX a -> GenMap CoreMapX b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> ListMap AltMap a -> ListMap AltMap b
forall a b. (a -> b) -> ListMap AltMap a -> ListMap AltMap b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) CoreMapG (ListMap AltMap a)
ccase, cm_ecase :: CoreMapG (TypeMapG b)
cm_ecase = (TypeMapG a -> TypeMapG b)
-> CoreMapG (TypeMapG a) -> CoreMapG (TypeMapG b)
forall a b. (a -> b) -> GenMap CoreMapX a -> GenMap CoreMapX b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> TypeMapG a -> TypeMapG b
forall a b. (a -> b) -> GenMap TypeMapX a -> GenMap TypeMapX b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) CoreMapG (TypeMapG a)
cecase
, cm_tick :: CoreMapG (TickishMap b)
cm_tick = (TickishMap a -> TickishMap b)
-> CoreMapG (TickishMap a) -> CoreMapG (TickishMap b)
forall a b. (a -> b) -> GenMap CoreMapX a -> GenMap CoreMapX b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> TickishMap a -> TickishMap b
forall a b.
(a -> b)
-> Map (GenTickish 'TickishPassCore) a
-> Map (GenTickish 'TickishPassCore) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) CoreMapG (TickishMap a)
ctick }
instance TrieMap CoreMapX where
type Key CoreMapX = DeBruijn CoreExpr
emptyTM :: forall a. CoreMapX a
emptyTM = CoreMapX a
forall a. CoreMapX a
emptyE
lookupTM :: forall b. Key CoreMapX -> CoreMapX b -> Maybe b
lookupTM = Key CoreMapX -> CoreMapX b -> Maybe b
DeBruijn (Expr Id) -> CoreMapX b -> Maybe b
forall a. DeBruijn (Expr Id) -> CoreMapX a -> Maybe a
lkE
alterTM :: forall b. Key CoreMapX -> XT b -> CoreMapX b -> CoreMapX b
alterTM = Key CoreMapX -> (Maybe b -> Maybe b) -> CoreMapX b -> CoreMapX b
DeBruijn (Expr Id)
-> (Maybe b -> Maybe b) -> CoreMapX b -> CoreMapX b
forall a. DeBruijn (Expr Id) -> XT a -> CoreMapX a -> CoreMapX a
xtE
foldTM :: forall a b. (a -> b -> b) -> CoreMapX a -> b -> b
foldTM = (a -> b -> b) -> CoreMapX a -> b -> b
forall a b. (a -> b -> b) -> CoreMapX a -> b -> b
fdE
filterTM :: forall a. (a -> Bool) -> CoreMapX a -> CoreMapX a
filterTM = (a -> Bool) -> CoreMapX a -> CoreMapX a
forall a. (a -> Bool) -> CoreMapX a -> CoreMapX a
ftE
ftE :: (a->Bool) -> CoreMapX a -> CoreMapX a
ftE :: forall a. (a -> Bool) -> CoreMapX a -> CoreMapX a
ftE a -> Bool
f (CM { cm_var :: forall a. CoreMapX a -> VarMap a
cm_var = VarMap a
cvar, cm_lit :: forall a. CoreMapX a -> LiteralMap a
cm_lit = LiteralMap a
clit
, cm_co :: forall a. CoreMapX a -> CoercionMapG a
cm_co = CoercionMapG a
cco, cm_type :: forall a. CoreMapX a -> TypeMapG a
cm_type = TypeMapG a
ctype
, cm_cast :: forall a. CoreMapX a -> CoreMapG (CoercionMapG a)
cm_cast = CoreMapG (CoercionMapG a)
ccast , cm_app :: forall a. CoreMapX a -> CoreMapG (CoreMapG a)
cm_app = CoreMapG (CoreMapG a)
capp
, cm_lam :: forall a. CoreMapX a -> CoreMapG (BndrMap a)
cm_lam = CoreMapG (BndrMap a)
clam, cm_letn :: forall a. CoreMapX a -> CoreMapG (CoreMapG (BndrMap a))
cm_letn = CoreMapG (CoreMapG (BndrMap a))
cletn
, cm_letr :: forall a.
CoreMapX a
-> ListMap (GenMap CoreMapX) (CoreMapG (ListMap BndrMap a))
cm_letr = ListMap (GenMap CoreMapX) (CoreMapG (ListMap BndrMap a))
cletr, cm_case :: forall a. CoreMapX a -> CoreMapG (ListMap AltMap a)
cm_case = CoreMapG (ListMap AltMap a)
ccase
, cm_ecase :: forall a. CoreMapX a -> CoreMapG (TypeMapG a)
cm_ecase = CoreMapG (TypeMapG a)
cecase, cm_tick :: forall a. CoreMapX a -> CoreMapG (TickishMap a)
cm_tick = CoreMapG (TickishMap a)
ctick })
= CM { cm_var :: VarMap a
cm_var = (a -> Bool) -> VarMap a -> VarMap a
forall a. (a -> Bool) -> VarMap a -> VarMap a
forall (m :: * -> *) a. TrieMap m => (a -> Bool) -> m a -> m a
filterTM a -> Bool
f VarMap a
cvar, cm_lit :: LiteralMap a
cm_lit = (a -> Bool) -> LiteralMap a -> LiteralMap a
forall a. (a -> Bool) -> Map Literal a -> Map Literal a
forall (m :: * -> *) a. TrieMap m => (a -> Bool) -> m a -> m a
filterTM a -> Bool
f LiteralMap a
clit
, cm_co :: CoercionMapG a
cm_co = (a -> Bool) -> CoercionMapG a -> CoercionMapG a
forall a.
(a -> Bool) -> GenMap CoercionMapX a -> GenMap CoercionMapX a
forall (m :: * -> *) a. TrieMap m => (a -> Bool) -> m a -> m a
filterTM a -> Bool
f CoercionMapG a
cco, cm_type :: TypeMapG a
cm_type = (a -> Bool) -> TypeMapG a -> TypeMapG a
forall a. (a -> Bool) -> GenMap TypeMapX a -> GenMap TypeMapX a
forall (m :: * -> *) a. TrieMap m => (a -> Bool) -> m a -> m a
filterTM a -> Bool
f TypeMapG a
ctype
, cm_cast :: CoreMapG (CoercionMapG a)
cm_cast = (CoercionMapG a -> CoercionMapG a)
-> CoreMapG (CoercionMapG a) -> CoreMapG (CoercionMapG a)
forall a b. (a -> b) -> GenMap CoreMapX a -> GenMap CoreMapX b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> Bool) -> CoercionMapG a -> CoercionMapG a
forall a.
(a -> Bool) -> GenMap CoercionMapX a -> GenMap CoercionMapX a
forall (m :: * -> *) a. TrieMap m => (a -> Bool) -> m a -> m a
filterTM a -> Bool
f) CoreMapG (CoercionMapG a)
ccast, cm_app :: CoreMapG (CoreMapG a)
cm_app = (CoreMapG a -> CoreMapG a)
-> CoreMapG (CoreMapG a) -> CoreMapG (CoreMapG a)
forall a b. (a -> b) -> GenMap CoreMapX a -> GenMap CoreMapX b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> Bool) -> CoreMapG a -> CoreMapG a
forall a. (a -> Bool) -> GenMap CoreMapX a -> GenMap CoreMapX a
forall (m :: * -> *) a. TrieMap m => (a -> Bool) -> m a -> m a
filterTM a -> Bool
f) CoreMapG (CoreMapG a)
capp
, cm_lam :: CoreMapG (BndrMap a)
cm_lam = (BndrMap a -> BndrMap a)
-> CoreMapG (BndrMap a) -> CoreMapG (BndrMap a)
forall a b. (a -> b) -> GenMap CoreMapX a -> GenMap CoreMapX b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> Bool) -> BndrMap a -> BndrMap a
forall a. (a -> Bool) -> BndrMap a -> BndrMap a
forall (m :: * -> *) a. TrieMap m => (a -> Bool) -> m a -> m a
filterTM a -> Bool
f) CoreMapG (BndrMap a)
clam, cm_letn :: CoreMapG (CoreMapG (BndrMap a))
cm_letn = (CoreMapG (BndrMap a) -> CoreMapG (BndrMap a))
-> CoreMapG (CoreMapG (BndrMap a))
-> CoreMapG (CoreMapG (BndrMap a))
forall a b. (a -> b) -> GenMap CoreMapX a -> GenMap CoreMapX b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((BndrMap a -> BndrMap a)
-> CoreMapG (BndrMap a) -> CoreMapG (BndrMap a)
forall a b. (a -> b) -> GenMap CoreMapX a -> GenMap CoreMapX b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> Bool) -> BndrMap a -> BndrMap a
forall a. (a -> Bool) -> BndrMap a -> BndrMap a
forall (m :: * -> *) a. TrieMap m => (a -> Bool) -> m a -> m a
filterTM a -> Bool
f)) CoreMapG (CoreMapG (BndrMap a))
cletn
, cm_letr :: ListMap (GenMap CoreMapX) (CoreMapG (ListMap BndrMap a))
cm_letr = (CoreMapG (ListMap BndrMap a) -> CoreMapG (ListMap BndrMap a))
-> ListMap (GenMap CoreMapX) (CoreMapG (ListMap BndrMap a))
-> ListMap (GenMap CoreMapX) (CoreMapG (ListMap BndrMap a))
forall a b.
(a -> b)
-> ListMap (GenMap CoreMapX) a -> ListMap (GenMap CoreMapX) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((ListMap BndrMap a -> ListMap BndrMap a)
-> CoreMapG (ListMap BndrMap a) -> CoreMapG (ListMap BndrMap a)
forall a b. (a -> b) -> GenMap CoreMapX a -> GenMap CoreMapX b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> Bool) -> ListMap BndrMap a -> ListMap BndrMap a
forall a. (a -> Bool) -> ListMap BndrMap a -> ListMap BndrMap a
forall (m :: * -> *) a. TrieMap m => (a -> Bool) -> m a -> m a
filterTM a -> Bool
f)) ListMap (GenMap CoreMapX) (CoreMapG (ListMap BndrMap a))
cletr, cm_case :: CoreMapG (ListMap AltMap a)
cm_case = (ListMap AltMap a -> ListMap AltMap a)
-> CoreMapG (ListMap AltMap a) -> CoreMapG (ListMap AltMap a)
forall a b. (a -> b) -> GenMap CoreMapX a -> GenMap CoreMapX b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> Bool) -> ListMap AltMap a -> ListMap AltMap a
forall a. (a -> Bool) -> ListMap AltMap a -> ListMap AltMap a
forall (m :: * -> *) a. TrieMap m => (a -> Bool) -> m a -> m a
filterTM a -> Bool
f) CoreMapG (ListMap AltMap a)
ccase
, cm_ecase :: CoreMapG (TypeMapG a)
cm_ecase = (TypeMapG a -> TypeMapG a)
-> CoreMapG (TypeMapG a) -> CoreMapG (TypeMapG a)
forall a b. (a -> b) -> GenMap CoreMapX a -> GenMap CoreMapX b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> Bool) -> TypeMapG a -> TypeMapG a
forall a. (a -> Bool) -> GenMap TypeMapX a -> GenMap TypeMapX a
forall (m :: * -> *) a. TrieMap m => (a -> Bool) -> m a -> m a
filterTM a -> Bool
f) CoreMapG (TypeMapG a)
cecase, cm_tick :: CoreMapG (TickishMap a)
cm_tick = (TickishMap a -> TickishMap a)
-> CoreMapG (TickishMap a) -> CoreMapG (TickishMap a)
forall a b. (a -> b) -> GenMap CoreMapX a -> GenMap CoreMapX b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> Bool) -> TickishMap a -> TickishMap a
forall a.
(a -> Bool)
-> Map (GenTickish 'TickishPassCore) a
-> Map (GenTickish 'TickishPassCore) a
forall (m :: * -> *) a. TrieMap m => (a -> Bool) -> m a -> m a
filterTM a -> Bool
f) CoreMapG (TickishMap a)
ctick }
lookupCoreMap :: CoreMap a -> CoreExpr -> Maybe a
lookupCoreMap :: forall a. CoreMap a -> Expr Id -> Maybe a
lookupCoreMap CoreMap a
cm Expr Id
e = Key CoreMap -> CoreMap a -> Maybe a
forall b. Key CoreMap -> CoreMap b -> Maybe b
forall (m :: * -> *) b. TrieMap m => Key m -> m b -> Maybe b
lookupTM Expr Id
Key CoreMap
e CoreMap a
cm
extendCoreMap :: CoreMap a -> CoreExpr -> a -> CoreMap a
extendCoreMap :: forall a. CoreMap a -> Expr Id -> a -> CoreMap a
extendCoreMap CoreMap a
m Expr Id
e a
v = Key CoreMap -> XT a -> CoreMap a -> CoreMap a
forall b. Key CoreMap -> XT b -> CoreMap b -> CoreMap b
forall (m :: * -> *) b. TrieMap m => Key m -> XT b -> m b -> m b
alterTM Expr Id
Key CoreMap
e (\Maybe a
_ -> a -> Maybe a
forall a. a -> Maybe a
Just a
v) CoreMap a
m
foldCoreMap :: (a -> b -> b) -> b -> CoreMap a -> b
foldCoreMap :: forall a b. (a -> b -> b) -> b -> CoreMap a -> b
foldCoreMap a -> b -> b
k b
z CoreMap a
m = (a -> b -> b) -> CoreMap a -> b -> b
forall a b. (a -> b -> b) -> CoreMap a -> b -> b
forall (m :: * -> *) a b.
TrieMap m =>
(a -> b -> b) -> m a -> b -> b
foldTM a -> b -> b
k CoreMap a
m b
z
emptyCoreMap :: CoreMap a
emptyCoreMap :: forall a. CoreMap a
emptyCoreMap = CoreMap a
forall a. CoreMap a
forall (m :: * -> *) a. TrieMap m => m a
emptyTM
instance Outputable a => Outputable (CoreMap a) where
ppr :: CoreMap a -> SDoc
ppr CoreMap a
m = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"CoreMap elts" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [a] -> SDoc
forall a. Outputable a => a -> SDoc
ppr ((a -> [a] -> [a]) -> CoreMap a -> [a] -> [a]
forall a b. (a -> b -> b) -> CoreMap a -> b -> b
forall (m :: * -> *) a b.
TrieMap m =>
(a -> b -> b) -> m a -> b -> b
foldTM (:) CoreMap a
m [])
fdE :: (a -> b -> b) -> CoreMapX a -> b -> b
fdE :: forall a b. (a -> b -> b) -> CoreMapX a -> b -> b
fdE a -> b -> b
k CoreMapX a
m
= (a -> b -> b) -> VarMap a -> b -> b
forall a b. (a -> b -> b) -> VarMap a -> b -> b
forall (m :: * -> *) a b.
TrieMap m =>
(a -> b -> b) -> m a -> b -> b
foldTM a -> b -> b
k (CoreMapX a -> VarMap a
forall a. CoreMapX a -> VarMap a
cm_var CoreMapX a
m)
(b -> b) -> (b -> b) -> b -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b -> b) -> Map Literal a -> b -> b
forall a b. (a -> b -> b) -> Map Literal a -> b -> b
forall (m :: * -> *) a b.
TrieMap m =>
(a -> b -> b) -> m a -> b -> b
foldTM a -> b -> b
k (CoreMapX a -> Map Literal a
forall a. CoreMapX a -> LiteralMap a
cm_lit CoreMapX a
m)
(b -> b) -> (b -> b) -> b -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b -> b) -> GenMap CoercionMapX a -> b -> b
forall a b. (a -> b -> b) -> GenMap CoercionMapX a -> b -> b
forall (m :: * -> *) a b.
TrieMap m =>
(a -> b -> b) -> m a -> b -> b
foldTM a -> b -> b
k (CoreMapX a -> GenMap CoercionMapX a
forall a. CoreMapX a -> CoercionMapG a
cm_co CoreMapX a
m)
(b -> b) -> (b -> b) -> b -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b -> b) -> GenMap TypeMapX a -> b -> b
forall a b. (a -> b -> b) -> GenMap TypeMapX a -> b -> b
forall (m :: * -> *) a b.
TrieMap m =>
(a -> b -> b) -> m a -> b -> b
foldTM a -> b -> b
k (CoreMapX a -> GenMap TypeMapX a
forall a. CoreMapX a -> TypeMapG a
cm_type CoreMapX a
m)
(b -> b) -> (b -> b) -> b -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GenMap CoercionMapX a -> b -> b)
-> GenMap CoreMapX (GenMap CoercionMapX a) -> b -> b
forall a b. (a -> b -> b) -> GenMap CoreMapX a -> b -> b
forall (m :: * -> *) a b.
TrieMap m =>
(a -> b -> b) -> m a -> b -> b
foldTM ((a -> b -> b) -> GenMap CoercionMapX a -> b -> b
forall a b. (a -> b -> b) -> GenMap CoercionMapX a -> b -> b
forall (m :: * -> *) a b.
TrieMap m =>
(a -> b -> b) -> m a -> b -> b
foldTM a -> b -> b
k) (CoreMapX a -> GenMap CoreMapX (GenMap CoercionMapX a)
forall a. CoreMapX a -> CoreMapG (CoercionMapG a)
cm_cast CoreMapX a
m)
(b -> b) -> (b -> b) -> b -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map (GenTickish 'TickishPassCore) a -> b -> b)
-> GenMap CoreMapX (Map (GenTickish 'TickishPassCore) a) -> b -> b
forall a b. (a -> b -> b) -> GenMap CoreMapX a -> b -> b
forall (m :: * -> *) a b.
TrieMap m =>
(a -> b -> b) -> m a -> b -> b
foldTM ((a -> b -> b) -> Map (GenTickish 'TickishPassCore) a -> b -> b
forall a b.
(a -> b -> b) -> Map (GenTickish 'TickishPassCore) a -> b -> b
forall (m :: * -> *) a b.
TrieMap m =>
(a -> b -> b) -> m a -> b -> b
foldTM a -> b -> b
k) (CoreMapX a -> GenMap CoreMapX (Map (GenTickish 'TickishPassCore) a)
forall a. CoreMapX a -> CoreMapG (TickishMap a)
cm_tick CoreMapX a
m)
(b -> b) -> (b -> b) -> b -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GenMap CoreMapX a -> b -> b)
-> GenMap CoreMapX (GenMap CoreMapX a) -> b -> b
forall a b. (a -> b -> b) -> GenMap CoreMapX a -> b -> b
forall (m :: * -> *) a b.
TrieMap m =>
(a -> b -> b) -> m a -> b -> b
foldTM ((a -> b -> b) -> GenMap CoreMapX a -> b -> b
forall a b. (a -> b -> b) -> GenMap CoreMapX a -> b -> b
forall (m :: * -> *) a b.
TrieMap m =>
(a -> b -> b) -> m a -> b -> b
foldTM a -> b -> b
k) (CoreMapX a -> GenMap CoreMapX (GenMap CoreMapX a)
forall a. CoreMapX a -> CoreMapG (CoreMapG a)
cm_app CoreMapX a
m)
(b -> b) -> (b -> b) -> b -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (BndrMap a -> b -> b) -> GenMap CoreMapX (BndrMap a) -> b -> b
forall a b. (a -> b -> b) -> GenMap CoreMapX a -> b -> b
forall (m :: * -> *) a b.
TrieMap m =>
(a -> b -> b) -> m a -> b -> b
foldTM ((a -> b -> b) -> BndrMap a -> b -> b
forall a b. (a -> b -> b) -> BndrMap a -> b -> b
forall (m :: * -> *) a b.
TrieMap m =>
(a -> b -> b) -> m a -> b -> b
foldTM a -> b -> b
k) (CoreMapX a -> GenMap CoreMapX (BndrMap a)
forall a. CoreMapX a -> CoreMapG (BndrMap a)
cm_lam CoreMapX a
m)
(b -> b) -> (b -> b) -> b -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GenMap CoreMapX (BndrMap a) -> b -> b)
-> GenMap CoreMapX (GenMap CoreMapX (BndrMap a)) -> b -> b
forall a b. (a -> b -> b) -> GenMap CoreMapX a -> b -> b
forall (m :: * -> *) a b.
TrieMap m =>
(a -> b -> b) -> m a -> b -> b
foldTM ((BndrMap a -> b -> b) -> GenMap CoreMapX (BndrMap a) -> b -> b
forall a b. (a -> b -> b) -> GenMap CoreMapX a -> b -> b
forall (m :: * -> *) a b.
TrieMap m =>
(a -> b -> b) -> m a -> b -> b
foldTM ((a -> b -> b) -> BndrMap a -> b -> b
forall a b. (a -> b -> b) -> BndrMap a -> b -> b
forall (m :: * -> *) a b.
TrieMap m =>
(a -> b -> b) -> m a -> b -> b
foldTM a -> b -> b
k)) (CoreMapX a -> GenMap CoreMapX (GenMap CoreMapX (BndrMap a))
forall a. CoreMapX a -> CoreMapG (CoreMapG (BndrMap a))
cm_letn CoreMapX a
m)
(b -> b) -> (b -> b) -> b -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GenMap CoreMapX (ListMap BndrMap a) -> b -> b)
-> ListMap (GenMap CoreMapX) (GenMap CoreMapX (ListMap BndrMap a))
-> b
-> b
forall a b. (a -> b -> b) -> ListMap (GenMap CoreMapX) a -> b -> b
forall (m :: * -> *) a b.
TrieMap m =>
(a -> b -> b) -> m a -> b -> b
foldTM ((ListMap BndrMap a -> b -> b)
-> GenMap CoreMapX (ListMap BndrMap a) -> b -> b
forall a b. (a -> b -> b) -> GenMap CoreMapX a -> b -> b
forall (m :: * -> *) a b.
TrieMap m =>
(a -> b -> b) -> m a -> b -> b
foldTM ((a -> b -> b) -> ListMap BndrMap a -> b -> b
forall a b. (a -> b -> b) -> ListMap BndrMap a -> b -> b
forall (m :: * -> *) a b.
TrieMap m =>
(a -> b -> b) -> m a -> b -> b
foldTM a -> b -> b
k)) (CoreMapX a
-> ListMap (GenMap CoreMapX) (GenMap CoreMapX (ListMap BndrMap a))
forall a.
CoreMapX a
-> ListMap (GenMap CoreMapX) (CoreMapG (ListMap BndrMap a))
cm_letr CoreMapX a
m)
(b -> b) -> (b -> b) -> b -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ListMap AltMap a -> b -> b)
-> GenMap CoreMapX (ListMap AltMap a) -> b -> b
forall a b. (a -> b -> b) -> GenMap CoreMapX a -> b -> b
forall (m :: * -> *) a b.
TrieMap m =>
(a -> b -> b) -> m a -> b -> b
foldTM ((a -> b -> b) -> ListMap AltMap a -> b -> b
forall a b. (a -> b -> b) -> ListMap AltMap a -> b -> b
forall (m :: * -> *) a b.
TrieMap m =>
(a -> b -> b) -> m a -> b -> b
foldTM a -> b -> b
k) (CoreMapX a -> GenMap CoreMapX (ListMap AltMap a)
forall a. CoreMapX a -> CoreMapG (ListMap AltMap a)
cm_case CoreMapX a
m)
(b -> b) -> (b -> b) -> b -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GenMap TypeMapX a -> b -> b)
-> GenMap CoreMapX (GenMap TypeMapX a) -> b -> b
forall a b. (a -> b -> b) -> GenMap CoreMapX a -> b -> b
forall (m :: * -> *) a b.
TrieMap m =>
(a -> b -> b) -> m a -> b -> b
foldTM ((a -> b -> b) -> GenMap TypeMapX a -> b -> b
forall a b. (a -> b -> b) -> GenMap TypeMapX a -> b -> b
forall (m :: * -> *) a b.
TrieMap m =>
(a -> b -> b) -> m a -> b -> b
foldTM a -> b -> b
k) (CoreMapX a -> GenMap CoreMapX (GenMap TypeMapX a)
forall a. CoreMapX a -> CoreMapG (TypeMapG a)
cm_ecase CoreMapX a
m)
lkE :: DeBruijn CoreExpr -> CoreMapX a -> Maybe a
lkE :: forall a. DeBruijn (Expr Id) -> CoreMapX a -> Maybe a
lkE (D CmEnv
env Expr Id
expr) CoreMapX a
cm = Expr Id -> CoreMapX a -> Maybe a
go Expr Id
expr CoreMapX a
cm
where
go :: Expr Id -> CoreMapX a -> Maybe a
go (Var Id
v) = CoreMapX a -> VarMap a
forall a. CoreMapX a -> VarMap a
cm_var (CoreMapX a -> VarMap a)
-> (VarMap a -> Maybe a) -> CoreMapX a -> Maybe a
forall a b c. (a -> b) -> (b -> c) -> a -> c
>.> CmEnv -> Id -> VarMap a -> Maybe a
forall a. CmEnv -> Id -> VarMap a -> Maybe a
lkVar CmEnv
env Id
v
go (Lit Literal
l) = CoreMapX a -> LiteralMap a
forall a. CoreMapX a -> LiteralMap a
cm_lit (CoreMapX a -> LiteralMap a)
-> (LiteralMap a -> Maybe a) -> CoreMapX a -> Maybe a
forall a b c. (a -> b) -> (b -> c) -> a -> c
>.> Key (Map Literal) -> LiteralMap a -> Maybe a
forall b. Key (Map Literal) -> Map Literal b -> Maybe b
forall (m :: * -> *) b. TrieMap m => Key m -> m b -> Maybe b
lookupTM Literal
Key (Map Literal)
l
go (Type Mult
t) = CoreMapX a -> TypeMapG a
forall a. CoreMapX a -> TypeMapG a
cm_type (CoreMapX a -> TypeMapG a)
-> (TypeMapG a -> Maybe a) -> CoreMapX a -> Maybe a
forall a b c. (a -> b) -> (b -> c) -> a -> c
>.> Key TypeMapX -> TypeMapG a -> Maybe a
forall (m :: * -> *) a.
(Eq (Key m), TrieMap m) =>
Key m -> GenMap m a -> Maybe a
lkG (CmEnv -> Mult -> DeBruijn Mult
forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env Mult
t)
go (Coercion CoercionR
c) = CoreMapX a -> CoercionMapG a
forall a. CoreMapX a -> CoercionMapG a
cm_co (CoreMapX a -> CoercionMapG a)
-> (CoercionMapG a -> Maybe a) -> CoreMapX a -> Maybe a
forall a b c. (a -> b) -> (b -> c) -> a -> c
>.> Key CoercionMapX -> CoercionMapG a -> Maybe a
forall (m :: * -> *) a.
(Eq (Key m), TrieMap m) =>
Key m -> GenMap m a -> Maybe a
lkG (CmEnv -> CoercionR -> DeBruijn CoercionR
forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env CoercionR
c)
go (Cast Expr Id
e CoercionR
c) = CoreMapX a -> CoreMapG (CoercionMapG a)
forall a. CoreMapX a -> CoreMapG (CoercionMapG a)
cm_cast (CoreMapX a -> CoreMapG (CoercionMapG a))
-> (CoreMapG (CoercionMapG a) -> Maybe a) -> CoreMapX a -> Maybe a
forall a b c. (a -> b) -> (b -> c) -> a -> c
>.> Key CoreMapX -> CoreMapG (CoercionMapG a) -> Maybe (CoercionMapG a)
forall (m :: * -> *) a.
(Eq (Key m), TrieMap m) =>
Key m -> GenMap m a -> Maybe a
lkG (CmEnv -> Expr Id -> DeBruijn (Expr Id)
forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env Expr Id
e) (CoreMapG (CoercionMapG a) -> Maybe (CoercionMapG a))
-> (CoercionMapG a -> Maybe a)
-> CoreMapG (CoercionMapG a)
-> Maybe a
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Key CoercionMapX -> CoercionMapG a -> Maybe a
forall (m :: * -> *) a.
(Eq (Key m), TrieMap m) =>
Key m -> GenMap m a -> Maybe a
lkG (CmEnv -> CoercionR -> DeBruijn CoercionR
forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env CoercionR
c)
go (Tick GenTickish 'TickishPassCore
tickish Expr Id
e) = CoreMapX a -> CoreMapG (TickishMap a)
forall a. CoreMapX a -> CoreMapG (TickishMap a)
cm_tick (CoreMapX a -> CoreMapG (TickishMap a))
-> (CoreMapG (TickishMap a) -> Maybe a) -> CoreMapX a -> Maybe a
forall a b c. (a -> b) -> (b -> c) -> a -> c
>.> Key CoreMapX -> CoreMapG (TickishMap a) -> Maybe (TickishMap a)
forall (m :: * -> *) a.
(Eq (Key m), TrieMap m) =>
Key m -> GenMap m a -> Maybe a
lkG (CmEnv -> Expr Id -> DeBruijn (Expr Id)
forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env Expr Id
e) (CoreMapG (TickishMap a) -> Maybe (TickishMap a))
-> (TickishMap a -> Maybe a) -> CoreMapG (TickishMap a) -> Maybe a
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> GenTickish 'TickishPassCore -> TickishMap a -> Maybe a
forall a. GenTickish 'TickishPassCore -> TickishMap a -> Maybe a
lkTickish GenTickish 'TickishPassCore
tickish
go (App Expr Id
e1 Expr Id
e2) = CoreMapX a -> CoreMapG (CoreMapG a)
forall a. CoreMapX a -> CoreMapG (CoreMapG a)
cm_app (CoreMapX a -> CoreMapG (CoreMapG a))
-> (CoreMapG (CoreMapG a) -> Maybe a) -> CoreMapX a -> Maybe a
forall a b c. (a -> b) -> (b -> c) -> a -> c
>.> Key CoreMapX -> CoreMapG (CoreMapG a) -> Maybe (CoreMapG a)
forall (m :: * -> *) a.
(Eq (Key m), TrieMap m) =>
Key m -> GenMap m a -> Maybe a
lkG (CmEnv -> Expr Id -> DeBruijn (Expr Id)
forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env Expr Id
e2) (CoreMapG (CoreMapG a) -> Maybe (CoreMapG a))
-> (CoreMapG a -> Maybe a) -> CoreMapG (CoreMapG a) -> Maybe a
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Key CoreMapX -> CoreMapG a -> Maybe a
forall (m :: * -> *) a.
(Eq (Key m), TrieMap m) =>
Key m -> GenMap m a -> Maybe a
lkG (CmEnv -> Expr Id -> DeBruijn (Expr Id)
forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env Expr Id
e1)
go (Lam Id
v Expr Id
e) = CoreMapX a -> CoreMapG (BndrMap a)
forall a. CoreMapX a -> CoreMapG (BndrMap a)
cm_lam (CoreMapX a -> CoreMapG (BndrMap a))
-> (CoreMapG (BndrMap a) -> Maybe a) -> CoreMapX a -> Maybe a
forall a b c. (a -> b) -> (b -> c) -> a -> c
>.> Key CoreMapX -> CoreMapG (BndrMap a) -> Maybe (BndrMap a)
forall (m :: * -> *) a.
(Eq (Key m), TrieMap m) =>
Key m -> GenMap m a -> Maybe a
lkG (CmEnv -> Expr Id -> DeBruijn (Expr Id)
forall a. CmEnv -> a -> DeBruijn a
D (CmEnv -> Id -> CmEnv
extendCME CmEnv
env Id
v) Expr Id
e)
(CoreMapG (BndrMap a) -> Maybe (BndrMap a))
-> (BndrMap a -> Maybe a) -> CoreMapG (BndrMap a) -> Maybe a
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> CmEnv -> Id -> BndrMap a -> Maybe a
forall a. CmEnv -> Id -> BndrMap a -> Maybe a
lkBndr CmEnv
env Id
v
go (Let (NonRec Id
b Expr Id
r) Expr Id
e) = CoreMapX a -> CoreMapG (CoreMapG (BndrMap a))
forall a. CoreMapX a -> CoreMapG (CoreMapG (BndrMap a))
cm_letn (CoreMapX a -> CoreMapG (CoreMapG (BndrMap a)))
-> (CoreMapG (CoreMapG (BndrMap a)) -> Maybe a)
-> CoreMapX a
-> Maybe a
forall a b c. (a -> b) -> (b -> c) -> a -> c
>.> Key CoreMapX
-> CoreMapG (CoreMapG (BndrMap a)) -> Maybe (CoreMapG (BndrMap a))
forall (m :: * -> *) a.
(Eq (Key m), TrieMap m) =>
Key m -> GenMap m a -> Maybe a
lkG (CmEnv -> Expr Id -> DeBruijn (Expr Id)
forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env Expr Id
r)
(CoreMapG (CoreMapG (BndrMap a)) -> Maybe (CoreMapG (BndrMap a)))
-> (CoreMapG (BndrMap a) -> Maybe a)
-> CoreMapG (CoreMapG (BndrMap a))
-> Maybe a
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Key CoreMapX -> CoreMapG (BndrMap a) -> Maybe (BndrMap a)
forall (m :: * -> *) a.
(Eq (Key m), TrieMap m) =>
Key m -> GenMap m a -> Maybe a
lkG (CmEnv -> Expr Id -> DeBruijn (Expr Id)
forall a. CmEnv -> a -> DeBruijn a
D (CmEnv -> Id -> CmEnv
extendCME CmEnv
env Id
b) Expr Id
e) (CoreMapG (BndrMap a) -> Maybe (BndrMap a))
-> (BndrMap a -> Maybe a) -> CoreMapG (BndrMap a) -> Maybe a
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> CmEnv -> Id -> BndrMap a -> Maybe a
forall a. CmEnv -> Id -> BndrMap a -> Maybe a
lkBndr CmEnv
env Id
b
go (Let (Rec [(Id, Expr Id)]
prs) Expr Id
e) = let ([Id]
bndrs,[Expr Id]
rhss) = [(Id, Expr Id)] -> ([Id], [Expr Id])
forall a b. [(a, b)] -> ([a], [b])
unzip [(Id, Expr Id)]
prs
env1 :: CmEnv
env1 = CmEnv -> [Id] -> CmEnv
extendCMEs CmEnv
env [Id]
bndrs
in CoreMapX a
-> ListMap (GenMap CoreMapX) (CoreMapG (ListMap BndrMap a))
forall a.
CoreMapX a
-> ListMap (GenMap CoreMapX) (CoreMapG (ListMap BndrMap a))
cm_letr
(CoreMapX a
-> ListMap (GenMap CoreMapX) (CoreMapG (ListMap BndrMap a)))
-> (ListMap (GenMap CoreMapX) (CoreMapG (ListMap BndrMap a))
-> Maybe a)
-> CoreMapX a
-> Maybe a
forall a b c. (a -> b) -> (b -> c) -> a -> c
>.> (forall b. Expr Id -> CoreMapG b -> Maybe b)
-> [Expr Id]
-> ListMap (GenMap CoreMapX) (CoreMapG (ListMap BndrMap a))
-> Maybe (CoreMapG (ListMap BndrMap a))
forall (m :: * -> *) k a.
TrieMap m =>
(forall b. k -> m b -> Maybe b) -> [k] -> ListMap m a -> Maybe a
lkList (Key CoreMapX -> GenMap CoreMapX b -> Maybe b
DeBruijn (Expr Id) -> GenMap CoreMapX b -> Maybe b
forall (m :: * -> *) a.
(Eq (Key m), TrieMap m) =>
Key m -> GenMap m a -> Maybe a
lkG (DeBruijn (Expr Id) -> GenMap CoreMapX b -> Maybe b)
-> (Expr Id -> DeBruijn (Expr Id))
-> Expr Id
-> GenMap CoreMapX b
-> Maybe b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CmEnv -> Expr Id -> DeBruijn (Expr Id)
forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env1) [Expr Id]
rhss
(ListMap (GenMap CoreMapX) (CoreMapG (ListMap BndrMap a))
-> Maybe (CoreMapG (ListMap BndrMap a)))
-> (CoreMapG (ListMap BndrMap a) -> Maybe a)
-> ListMap (GenMap CoreMapX) (CoreMapG (ListMap BndrMap a))
-> Maybe a
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Key CoreMapX
-> CoreMapG (ListMap BndrMap a) -> Maybe (ListMap BndrMap a)
forall (m :: * -> *) a.
(Eq (Key m), TrieMap m) =>
Key m -> GenMap m a -> Maybe a
lkG (CmEnv -> Expr Id -> DeBruijn (Expr Id)
forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env1 Expr Id
e)
(CoreMapG (ListMap BndrMap a) -> Maybe (ListMap BndrMap a))
-> (ListMap BndrMap a -> Maybe a)
-> CoreMapG (ListMap BndrMap a)
-> Maybe a
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (forall b. Id -> BndrMap b -> Maybe b)
-> [Id] -> ListMap BndrMap a -> Maybe a
forall (m :: * -> *) k a.
TrieMap m =>
(forall b. k -> m b -> Maybe b) -> [k] -> ListMap m a -> Maybe a
lkList (CmEnv -> Id -> BndrMap b -> Maybe b
forall a. CmEnv -> Id -> BndrMap a -> Maybe a
lkBndr CmEnv
env1) [Id]
bndrs
go (Case Expr Id
e Id
b Mult
ty [Alt Id]
as)
| [Alt Id] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Alt Id]
as = CoreMapX a -> CoreMapG (TypeMapG a)
forall a. CoreMapX a -> CoreMapG (TypeMapG a)
cm_ecase (CoreMapX a -> CoreMapG (TypeMapG a))
-> (CoreMapG (TypeMapG a) -> Maybe a) -> CoreMapX a -> Maybe a
forall a b c. (a -> b) -> (b -> c) -> a -> c
>.> Key CoreMapX -> CoreMapG (TypeMapG a) -> Maybe (TypeMapG a)
forall (m :: * -> *) a.
(Eq (Key m), TrieMap m) =>
Key m -> GenMap m a -> Maybe a
lkG (CmEnv -> Expr Id -> DeBruijn (Expr Id)
forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env Expr Id
e) (CoreMapG (TypeMapG a) -> Maybe (TypeMapG a))
-> (TypeMapG a -> Maybe a) -> CoreMapG (TypeMapG a) -> Maybe a
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Key TypeMapX -> TypeMapG a -> Maybe a
forall (m :: * -> *) a.
(Eq (Key m), TrieMap m) =>
Key m -> GenMap m a -> Maybe a
lkG (CmEnv -> Mult -> DeBruijn Mult
forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env Mult
ty)
| Bool
otherwise = CoreMapX a -> CoreMapG (ListMap AltMap a)
forall a. CoreMapX a -> CoreMapG (ListMap AltMap a)
cm_case (CoreMapX a -> CoreMapG (ListMap AltMap a))
-> (CoreMapG (ListMap AltMap a) -> Maybe a)
-> CoreMapX a
-> Maybe a
forall a b c. (a -> b) -> (b -> c) -> a -> c
>.> Key CoreMapX
-> CoreMapG (ListMap AltMap a) -> Maybe (ListMap AltMap a)
forall (m :: * -> *) a.
(Eq (Key m), TrieMap m) =>
Key m -> GenMap m a -> Maybe a
lkG (CmEnv -> Expr Id -> DeBruijn (Expr Id)
forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env Expr Id
e)
(CoreMapG (ListMap AltMap a) -> Maybe (ListMap AltMap a))
-> (ListMap AltMap a -> Maybe a)
-> CoreMapG (ListMap AltMap a)
-> Maybe a
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (forall b. Alt Id -> AltMap b -> Maybe b)
-> [Alt Id] -> ListMap AltMap a -> Maybe a
forall (m :: * -> *) k a.
TrieMap m =>
(forall b. k -> m b -> Maybe b) -> [k] -> ListMap m a -> Maybe a
lkList (CmEnv -> Alt Id -> AltMap b -> Maybe b
forall a. CmEnv -> Alt Id -> AltMap a -> Maybe a
lkA (CmEnv -> Id -> CmEnv
extendCME CmEnv
env Id
b)) [Alt Id]
as
xtE :: DeBruijn CoreExpr -> XT a -> CoreMapX a -> CoreMapX a
xtE :: forall a. DeBruijn (Expr Id) -> XT a -> CoreMapX a -> CoreMapX a
xtE (D CmEnv
env (Var Id
v)) XT a
f CoreMapX a
m = CoreMapX a
m { cm_var = cm_var m
|> xtVar env v f }
xtE (D CmEnv
env (Type Mult
t)) XT a
f CoreMapX a
m = CoreMapX a
m { cm_type = cm_type m
|> xtG (D env t) f }
xtE (D CmEnv
env (Coercion CoercionR
c)) XT a
f CoreMapX a
m = CoreMapX a
m { cm_co = cm_co m
|> xtG (D env c) f }
xtE (D CmEnv
_ (Lit Literal
l)) XT a
f CoreMapX a
m = CoreMapX a
m { cm_lit = cm_lit m |> alterTM l f }
xtE (D CmEnv
env (Cast Expr Id
e CoercionR
c)) XT a
f CoreMapX a
m = CoreMapX a
m { cm_cast = cm_cast m |> xtG (D env e)
|>> xtG (D env c) f }
xtE (D CmEnv
env (Tick GenTickish 'TickishPassCore
t Expr Id
e)) XT a
f CoreMapX a
m = CoreMapX a
m { cm_tick = cm_tick m |> xtG (D env e)
|>> xtTickish t f }
xtE (D CmEnv
env (App Expr Id
e1 Expr Id
e2)) XT a
f CoreMapX a
m = CoreMapX a
m { cm_app = cm_app m |> xtG (D env e2)
|>> xtG (D env e1) f }
xtE (D CmEnv
env (Lam Id
v Expr Id
e)) XT a
f CoreMapX a
m = CoreMapX a
m { cm_lam = cm_lam m
|> xtG (D (extendCME env v) e)
|>> xtBndr env v f }
xtE (D CmEnv
env (Let (NonRec Id
b Expr Id
r) Expr Id
e)) XT a
f CoreMapX a
m = CoreMapX a
m { cm_letn = cm_letn m
|> xtG (D (extendCME env b) e)
|>> xtG (D env r)
|>> xtBndr env b f }
xtE (D CmEnv
env (Let (Rec [(Id, Expr Id)]
prs) Expr Id
e)) XT a
f CoreMapX a
m = CoreMapX a
m { cm_letr =
let (bndrs,rhss) = unzip prs
env1 = CmEnv -> [Id] -> CmEnv
extendCMEs CmEnv
env [Id]
bndrs
in cm_letr m
|> xtList (xtG . D env1) rhss
|>> xtG (D env1 e)
|>> xtList (xtBndr env1)
bndrs f }
xtE (D CmEnv
env (Case Expr Id
e Id
b Mult
ty [Alt Id]
as)) XT a
f CoreMapX a
m
| [Alt Id] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Alt Id]
as = CoreMapX a
m { cm_ecase = cm_ecase m |> xtG (D env e)
|>> xtG (D env ty) f }
| Bool
otherwise = CoreMapX a
m { cm_case = cm_case m |> xtG (D env e)
|>> let env1 = CmEnv -> Id -> CmEnv
extendCME CmEnv
env Id
b
in xtList (xtA env1) as f }
type TickishMap a = Map.Map CoreTickish a
lkTickish :: CoreTickish -> TickishMap a -> Maybe a
lkTickish :: forall a. GenTickish 'TickishPassCore -> TickishMap a -> Maybe a
lkTickish = GenTickish 'TickishPassCore
-> Map (GenTickish 'TickishPassCore) a -> Maybe a
Key (Map (GenTickish 'TickishPassCore))
-> Map (GenTickish 'TickishPassCore) a -> Maybe a
forall b.
Key (Map (GenTickish 'TickishPassCore))
-> Map (GenTickish 'TickishPassCore) b -> Maybe b
forall (m :: * -> *) b. TrieMap m => Key m -> m b -> Maybe b
lookupTM
xtTickish :: CoreTickish -> XT a -> TickishMap a -> TickishMap a
xtTickish :: forall a.
GenTickish 'TickishPassCore -> XT a -> TickishMap a -> TickishMap a
xtTickish = GenTickish 'TickishPassCore
-> (Maybe a -> Maybe a)
-> Map (GenTickish 'TickishPassCore) a
-> Map (GenTickish 'TickishPassCore) a
Key (Map (GenTickish 'TickishPassCore))
-> (Maybe a -> Maybe a)
-> Map (GenTickish 'TickishPassCore) a
-> Map (GenTickish 'TickishPassCore) a
forall b.
Key (Map (GenTickish 'TickishPassCore))
-> XT b
-> Map (GenTickish 'TickishPassCore) b
-> Map (GenTickish 'TickishPassCore) b
forall (m :: * -> *) b. TrieMap m => Key m -> XT b -> m b -> m b
alterTM
data AltMap a
= AM { forall a. AltMap a -> CoreMapG a
am_deflt :: CoreMapG a
, forall a. AltMap a -> DNameEnv (CoreMapG a)
am_data :: DNameEnv (CoreMapG a)
, forall a. AltMap a -> LiteralMap (CoreMapG a)
am_lit :: LiteralMap (CoreMapG a) }
instance Functor AltMap where
fmap :: forall a b. (a -> b) -> AltMap a -> AltMap b
fmap a -> b
f AM { am_deflt :: forall a. AltMap a -> CoreMapG a
am_deflt = CoreMapG a
adeflt, am_data :: forall a. AltMap a -> DNameEnv (CoreMapG a)
am_data = DNameEnv (CoreMapG a)
adata, am_lit :: forall a. AltMap a -> LiteralMap (CoreMapG a)
am_lit = LiteralMap (CoreMapG a)
alit } = AM
{ am_deflt :: CoreMapG b
am_deflt = (a -> b) -> CoreMapG a -> CoreMapG b
forall a b. (a -> b) -> GenMap CoreMapX a -> GenMap CoreMapX b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f CoreMapG a
adeflt, am_data :: DNameEnv (CoreMapG b)
am_data = (CoreMapG a -> CoreMapG b)
-> DNameEnv (CoreMapG a) -> DNameEnv (CoreMapG b)
forall a b. (a -> b) -> UniqDFM Name a -> UniqDFM Name b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> CoreMapG a -> CoreMapG b
forall a b. (a -> b) -> GenMap CoreMapX a -> GenMap CoreMapX b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) DNameEnv (CoreMapG a)
adata, am_lit :: LiteralMap (CoreMapG b)
am_lit = (CoreMapG a -> CoreMapG b)
-> LiteralMap (CoreMapG a) -> LiteralMap (CoreMapG b)
forall a b. (a -> b) -> Map Literal a -> Map Literal b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> CoreMapG a -> CoreMapG b
forall a b. (a -> b) -> GenMap CoreMapX a -> GenMap CoreMapX b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) LiteralMap (CoreMapG a)
alit }
instance TrieMap AltMap where
type Key AltMap = CoreAlt
emptyTM :: forall a. AltMap a
emptyTM = AM { am_deflt :: CoreMapG a
am_deflt = CoreMapG a
forall a. GenMap CoreMapX a
forall (m :: * -> *) a. TrieMap m => m a
emptyTM
, am_data :: DNameEnv (CoreMapG a)
am_data = DNameEnv (CoreMapG a)
forall a. DNameEnv a
emptyDNameEnv
, am_lit :: LiteralMap (CoreMapG a)
am_lit = LiteralMap (CoreMapG a)
forall a. Map Literal a
forall (m :: * -> *) a. TrieMap m => m a
emptyTM }
lookupTM :: forall b. Key AltMap -> AltMap b -> Maybe b
lookupTM = CmEnv -> Alt Id -> AltMap b -> Maybe b
forall a. CmEnv -> Alt Id -> AltMap a -> Maybe a
lkA CmEnv
emptyCME
alterTM :: forall b. Key AltMap -> XT b -> AltMap b -> AltMap b
alterTM = CmEnv -> Alt Id -> (Maybe b -> Maybe b) -> AltMap b -> AltMap b
forall a. CmEnv -> Alt Id -> XT a -> AltMap a -> AltMap a
xtA CmEnv
emptyCME
foldTM :: forall a b. (a -> b -> b) -> AltMap a -> b -> b
foldTM = (a -> b -> b) -> AltMap a -> b -> b
forall a b. (a -> b -> b) -> AltMap a -> b -> b
fdA
filterTM :: forall a. (a -> Bool) -> AltMap a -> AltMap a
filterTM = (a -> Bool) -> AltMap a -> AltMap a
forall a. (a -> Bool) -> AltMap a -> AltMap a
ftA
instance Eq (DeBruijn CoreAlt) where
D CmEnv
env1 Alt Id
a1 == :: DeBruijn (Alt Id) -> DeBruijn (Alt Id) -> Bool
== D CmEnv
env2 Alt Id
a2 = Alt Id -> Alt Id -> Bool
go Alt Id
a1 Alt Id
a2 where
go :: Alt Id -> Alt Id -> Bool
go (Alt AltCon
DEFAULT [Id]
_ Expr Id
rhs1) (Alt AltCon
DEFAULT [Id]
_ Expr Id
rhs2)
= CmEnv -> Expr Id -> DeBruijn (Expr Id)
forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env1 Expr Id
rhs1 DeBruijn (Expr Id) -> DeBruijn (Expr Id) -> Bool
forall a. Eq a => a -> a -> Bool
== CmEnv -> Expr Id -> DeBruijn (Expr Id)
forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env2 Expr Id
rhs2
go (Alt (LitAlt Literal
lit1) [Id]
_ Expr Id
rhs1) (Alt (LitAlt Literal
lit2) [Id]
_ Expr Id
rhs2)
= Literal
lit1 Literal -> Literal -> Bool
forall a. Eq a => a -> a -> Bool
== Literal
lit2 Bool -> Bool -> Bool
&& CmEnv -> Expr Id -> DeBruijn (Expr Id)
forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env1 Expr Id
rhs1 DeBruijn (Expr Id) -> DeBruijn (Expr Id) -> Bool
forall a. Eq a => a -> a -> Bool
== CmEnv -> Expr Id -> DeBruijn (Expr Id)
forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env2 Expr Id
rhs2
go (Alt (DataAlt DataCon
dc1) [Id]
bs1 Expr Id
rhs1) (Alt (DataAlt DataCon
dc2) [Id]
bs2 Expr Id
rhs2)
= DataCon
dc1 DataCon -> DataCon -> Bool
forall a. Eq a => a -> a -> Bool
== DataCon
dc2 Bool -> Bool -> Bool
&&
CmEnv -> Expr Id -> DeBruijn (Expr Id)
forall a. CmEnv -> a -> DeBruijn a
D (CmEnv -> [Id] -> CmEnv
extendCMEs CmEnv
env1 [Id]
bs1) Expr Id
rhs1 DeBruijn (Expr Id) -> DeBruijn (Expr Id) -> Bool
forall a. Eq a => a -> a -> Bool
== CmEnv -> Expr Id -> DeBruijn (Expr Id)
forall a. CmEnv -> a -> DeBruijn a
D (CmEnv -> [Id] -> CmEnv
extendCMEs CmEnv
env2 [Id]
bs2) Expr Id
rhs2
go Alt Id
_ Alt Id
_ = Bool
False
ftA :: (a->Bool) -> AltMap a -> AltMap a
ftA :: forall a. (a -> Bool) -> AltMap a -> AltMap a
ftA a -> Bool
f (AM { am_deflt :: forall a. AltMap a -> CoreMapG a
am_deflt = CoreMapG a
adeflt, am_data :: forall a. AltMap a -> DNameEnv (CoreMapG a)
am_data = DNameEnv (CoreMapG a)
adata, am_lit :: forall a. AltMap a -> LiteralMap (CoreMapG a)
am_lit = LiteralMap (CoreMapG a)
alit })
= AM { am_deflt :: CoreMapG a
am_deflt = (a -> Bool) -> CoreMapG a -> CoreMapG a
forall a. (a -> Bool) -> GenMap CoreMapX a -> GenMap CoreMapX a
forall (m :: * -> *) a. TrieMap m => (a -> Bool) -> m a -> m a
filterTM a -> Bool
f CoreMapG a
adeflt
, am_data :: DNameEnv (CoreMapG a)
am_data = (CoreMapG a -> CoreMapG a)
-> DNameEnv (CoreMapG a) -> DNameEnv (CoreMapG a)
forall a b. (a -> b) -> UniqDFM Name a -> UniqDFM Name b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> Bool) -> CoreMapG a -> CoreMapG a
forall a. (a -> Bool) -> GenMap CoreMapX a -> GenMap CoreMapX a
forall (m :: * -> *) a. TrieMap m => (a -> Bool) -> m a -> m a
filterTM a -> Bool
f) DNameEnv (CoreMapG a)
adata
, am_lit :: LiteralMap (CoreMapG a)
am_lit = (CoreMapG a -> CoreMapG a)
-> LiteralMap (CoreMapG a) -> LiteralMap (CoreMapG a)
forall a b. (a -> b) -> Map Literal a -> Map Literal b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> Bool) -> CoreMapG a -> CoreMapG a
forall a. (a -> Bool) -> GenMap CoreMapX a -> GenMap CoreMapX a
forall (m :: * -> *) a. TrieMap m => (a -> Bool) -> m a -> m a
filterTM a -> Bool
f) LiteralMap (CoreMapG a)
alit }
lkA :: CmEnv -> CoreAlt -> AltMap a -> Maybe a
lkA :: forall a. CmEnv -> Alt Id -> AltMap a -> Maybe a
lkA CmEnv
env (Alt AltCon
DEFAULT [Id]
_ Expr Id
rhs) = AltMap a -> CoreMapG a
forall a. AltMap a -> CoreMapG a
am_deflt (AltMap a -> CoreMapG a)
-> (CoreMapG a -> Maybe a) -> AltMap a -> Maybe a
forall a b c. (a -> b) -> (b -> c) -> a -> c
>.> Key CoreMapX -> CoreMapG a -> Maybe a
forall (m :: * -> *) a.
(Eq (Key m), TrieMap m) =>
Key m -> GenMap m a -> Maybe a
lkG (CmEnv -> Expr Id -> DeBruijn (Expr Id)
forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env Expr Id
rhs)
lkA CmEnv
env (Alt (LitAlt Literal
lit) [Id]
_ Expr Id
rhs) = AltMap a -> LiteralMap (CoreMapG a)
forall a. AltMap a -> LiteralMap (CoreMapG a)
am_lit (AltMap a -> LiteralMap (CoreMapG a))
-> (LiteralMap (CoreMapG a) -> Maybe a) -> AltMap a -> Maybe a
forall a b c. (a -> b) -> (b -> c) -> a -> c
>.> Key (Map Literal) -> LiteralMap (CoreMapG a) -> Maybe (CoreMapG a)
forall b. Key (Map Literal) -> Map Literal b -> Maybe b
forall (m :: * -> *) b. TrieMap m => Key m -> m b -> Maybe b
lookupTM Literal
Key (Map Literal)
lit (LiteralMap (CoreMapG a) -> Maybe (CoreMapG a))
-> (CoreMapG a -> Maybe a) -> LiteralMap (CoreMapG a) -> Maybe a
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Key CoreMapX -> CoreMapG a -> Maybe a
forall (m :: * -> *) a.
(Eq (Key m), TrieMap m) =>
Key m -> GenMap m a -> Maybe a
lkG (CmEnv -> Expr Id -> DeBruijn (Expr Id)
forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env Expr Id
rhs)
lkA CmEnv
env (Alt (DataAlt DataCon
dc) [Id]
bs Expr Id
rhs) = AltMap a -> DNameEnv (CoreMapG a)
forall a. AltMap a -> DNameEnv (CoreMapG a)
am_data (AltMap a -> DNameEnv (CoreMapG a))
-> (DNameEnv (CoreMapG a) -> Maybe a) -> AltMap a -> Maybe a
forall a b c. (a -> b) -> (b -> c) -> a -> c
>.> DataCon -> DNameEnv (CoreMapG a) -> Maybe (CoreMapG a)
forall n a. NamedThing n => n -> DNameEnv a -> Maybe a
lkDNamed DataCon
dc
(DNameEnv (CoreMapG a) -> Maybe (CoreMapG a))
-> (CoreMapG a -> Maybe a) -> DNameEnv (CoreMapG a) -> Maybe a
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Key CoreMapX -> CoreMapG a -> Maybe a
forall (m :: * -> *) a.
(Eq (Key m), TrieMap m) =>
Key m -> GenMap m a -> Maybe a
lkG (CmEnv -> Expr Id -> DeBruijn (Expr Id)
forall a. CmEnv -> a -> DeBruijn a
D (CmEnv -> [Id] -> CmEnv
extendCMEs CmEnv
env [Id]
bs) Expr Id
rhs)
xtA :: CmEnv -> CoreAlt -> XT a -> AltMap a -> AltMap a
xtA :: forall a. CmEnv -> Alt Id -> XT a -> AltMap a -> AltMap a
xtA CmEnv
env (Alt AltCon
DEFAULT [Id]
_ Expr Id
rhs) XT a
f AltMap a
m =
AltMap a
m { am_deflt = am_deflt m |> xtG (D env rhs) f }
xtA CmEnv
env (Alt (LitAlt Literal
l) [Id]
_ Expr Id
rhs) XT a
f AltMap a
m =
AltMap a
m { am_lit = am_lit m |> alterTM l |>> xtG (D env rhs) f }
xtA CmEnv
env (Alt (DataAlt DataCon
d) [Id]
bs Expr Id
rhs) XT a
f AltMap a
m =
AltMap a
m { am_data = am_data m |> xtDNamed d
|>> xtG (D (extendCMEs env bs) rhs) f }
fdA :: (a -> b -> b) -> AltMap a -> b -> b
fdA :: forall a b. (a -> b -> b) -> AltMap a -> b -> b
fdA a -> b -> b
k AltMap a
m = (a -> b -> b) -> GenMap CoreMapX a -> b -> b
forall a b. (a -> b -> b) -> GenMap CoreMapX a -> b -> b
forall (m :: * -> *) a b.
TrieMap m =>
(a -> b -> b) -> m a -> b -> b
foldTM a -> b -> b
k (AltMap a -> GenMap CoreMapX a
forall a. AltMap a -> CoreMapG a
am_deflt AltMap a
m)
(b -> b) -> (b -> b) -> b -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GenMap CoreMapX a -> b -> b)
-> UniqDFM Name (GenMap CoreMapX a) -> b -> b
forall a b. (a -> b -> b) -> UniqDFM Name a -> b -> b
forall (m :: * -> *) a b.
TrieMap m =>
(a -> b -> b) -> m a -> b -> b
foldTM ((a -> b -> b) -> GenMap CoreMapX a -> b -> b
forall a b. (a -> b -> b) -> GenMap CoreMapX a -> b -> b
forall (m :: * -> *) a b.
TrieMap m =>
(a -> b -> b) -> m a -> b -> b
foldTM a -> b -> b
k) (AltMap a -> UniqDFM Name (GenMap CoreMapX a)
forall a. AltMap a -> DNameEnv (CoreMapG a)
am_data AltMap a
m)
(b -> b) -> (b -> b) -> b -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GenMap CoreMapX a -> b -> b)
-> Map Literal (GenMap CoreMapX a) -> b -> b
forall a b. (a -> b -> b) -> Map Literal a -> b -> b
forall (m :: * -> *) a b.
TrieMap m =>
(a -> b -> b) -> m a -> b -> b
foldTM ((a -> b -> b) -> GenMap CoreMapX a -> b -> b
forall a b. (a -> b -> b) -> GenMap CoreMapX a -> b -> b
forall (m :: * -> *) a b.
TrieMap m =>
(a -> b -> b) -> m a -> b -> b
foldTM a -> b -> b
k) (AltMap a -> Map Literal (GenMap CoreMapX a)
forall a. AltMap a -> LiteralMap (CoreMapG a)
am_lit AltMap a
m)