{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}

{-
(c) The University of Glasgow 2006
(c) The GRASP/AQUA Project, Glasgow University, 1992-1998
-}

{-# OPTIONS_GHC -Wno-orphans #-}
 -- Eq (DeBruijn CoreExpr) and Eq (DeBruijn CoreAlt)

module GHC.Core.Map.Expr (
   -- * Maps over Core expressions
   CoreMap, emptyCoreMap, extendCoreMap, lookupCoreMap, foldCoreMap,
   -- * Alpha equality
   eqDeBruijnExpr, eqCoreExpr,
   -- * 'TrieMap' class reexports
   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( (>=>) )

{-
This module implements TrieMaps over Core related data structures
like CoreExpr or Type. It is built on the Tries from the TrieMap
module.

The code is very regular and boilerplate-like, but there is
some neat handling of *binders*.  In effect they are deBruijn
numbered on the fly.


-}

----------------------
-- Recall that
--   Control.Monad.(>=>) :: (a -> Maybe b) -> (b -> Maybe c) -> a -> Maybe c

-- The CoreMap makes heavy use of GenMap. However the CoreMap Types are not
-- known when defining GenMap so we can only specialize them here.

{-# 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 #-}


{-
************************************************************************
*                                                                      *
                   CoreMap
*                                                                      *
************************************************************************
-}

{-
Note [Binders]
~~~~~~~~~~~~~~
 * In general we check binders as late as possible because types are
   less likely to differ than expression structure.  That's why
      cm_lam :: CoreMapG (TypeMapG a)
   rather than
      cm_lam :: TypeMapG (CoreMapG a)

 * We don't need to look at the type of some binders, notably
     - the case binder in (Case _ b _ _)
     - the binders in an alternative
   because they are totally fixed by the context

Note [Empty case alternatives]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
* For a key (Case e b ty (alt:alts))  we don't need to look the return type
  'ty', because every alternative has that type.

* For a key (Case e b ty []) we MUST look at the return type 'ty', because
  otherwise (Case (error () "urk") _ Int  []) would compare equal to
            (Case (error () "urk") _ Bool [])
  which is utterly wrong (#6097)

We could compare the return type regardless, but the wildly common case
is that it's unnecessary, so we have two fields (cm_case and cm_ecase)
for the two possibilities.  Only cm_ecase looks at the type.

See also Note [Empty case alternatives] in GHC.Core.
-}

-- | @CoreMap a@ is a map from 'CoreExpr' to @a@.  If you are a client, this
-- is the type you want.
newtype CoreMap a = CoreMap (CoreMapG a)

-- TODO(22292): derive
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)

-- | @CoreMapG a@ is a map from @DeBruijn CoreExpr@ to @a@.  The extended
-- key makes it suitable for recursive traversal, since it can track binders,
-- but it is strictly internal to this module.  If you are including a 'CoreMap'
-- inside another 'TrieMap', this is the type you want.
type CoreMapG = GenMap CoreMapX

-- | @CoreMapX a@ is the base map from @DeBruijn CoreExpr@ to @a@, but without
-- the 'GenMap' optimization.
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)    -- Note [Binders]
       , 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)    -- Note [Empty case alternatives]
     }

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)
    -- See Note [Alpha-equality for Coercion arguments]
    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 -- See Note [Alpha-equality for let-bindings]
      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
      -- See Note [Alpha-equality for let-bindings]
      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   -- See Note [Empty case alternatives]
      = [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

-- Compares for equality, modulo alpha
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)

{- Note [Alpha-equality for Coercion arguments]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
The 'Coercion' constructor only appears in argument positions, and so, if the
functions are equal, then the arguments must have equal types. Because the
comparison for coercions (correctly) checks only their types, checking for
alpha-equality of the coercions is redundant.
-}

{- Note [Alpha-equality for let-bindings]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
For /recursive/ let-bindings we need to check that the types of the binders
are alpha-equivalent. Otherwise

  letrec (x : Bool) = x in x

and

  letrec (y : Char) = y in y

would be considered alpha-equivalent, which they are obviously not.

For /non-recursive/ let-bindings, we do not have to check that the types of
the binders are alpha-equivalent. When the RHSs (the expressions) of the
non-recursive let-binders are well-formed and well-typed (which we assume they
are at this point in the compiler), and the RHSs are alpha-equivalent, then the
bindings must have the same type.

In addition, it is also worth pointing out that

  letrec { x = e1; y = e2 } in b

is NOT considered equal to

  letrec { y = e2; x = e1 } in b
-}

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 }

-- TODO(22292): derive
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: lookup in trie for expressions
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)     -- See Note [Empty case alternatives]
               | [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 }

-- TODO: this seems a bit dodgy, see 'eqTickish'
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   -- A single alternative
  = 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) }

-- TODO(22292): derive
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)