{-# LANGUAGE CPP #-}
{-# 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,
TrieMap(..), insertTM, deleteTM,
lkDFreeVar, xtDFreeVar,
lkDNamed, xtDNamed,
(>.>), (|>), (|>>),
) where
#include "HsVersions.h"
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 TrieMap CoreMap where
type Key CoreMap = CoreExpr
emptyTM :: forall a. CoreMap a
emptyTM = forall a. CoreMapG a -> CoreMap a
CoreMap 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) = forall (m :: * -> *) b. TrieMap m => Key m -> m b -> Maybe b
lookupTM (forall a. a -> DeBruijn a
deBruijnize 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) = forall a. CoreMapG a -> CoreMap a
CoreMap (forall (m :: * -> *) b. TrieMap m => Key m -> XT b -> m b -> m b
alterTM (forall a. a -> DeBruijn a
deBruijnize 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) = forall (m :: * -> *) a b.
TrieMap m =>
(a -> b -> b) -> m a -> b -> b
foldTM a -> b -> b
k CoreMapG a
m
mapTM :: forall a b. (a -> b) -> CoreMap a -> CoreMap b
mapTM a -> b
f (CoreMap CoreMapG a
m) = forall a. CoreMapG a -> CoreMap a
CoreMap (forall (m :: * -> *) a b. TrieMap m => (a -> b) -> m a -> m b
mapTM a -> b
f CoreMapG a
m)
filterTM :: forall a. (a -> Bool) -> CoreMap a -> CoreMap a
filterTM a -> Bool
f (CoreMap CoreMapG a
m) = forall a. CoreMapG a -> CoreMap a
CoreMap (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
D CmEnv
env1 CoreExpr
e1 == :: DeBruijn CoreExpr -> DeBruijn CoreExpr -> Bool
== D CmEnv
env2 CoreExpr
e2 = CoreExpr -> CoreExpr -> Bool
go CoreExpr
e1 CoreExpr
e2 where
go :: CoreExpr -> CoreExpr -> Bool
go (Var Id
v1) (Var Id
v2)
= case (CmEnv -> Id -> Maybe BoundVar
lookupCME CmEnv
env1 Id
v1, CmEnv -> Id -> Maybe BoundVar
lookupCME CmEnv
env2 Id
v2) of
(Just BoundVar
b1, Just BoundVar
b2) -> BoundVar
b1 forall a. Eq a => a -> a -> Bool
== BoundVar
b2
(Maybe BoundVar
Nothing, Maybe BoundVar
Nothing) -> Id
v1 forall a. Eq a => a -> a -> Bool
== Id
v2
(Maybe BoundVar, Maybe BoundVar)
_ -> Bool
False
go (Lit Literal
lit1) (Lit Literal
lit2) = Literal
lit1 forall a. Eq a => a -> a -> Bool
== Literal
lit2
go (Type Type
t1) (Type Type
t2) = forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env1 Type
t1 forall a. Eq a => a -> a -> Bool
== forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env2 Type
t2
go (Coercion Coercion
co1) (Coercion Coercion
co2) = forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env1 Coercion
co1 forall a. Eq a => a -> a -> Bool
== forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env2 Coercion
co2
go (Cast CoreExpr
e1 Coercion
co1) (Cast CoreExpr
e2 Coercion
co2) = forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env1 Coercion
co1 forall a. Eq a => a -> a -> Bool
== forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env2 Coercion
co2 Bool -> Bool -> Bool
&& CoreExpr -> CoreExpr -> Bool
go CoreExpr
e1 CoreExpr
e2
go (App CoreExpr
f1 CoreExpr
a1) (App CoreExpr
f2 CoreExpr
a2) = CoreExpr -> CoreExpr -> Bool
go CoreExpr
f1 CoreExpr
f2 Bool -> Bool -> Bool
&& CoreExpr -> CoreExpr -> Bool
go CoreExpr
a1 CoreExpr
a2
go (Tick CoreTickish
n1 CoreExpr
e1) (Tick CoreTickish
n2 CoreExpr
e2) = CoreTickish
n1 forall a. Eq a => a -> a -> Bool
== CoreTickish
n2 Bool -> Bool -> Bool
&& CoreExpr -> CoreExpr -> Bool
go CoreExpr
e1 CoreExpr
e2
go (Lam Id
b1 CoreExpr
e1) (Lam Id
b2 CoreExpr
e2)
= forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env1 (Id -> Type
varType Id
b1) forall a. Eq a => a -> a -> Bool
== forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env2 (Id -> Type
varType Id
b2)
Bool -> Bool -> Bool
&& forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env1 (Id -> Maybe Type
varMultMaybe Id
b1) forall a. Eq a => a -> a -> Bool
== forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env2 (Id -> Maybe Type
varMultMaybe Id
b2)
Bool -> Bool -> Bool
&& forall a. CmEnv -> a -> DeBruijn a
D (CmEnv -> Id -> CmEnv
extendCME CmEnv
env1 Id
b1) CoreExpr
e1 forall a. Eq a => a -> a -> Bool
== forall a. CmEnv -> a -> DeBruijn a
D (CmEnv -> Id -> CmEnv
extendCME CmEnv
env2 Id
b2) CoreExpr
e2
go (Let (NonRec Id
v1 CoreExpr
r1) CoreExpr
e1) (Let (NonRec Id
v2 CoreExpr
r2) CoreExpr
e2)
= CoreExpr -> CoreExpr -> Bool
go CoreExpr
r1 CoreExpr
r2
Bool -> Bool -> Bool
&& forall a. CmEnv -> a -> DeBruijn a
D (CmEnv -> Id -> CmEnv
extendCME CmEnv
env1 Id
v1) CoreExpr
e1 forall a. Eq a => a -> a -> Bool
== forall a. CmEnv -> a -> DeBruijn a
D (CmEnv -> Id -> CmEnv
extendCME CmEnv
env2 Id
v2) CoreExpr
e2
go (Let (Rec [(Id, CoreExpr)]
ps1) CoreExpr
e1) (Let (Rec [(Id, CoreExpr)]
ps2) CoreExpr
e2)
= forall a b. [a] -> [b] -> Bool
equalLength [(Id, CoreExpr)]
ps1 [(Id, CoreExpr)]
ps2
Bool -> Bool -> Bool
&& forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env1' [CoreExpr]
rs1 forall a. Eq a => a -> a -> Bool
== forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env2' [CoreExpr]
rs2
Bool -> Bool -> Bool
&& forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env1' CoreExpr
e1 forall a. Eq a => a -> a -> Bool
== forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env2' CoreExpr
e2
where
([Id]
bs1,[CoreExpr]
rs1) = forall a b. [(a, b)] -> ([a], [b])
unzip [(Id, CoreExpr)]
ps1
([Id]
bs2,[CoreExpr]
rs2) = forall a b. [(a, b)] -> ([a], [b])
unzip [(Id, CoreExpr)]
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 CoreExpr
e1 Id
b1 Type
t1 [CoreAlt]
a1) (Case CoreExpr
e2 Id
b2 Type
t2 [CoreAlt]
a2)
| forall (t :: * -> *) a. Foldable t => t a -> Bool
null [CoreAlt]
a1
= forall (t :: * -> *) a. Foldable t => t a -> Bool
null [CoreAlt]
a2 Bool -> Bool -> Bool
&& CoreExpr -> CoreExpr -> Bool
go CoreExpr
e1 CoreExpr
e2 Bool -> Bool -> Bool
&& forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env1 Type
t1 forall a. Eq a => a -> a -> Bool
== forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env2 Type
t2
| Bool
otherwise
= CoreExpr -> CoreExpr -> Bool
go CoreExpr
e1 CoreExpr
e2 Bool -> Bool -> Bool
&& forall a. CmEnv -> a -> DeBruijn a
D (CmEnv -> Id -> CmEnv
extendCME CmEnv
env1 Id
b1) [CoreAlt]
a1 forall a. Eq a => a -> a -> Bool
== forall a. CmEnv -> a -> DeBruijn a
D (CmEnv -> Id -> CmEnv
extendCME CmEnv
env2 Id
b2) [CoreAlt]
a2
go CoreExpr
_ CoreExpr
_ = Bool
False
emptyE :: CoreMapX a
emptyE :: forall a. CoreMapX a
emptyE = CM { cm_var :: VarMap a
cm_var = forall (m :: * -> *) a. TrieMap m => m a
emptyTM, cm_lit :: LiteralMap a
cm_lit = forall (m :: * -> *) a. TrieMap m => m a
emptyTM
, cm_co :: CoercionMapG a
cm_co = forall (m :: * -> *) a. TrieMap m => m a
emptyTM, cm_type :: TypeMapG a
cm_type = forall (m :: * -> *) a. TrieMap m => m a
emptyTM
, cm_cast :: CoreMapG (CoercionMapG a)
cm_cast = forall (m :: * -> *) a. TrieMap m => m a
emptyTM, cm_app :: CoreMapG (CoreMapG a)
cm_app = forall (m :: * -> *) a. TrieMap m => m a
emptyTM
, cm_lam :: CoreMapG (BndrMap a)
cm_lam = forall (m :: * -> *) a. TrieMap m => m a
emptyTM, cm_letn :: CoreMapG (CoreMapG (BndrMap a))
cm_letn = forall (m :: * -> *) a. TrieMap m => m a
emptyTM
, cm_letr :: ListMap (GenMap CoreMapX) (CoreMapG (ListMap BndrMap a))
cm_letr = forall (m :: * -> *) a. TrieMap m => m a
emptyTM, cm_case :: CoreMapG (ListMap AltMap a)
cm_case = forall (m :: * -> *) a. TrieMap m => m a
emptyTM
, cm_ecase :: CoreMapG (TypeMapG a)
cm_ecase = forall (m :: * -> *) a. TrieMap m => m a
emptyTM, cm_tick :: CoreMapG (TickishMap a)
cm_tick = forall (m :: * -> *) a. TrieMap m => m a
emptyTM }
instance TrieMap CoreMapX where
type Key CoreMapX = DeBruijn CoreExpr
emptyTM :: forall a. CoreMapX a
emptyTM = forall a. CoreMapX a
emptyE
lookupTM :: forall b. Key CoreMapX -> CoreMapX b -> Maybe b
lookupTM = forall a. DeBruijn CoreExpr -> CoreMapX a -> Maybe a
lkE
alterTM :: forall b. Key CoreMapX -> XT b -> CoreMapX b -> CoreMapX b
alterTM = forall a. DeBruijn CoreExpr -> XT a -> CoreMapX a -> CoreMapX a
xtE
foldTM :: forall a b. (a -> b -> b) -> CoreMapX a -> b -> b
foldTM = forall a b. (a -> b -> b) -> CoreMapX a -> b -> b
fdE
mapTM :: forall a b. (a -> b) -> CoreMapX a -> CoreMapX b
mapTM = forall a b. (a -> b) -> CoreMapX a -> CoreMapX b
mapE
filterTM :: forall a. (a -> Bool) -> CoreMapX a -> CoreMapX a
filterTM = forall a. (a -> Bool) -> CoreMapX a -> CoreMapX a
ftE
mapE :: (a->b) -> CoreMapX a -> CoreMapX b
mapE :: forall a b. (a -> b) -> CoreMapX a -> CoreMapX b
mapE 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 = forall (m :: * -> *) a b. TrieMap m => (a -> b) -> m a -> m b
mapTM a -> b
f VarMap a
cvar, cm_lit :: LiteralMap b
cm_lit = forall (m :: * -> *) a b. TrieMap m => (a -> b) -> m a -> m b
mapTM a -> b
f LiteralMap a
clit
, cm_co :: CoercionMapG b
cm_co = forall (m :: * -> *) a b. TrieMap m => (a -> b) -> m a -> m b
mapTM a -> b
f CoercionMapG a
cco, cm_type :: TypeMapG b
cm_type = forall (m :: * -> *) a b. TrieMap m => (a -> b) -> m a -> m b
mapTM a -> b
f TypeMapG a
ctype
, cm_cast :: CoreMapG (CoercionMapG b)
cm_cast = forall (m :: * -> *) a b. TrieMap m => (a -> b) -> m a -> m b
mapTM (forall (m :: * -> *) a b. TrieMap m => (a -> b) -> m a -> m b
mapTM a -> b
f) CoreMapG (CoercionMapG a)
ccast, cm_app :: CoreMapG (CoreMapG b)
cm_app = forall (m :: * -> *) a b. TrieMap m => (a -> b) -> m a -> m b
mapTM (forall (m :: * -> *) a b. TrieMap m => (a -> b) -> m a -> m b
mapTM a -> b
f) CoreMapG (CoreMapG a)
capp
, cm_lam :: CoreMapG (BndrMap b)
cm_lam = forall (m :: * -> *) a b. TrieMap m => (a -> b) -> m a -> m b
mapTM (forall (m :: * -> *) a b. TrieMap m => (a -> b) -> m a -> m b
mapTM a -> b
f) CoreMapG (BndrMap a)
clam, cm_letn :: CoreMapG (CoreMapG (BndrMap b))
cm_letn = forall (m :: * -> *) a b. TrieMap m => (a -> b) -> m a -> m b
mapTM (forall (m :: * -> *) a b. TrieMap m => (a -> b) -> m a -> m b
mapTM (forall (m :: * -> *) a b. TrieMap m => (a -> b) -> m a -> m b
mapTM a -> b
f)) CoreMapG (CoreMapG (BndrMap a))
cletn
, cm_letr :: ListMap (GenMap CoreMapX) (CoreMapG (ListMap BndrMap b))
cm_letr = forall (m :: * -> *) a b. TrieMap m => (a -> b) -> m a -> m b
mapTM (forall (m :: * -> *) a b. TrieMap m => (a -> b) -> m a -> m b
mapTM (forall (m :: * -> *) a b. TrieMap m => (a -> b) -> m a -> m b
mapTM a -> b
f)) ListMap (GenMap CoreMapX) (CoreMapG (ListMap BndrMap a))
cletr, cm_case :: CoreMapG (ListMap AltMap b)
cm_case = forall (m :: * -> *) a b. TrieMap m => (a -> b) -> m a -> m b
mapTM (forall (m :: * -> *) a b. TrieMap m => (a -> b) -> m a -> m b
mapTM a -> b
f) CoreMapG (ListMap AltMap a)
ccase
, cm_ecase :: CoreMapG (TypeMapG b)
cm_ecase = forall (m :: * -> *) a b. TrieMap m => (a -> b) -> m a -> m b
mapTM (forall (m :: * -> *) a b. TrieMap m => (a -> b) -> m a -> m b
mapTM a -> b
f) CoreMapG (TypeMapG a)
cecase, cm_tick :: CoreMapG (TickishMap b)
cm_tick = forall (m :: * -> *) a b. TrieMap m => (a -> b) -> m a -> m b
mapTM (forall (m :: * -> *) a b. TrieMap m => (a -> b) -> m a -> m b
mapTM a -> b
f) CoreMapG (TickishMap a)
ctick }
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 = forall (m :: * -> *) a. TrieMap m => (a -> Bool) -> m a -> m a
filterTM a -> Bool
f VarMap a
cvar, cm_lit :: LiteralMap a
cm_lit = forall (m :: * -> *) a. TrieMap m => (a -> Bool) -> m a -> m a
filterTM a -> Bool
f LiteralMap a
clit
, cm_co :: CoercionMapG a
cm_co = forall (m :: * -> *) a. TrieMap m => (a -> Bool) -> m a -> m a
filterTM a -> Bool
f CoercionMapG a
cco, cm_type :: TypeMapG a
cm_type = 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 = forall (m :: * -> *) a b. TrieMap m => (a -> b) -> m a -> m b
mapTM (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 = forall (m :: * -> *) a b. TrieMap m => (a -> b) -> m a -> m b
mapTM (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 = forall (m :: * -> *) a b. TrieMap m => (a -> b) -> m a -> m b
mapTM (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 = forall (m :: * -> *) a b. TrieMap m => (a -> b) -> m a -> m b
mapTM (forall (m :: * -> *) a b. TrieMap m => (a -> b) -> m a -> m b
mapTM (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 = forall (m :: * -> *) a b. TrieMap m => (a -> b) -> m a -> m b
mapTM (forall (m :: * -> *) a b. TrieMap m => (a -> b) -> m a -> m b
mapTM (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 = forall (m :: * -> *) a b. TrieMap m => (a -> b) -> m a -> m b
mapTM (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 = forall (m :: * -> *) a b. TrieMap m => (a -> b) -> m a -> m b
mapTM (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 = forall (m :: * -> *) a b. TrieMap m => (a -> b) -> m a -> m b
mapTM (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 -> CoreExpr -> Maybe a
lookupCoreMap CoreMap a
cm CoreExpr
e = forall (m :: * -> *) b. TrieMap m => Key m -> m b -> Maybe b
lookupTM CoreExpr
e CoreMap a
cm
extendCoreMap :: CoreMap a -> CoreExpr -> a -> CoreMap a
extendCoreMap :: forall a. CoreMap a -> CoreExpr -> a -> CoreMap a
extendCoreMap CoreMap a
m CoreExpr
e a
v = forall (m :: * -> *) b. TrieMap m => Key m -> XT b -> m b -> m b
alterTM CoreExpr
e (\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 = 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 = 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
text String
"CoreMap elts" SDoc -> SDoc -> SDoc
<+> forall a. Outputable a => a -> SDoc
ppr (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
= forall (m :: * -> *) a b.
TrieMap m =>
(a -> b -> b) -> m a -> b -> b
foldTM a -> b -> b
k (forall a. CoreMapX a -> VarMap a
cm_var CoreMapX a
m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a b.
TrieMap m =>
(a -> b -> b) -> m a -> b -> b
foldTM a -> b -> b
k (forall a. CoreMapX a -> LiteralMap a
cm_lit CoreMapX a
m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a b.
TrieMap m =>
(a -> b -> b) -> m a -> b -> b
foldTM a -> b -> b
k (forall a. CoreMapX a -> CoercionMapG a
cm_co CoreMapX a
m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a b.
TrieMap m =>
(a -> b -> b) -> m a -> b -> b
foldTM a -> b -> b
k (forall a. CoreMapX a -> TypeMapG a
cm_type CoreMapX a
m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a b.
TrieMap m =>
(a -> b -> b) -> m a -> b -> b
foldTM (forall (m :: * -> *) a b.
TrieMap m =>
(a -> b -> b) -> m a -> b -> b
foldTM a -> b -> b
k) (forall a. CoreMapX a -> CoreMapG (CoercionMapG a)
cm_cast CoreMapX a
m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a b.
TrieMap m =>
(a -> b -> b) -> m a -> b -> b
foldTM (forall (m :: * -> *) a b.
TrieMap m =>
(a -> b -> b) -> m a -> b -> b
foldTM a -> b -> b
k) (forall a. CoreMapX a -> CoreMapG (TickishMap a)
cm_tick CoreMapX a
m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a b.
TrieMap m =>
(a -> b -> b) -> m a -> b -> b
foldTM (forall (m :: * -> *) a b.
TrieMap m =>
(a -> b -> b) -> m a -> b -> b
foldTM a -> b -> b
k) (forall a. CoreMapX a -> CoreMapG (CoreMapG a)
cm_app CoreMapX a
m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a b.
TrieMap m =>
(a -> b -> b) -> m a -> b -> b
foldTM (forall (m :: * -> *) a b.
TrieMap m =>
(a -> b -> b) -> m a -> b -> b
foldTM a -> b -> b
k) (forall a. CoreMapX a -> CoreMapG (BndrMap a)
cm_lam CoreMapX a
m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a b.
TrieMap m =>
(a -> b -> b) -> m a -> b -> b
foldTM (forall (m :: * -> *) a b.
TrieMap m =>
(a -> b -> b) -> m a -> b -> b
foldTM (forall (m :: * -> *) a b.
TrieMap m =>
(a -> b -> b) -> m a -> b -> b
foldTM a -> b -> b
k)) (forall a. CoreMapX a -> CoreMapG (CoreMapG (BndrMap a))
cm_letn CoreMapX a
m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a b.
TrieMap m =>
(a -> b -> b) -> m a -> b -> b
foldTM (forall (m :: * -> *) a b.
TrieMap m =>
(a -> b -> b) -> m a -> b -> b
foldTM (forall (m :: * -> *) a b.
TrieMap m =>
(a -> b -> b) -> m a -> b -> b
foldTM a -> b -> b
k)) (forall a.
CoreMapX a
-> ListMap (GenMap CoreMapX) (CoreMapG (ListMap BndrMap a))
cm_letr CoreMapX a
m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a b.
TrieMap m =>
(a -> b -> b) -> m a -> b -> b
foldTM (forall (m :: * -> *) a b.
TrieMap m =>
(a -> b -> b) -> m a -> b -> b
foldTM a -> b -> b
k) (forall a. CoreMapX a -> CoreMapG (ListMap AltMap a)
cm_case CoreMapX a
m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a b.
TrieMap m =>
(a -> b -> b) -> m a -> b -> b
foldTM (forall (m :: * -> *) a b.
TrieMap m =>
(a -> b -> b) -> m a -> b -> b
foldTM a -> b -> b
k) (forall a. CoreMapX a -> CoreMapG (TypeMapG a)
cm_ecase CoreMapX a
m)
lkE :: DeBruijn CoreExpr -> CoreMapX a -> Maybe a
lkE :: forall a. DeBruijn CoreExpr -> CoreMapX a -> Maybe a
lkE (D CmEnv
env CoreExpr
expr) CoreMapX a
cm = CoreExpr -> CoreMapX a -> Maybe a
go CoreExpr
expr CoreMapX a
cm
where
go :: CoreExpr -> CoreMapX a -> Maybe a
go (Var Id
v) = forall a. CoreMapX a -> VarMap a
cm_var forall a b c. (a -> b) -> (b -> c) -> a -> c
>.> forall a. CmEnv -> Id -> VarMap a -> Maybe a
lkVar CmEnv
env Id
v
go (Lit Literal
l) = forall a. CoreMapX a -> LiteralMap a
cm_lit forall a b c. (a -> b) -> (b -> c) -> a -> c
>.> forall (m :: * -> *) b. TrieMap m => Key m -> m b -> Maybe b
lookupTM Literal
l
go (Type Type
t) = forall a. CoreMapX a -> TypeMapG a
cm_type forall a b c. (a -> b) -> (b -> c) -> a -> c
>.> forall (m :: * -> *) a.
(Eq (Key m), TrieMap m) =>
Key m -> GenMap m a -> Maybe a
lkG (forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env Type
t)
go (Coercion Coercion
c) = forall a. CoreMapX a -> CoercionMapG a
cm_co forall a b c. (a -> b) -> (b -> c) -> a -> c
>.> forall (m :: * -> *) a.
(Eq (Key m), TrieMap m) =>
Key m -> GenMap m a -> Maybe a
lkG (forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env Coercion
c)
go (Cast CoreExpr
e Coercion
c) = forall a. CoreMapX a -> CoreMapG (CoercionMapG a)
cm_cast forall a b c. (a -> b) -> (b -> c) -> a -> c
>.> forall (m :: * -> *) a.
(Eq (Key m), TrieMap m) =>
Key m -> GenMap m a -> Maybe a
lkG (forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env CoreExpr
e) forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (m :: * -> *) a.
(Eq (Key m), TrieMap m) =>
Key m -> GenMap m a -> Maybe a
lkG (forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env Coercion
c)
go (Tick CoreTickish
tickish CoreExpr
e) = forall a. CoreMapX a -> CoreMapG (TickishMap a)
cm_tick forall a b c. (a -> b) -> (b -> c) -> a -> c
>.> forall (m :: * -> *) a.
(Eq (Key m), TrieMap m) =>
Key m -> GenMap m a -> Maybe a
lkG (forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env CoreExpr
e) forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall a. CoreTickish -> TickishMap a -> Maybe a
lkTickish CoreTickish
tickish
go (App CoreExpr
e1 CoreExpr
e2) = forall a. CoreMapX a -> CoreMapG (CoreMapG a)
cm_app forall a b c. (a -> b) -> (b -> c) -> a -> c
>.> forall (m :: * -> *) a.
(Eq (Key m), TrieMap m) =>
Key m -> GenMap m a -> Maybe a
lkG (forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env CoreExpr
e2) forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (m :: * -> *) a.
(Eq (Key m), TrieMap m) =>
Key m -> GenMap m a -> Maybe a
lkG (forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env CoreExpr
e1)
go (Lam Id
v CoreExpr
e) = forall a. CoreMapX a -> CoreMapG (BndrMap a)
cm_lam forall a b c. (a -> b) -> (b -> c) -> a -> c
>.> forall (m :: * -> *) a.
(Eq (Key m), TrieMap m) =>
Key m -> GenMap m a -> Maybe a
lkG (forall a. CmEnv -> a -> DeBruijn a
D (CmEnv -> Id -> CmEnv
extendCME CmEnv
env Id
v) CoreExpr
e)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall a. CmEnv -> Id -> BndrMap a -> Maybe a
lkBndr CmEnv
env Id
v
go (Let (NonRec Id
b CoreExpr
r) CoreExpr
e) = forall a. CoreMapX a -> CoreMapG (CoreMapG (BndrMap a))
cm_letn forall a b c. (a -> b) -> (b -> c) -> a -> c
>.> forall (m :: * -> *) a.
(Eq (Key m), TrieMap m) =>
Key m -> GenMap m a -> Maybe a
lkG (forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env CoreExpr
r)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (m :: * -> *) a.
(Eq (Key m), TrieMap m) =>
Key m -> GenMap m a -> Maybe a
lkG (forall a. CmEnv -> a -> DeBruijn a
D (CmEnv -> Id -> CmEnv
extendCME CmEnv
env Id
b) CoreExpr
e) forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall a. CmEnv -> Id -> BndrMap a -> Maybe a
lkBndr CmEnv
env Id
b
go (Let (Rec [(Id, CoreExpr)]
prs) CoreExpr
e) = let ([Id]
bndrs,[CoreExpr]
rhss) = forall a b. [(a, b)] -> ([a], [b])
unzip [(Id, CoreExpr)]
prs
env1 :: CmEnv
env1 = CmEnv -> [Id] -> CmEnv
extendCMEs CmEnv
env [Id]
bndrs
in forall a.
CoreMapX a
-> ListMap (GenMap CoreMapX) (CoreMapG (ListMap BndrMap a))
cm_letr
forall a b c. (a -> b) -> (b -> c) -> a -> c
>.> forall (m :: * -> *) k a.
TrieMap m =>
(forall b. k -> m b -> Maybe b) -> [k] -> ListMap m a -> Maybe a
lkList (forall (m :: * -> *) a.
(Eq (Key m), TrieMap m) =>
Key m -> GenMap m a -> Maybe a
lkG forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env1) [CoreExpr]
rhss
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (m :: * -> *) a.
(Eq (Key m), TrieMap m) =>
Key m -> GenMap m a -> Maybe a
lkG (forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env1 CoreExpr
e)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (m :: * -> *) k a.
TrieMap m =>
(forall b. k -> m b -> Maybe b) -> [k] -> ListMap m a -> Maybe a
lkList (forall a. CmEnv -> Id -> BndrMap a -> Maybe a
lkBndr CmEnv
env1) [Id]
bndrs
go (Case CoreExpr
e Id
b Type
ty [CoreAlt]
as)
| forall (t :: * -> *) a. Foldable t => t a -> Bool
null [CoreAlt]
as = forall a. CoreMapX a -> CoreMapG (TypeMapG a)
cm_ecase forall a b c. (a -> b) -> (b -> c) -> a -> c
>.> forall (m :: * -> *) a.
(Eq (Key m), TrieMap m) =>
Key m -> GenMap m a -> Maybe a
lkG (forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env CoreExpr
e) forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (m :: * -> *) a.
(Eq (Key m), TrieMap m) =>
Key m -> GenMap m a -> Maybe a
lkG (forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env Type
ty)
| Bool
otherwise = forall a. CoreMapX a -> CoreMapG (ListMap AltMap a)
cm_case forall a b c. (a -> b) -> (b -> c) -> a -> c
>.> forall (m :: * -> *) a.
(Eq (Key m), TrieMap m) =>
Key m -> GenMap m a -> Maybe a
lkG (forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env CoreExpr
e)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (m :: * -> *) k a.
TrieMap m =>
(forall b. k -> m b -> Maybe b) -> [k] -> ListMap m a -> Maybe a
lkList (forall a. CmEnv -> CoreAlt -> AltMap a -> Maybe a
lkA (CmEnv -> Id -> CmEnv
extendCME CmEnv
env Id
b)) [CoreAlt]
as
xtE :: DeBruijn CoreExpr -> XT a -> CoreMapX a -> CoreMapX a
xtE :: forall a. DeBruijn CoreExpr -> XT a -> CoreMapX a -> CoreMapX a
xtE (D CmEnv
env (Var Id
v)) XT a
f CoreMapX a
m = CoreMapX a
m { cm_var :: VarMap a
cm_var = forall a. CoreMapX a -> VarMap a
cm_var CoreMapX a
m
forall a b. a -> (a -> b) -> b
|> forall a. CmEnv -> Id -> XT a -> VarMap a -> VarMap a
xtVar CmEnv
env Id
v XT a
f }
xtE (D CmEnv
env (Type Type
t)) XT a
f CoreMapX a
m = CoreMapX a
m { cm_type :: TypeMapG a
cm_type = forall a. CoreMapX a -> TypeMapG a
cm_type CoreMapX a
m
forall a b. a -> (a -> b) -> b
|> forall (m :: * -> *) a.
(Eq (Key m), TrieMap m) =>
Key m -> XT a -> GenMap m a -> GenMap m a
xtG (forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env Type
t) XT a
f }
xtE (D CmEnv
env (Coercion Coercion
c)) XT a
f CoreMapX a
m = CoreMapX a
m { cm_co :: CoercionMapG a
cm_co = forall a. CoreMapX a -> CoercionMapG a
cm_co CoreMapX a
m
forall a b. a -> (a -> b) -> b
|> forall (m :: * -> *) a.
(Eq (Key m), TrieMap m) =>
Key m -> XT a -> GenMap m a -> GenMap m a
xtG (forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env Coercion
c) XT a
f }
xtE (D CmEnv
_ (Lit Literal
l)) XT a
f CoreMapX a
m = CoreMapX a
m { cm_lit :: LiteralMap a
cm_lit = forall a. CoreMapX a -> LiteralMap a
cm_lit CoreMapX a
m forall a b. a -> (a -> b) -> b
|> forall (m :: * -> *) b. TrieMap m => Key m -> XT b -> m b -> m b
alterTM Literal
l XT a
f }
xtE (D CmEnv
env (Cast CoreExpr
e Coercion
c)) XT a
f CoreMapX a
m = CoreMapX a
m { cm_cast :: CoreMapG (CoercionMapG a)
cm_cast = forall a. CoreMapX a -> CoreMapG (CoercionMapG a)
cm_cast CoreMapX a
m forall a b. a -> (a -> b) -> b
|> forall (m :: * -> *) a.
(Eq (Key m), TrieMap m) =>
Key m -> XT a -> GenMap m a -> GenMap m a
xtG (forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env CoreExpr
e)
forall (m2 :: * -> *) a (m1 :: * -> *).
TrieMap m2 =>
(XT (m2 a) -> m1 (m2 a) -> m1 (m2 a))
-> (m2 a -> m2 a) -> m1 (m2 a) -> m1 (m2 a)
|>> forall (m :: * -> *) a.
(Eq (Key m), TrieMap m) =>
Key m -> XT a -> GenMap m a -> GenMap m a
xtG (forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env Coercion
c) XT a
f }
xtE (D CmEnv
env (Tick CoreTickish
t CoreExpr
e)) XT a
f CoreMapX a
m = CoreMapX a
m { cm_tick :: CoreMapG (TickishMap a)
cm_tick = forall a. CoreMapX a -> CoreMapG (TickishMap a)
cm_tick CoreMapX a
m forall a b. a -> (a -> b) -> b
|> forall (m :: * -> *) a.
(Eq (Key m), TrieMap m) =>
Key m -> XT a -> GenMap m a -> GenMap m a
xtG (forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env CoreExpr
e)
forall (m2 :: * -> *) a (m1 :: * -> *).
TrieMap m2 =>
(XT (m2 a) -> m1 (m2 a) -> m1 (m2 a))
-> (m2 a -> m2 a) -> m1 (m2 a) -> m1 (m2 a)
|>> forall a. CoreTickish -> XT a -> TickishMap a -> TickishMap a
xtTickish CoreTickish
t XT a
f }
xtE (D CmEnv
env (App CoreExpr
e1 CoreExpr
e2)) XT a
f CoreMapX a
m = CoreMapX a
m { cm_app :: CoreMapG (CoreMapG a)
cm_app = forall a. CoreMapX a -> CoreMapG (CoreMapG a)
cm_app CoreMapX a
m forall a b. a -> (a -> b) -> b
|> forall (m :: * -> *) a.
(Eq (Key m), TrieMap m) =>
Key m -> XT a -> GenMap m a -> GenMap m a
xtG (forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env CoreExpr
e2)
forall (m2 :: * -> *) a (m1 :: * -> *).
TrieMap m2 =>
(XT (m2 a) -> m1 (m2 a) -> m1 (m2 a))
-> (m2 a -> m2 a) -> m1 (m2 a) -> m1 (m2 a)
|>> forall (m :: * -> *) a.
(Eq (Key m), TrieMap m) =>
Key m -> XT a -> GenMap m a -> GenMap m a
xtG (forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env CoreExpr
e1) XT a
f }
xtE (D CmEnv
env (Lam Id
v CoreExpr
e)) XT a
f CoreMapX a
m = CoreMapX a
m { cm_lam :: CoreMapG (BndrMap a)
cm_lam = forall a. CoreMapX a -> CoreMapG (BndrMap a)
cm_lam CoreMapX a
m
forall a b. a -> (a -> b) -> b
|> forall (m :: * -> *) a.
(Eq (Key m), TrieMap m) =>
Key m -> XT a -> GenMap m a -> GenMap m a
xtG (forall a. CmEnv -> a -> DeBruijn a
D (CmEnv -> Id -> CmEnv
extendCME CmEnv
env Id
v) CoreExpr
e)
forall (m2 :: * -> *) a (m1 :: * -> *).
TrieMap m2 =>
(XT (m2 a) -> m1 (m2 a) -> m1 (m2 a))
-> (m2 a -> m2 a) -> m1 (m2 a) -> m1 (m2 a)
|>> forall a. CmEnv -> Id -> XT a -> BndrMap a -> BndrMap a
xtBndr CmEnv
env Id
v XT a
f }
xtE (D CmEnv
env (Let (NonRec Id
b CoreExpr
r) CoreExpr
e)) XT a
f CoreMapX a
m = CoreMapX a
m { cm_letn :: CoreMapG (CoreMapG (BndrMap a))
cm_letn = forall a. CoreMapX a -> CoreMapG (CoreMapG (BndrMap a))
cm_letn CoreMapX a
m
forall a b. a -> (a -> b) -> b
|> forall (m :: * -> *) a.
(Eq (Key m), TrieMap m) =>
Key m -> XT a -> GenMap m a -> GenMap m a
xtG (forall a. CmEnv -> a -> DeBruijn a
D (CmEnv -> Id -> CmEnv
extendCME CmEnv
env Id
b) CoreExpr
e)
forall (m2 :: * -> *) a (m1 :: * -> *).
TrieMap m2 =>
(XT (m2 a) -> m1 (m2 a) -> m1 (m2 a))
-> (m2 a -> m2 a) -> m1 (m2 a) -> m1 (m2 a)
|>> forall (m :: * -> *) a.
(Eq (Key m), TrieMap m) =>
Key m -> XT a -> GenMap m a -> GenMap m a
xtG (forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env CoreExpr
r)
forall (m2 :: * -> *) a (m1 :: * -> *).
TrieMap m2 =>
(XT (m2 a) -> m1 (m2 a) -> m1 (m2 a))
-> (m2 a -> m2 a) -> m1 (m2 a) -> m1 (m2 a)
|>> forall a. CmEnv -> Id -> XT a -> BndrMap a -> BndrMap a
xtBndr CmEnv
env Id
b XT a
f }
xtE (D CmEnv
env (Let (Rec [(Id, CoreExpr)]
prs) CoreExpr
e)) XT a
f CoreMapX a
m = CoreMapX a
m { cm_letr :: ListMap (GenMap CoreMapX) (CoreMapG (ListMap BndrMap a))
cm_letr =
let ([Id]
bndrs,[CoreExpr]
rhss) = forall a b. [(a, b)] -> ([a], [b])
unzip [(Id, CoreExpr)]
prs
env1 :: CmEnv
env1 = CmEnv -> [Id] -> CmEnv
extendCMEs CmEnv
env [Id]
bndrs
in forall a.
CoreMapX a
-> ListMap (GenMap CoreMapX) (CoreMapG (ListMap BndrMap a))
cm_letr CoreMapX a
m
forall a b. a -> (a -> b) -> b
|> forall (m :: * -> *) k a.
TrieMap m =>
(forall b. k -> XT b -> m b -> m b)
-> [k] -> XT a -> ListMap m a -> ListMap m a
xtList (forall (m :: * -> *) a.
(Eq (Key m), TrieMap m) =>
Key m -> XT a -> GenMap m a -> GenMap m a
xtG forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env1) [CoreExpr]
rhss
forall (m2 :: * -> *) a (m1 :: * -> *).
TrieMap m2 =>
(XT (m2 a) -> m1 (m2 a) -> m1 (m2 a))
-> (m2 a -> m2 a) -> m1 (m2 a) -> m1 (m2 a)
|>> forall (m :: * -> *) a.
(Eq (Key m), TrieMap m) =>
Key m -> XT a -> GenMap m a -> GenMap m a
xtG (forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env1 CoreExpr
e)
forall (m2 :: * -> *) a (m1 :: * -> *).
TrieMap m2 =>
(XT (m2 a) -> m1 (m2 a) -> m1 (m2 a))
-> (m2 a -> m2 a) -> m1 (m2 a) -> m1 (m2 a)
|>> forall (m :: * -> *) k a.
TrieMap m =>
(forall b. k -> XT b -> m b -> m b)
-> [k] -> XT a -> ListMap m a -> ListMap m a
xtList (forall a. CmEnv -> Id -> XT a -> BndrMap a -> BndrMap a
xtBndr CmEnv
env1)
[Id]
bndrs XT a
f }
xtE (D CmEnv
env (Case CoreExpr
e Id
b Type
ty [CoreAlt]
as)) XT a
f CoreMapX a
m
| forall (t :: * -> *) a. Foldable t => t a -> Bool
null [CoreAlt]
as = CoreMapX a
m { cm_ecase :: CoreMapG (TypeMapG a)
cm_ecase = forall a. CoreMapX a -> CoreMapG (TypeMapG a)
cm_ecase CoreMapX a
m forall a b. a -> (a -> b) -> b
|> forall (m :: * -> *) a.
(Eq (Key m), TrieMap m) =>
Key m -> XT a -> GenMap m a -> GenMap m a
xtG (forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env CoreExpr
e)
forall (m2 :: * -> *) a (m1 :: * -> *).
TrieMap m2 =>
(XT (m2 a) -> m1 (m2 a) -> m1 (m2 a))
-> (m2 a -> m2 a) -> m1 (m2 a) -> m1 (m2 a)
|>> forall (m :: * -> *) a.
(Eq (Key m), TrieMap m) =>
Key m -> XT a -> GenMap m a -> GenMap m a
xtG (forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env Type
ty) XT a
f }
| Bool
otherwise = CoreMapX a
m { cm_case :: CoreMapG (ListMap AltMap a)
cm_case = forall a. CoreMapX a -> CoreMapG (ListMap AltMap a)
cm_case CoreMapX a
m forall a b. a -> (a -> b) -> b
|> forall (m :: * -> *) a.
(Eq (Key m), TrieMap m) =>
Key m -> XT a -> GenMap m a -> GenMap m a
xtG (forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env CoreExpr
e)
forall (m2 :: * -> *) a (m1 :: * -> *).
TrieMap m2 =>
(XT (m2 a) -> m1 (m2 a) -> m1 (m2 a))
-> (m2 a -> m2 a) -> m1 (m2 a) -> m1 (m2 a)
|>> let env1 :: CmEnv
env1 = CmEnv -> Id -> CmEnv
extendCME CmEnv
env Id
b
in forall (m :: * -> *) k a.
TrieMap m =>
(forall b. k -> XT b -> m b -> m b)
-> [k] -> XT a -> ListMap m a -> ListMap m a
xtList (forall a. CmEnv -> CoreAlt -> XT a -> AltMap a -> AltMap a
xtA CmEnv
env1) [CoreAlt]
as XT a
f }
type TickishMap a = Map.Map CoreTickish a
lkTickish :: CoreTickish -> TickishMap a -> Maybe a
lkTickish :: forall a. CoreTickish -> TickishMap a -> Maybe a
lkTickish = forall (m :: * -> *) b. TrieMap m => Key m -> m b -> Maybe b
lookupTM
xtTickish :: CoreTickish -> XT a -> TickishMap a -> TickishMap a
xtTickish :: forall a. CoreTickish -> XT a -> TickishMap a -> TickishMap a
xtTickish = 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 TrieMap AltMap where
type Key AltMap = CoreAlt
emptyTM :: forall a. AltMap a
emptyTM = AM { am_deflt :: CoreMapG a
am_deflt = forall (m :: * -> *) a. TrieMap m => m a
emptyTM
, am_data :: DNameEnv (CoreMapG a)
am_data = forall a. DNameEnv a
emptyDNameEnv
, am_lit :: LiteralMap (CoreMapG a)
am_lit = forall (m :: * -> *) a. TrieMap m => m a
emptyTM }
lookupTM :: forall b. Key AltMap -> AltMap b -> Maybe b
lookupTM = forall a. CmEnv -> CoreAlt -> AltMap a -> Maybe a
lkA CmEnv
emptyCME
alterTM :: forall b. Key AltMap -> XT b -> AltMap b -> AltMap b
alterTM = forall a. CmEnv -> CoreAlt -> XT a -> AltMap a -> AltMap a
xtA CmEnv
emptyCME
foldTM :: forall a b. (a -> b -> b) -> AltMap a -> b -> b
foldTM = forall a b. (a -> b -> b) -> AltMap a -> b -> b
fdA
mapTM :: forall a b. (a -> b) -> AltMap a -> AltMap b
mapTM = forall a b. (a -> b) -> AltMap a -> AltMap b
mapA
filterTM :: forall a. (a -> Bool) -> AltMap a -> AltMap a
filterTM = forall a. (a -> Bool) -> AltMap a -> AltMap a
ftA
instance Eq (DeBruijn CoreAlt) where
D CmEnv
env1 CoreAlt
a1 == :: DeBruijn CoreAlt -> DeBruijn CoreAlt -> Bool
== D CmEnv
env2 CoreAlt
a2 = CoreAlt -> CoreAlt -> Bool
go CoreAlt
a1 CoreAlt
a2 where
go :: CoreAlt -> CoreAlt -> Bool
go (Alt AltCon
DEFAULT [Id]
_ CoreExpr
rhs1) (Alt AltCon
DEFAULT [Id]
_ CoreExpr
rhs2)
= forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env1 CoreExpr
rhs1 forall a. Eq a => a -> a -> Bool
== forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env2 CoreExpr
rhs2
go (Alt (LitAlt Literal
lit1) [Id]
_ CoreExpr
rhs1) (Alt (LitAlt Literal
lit2) [Id]
_ CoreExpr
rhs2)
= Literal
lit1 forall a. Eq a => a -> a -> Bool
== Literal
lit2 Bool -> Bool -> Bool
&& forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env1 CoreExpr
rhs1 forall a. Eq a => a -> a -> Bool
== forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env2 CoreExpr
rhs2
go (Alt (DataAlt DataCon
dc1) [Id]
bs1 CoreExpr
rhs1) (Alt (DataAlt DataCon
dc2) [Id]
bs2 CoreExpr
rhs2)
= DataCon
dc1 forall a. Eq a => a -> a -> Bool
== DataCon
dc2 Bool -> Bool -> Bool
&&
forall a. CmEnv -> a -> DeBruijn a
D (CmEnv -> [Id] -> CmEnv
extendCMEs CmEnv
env1 [Id]
bs1) CoreExpr
rhs1 forall a. Eq a => a -> a -> Bool
== forall a. CmEnv -> a -> DeBruijn a
D (CmEnv -> [Id] -> CmEnv
extendCMEs CmEnv
env2 [Id]
bs2) CoreExpr
rhs2
go CoreAlt
_ CoreAlt
_ = Bool
False
mapA :: (a->b) -> AltMap a -> AltMap b
mapA :: forall a b. (a -> b) -> AltMap a -> AltMap b
mapA 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 = forall (m :: * -> *) a b. TrieMap m => (a -> b) -> m a -> m b
mapTM a -> b
f CoreMapG a
adeflt
, am_data :: DNameEnv (CoreMapG b)
am_data = forall (m :: * -> *) a b. TrieMap m => (a -> b) -> m a -> m b
mapTM (forall (m :: * -> *) a b. TrieMap m => (a -> b) -> m a -> m b
mapTM a -> b
f) DNameEnv (CoreMapG a)
adata
, am_lit :: LiteralMap (CoreMapG b)
am_lit = forall (m :: * -> *) a b. TrieMap m => (a -> b) -> m a -> m b
mapTM (forall (m :: * -> *) a b. TrieMap m => (a -> b) -> m a -> m b
mapTM a -> b
f) LiteralMap (CoreMapG a)
alit }
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 = 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 = forall (m :: * -> *) a b. TrieMap m => (a -> b) -> m a -> m b
mapTM (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 = forall (m :: * -> *) a b. TrieMap m => (a -> b) -> m a -> m b
mapTM (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 -> CoreAlt -> AltMap a -> Maybe a
lkA CmEnv
env (Alt AltCon
DEFAULT [Id]
_ CoreExpr
rhs) = forall a. AltMap a -> CoreMapG a
am_deflt forall a b c. (a -> b) -> (b -> c) -> a -> c
>.> forall (m :: * -> *) a.
(Eq (Key m), TrieMap m) =>
Key m -> GenMap m a -> Maybe a
lkG (forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env CoreExpr
rhs)
lkA CmEnv
env (Alt (LitAlt Literal
lit) [Id]
_ CoreExpr
rhs) = forall a. AltMap a -> LiteralMap (CoreMapG a)
am_lit forall a b c. (a -> b) -> (b -> c) -> a -> c
>.> forall (m :: * -> *) b. TrieMap m => Key m -> m b -> Maybe b
lookupTM Literal
lit forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (m :: * -> *) a.
(Eq (Key m), TrieMap m) =>
Key m -> GenMap m a -> Maybe a
lkG (forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env CoreExpr
rhs)
lkA CmEnv
env (Alt (DataAlt DataCon
dc) [Id]
bs CoreExpr
rhs) = forall a. AltMap a -> DNameEnv (CoreMapG a)
am_data forall a b c. (a -> b) -> (b -> c) -> a -> c
>.> forall n a. NamedThing n => n -> DNameEnv a -> Maybe a
lkDNamed DataCon
dc
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (m :: * -> *) a.
(Eq (Key m), TrieMap m) =>
Key m -> GenMap m a -> Maybe a
lkG (forall a. CmEnv -> a -> DeBruijn a
D (CmEnv -> [Id] -> CmEnv
extendCMEs CmEnv
env [Id]
bs) CoreExpr
rhs)
xtA :: CmEnv -> CoreAlt -> XT a -> AltMap a -> AltMap a
xtA :: forall a. CmEnv -> CoreAlt -> XT a -> AltMap a -> AltMap a
xtA CmEnv
env (Alt AltCon
DEFAULT [Id]
_ CoreExpr
rhs) XT a
f AltMap a
m =
AltMap a
m { am_deflt :: CoreMapG a
am_deflt = forall a. AltMap a -> CoreMapG a
am_deflt AltMap a
m forall a b. a -> (a -> b) -> b
|> forall (m :: * -> *) a.
(Eq (Key m), TrieMap m) =>
Key m -> XT a -> GenMap m a -> GenMap m a
xtG (forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env CoreExpr
rhs) XT a
f }
xtA CmEnv
env (Alt (LitAlt Literal
l) [Id]
_ CoreExpr
rhs) XT a
f AltMap a
m =
AltMap a
m { am_lit :: LiteralMap (CoreMapG a)
am_lit = forall a. AltMap a -> LiteralMap (CoreMapG a)
am_lit AltMap a
m forall a b. a -> (a -> b) -> b
|> forall (m :: * -> *) b. TrieMap m => Key m -> XT b -> m b -> m b
alterTM Literal
l forall (m2 :: * -> *) a (m1 :: * -> *).
TrieMap m2 =>
(XT (m2 a) -> m1 (m2 a) -> m1 (m2 a))
-> (m2 a -> m2 a) -> m1 (m2 a) -> m1 (m2 a)
|>> forall (m :: * -> *) a.
(Eq (Key m), TrieMap m) =>
Key m -> XT a -> GenMap m a -> GenMap m a
xtG (forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env CoreExpr
rhs) XT a
f }
xtA CmEnv
env (Alt (DataAlt DataCon
d) [Id]
bs CoreExpr
rhs) XT a
f AltMap a
m =
AltMap a
m { am_data :: DNameEnv (CoreMapG a)
am_data = forall a. AltMap a -> DNameEnv (CoreMapG a)
am_data AltMap a
m forall a b. a -> (a -> b) -> b
|> forall n a. NamedThing n => n -> XT a -> DNameEnv a -> DNameEnv a
xtDNamed DataCon
d
forall (m2 :: * -> *) a (m1 :: * -> *).
TrieMap m2 =>
(XT (m2 a) -> m1 (m2 a) -> m1 (m2 a))
-> (m2 a -> m2 a) -> m1 (m2 a) -> m1 (m2 a)
|>> forall (m :: * -> *) a.
(Eq (Key m), TrieMap m) =>
Key m -> XT a -> GenMap m a -> GenMap m a
xtG (forall a. CmEnv -> a -> DeBruijn a
D (CmEnv -> [Id] -> CmEnv
extendCMEs CmEnv
env [Id]
bs) CoreExpr
rhs) XT a
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 = forall (m :: * -> *) a b.
TrieMap m =>
(a -> b -> b) -> m a -> b -> b
foldTM a -> b -> b
k (forall a. AltMap a -> CoreMapG a
am_deflt AltMap a
m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a b.
TrieMap m =>
(a -> b -> b) -> m a -> b -> b
foldTM (forall (m :: * -> *) a b.
TrieMap m =>
(a -> b -> b) -> m a -> b -> b
foldTM a -> b -> b
k) (forall a. AltMap a -> DNameEnv (CoreMapG a)
am_data AltMap a
m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a b.
TrieMap m =>
(a -> b -> b) -> m a -> b -> b
foldTM (forall (m :: * -> *) a b.
TrieMap m =>
(a -> b -> b) -> m a -> b -> b
foldTM a -> b -> b
k) (forall a. AltMap a -> LiteralMap (CoreMapG a)
am_lit AltMap a
m)