{-# LANGUAGE CPP #-}
{-# 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,
   -- * 'TrieMap' class reexports
   TrieMap(..), insertTM, deleteTM,
   lkDFreeVar, xtDFreeVar,
   lkDNamed, xtDNamed,
   (>.>), (|>), (|>>),
 ) where

#include "HsVersions.h"

import GHC.Prelude

import GHC.Data.TrieMap
import GHC.Core.Map.Type
import GHC.Core
import GHC.Core.Type
import GHC.Types.Tickish
import GHC.Types.Var

import GHC.Utils.Misc
import GHC.Utils.Outputable

import qualified Data.Map    as Map
import GHC.Types.Name.Env
import Control.Monad( (>=>) )

{-
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
  D CmEnv
env1 CoreExpr
e1 == :: DeBruijn CoreExpr -> DeBruijn CoreExpr -> Bool
== D CmEnv
env2 CoreExpr
e2 = CoreExpr -> CoreExpr -> Bool
go CoreExpr
e1 CoreExpr
e2 where
    go :: CoreExpr -> CoreExpr -> Bool
go (Var Id
v1) (Var Id
v2)
      = case (CmEnv -> Id -> Maybe BoundVar
lookupCME CmEnv
env1 Id
v1, CmEnv -> Id -> Maybe BoundVar
lookupCME CmEnv
env2 Id
v2) of
                            (Just BoundVar
b1, Just BoundVar
b2) -> BoundVar
b1 forall a. Eq a => a -> a -> Bool
== BoundVar
b2
                            (Maybe BoundVar
Nothing, Maybe BoundVar
Nothing) -> Id
v1 forall a. Eq a => a -> a -> Bool
== Id
v2
                            (Maybe BoundVar, Maybe BoundVar)
_ -> Bool
False
    go (Lit Literal
lit1)    (Lit Literal
lit2)      = Literal
lit1 forall a. Eq a => a -> a -> Bool
== Literal
lit2
    go (Type Type
t1)    (Type Type
t2)        = forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env1 Type
t1 forall a. Eq a => a -> a -> Bool
== forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env2 Type
t2
    go (Coercion Coercion
co1) (Coercion Coercion
co2) = forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env1 Coercion
co1 forall a. Eq a => a -> a -> Bool
== forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env2 Coercion
co2
    go (Cast CoreExpr
e1 Coercion
co1) (Cast CoreExpr
e2 Coercion
co2) = forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env1 Coercion
co1 forall a. Eq a => a -> a -> Bool
== forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env2 Coercion
co2 Bool -> Bool -> Bool
&& CoreExpr -> CoreExpr -> Bool
go CoreExpr
e1 CoreExpr
e2
    go (App CoreExpr
f1 CoreExpr
a1)   (App CoreExpr
f2 CoreExpr
a2)   = CoreExpr -> CoreExpr -> Bool
go CoreExpr
f1 CoreExpr
f2 Bool -> Bool -> Bool
&& CoreExpr -> CoreExpr -> Bool
go CoreExpr
a1 CoreExpr
a2
    -- This seems a bit dodgy, see 'eqTickish'
    go (Tick CoreTickish
n1 CoreExpr
e1)  (Tick CoreTickish
n2 CoreExpr
e2)  = CoreTickish
n1 forall a. Eq a => a -> a -> Bool
== CoreTickish
n2 Bool -> Bool -> Bool
&& CoreExpr -> CoreExpr -> Bool
go CoreExpr
e1 CoreExpr
e2

    go (Lam Id
b1 CoreExpr
e1)  (Lam Id
b2 CoreExpr
e2)
      =  forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env1 (Id -> Type
varType Id
b1) forall a. Eq a => a -> a -> Bool
== forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env2 (Id -> Type
varType Id
b2)
      Bool -> Bool -> Bool
&& forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env1 (Id -> Maybe Type
varMultMaybe Id
b1) forall a. Eq a => a -> a -> Bool
== forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env2 (Id -> Maybe Type
varMultMaybe Id
b2)
      Bool -> Bool -> Bool
&& forall a. CmEnv -> a -> DeBruijn a
D (CmEnv -> Id -> CmEnv
extendCME CmEnv
env1 Id
b1) CoreExpr
e1 forall a. Eq a => a -> a -> Bool
== forall a. CmEnv -> a -> DeBruijn a
D (CmEnv -> Id -> CmEnv
extendCME CmEnv
env2 Id
b2) CoreExpr
e2

    go (Let (NonRec Id
v1 CoreExpr
r1) CoreExpr
e1) (Let (NonRec Id
v2 CoreExpr
r2) CoreExpr
e2)
      =  CoreExpr -> CoreExpr -> Bool
go CoreExpr
r1 CoreExpr
r2
      Bool -> Bool -> Bool
&& forall a. CmEnv -> a -> DeBruijn a
D (CmEnv -> Id -> CmEnv
extendCME CmEnv
env1 Id
v1) CoreExpr
e1 forall a. Eq a => a -> a -> Bool
== forall a. CmEnv -> a -> DeBruijn a
D (CmEnv -> Id -> CmEnv
extendCME CmEnv
env2 Id
v2) CoreExpr
e2

    go (Let (Rec [(Id, CoreExpr)]
ps1) CoreExpr
e1) (Let (Rec [(Id, CoreExpr)]
ps2) CoreExpr
e2)
      = forall a b. [a] -> [b] -> Bool
equalLength [(Id, CoreExpr)]
ps1 [(Id, CoreExpr)]
ps2
      Bool -> Bool -> Bool
&& forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env1' [CoreExpr]
rs1 forall a. Eq a => a -> a -> Bool
== forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env2' [CoreExpr]
rs2
      Bool -> Bool -> Bool
&& forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env1' CoreExpr
e1  forall a. Eq a => a -> a -> Bool
== forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env2' CoreExpr
e2
      where
        ([Id]
bs1,[CoreExpr]
rs1) = forall a b. [(a, b)] -> ([a], [b])
unzip [(Id, CoreExpr)]
ps1
        ([Id]
bs2,[CoreExpr]
rs2) = forall a b. [(a, b)] -> ([a], [b])
unzip [(Id, CoreExpr)]
ps2
        env1' :: CmEnv
env1' = CmEnv -> [Id] -> CmEnv
extendCMEs CmEnv
env1 [Id]
bs1
        env2' :: CmEnv
env2' = CmEnv -> [Id] -> CmEnv
extendCMEs CmEnv
env2 [Id]
bs2

    go (Case CoreExpr
e1 Id
b1 Type
t1 [CoreAlt]
a1) (Case CoreExpr
e2 Id
b2 Type
t2 [CoreAlt]
a2)
      | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [CoreAlt]
a1   -- 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 Type
t1 forall a. Eq a => a -> a -> Bool
== forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env2 Type
t2
      | Bool
otherwise
      =  CoreExpr -> CoreExpr -> Bool
go CoreExpr
e1 CoreExpr
e2 Bool -> Bool -> Bool
&& forall a. CmEnv -> a -> DeBruijn a
D (CmEnv -> Id -> CmEnv
extendCME CmEnv
env1 Id
b1) [CoreAlt]
a1 forall a. Eq a => a -> a -> Bool
== forall a. CmEnv -> a -> DeBruijn a
D (CmEnv -> Id -> CmEnv
extendCME CmEnv
env2 Id
b2) [CoreAlt]
a2

    go CoreExpr
_ CoreExpr
_ = Bool
False

emptyE :: CoreMapX a
emptyE :: forall a. CoreMapX a
emptyE = CM { cm_var :: VarMap a
cm_var = forall (m :: * -> *) a. TrieMap m => m a
emptyTM, cm_lit :: LiteralMap a
cm_lit = forall (m :: * -> *) a. TrieMap m => m a
emptyTM
            , cm_co :: CoercionMapG a
cm_co = forall (m :: * -> *) a. TrieMap m => m a
emptyTM, cm_type :: TypeMapG a
cm_type = forall (m :: * -> *) a. TrieMap m => m a
emptyTM
            , cm_cast :: CoreMapG (CoercionMapG a)
cm_cast = forall (m :: * -> *) a. TrieMap m => m a
emptyTM, cm_app :: CoreMapG (CoreMapG a)
cm_app = forall (m :: * -> *) a. TrieMap m => m a
emptyTM
            , cm_lam :: CoreMapG (BndrMap a)
cm_lam = forall (m :: * -> *) a. TrieMap m => m a
emptyTM, cm_letn :: CoreMapG (CoreMapG (BndrMap a))
cm_letn = forall (m :: * -> *) a. TrieMap m => m a
emptyTM
            , cm_letr :: ListMap (GenMap CoreMapX) (CoreMapG (ListMap BndrMap a))
cm_letr = forall (m :: * -> *) a. TrieMap m => m a
emptyTM, cm_case :: CoreMapG (ListMap AltMap a)
cm_case = forall (m :: * -> *) a. TrieMap m => m a
emptyTM
            , cm_ecase :: CoreMapG (TypeMapG a)
cm_ecase = forall (m :: * -> *) a. TrieMap m => m a
emptyTM, cm_tick :: CoreMapG (TickishMap a)
cm_tick = forall (m :: * -> *) a. TrieMap m => m a
emptyTM }

instance TrieMap CoreMapX where
   type Key CoreMapX = DeBruijn CoreExpr
   emptyTM :: forall a. CoreMapX a
emptyTM  = forall a. CoreMapX a
emptyE
   lookupTM :: forall b. Key CoreMapX -> CoreMapX b -> Maybe b
lookupTM = forall a. DeBruijn CoreExpr -> CoreMapX a -> Maybe a
lkE
   alterTM :: forall b. Key CoreMapX -> XT b -> CoreMapX b -> CoreMapX b
alterTM  = forall a. DeBruijn CoreExpr -> XT a -> CoreMapX a -> CoreMapX a
xtE
   foldTM :: forall a b. (a -> b -> b) -> CoreMapX a -> b -> b
foldTM   = forall a b. (a -> b -> b) -> CoreMapX a -> b -> b
fdE
   mapTM :: forall a b. (a -> b) -> CoreMapX a -> CoreMapX b
mapTM    = forall a b. (a -> b) -> CoreMapX a -> CoreMapX b
mapE
   filterTM :: forall a. (a -> Bool) -> CoreMapX a -> CoreMapX a
filterTM = forall a. (a -> Bool) -> CoreMapX a -> CoreMapX a
ftE

--------------------------
mapE :: (a->b) -> CoreMapX a -> CoreMapX b
mapE :: forall a b. (a -> b) -> CoreMapX a -> CoreMapX b
mapE a -> b
f (CM { cm_var :: forall a. CoreMapX a -> VarMap a
cm_var = VarMap a
cvar, cm_lit :: forall a. CoreMapX a -> LiteralMap a
cm_lit = LiteralMap a
clit
           , cm_co :: forall a. CoreMapX a -> CoercionMapG a
cm_co = CoercionMapG a
cco, cm_type :: forall a. CoreMapX a -> TypeMapG a
cm_type = TypeMapG a
ctype
           , cm_cast :: forall a. CoreMapX a -> CoreMapG (CoercionMapG a)
cm_cast = CoreMapG (CoercionMapG a)
ccast , cm_app :: forall a. CoreMapX a -> CoreMapG (CoreMapG a)
cm_app = CoreMapG (CoreMapG a)
capp
           , cm_lam :: forall a. CoreMapX a -> CoreMapG (BndrMap a)
cm_lam = CoreMapG (BndrMap a)
clam, cm_letn :: forall a. CoreMapX a -> CoreMapG (CoreMapG (BndrMap a))
cm_letn = CoreMapG (CoreMapG (BndrMap a))
cletn
           , cm_letr :: forall a.
CoreMapX a
-> ListMap (GenMap CoreMapX) (CoreMapG (ListMap BndrMap a))
cm_letr = ListMap (GenMap CoreMapX) (CoreMapG (ListMap BndrMap a))
cletr, cm_case :: forall a. CoreMapX a -> CoreMapG (ListMap AltMap a)
cm_case = CoreMapG (ListMap AltMap a)
ccase
           , cm_ecase :: forall a. CoreMapX a -> CoreMapG (TypeMapG a)
cm_ecase = CoreMapG (TypeMapG a)
cecase, cm_tick :: forall a. CoreMapX a -> CoreMapG (TickishMap a)
cm_tick = CoreMapG (TickishMap a)
ctick })
  = CM { cm_var :: VarMap b
cm_var = forall (m :: * -> *) a b. TrieMap m => (a -> b) -> m a -> m b
mapTM a -> b
f VarMap a
cvar, cm_lit :: LiteralMap b
cm_lit = forall (m :: * -> *) a b. TrieMap m => (a -> b) -> m a -> m b
mapTM a -> b
f LiteralMap a
clit
       , cm_co :: CoercionMapG b
cm_co = forall (m :: * -> *) a b. TrieMap m => (a -> b) -> m a -> m b
mapTM a -> b
f CoercionMapG a
cco, cm_type :: TypeMapG b
cm_type = forall (m :: * -> *) a b. TrieMap m => (a -> b) -> m a -> m b
mapTM a -> b
f TypeMapG a
ctype
       , cm_cast :: CoreMapG (CoercionMapG b)
cm_cast = forall (m :: * -> *) a b. TrieMap m => (a -> b) -> m a -> m b
mapTM (forall (m :: * -> *) a b. TrieMap m => (a -> b) -> m a -> m b
mapTM a -> b
f) CoreMapG (CoercionMapG a)
ccast, cm_app :: CoreMapG (CoreMapG b)
cm_app = forall (m :: * -> *) a b. TrieMap m => (a -> b) -> m a -> m b
mapTM (forall (m :: * -> *) a b. TrieMap m => (a -> b) -> m a -> m b
mapTM a -> b
f) CoreMapG (CoreMapG a)
capp
       , cm_lam :: CoreMapG (BndrMap b)
cm_lam = forall (m :: * -> *) a b. TrieMap m => (a -> b) -> m a -> m b
mapTM (forall (m :: * -> *) a b. TrieMap m => (a -> b) -> m a -> m b
mapTM a -> b
f) CoreMapG (BndrMap a)
clam, cm_letn :: CoreMapG (CoreMapG (BndrMap b))
cm_letn = forall (m :: * -> *) a b. TrieMap m => (a -> b) -> m a -> m b
mapTM (forall (m :: * -> *) a b. TrieMap m => (a -> b) -> m a -> m b
mapTM (forall (m :: * -> *) a b. TrieMap m => (a -> b) -> m a -> m b
mapTM a -> b
f)) CoreMapG (CoreMapG (BndrMap a))
cletn
       , cm_letr :: ListMap (GenMap CoreMapX) (CoreMapG (ListMap BndrMap b))
cm_letr = forall (m :: * -> *) a b. TrieMap m => (a -> b) -> m a -> m b
mapTM (forall (m :: * -> *) a b. TrieMap m => (a -> b) -> m a -> m b
mapTM (forall (m :: * -> *) a b. TrieMap m => (a -> b) -> m a -> m b
mapTM a -> b
f)) ListMap (GenMap CoreMapX) (CoreMapG (ListMap BndrMap a))
cletr, cm_case :: CoreMapG (ListMap AltMap b)
cm_case = forall (m :: * -> *) a b. TrieMap m => (a -> b) -> m a -> m b
mapTM (forall (m :: * -> *) a b. TrieMap m => (a -> b) -> m a -> m b
mapTM a -> b
f) CoreMapG (ListMap AltMap a)
ccase
       , cm_ecase :: CoreMapG (TypeMapG b)
cm_ecase = forall (m :: * -> *) a b. TrieMap m => (a -> b) -> m a -> m b
mapTM (forall (m :: * -> *) a b. TrieMap m => (a -> b) -> m a -> m b
mapTM a -> b
f) CoreMapG (TypeMapG a)
cecase, cm_tick :: CoreMapG (TickishMap b)
cm_tick = forall (m :: * -> *) a b. TrieMap m => (a -> b) -> m a -> m b
mapTM (forall (m :: * -> *) a b. TrieMap m => (a -> b) -> m a -> m b
mapTM a -> b
f) CoreMapG (TickishMap a)
ctick }

ftE :: (a->Bool) -> CoreMapX a -> CoreMapX a
ftE :: forall a. (a -> Bool) -> CoreMapX a -> CoreMapX a
ftE a -> Bool
f (CM { cm_var :: forall a. CoreMapX a -> VarMap a
cm_var = VarMap a
cvar, cm_lit :: forall a. CoreMapX a -> LiteralMap a
cm_lit = LiteralMap a
clit
          , cm_co :: forall a. CoreMapX a -> CoercionMapG a
cm_co = CoercionMapG a
cco, cm_type :: forall a. CoreMapX a -> TypeMapG a
cm_type = TypeMapG a
ctype
          , cm_cast :: forall a. CoreMapX a -> CoreMapG (CoercionMapG a)
cm_cast = CoreMapG (CoercionMapG a)
ccast , cm_app :: forall a. CoreMapX a -> CoreMapG (CoreMapG a)
cm_app = CoreMapG (CoreMapG a)
capp
          , cm_lam :: forall a. CoreMapX a -> CoreMapG (BndrMap a)
cm_lam = CoreMapG (BndrMap a)
clam, cm_letn :: forall a. CoreMapX a -> CoreMapG (CoreMapG (BndrMap a))
cm_letn = CoreMapG (CoreMapG (BndrMap a))
cletn
          , cm_letr :: forall a.
CoreMapX a
-> ListMap (GenMap CoreMapX) (CoreMapG (ListMap BndrMap a))
cm_letr = ListMap (GenMap CoreMapX) (CoreMapG (ListMap BndrMap a))
cletr, cm_case :: forall a. CoreMapX a -> CoreMapG (ListMap AltMap a)
cm_case = CoreMapG (ListMap AltMap a)
ccase
          , cm_ecase :: forall a. CoreMapX a -> CoreMapG (TypeMapG a)
cm_ecase = CoreMapG (TypeMapG a)
cecase, cm_tick :: forall a. CoreMapX a -> CoreMapG (TickishMap a)
cm_tick = CoreMapG (TickishMap a)
ctick })
  = CM { cm_var :: VarMap a
cm_var = forall (m :: * -> *) a. TrieMap m => (a -> Bool) -> m a -> m a
filterTM a -> Bool
f VarMap a
cvar, cm_lit :: LiteralMap a
cm_lit = forall (m :: * -> *) a. TrieMap m => (a -> Bool) -> m a -> m a
filterTM a -> Bool
f LiteralMap a
clit
       , cm_co :: CoercionMapG a
cm_co = forall (m :: * -> *) a. TrieMap m => (a -> Bool) -> m a -> m a
filterTM a -> Bool
f CoercionMapG a
cco, cm_type :: TypeMapG a
cm_type = forall (m :: * -> *) a. TrieMap m => (a -> Bool) -> m a -> m a
filterTM a -> Bool
f TypeMapG a
ctype
       , cm_cast :: CoreMapG (CoercionMapG a)
cm_cast = forall (m :: * -> *) a b. TrieMap m => (a -> b) -> m a -> m b
mapTM (forall (m :: * -> *) a. TrieMap m => (a -> Bool) -> m a -> m a
filterTM a -> Bool
f) CoreMapG (CoercionMapG a)
ccast, cm_app :: CoreMapG (CoreMapG a)
cm_app = forall (m :: * -> *) a b. TrieMap m => (a -> b) -> m a -> m b
mapTM (forall (m :: * -> *) a. TrieMap m => (a -> Bool) -> m a -> m a
filterTM a -> Bool
f) CoreMapG (CoreMapG a)
capp
       , cm_lam :: CoreMapG (BndrMap a)
cm_lam = forall (m :: * -> *) a b. TrieMap m => (a -> b) -> m a -> m b
mapTM (forall (m :: * -> *) a. TrieMap m => (a -> Bool) -> m a -> m a
filterTM a -> Bool
f) CoreMapG (BndrMap a)
clam, cm_letn :: CoreMapG (CoreMapG (BndrMap a))
cm_letn = forall (m :: * -> *) a b. TrieMap m => (a -> b) -> m a -> m b
mapTM (forall (m :: * -> *) a b. TrieMap m => (a -> b) -> m a -> m b
mapTM (forall (m :: * -> *) a. TrieMap m => (a -> Bool) -> m a -> m a
filterTM a -> Bool
f)) CoreMapG (CoreMapG (BndrMap a))
cletn
       , cm_letr :: ListMap (GenMap CoreMapX) (CoreMapG (ListMap BndrMap a))
cm_letr = forall (m :: * -> *) a b. TrieMap m => (a -> b) -> m a -> m b
mapTM (forall (m :: * -> *) a b. TrieMap m => (a -> b) -> m a -> m b
mapTM (forall (m :: * -> *) a. TrieMap m => (a -> Bool) -> m a -> m a
filterTM a -> Bool
f)) ListMap (GenMap CoreMapX) (CoreMapG (ListMap BndrMap a))
cletr, cm_case :: CoreMapG (ListMap AltMap a)
cm_case = forall (m :: * -> *) a b. TrieMap m => (a -> b) -> m a -> m b
mapTM (forall (m :: * -> *) a. TrieMap m => (a -> Bool) -> m a -> m a
filterTM a -> Bool
f) CoreMapG (ListMap AltMap a)
ccase
       , cm_ecase :: CoreMapG (TypeMapG a)
cm_ecase = forall (m :: * -> *) a b. TrieMap m => (a -> b) -> m a -> m b
mapTM (forall (m :: * -> *) a. TrieMap m => (a -> Bool) -> m a -> m a
filterTM a -> Bool
f) CoreMapG (TypeMapG a)
cecase, cm_tick :: CoreMapG (TickishMap a)
cm_tick = forall (m :: * -> *) a b. TrieMap m => (a -> b) -> m a -> m b
mapTM (forall (m :: * -> *) a. TrieMap m => (a -> Bool) -> m a -> m a
filterTM a -> Bool
f) CoreMapG (TickishMap a)
ctick }

--------------------------
lookupCoreMap :: CoreMap a -> CoreExpr -> Maybe a
lookupCoreMap :: forall a. CoreMap a -> CoreExpr -> Maybe a
lookupCoreMap CoreMap a
cm CoreExpr
e = forall (m :: * -> *) b. TrieMap m => Key m -> m b -> Maybe b
lookupTM CoreExpr
e CoreMap a
cm

extendCoreMap :: CoreMap a -> CoreExpr -> a -> CoreMap a
extendCoreMap :: forall a. CoreMap a -> CoreExpr -> a -> CoreMap a
extendCoreMap CoreMap a
m CoreExpr
e a
v = forall (m :: * -> *) b. TrieMap m => Key m -> XT b -> m b -> m b
alterTM CoreExpr
e (\Maybe a
_ -> forall a. a -> Maybe a
Just a
v) CoreMap a
m

foldCoreMap :: (a -> b -> b) -> b -> CoreMap a -> b
foldCoreMap :: forall a b. (a -> b -> b) -> b -> CoreMap a -> b
foldCoreMap a -> b -> b
k b
z CoreMap a
m = forall (m :: * -> *) a b.
TrieMap m =>
(a -> b -> b) -> m a -> b -> b
foldTM a -> b -> b
k CoreMap a
m b
z

emptyCoreMap :: CoreMap a
emptyCoreMap :: forall a. CoreMap a
emptyCoreMap = forall (m :: * -> *) a. TrieMap m => m a
emptyTM

instance Outputable a => Outputable (CoreMap a) where
  ppr :: CoreMap a -> SDoc
ppr CoreMap a
m = String -> SDoc
text String
"CoreMap elts" SDoc -> SDoc -> SDoc
<+> forall a. Outputable a => a -> SDoc
ppr (forall (m :: * -> *) a b.
TrieMap m =>
(a -> b -> b) -> m a -> b -> b
foldTM (:) CoreMap a
m [])

-------------------------
fdE :: (a -> b -> b) -> CoreMapX a -> b -> b
fdE :: forall a b. (a -> b -> b) -> CoreMapX a -> b -> b
fdE a -> b -> b
k CoreMapX a
m
  = forall (m :: * -> *) a b.
TrieMap m =>
(a -> b -> b) -> m a -> b -> b
foldTM a -> b -> b
k (forall a. CoreMapX a -> VarMap a
cm_var CoreMapX a
m)
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a b.
TrieMap m =>
(a -> b -> b) -> m a -> b -> b
foldTM a -> b -> b
k (forall a. CoreMapX a -> LiteralMap a
cm_lit CoreMapX a
m)
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a b.
TrieMap m =>
(a -> b -> b) -> m a -> b -> b
foldTM a -> b -> b
k (forall a. CoreMapX a -> CoercionMapG a
cm_co CoreMapX a
m)
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a b.
TrieMap m =>
(a -> b -> b) -> m a -> b -> b
foldTM a -> b -> b
k (forall a. CoreMapX a -> TypeMapG a
cm_type CoreMapX a
m)
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a b.
TrieMap m =>
(a -> b -> b) -> m a -> b -> b
foldTM (forall (m :: * -> *) a b.
TrieMap m =>
(a -> b -> b) -> m a -> b -> b
foldTM a -> b -> b
k) (forall a. CoreMapX a -> CoreMapG (CoercionMapG a)
cm_cast CoreMapX a
m)
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a b.
TrieMap m =>
(a -> b -> b) -> m a -> b -> b
foldTM (forall (m :: * -> *) a b.
TrieMap m =>
(a -> b -> b) -> m a -> b -> b
foldTM a -> b -> b
k) (forall a. CoreMapX a -> CoreMapG (TickishMap a)
cm_tick CoreMapX a
m)
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a b.
TrieMap m =>
(a -> b -> b) -> m a -> b -> b
foldTM (forall (m :: * -> *) a b.
TrieMap m =>
(a -> b -> b) -> m a -> b -> b
foldTM a -> b -> b
k) (forall a. CoreMapX a -> CoreMapG (CoreMapG a)
cm_app CoreMapX a
m)
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a b.
TrieMap m =>
(a -> b -> b) -> m a -> b -> b
foldTM (forall (m :: * -> *) a b.
TrieMap m =>
(a -> b -> b) -> m a -> b -> b
foldTM a -> b -> b
k) (forall a. CoreMapX a -> CoreMapG (BndrMap a)
cm_lam CoreMapX a
m)
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a b.
TrieMap m =>
(a -> b -> b) -> m a -> b -> b
foldTM (forall (m :: * -> *) a b.
TrieMap m =>
(a -> b -> b) -> m a -> b -> b
foldTM (forall (m :: * -> *) a b.
TrieMap m =>
(a -> b -> b) -> m a -> b -> b
foldTM a -> b -> b
k)) (forall a. CoreMapX a -> CoreMapG (CoreMapG (BndrMap a))
cm_letn CoreMapX a
m)
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a b.
TrieMap m =>
(a -> b -> b) -> m a -> b -> b
foldTM (forall (m :: * -> *) a b.
TrieMap m =>
(a -> b -> b) -> m a -> b -> b
foldTM (forall (m :: * -> *) a b.
TrieMap m =>
(a -> b -> b) -> m a -> b -> b
foldTM a -> b -> b
k)) (forall a.
CoreMapX a
-> ListMap (GenMap CoreMapX) (CoreMapG (ListMap BndrMap a))
cm_letr CoreMapX a
m)
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a b.
TrieMap m =>
(a -> b -> b) -> m a -> b -> b
foldTM (forall (m :: * -> *) a b.
TrieMap m =>
(a -> b -> b) -> m a -> b -> b
foldTM a -> b -> b
k) (forall a. CoreMapX a -> CoreMapG (ListMap AltMap a)
cm_case CoreMapX a
m)
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a b.
TrieMap m =>
(a -> b -> b) -> m a -> b -> b
foldTM (forall (m :: * -> *) a b.
TrieMap m =>
(a -> b -> b) -> m a -> b -> b
foldTM a -> b -> b
k) (forall a. CoreMapX a -> CoreMapG (TypeMapG a)
cm_ecase CoreMapX a
m)

-- lkE: 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 Type
t)             = forall a. CoreMapX a -> TypeMapG a
cm_type forall a b c. (a -> b) -> (b -> c) -> a -> c
>.> forall (m :: * -> *) a.
(Eq (Key m), TrieMap m) =>
Key m -> GenMap m a -> Maybe a
lkG (forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env Type
t)
    go (Coercion Coercion
c)         = forall a. CoreMapX a -> CoercionMapG a
cm_co   forall a b c. (a -> b) -> (b -> c) -> a -> c
>.> forall (m :: * -> *) a.
(Eq (Key m), TrieMap m) =>
Key m -> GenMap m a -> Maybe a
lkG (forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env Coercion
c)
    go (Cast CoreExpr
e Coercion
c)           = forall a. CoreMapX a -> CoreMapG (CoercionMapG a)
cm_cast forall a b c. (a -> b) -> (b -> c) -> a -> c
>.> forall (m :: * -> *) a.
(Eq (Key m), TrieMap m) =>
Key m -> GenMap m a -> Maybe a
lkG (forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env CoreExpr
e) forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (m :: * -> *) a.
(Eq (Key m), TrieMap m) =>
Key m -> GenMap m a -> Maybe a
lkG (forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env Coercion
c)
    go (Tick CoreTickish
tickish CoreExpr
e)     = forall a. CoreMapX a -> CoreMapG (TickishMap a)
cm_tick forall a b c. (a -> b) -> (b -> c) -> a -> c
>.> forall (m :: * -> *) a.
(Eq (Key m), TrieMap m) =>
Key m -> GenMap m a -> Maybe a
lkG (forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env CoreExpr
e) forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall a. CoreTickish -> TickishMap a -> Maybe a
lkTickish CoreTickish
tickish
    go (App CoreExpr
e1 CoreExpr
e2)          = forall a. CoreMapX a -> CoreMapG (CoreMapG a)
cm_app  forall a b c. (a -> b) -> (b -> c) -> a -> c
>.> forall (m :: * -> *) a.
(Eq (Key m), TrieMap m) =>
Key m -> GenMap m a -> Maybe a
lkG (forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env CoreExpr
e2) forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (m :: * -> *) a.
(Eq (Key m), TrieMap m) =>
Key m -> GenMap m a -> Maybe a
lkG (forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env CoreExpr
e1)
    go (Lam Id
v CoreExpr
e)            = forall a. CoreMapX a -> CoreMapG (BndrMap a)
cm_lam  forall a b c. (a -> b) -> (b -> c) -> a -> c
>.> forall (m :: * -> *) a.
(Eq (Key m), TrieMap m) =>
Key m -> GenMap m a -> Maybe a
lkG (forall a. CmEnv -> a -> DeBruijn a
D (CmEnv -> Id -> CmEnv
extendCME CmEnv
env Id
v) CoreExpr
e)
                              forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall a. CmEnv -> Id -> BndrMap a -> Maybe a
lkBndr CmEnv
env Id
v
    go (Let (NonRec Id
b CoreExpr
r) CoreExpr
e) = forall a. CoreMapX a -> CoreMapG (CoreMapG (BndrMap a))
cm_letn forall a b c. (a -> b) -> (b -> c) -> a -> c
>.> forall (m :: * -> *) a.
(Eq (Key m), TrieMap m) =>
Key m -> GenMap m a -> Maybe a
lkG (forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env CoreExpr
r)
                              forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (m :: * -> *) a.
(Eq (Key m), TrieMap m) =>
Key m -> GenMap m a -> Maybe a
lkG (forall a. CmEnv -> a -> DeBruijn a
D (CmEnv -> Id -> CmEnv
extendCME CmEnv
env Id
b) CoreExpr
e) forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall a. CmEnv -> Id -> BndrMap a -> Maybe a
lkBndr CmEnv
env Id
b
    go (Let (Rec [(Id, CoreExpr)]
prs) CoreExpr
e)    = let ([Id]
bndrs,[CoreExpr]
rhss) = forall a b. [(a, b)] -> ([a], [b])
unzip [(Id, CoreExpr)]
prs
                                  env1 :: CmEnv
env1 = CmEnv -> [Id] -> CmEnv
extendCMEs CmEnv
env [Id]
bndrs
                              in forall a.
CoreMapX a
-> ListMap (GenMap CoreMapX) (CoreMapG (ListMap BndrMap a))
cm_letr
                                 forall a b c. (a -> b) -> (b -> c) -> a -> c
>.> forall (m :: * -> *) k a.
TrieMap m =>
(forall b. k -> m b -> Maybe b) -> [k] -> ListMap m a -> Maybe a
lkList (forall (m :: * -> *) a.
(Eq (Key m), TrieMap m) =>
Key m -> GenMap m a -> Maybe a
lkG forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env1) [CoreExpr]
rhss
                                 forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (m :: * -> *) a.
(Eq (Key m), TrieMap m) =>
Key m -> GenMap m a -> Maybe a
lkG (forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env1 CoreExpr
e)
                                 forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (m :: * -> *) k a.
TrieMap m =>
(forall b. k -> m b -> Maybe b) -> [k] -> ListMap m a -> Maybe a
lkList (forall a. CmEnv -> Id -> BndrMap a -> Maybe a
lkBndr CmEnv
env1) [Id]
bndrs
    go (Case CoreExpr
e Id
b Type
ty [CoreAlt]
as)     -- 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 Type
ty)
               | Bool
otherwise  = forall a. CoreMapX a -> CoreMapG (ListMap AltMap a)
cm_case forall a b c. (a -> b) -> (b -> c) -> a -> c
>.> forall (m :: * -> *) a.
(Eq (Key m), TrieMap m) =>
Key m -> GenMap m a -> Maybe a
lkG (forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env CoreExpr
e)
                              forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (m :: * -> *) k a.
TrieMap m =>
(forall b. k -> m b -> Maybe b) -> [k] -> ListMap m a -> Maybe a
lkList (forall a. CmEnv -> CoreAlt -> AltMap a -> Maybe a
lkA (CmEnv -> Id -> CmEnv
extendCME CmEnv
env Id
b)) [CoreAlt]
as

xtE :: DeBruijn CoreExpr -> XT a -> CoreMapX a -> CoreMapX a
xtE :: forall a. DeBruijn CoreExpr -> XT a -> CoreMapX a -> CoreMapX a
xtE (D CmEnv
env (Var Id
v))              XT a
f CoreMapX a
m = CoreMapX a
m { cm_var :: VarMap a
cm_var  = forall a. CoreMapX a -> VarMap a
cm_var CoreMapX a
m
                                                 forall a b. a -> (a -> b) -> b
|> forall a. CmEnv -> Id -> XT a -> VarMap a -> VarMap a
xtVar CmEnv
env Id
v XT a
f }
xtE (D CmEnv
env (Type Type
t))             XT a
f CoreMapX a
m = CoreMapX a
m { cm_type :: TypeMapG a
cm_type = forall a. CoreMapX a -> TypeMapG a
cm_type CoreMapX a
m
                                                 forall a b. a -> (a -> b) -> b
|> forall (m :: * -> *) a.
(Eq (Key m), TrieMap m) =>
Key m -> XT a -> GenMap m a -> GenMap m a
xtG (forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env Type
t) XT a
f }
xtE (D CmEnv
env (Coercion Coercion
c))         XT a
f CoreMapX a
m = CoreMapX a
m { cm_co :: CoercionMapG a
cm_co   = forall a. CoreMapX a -> CoercionMapG a
cm_co CoreMapX a
m
                                                 forall a b. a -> (a -> b) -> b
|> forall (m :: * -> *) a.
(Eq (Key m), TrieMap m) =>
Key m -> XT a -> GenMap m a -> GenMap m a
xtG (forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env Coercion
c) XT a
f }
xtE (D CmEnv
_   (Lit Literal
l))              XT a
f CoreMapX a
m = CoreMapX a
m { cm_lit :: LiteralMap a
cm_lit  = forall a. CoreMapX a -> LiteralMap a
cm_lit CoreMapX a
m  forall a b. a -> (a -> b) -> b
|> forall (m :: * -> *) b. TrieMap m => Key m -> XT b -> m b -> m b
alterTM Literal
l XT a
f }
xtE (D CmEnv
env (Cast CoreExpr
e Coercion
c))           XT a
f CoreMapX a
m = CoreMapX a
m { cm_cast :: CoreMapG (CoercionMapG a)
cm_cast = forall a. CoreMapX a -> CoreMapG (CoercionMapG a)
cm_cast CoreMapX a
m forall a b. a -> (a -> b) -> b
|> forall (m :: * -> *) a.
(Eq (Key m), TrieMap m) =>
Key m -> XT a -> GenMap m a -> GenMap m a
xtG (forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env CoreExpr
e)
                                                 forall (m2 :: * -> *) a (m1 :: * -> *).
TrieMap m2 =>
(XT (m2 a) -> m1 (m2 a) -> m1 (m2 a))
-> (m2 a -> m2 a) -> m1 (m2 a) -> m1 (m2 a)
|>> forall (m :: * -> *) a.
(Eq (Key m), TrieMap m) =>
Key m -> XT a -> GenMap m a -> GenMap m a
xtG (forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env Coercion
c) XT a
f }
xtE (D CmEnv
env (Tick CoreTickish
t CoreExpr
e))           XT a
f CoreMapX a
m = CoreMapX a
m { cm_tick :: CoreMapG (TickishMap a)
cm_tick = forall a. CoreMapX a -> CoreMapG (TickishMap a)
cm_tick CoreMapX a
m forall a b. a -> (a -> b) -> b
|> forall (m :: * -> *) a.
(Eq (Key m), TrieMap m) =>
Key m -> XT a -> GenMap m a -> GenMap m a
xtG (forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env CoreExpr
e)
                                                 forall (m2 :: * -> *) a (m1 :: * -> *).
TrieMap m2 =>
(XT (m2 a) -> m1 (m2 a) -> m1 (m2 a))
-> (m2 a -> m2 a) -> m1 (m2 a) -> m1 (m2 a)
|>> forall a. CoreTickish -> XT a -> TickishMap a -> TickishMap a
xtTickish CoreTickish
t XT a
f }
xtE (D CmEnv
env (App CoreExpr
e1 CoreExpr
e2))          XT a
f CoreMapX a
m = CoreMapX a
m { cm_app :: CoreMapG (CoreMapG a)
cm_app = forall a. CoreMapX a -> CoreMapG (CoreMapG a)
cm_app CoreMapX a
m forall a b. a -> (a -> b) -> b
|> forall (m :: * -> *) a.
(Eq (Key m), TrieMap m) =>
Key m -> XT a -> GenMap m a -> GenMap m a
xtG (forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env CoreExpr
e2)
                                                 forall (m2 :: * -> *) a (m1 :: * -> *).
TrieMap m2 =>
(XT (m2 a) -> m1 (m2 a) -> m1 (m2 a))
-> (m2 a -> m2 a) -> m1 (m2 a) -> m1 (m2 a)
|>> forall (m :: * -> *) a.
(Eq (Key m), TrieMap m) =>
Key m -> XT a -> GenMap m a -> GenMap m a
xtG (forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env CoreExpr
e1) XT a
f }
xtE (D CmEnv
env (Lam Id
v CoreExpr
e))            XT a
f CoreMapX a
m = CoreMapX a
m { cm_lam :: CoreMapG (BndrMap a)
cm_lam = forall a. CoreMapX a -> CoreMapG (BndrMap a)
cm_lam CoreMapX a
m
                                                 forall a b. a -> (a -> b) -> b
|> forall (m :: * -> *) a.
(Eq (Key m), TrieMap m) =>
Key m -> XT a -> GenMap m a -> GenMap m a
xtG (forall a. CmEnv -> a -> DeBruijn a
D (CmEnv -> Id -> CmEnv
extendCME CmEnv
env Id
v) CoreExpr
e)
                                                 forall (m2 :: * -> *) a (m1 :: * -> *).
TrieMap m2 =>
(XT (m2 a) -> m1 (m2 a) -> m1 (m2 a))
-> (m2 a -> m2 a) -> m1 (m2 a) -> m1 (m2 a)
|>> forall a. CmEnv -> Id -> XT a -> BndrMap a -> BndrMap a
xtBndr CmEnv
env Id
v XT a
f }
xtE (D CmEnv
env (Let (NonRec Id
b CoreExpr
r) CoreExpr
e)) XT a
f CoreMapX a
m = CoreMapX a
m { cm_letn :: CoreMapG (CoreMapG (BndrMap a))
cm_letn = forall a. CoreMapX a -> CoreMapG (CoreMapG (BndrMap a))
cm_letn CoreMapX a
m
                                                 forall a b. a -> (a -> b) -> b
|> forall (m :: * -> *) a.
(Eq (Key m), TrieMap m) =>
Key m -> XT a -> GenMap m a -> GenMap m a
xtG (forall a. CmEnv -> a -> DeBruijn a
D (CmEnv -> Id -> CmEnv
extendCME CmEnv
env Id
b) CoreExpr
e)
                                                 forall (m2 :: * -> *) a (m1 :: * -> *).
TrieMap m2 =>
(XT (m2 a) -> m1 (m2 a) -> m1 (m2 a))
-> (m2 a -> m2 a) -> m1 (m2 a) -> m1 (m2 a)
|>> forall (m :: * -> *) a.
(Eq (Key m), TrieMap m) =>
Key m -> XT a -> GenMap m a -> GenMap m a
xtG (forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env CoreExpr
r)
                                                 forall (m2 :: * -> *) a (m1 :: * -> *).
TrieMap m2 =>
(XT (m2 a) -> m1 (m2 a) -> m1 (m2 a))
-> (m2 a -> m2 a) -> m1 (m2 a) -> m1 (m2 a)
|>> forall a. CmEnv -> Id -> XT a -> BndrMap a -> BndrMap a
xtBndr CmEnv
env Id
b XT a
f }
xtE (D CmEnv
env (Let (Rec [(Id, CoreExpr)]
prs) CoreExpr
e))    XT a
f CoreMapX a
m = CoreMapX a
m { cm_letr :: ListMap (GenMap CoreMapX) (CoreMapG (ListMap BndrMap a))
cm_letr =
                                              let ([Id]
bndrs,[CoreExpr]
rhss) = forall a b. [(a, b)] -> ([a], [b])
unzip [(Id, CoreExpr)]
prs
                                                  env1 :: CmEnv
env1 = CmEnv -> [Id] -> CmEnv
extendCMEs CmEnv
env [Id]
bndrs
                                              in forall a.
CoreMapX a
-> ListMap (GenMap CoreMapX) (CoreMapG (ListMap BndrMap a))
cm_letr CoreMapX a
m
                                                 forall a b. a -> (a -> b) -> b
|>  forall (m :: * -> *) k a.
TrieMap m =>
(forall b. k -> XT b -> m b -> m b)
-> [k] -> XT a -> ListMap m a -> ListMap m a
xtList (forall (m :: * -> *) a.
(Eq (Key m), TrieMap m) =>
Key m -> XT a -> GenMap m a -> GenMap m a
xtG forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env1) [CoreExpr]
rhss
                                                 forall (m2 :: * -> *) a (m1 :: * -> *).
TrieMap m2 =>
(XT (m2 a) -> m1 (m2 a) -> m1 (m2 a))
-> (m2 a -> m2 a) -> m1 (m2 a) -> m1 (m2 a)
|>> forall (m :: * -> *) a.
(Eq (Key m), TrieMap m) =>
Key m -> XT a -> GenMap m a -> GenMap m a
xtG (forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env1 CoreExpr
e)
                                                 forall (m2 :: * -> *) a (m1 :: * -> *).
TrieMap m2 =>
(XT (m2 a) -> m1 (m2 a) -> m1 (m2 a))
-> (m2 a -> m2 a) -> m1 (m2 a) -> m1 (m2 a)
|>> forall (m :: * -> *) k a.
TrieMap m =>
(forall b. k -> XT b -> m b -> m b)
-> [k] -> XT a -> ListMap m a -> ListMap m a
xtList (forall a. CmEnv -> Id -> XT a -> BndrMap a -> BndrMap a
xtBndr CmEnv
env1)
                                                            [Id]
bndrs XT a
f }
xtE (D CmEnv
env (Case CoreExpr
e Id
b Type
ty [CoreAlt]
as))     XT a
f CoreMapX a
m
                     | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [CoreAlt]
as   = CoreMapX a
m { cm_ecase :: CoreMapG (TypeMapG a)
cm_ecase = forall a. CoreMapX a -> CoreMapG (TypeMapG a)
cm_ecase CoreMapX a
m forall a b. a -> (a -> b) -> b
|> forall (m :: * -> *) a.
(Eq (Key m), TrieMap m) =>
Key m -> XT a -> GenMap m a -> GenMap m a
xtG (forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env CoreExpr
e)
                                                 forall (m2 :: * -> *) a (m1 :: * -> *).
TrieMap m2 =>
(XT (m2 a) -> m1 (m2 a) -> m1 (m2 a))
-> (m2 a -> m2 a) -> m1 (m2 a) -> m1 (m2 a)
|>> forall (m :: * -> *) a.
(Eq (Key m), TrieMap m) =>
Key m -> XT a -> GenMap m a -> GenMap m a
xtG (forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env Type
ty) XT a
f }
                     | Bool
otherwise = CoreMapX a
m { cm_case :: CoreMapG (ListMap AltMap a)
cm_case = forall a. CoreMapX a -> CoreMapG (ListMap AltMap a)
cm_case CoreMapX a
m forall a b. a -> (a -> b) -> b
|> forall (m :: * -> *) a.
(Eq (Key m), TrieMap m) =>
Key m -> XT a -> GenMap m a -> GenMap m a
xtG (forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env CoreExpr
e)
                                                 forall (m2 :: * -> *) a (m1 :: * -> *).
TrieMap m2 =>
(XT (m2 a) -> m1 (m2 a) -> m1 (m2 a))
-> (m2 a -> m2 a) -> m1 (m2 a) -> m1 (m2 a)
|>> let env1 :: CmEnv
env1 = CmEnv -> Id -> CmEnv
extendCME CmEnv
env Id
b
                                                     in forall (m :: * -> *) k a.
TrieMap m =>
(forall b. k -> XT b -> m b -> m b)
-> [k] -> XT a -> ListMap m a -> ListMap m a
xtList (forall a. CmEnv -> CoreAlt -> XT a -> AltMap a -> AltMap a
xtA CmEnv
env1) [CoreAlt]
as XT a
f }

-- TODO: this seems a bit dodgy, see 'eqTickish'
type TickishMap a = Map.Map CoreTickish a
lkTickish :: CoreTickish -> TickishMap a -> Maybe a
lkTickish :: forall a. CoreTickish -> TickishMap a -> Maybe a
lkTickish = forall (m :: * -> *) b. TrieMap m => Key m -> m b -> Maybe b
lookupTM

xtTickish :: CoreTickish -> XT a -> TickishMap a -> TickishMap a
xtTickish :: forall a. CoreTickish -> XT a -> TickishMap a -> TickishMap a
xtTickish = forall (m :: * -> *) b. TrieMap m => Key m -> XT b -> m b -> m b
alterTM

------------------------
data AltMap a   -- 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)