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

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)

-- | @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 CoreExpr -> DeBruijn CoreExpr -> Bool
(==) = DeBruijn CoreExpr -> DeBruijn CoreExpr -> Bool
eqDeBruijnExpr

eqDeBruijnExpr :: DeBruijn CoreExpr -> DeBruijn CoreExpr -> Bool
eqDeBruijnExpr :: DeBruijn CoreExpr -> DeBruijn CoreExpr -> Bool
eqDeBruijnExpr (D CmEnv
env1 CoreExpr
e1) (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) = DeBruijn Id -> DeBruijn Id -> Bool
eqDeBruijnVar (forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env1 Id
v1) (forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env2 Id
v2)
    go (Lit Literal
lit1)    (Lit Literal
lit2)      = Literal
lit1 forall a. Eq a => a -> a -> Bool
== Literal
lit2
    -- See Note [Using tcView inside eqDeBruijnType] in GHC.Core.Map.Type
    go (Type Mult
t1)    (Type Mult
t2)        = DeBruijn Mult -> DeBruijn Mult -> Bool
eqDeBruijnType (forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env1 Mult
t1) (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 CoreExpr
e1 CoercionR
co1) (Cast CoreExpr
e2 CoercionR
co2) = forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env1 CoercionR
co1 forall a. Eq a => a -> a -> Bool
== forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env2 CoercionR
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 GenTickish 'TickishPassCore
n1 CoreExpr
e1) (Tick GenTickish 'TickishPassCore
n2 CoreExpr
e2)
      =  DeBruijn (GenTickish 'TickishPassCore)
-> DeBruijn (GenTickish 'TickishPassCore) -> Bool
eqDeBruijnTickish (forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env1 GenTickish 'TickishPassCore
n1) (forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env2 GenTickish 'TickishPassCore
n2)
      Bool -> Bool -> Bool
&& CoreExpr -> CoreExpr -> Bool
go CoreExpr
e1 CoreExpr
e2

    go (Lam Id
b1 CoreExpr
e1)  (Lam Id
b2 CoreExpr
e2)
          -- See Note [Using tcView inside eqDeBruijnType] in GHC.Core.Map.Type
      =  DeBruijn Mult -> DeBruijn Mult -> Bool
eqDeBruijnType (forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env1 (Id -> Mult
varType Id
b1)) (forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env2 (Id -> Mult
varType Id
b2))
      Bool -> Bool -> Bool
&& forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env1 (Id -> Maybe Mult
varMultMaybe Id
b1) forall a. Eq a => a -> a -> Bool
== forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env2 (Id -> Maybe Mult
varMultMaybe Id
b2)
      Bool -> Bool -> Bool
&& DeBruijn CoreExpr -> DeBruijn CoreExpr -> Bool
eqDeBruijnExpr (forall a. CmEnv -> a -> DeBruijn a
D (CmEnv -> Id -> CmEnv
extendCME CmEnv
env1 Id
b1) CoreExpr
e1) (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 -- See Note [Alpha-equality for let-bindings]
      Bool -> Bool -> Bool
&& DeBruijn CoreExpr -> DeBruijn CoreExpr -> Bool
eqDeBruijnExpr (forall a. CmEnv -> a -> DeBruijn a
D (CmEnv -> Id -> CmEnv
extendCME CmEnv
env1 Id
v1) CoreExpr
e1) (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
      -- See Note [Alpha-equality for let-bindings]
      Bool -> Bool -> Bool
&& forall a b. (a -> b -> Bool) -> [a] -> [b] -> Bool
all2 (\Id
b1 Id
b2 -> -- See Note [Using tcView inside eqDeBruijnType] in
                         -- GHC.Core.Map.Type
                         DeBruijn Mult -> DeBruijn Mult -> Bool
eqDeBruijnType (forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env1 (Id -> Mult
varType Id
b1))
                                        (forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env2 (Id -> Mult
varType Id
b2)))
              [Id]
bs1 [Id]
bs2
      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
&& DeBruijn CoreExpr -> DeBruijn CoreExpr -> Bool
eqDeBruijnExpr (forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env1' CoreExpr
e1) (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 Mult
t1 [CoreAlt]
a1) (Case CoreExpr
e2 Id
b2 Mult
t2 [CoreAlt]
a2)
      | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [CoreAlt]
a1   -- See Note [Empty case alternatives]
      = 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 Mult
t1 forall a. Eq a => a -> a -> Bool
== forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env2 Mult
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

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 forall a. Eq a => a -> a -> Bool
== Int
rid
        Bool -> Bool -> Bool
&& forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env1 [XTickishId 'TickishPassCore]
lids forall a. Eq a => a -> a -> Bool
== forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env2 [XTickishId 'TickishPassCore]
rids
        Bool -> Bool -> Bool
&& XBreakpoint 'TickishPassCore
lext forall a. Eq a => a -> a -> Bool
== XBreakpoint 'TickishPassCore
rext
    go GenTickish 'TickishPassCore
l GenTickish 'TickishPassCore
r = GenTickish 'TickishPassCore
l forall a. Eq a => a -> a -> Bool
== GenTickish 'TickishPassCore
r

-- Compares for equality, modulo alpha
eqCoreExpr :: CoreExpr -> CoreExpr -> Bool
eqCoreExpr :: CoreExpr -> CoreExpr -> Bool
eqCoreExpr CoreExpr
e1 CoreExpr
e2 = DeBruijn CoreExpr -> DeBruijn CoreExpr -> Bool
eqDeBruijnExpr (forall a. a -> DeBruijn a
deBruijnize CoreExpr
e1) (forall a. a -> DeBruijn a
deBruijnize CoreExpr
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 = 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: lookup in trie for expressions
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 Mult
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 Mult
t)
    go (Coercion CoercionR
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 CoercionR
c)
    go (Cast CoreExpr
e CoercionR
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 CoercionR
c)
    go (Tick GenTickish 'TickishPassCore
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. GenTickish 'TickishPassCore -> TickishMap a -> Maybe a
lkTickish GenTickish 'TickishPassCore
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 Mult
ty [CoreAlt]
as)     -- See Note [Empty case alternatives]
               | 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 Mult
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 Mult
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 Mult
t) XT a
f }
xtE (D CmEnv
env (Coercion CoercionR
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 CoercionR
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 CoercionR
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 CoercionR
c) XT a
f }
xtE (D CmEnv
env (Tick GenTickish 'TickishPassCore
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.
GenTickish 'TickishPassCore -> XT a -> TickishMap a -> TickishMap a
xtTickish GenTickish 'TickishPassCore
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 Mult
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 Mult
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 }

-- 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 = 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 = 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) }

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)