{-# 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 = CoreMapG a -> CoreMap a
forall a. CoreMapG a -> CoreMap a
CoreMap CoreMapG a
forall (m :: * -> *) a. TrieMap m => m a
emptyTM
    lookupTM :: forall b. Key CoreMap -> CoreMap b -> Maybe b
lookupTM Key CoreMap
k (CoreMap CoreMapG b
m) = Key (GenMap CoreMapX) -> CoreMapG b -> Maybe b
forall (m :: * -> *) b. TrieMap m => Key m -> m b -> Maybe b
lookupTM (CoreExpr -> DeBruijn CoreExpr
forall a. a -> DeBruijn a
deBruijnize Key CoreMap
CoreExpr
k) CoreMapG b
m
    alterTM :: forall b. Key CoreMap -> XT b -> CoreMap b -> CoreMap b
alterTM Key CoreMap
k XT b
f (CoreMap CoreMapG b
m) = CoreMapG b -> CoreMap b
forall a. CoreMapG a -> CoreMap a
CoreMap (Key (GenMap CoreMapX) -> XT b -> CoreMapG b -> CoreMapG b
forall (m :: * -> *) b. TrieMap m => Key m -> XT b -> m b -> m b
alterTM (CoreExpr -> DeBruijn CoreExpr
forall a. a -> DeBruijn a
deBruijnize Key CoreMap
CoreExpr
k) XT b
f CoreMapG b
m)
    foldTM :: forall a b. (a -> b -> b) -> CoreMap a -> b -> b
foldTM a -> b -> b
k (CoreMap CoreMapG a
m) = (a -> b -> b) -> CoreMapG a -> b -> b
forall (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) = CoreMapG b -> CoreMap b
forall a. CoreMapG a -> CoreMap a
CoreMap ((a -> b) -> CoreMapG a -> CoreMapG b
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) = CoreMapG a -> CoreMap a
forall a. CoreMapG a -> CoreMap a
CoreMap ((a -> Bool) -> CoreMapG a -> CoreMapG a
forall (m :: * -> *) a. TrieMap m => (a -> Bool) -> m a -> m a
filterTM a -> Bool
f CoreMapG a
m)

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

-- | @CoreMapX a@ is the base map from @DeBruijn CoreExpr@ to @a@, but without
-- the 'GenMap' optimization.
data CoreMapX a
  = CM { forall a. CoreMapX a -> VarMap a
cm_var   :: VarMap a
       , forall a. CoreMapX a -> LiteralMap a
cm_lit   :: LiteralMap a
       , forall a. CoreMapX a -> CoercionMapG a
cm_co    :: CoercionMapG a
       , forall a. CoreMapX a -> TypeMapG a
cm_type  :: TypeMapG a
       , forall a. CoreMapX a -> CoreMapG (CoercionMapG a)
cm_cast  :: CoreMapG (CoercionMapG a)
       , forall a. CoreMapX a -> CoreMapG (TickishMap a)
cm_tick  :: CoreMapG (TickishMap a)
       , forall a. CoreMapX a -> CoreMapG (CoreMapG a)
cm_app   :: CoreMapG (CoreMapG a)
       , forall a. CoreMapX a -> CoreMapG (BndrMap a)
cm_lam   :: CoreMapG (BndrMap a)    -- Note [Binders]
       , forall a. CoreMapX a -> CoreMapG (CoreMapG (BndrMap a))
cm_letn  :: CoreMapG (CoreMapG (BndrMap a))
       , forall a.
CoreMapX a
-> ListMap (GenMap CoreMapX) (CoreMapG (ListMap BndrMap a))
cm_letr  :: ListMap CoreMapG (CoreMapG (ListMap BndrMap a))
       , forall a. CoreMapX a -> CoreMapG (ListMap AltMap a)
cm_case  :: CoreMapG (ListMap AltMap a)
       , forall a. CoreMapX a -> CoreMapG (TypeMapG a)
cm_ecase :: CoreMapG (TypeMapG a)    -- Note [Empty case alternatives]
     }

instance Eq (DeBruijn CoreExpr) where
  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 BoundVar -> BoundVar -> Bool
forall a. Eq a => a -> a -> Bool
== BoundVar
b2
                            (Maybe BoundVar
Nothing, Maybe BoundVar
Nothing) -> Id
v1 Id -> Id -> Bool
forall a. Eq a => a -> a -> Bool
== Id
v2
                            (Maybe BoundVar, Maybe BoundVar)
_ -> Bool
False
    go (Lit Literal
lit1)    (Lit Literal
lit2)      = Literal
lit1 Literal -> Literal -> Bool
forall a. Eq a => a -> a -> Bool
== Literal
lit2
    go (Type Type
t1)    (Type Type
t2)        = CmEnv -> Type -> DeBruijn Type
forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env1 Type
t1 DeBruijn Type -> DeBruijn Type -> Bool
forall a. Eq a => a -> a -> Bool
== CmEnv -> Type -> DeBruijn Type
forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env2 Type
t2
    go (Coercion Coercion
co1) (Coercion Coercion
co2) = CmEnv -> Coercion -> DeBruijn Coercion
forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env1 Coercion
co1 DeBruijn Coercion -> DeBruijn Coercion -> Bool
forall a. Eq a => a -> a -> Bool
== CmEnv -> Coercion -> DeBruijn Coercion
forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env2 Coercion
co2
    go (Cast CoreExpr
e1 Coercion
co1) (Cast CoreExpr
e2 Coercion
co2) = CmEnv -> Coercion -> DeBruijn Coercion
forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env1 Coercion
co1 DeBruijn Coercion -> DeBruijn Coercion -> Bool
forall a. Eq a => a -> a -> Bool
== CmEnv -> Coercion -> DeBruijn Coercion
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 CoreTickish -> CoreTickish -> Bool
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)
      =  CmEnv -> Type -> DeBruijn Type
forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env1 (Id -> Type
varType Id
b1) DeBruijn Type -> DeBruijn Type -> Bool
forall a. Eq a => a -> a -> Bool
== CmEnv -> Type -> DeBruijn Type
forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env2 (Id -> Type
varType Id
b2)
      Bool -> Bool -> Bool
&& CmEnv -> Maybe Type -> DeBruijn (Maybe Type)
forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env1 (Id -> Maybe Type
varMultMaybe Id
b1) DeBruijn (Maybe Type) -> DeBruijn (Maybe Type) -> Bool
forall a. Eq a => a -> a -> Bool
== CmEnv -> Maybe Type -> DeBruijn (Maybe Type)
forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env2 (Id -> Maybe Type
varMultMaybe Id
b2)
      Bool -> Bool -> Bool
&& CmEnv -> CoreExpr -> DeBruijn CoreExpr
forall a. CmEnv -> a -> DeBruijn a
D (CmEnv -> Id -> CmEnv
extendCME CmEnv
env1 Id
b1) CoreExpr
e1 DeBruijn CoreExpr -> DeBruijn CoreExpr -> Bool
forall a. Eq a => a -> a -> Bool
== CmEnv -> CoreExpr -> DeBruijn CoreExpr
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
&& CmEnv -> CoreExpr -> DeBruijn CoreExpr
forall a. CmEnv -> a -> DeBruijn a
D (CmEnv -> Id -> CmEnv
extendCME CmEnv
env1 Id
v1) CoreExpr
e1 DeBruijn CoreExpr -> DeBruijn CoreExpr -> Bool
forall a. Eq a => a -> a -> Bool
== CmEnv -> CoreExpr -> DeBruijn CoreExpr
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)
      = [(Id, CoreExpr)] -> [(Id, CoreExpr)] -> Bool
forall a b. [a] -> [b] -> Bool
equalLength [(Id, CoreExpr)]
ps1 [(Id, CoreExpr)]
ps2
      Bool -> Bool -> Bool
&& CmEnv -> [CoreExpr] -> DeBruijn [CoreExpr]
forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env1' [CoreExpr]
rs1 DeBruijn [CoreExpr] -> DeBruijn [CoreExpr] -> Bool
forall a. Eq a => a -> a -> Bool
== CmEnv -> [CoreExpr] -> DeBruijn [CoreExpr]
forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env2' [CoreExpr]
rs2
      Bool -> Bool -> Bool
&& CmEnv -> CoreExpr -> DeBruijn CoreExpr
forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env1' CoreExpr
e1  DeBruijn CoreExpr -> DeBruijn CoreExpr -> Bool
forall a. Eq a => a -> a -> Bool
== CmEnv -> CoreExpr -> DeBruijn CoreExpr
forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env2' CoreExpr
e2
      where
        ([Id]
bs1,[CoreExpr]
rs1) = [(Id, CoreExpr)] -> ([Id], [CoreExpr])
forall a b. [(a, b)] -> ([a], [b])
unzip [(Id, CoreExpr)]
ps1
        ([Id]
bs2,[CoreExpr]
rs2) = [(Id, CoreExpr)] -> ([Id], [CoreExpr])
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)
      | [CoreAlt] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [CoreAlt]
a1   -- See Note [Empty case alternatives]
      = [CoreAlt] -> Bool
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
&& CmEnv -> Type -> DeBruijn Type
forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env1 Type
t1 DeBruijn Type -> DeBruijn Type -> Bool
forall a. Eq a => a -> a -> Bool
== CmEnv -> Type -> DeBruijn Type
forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env2 Type
t2
      | Bool
otherwise
      =  CoreExpr -> CoreExpr -> Bool
go CoreExpr
e1 CoreExpr
e2 Bool -> Bool -> Bool
&& CmEnv -> [CoreAlt] -> DeBruijn [CoreAlt]
forall a. CmEnv -> a -> DeBruijn a
D (CmEnv -> Id -> CmEnv
extendCME CmEnv
env1 Id
b1) [CoreAlt]
a1 DeBruijn [CoreAlt] -> DeBruijn [CoreAlt] -> Bool
forall a. Eq a => a -> a -> Bool
== CmEnv -> [CoreAlt] -> DeBruijn [CoreAlt]
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 = VarMap a
forall (m :: * -> *) a. TrieMap m => m a
emptyTM, cm_lit :: LiteralMap a
cm_lit = LiteralMap a
forall (m :: * -> *) a. TrieMap m => m a
emptyTM
            , cm_co :: CoercionMapG a
cm_co = CoercionMapG a
forall (m :: * -> *) a. TrieMap m => m a
emptyTM, cm_type :: TypeMapG a
cm_type = TypeMapG a
forall (m :: * -> *) a. TrieMap m => m a
emptyTM
            , cm_cast :: CoreMapG (CoercionMapG a)
cm_cast = CoreMapG (CoercionMapG a)
forall (m :: * -> *) a. TrieMap m => m a
emptyTM, cm_app :: CoreMapG (CoreMapG a)
cm_app = CoreMapG (CoreMapG a)
forall (m :: * -> *) a. TrieMap m => m a
emptyTM
            , cm_lam :: CoreMapG (BndrMap a)
cm_lam = CoreMapG (BndrMap a)
forall (m :: * -> *) a. TrieMap m => m a
emptyTM, cm_letn :: CoreMapG (CoreMapG (BndrMap a))
cm_letn = CoreMapG (CoreMapG (BndrMap a))
forall (m :: * -> *) a. TrieMap m => m a
emptyTM
            , cm_letr :: ListMap (GenMap CoreMapX) (CoreMapG (ListMap BndrMap a))
cm_letr = ListMap (GenMap CoreMapX) (CoreMapG (ListMap BndrMap a))
forall (m :: * -> *) a. TrieMap m => m a
emptyTM, cm_case :: CoreMapG (ListMap AltMap a)
cm_case = CoreMapG (ListMap AltMap a)
forall (m :: * -> *) a. TrieMap m => m a
emptyTM
            , cm_ecase :: CoreMapG (TypeMapG a)
cm_ecase = CoreMapG (TypeMapG a)
forall (m :: * -> *) a. TrieMap m => m a
emptyTM, cm_tick :: CoreMapG (TickishMap a)
cm_tick = CoreMapG (TickishMap a)
forall (m :: * -> *) a. TrieMap m => m a
emptyTM }

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

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

--------------------------
lookupCoreMap :: CoreMap a -> CoreExpr -> Maybe a
lookupCoreMap :: forall a. CoreMap a -> CoreExpr -> Maybe a
lookupCoreMap CoreMap a
cm CoreExpr
e = Key CoreMap -> CoreMap a -> Maybe a
forall (m :: * -> *) b. TrieMap m => Key m -> m b -> Maybe b
lookupTM Key CoreMap
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 = Key CoreMap -> XT a -> CoreMap a -> CoreMap a
forall (m :: * -> *) b. TrieMap m => Key m -> XT b -> m b -> m b
alterTM Key CoreMap
CoreExpr
e (\Maybe a
_ -> a -> Maybe a
forall a. a -> Maybe a
Just a
v) CoreMap a
m

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

emptyCoreMap :: CoreMap a
emptyCoreMap :: forall a. CoreMap a
emptyCoreMap = CoreMap a
forall (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
<+> [a] -> SDoc
forall a. Outputable a => a -> SDoc
ppr ((a -> [a] -> [a]) -> CoreMap a -> [a] -> [a]
forall (m :: * -> *) a b.
TrieMap m =>
(a -> b -> b) -> m a -> b -> b
foldTM (:) CoreMap a
m [])

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

-- lkE: lookup in trie for expressions
lkE :: DeBruijn CoreExpr -> CoreMapX a -> Maybe a
lkE :: forall a. DeBruijn 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)              = CoreMapX a -> VarMap a
forall a. CoreMapX a -> VarMap a
cm_var  (CoreMapX a -> VarMap a)
-> (VarMap a -> Maybe a) -> CoreMapX a -> Maybe a
forall a b c. (a -> b) -> (b -> c) -> a -> c
>.> CmEnv -> Id -> VarMap a -> Maybe a
forall a. CmEnv -> Id -> VarMap a -> Maybe a
lkVar CmEnv
env Id
v
    go (Lit Literal
l)              = CoreMapX a -> LiteralMap a
forall a. CoreMapX a -> LiteralMap a
cm_lit  (CoreMapX a -> LiteralMap a)
-> (LiteralMap a -> Maybe a) -> CoreMapX a -> Maybe a
forall a b c. (a -> b) -> (b -> c) -> a -> c
>.> Key (Map Literal) -> LiteralMap a -> Maybe a
forall (m :: * -> *) b. TrieMap m => Key m -> m b -> Maybe b
lookupTM Literal
Key (Map Literal)
l
    go (Type Type
t)             = CoreMapX a -> TypeMapG a
forall a. CoreMapX a -> TypeMapG a
cm_type (CoreMapX a -> TypeMapG a)
-> (TypeMapG a -> Maybe a) -> CoreMapX a -> Maybe a
forall a b c. (a -> b) -> (b -> c) -> a -> c
>.> Key TypeMapX -> TypeMapG a -> Maybe a
forall (m :: * -> *) a.
(Eq (Key m), TrieMap m) =>
Key m -> GenMap m a -> Maybe a
lkG (CmEnv -> Type -> DeBruijn Type
forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env Type
t)
    go (Coercion Coercion
c)         = CoreMapX a -> CoercionMapG a
forall a. CoreMapX a -> CoercionMapG a
cm_co   (CoreMapX a -> CoercionMapG a)
-> (CoercionMapG a -> Maybe a) -> CoreMapX a -> Maybe a
forall a b c. (a -> b) -> (b -> c) -> a -> c
>.> Key CoercionMapX -> CoercionMapG a -> Maybe a
forall (m :: * -> *) a.
(Eq (Key m), TrieMap m) =>
Key m -> GenMap m a -> Maybe a
lkG (CmEnv -> Coercion -> DeBruijn Coercion
forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env Coercion
c)
    go (Cast CoreExpr
e Coercion
c)           = CoreMapX a -> CoreMapG (CoercionMapG a)
forall a. CoreMapX a -> CoreMapG (CoercionMapG a)
cm_cast (CoreMapX a -> CoreMapG (CoercionMapG a))
-> (CoreMapG (CoercionMapG a) -> Maybe a) -> CoreMapX a -> Maybe a
forall a b c. (a -> b) -> (b -> c) -> a -> c
>.> Key CoreMapX -> CoreMapG (CoercionMapG a) -> Maybe (CoercionMapG a)
forall (m :: * -> *) a.
(Eq (Key m), TrieMap m) =>
Key m -> GenMap m a -> Maybe a
lkG (CmEnv -> CoreExpr -> DeBruijn CoreExpr
forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env CoreExpr
e) (CoreMapG (CoercionMapG a) -> Maybe (CoercionMapG a))
-> (CoercionMapG a -> Maybe a)
-> CoreMapG (CoercionMapG a)
-> Maybe a
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Key CoercionMapX -> CoercionMapG a -> Maybe a
forall (m :: * -> *) a.
(Eq (Key m), TrieMap m) =>
Key m -> GenMap m a -> Maybe a
lkG (CmEnv -> Coercion -> DeBruijn Coercion
forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env Coercion
c)
    go (Tick CoreTickish
tickish CoreExpr
e)     = CoreMapX a -> CoreMapG (TickishMap a)
forall a. CoreMapX a -> CoreMapG (TickishMap a)
cm_tick (CoreMapX a -> CoreMapG (TickishMap a))
-> (CoreMapG (TickishMap a) -> Maybe a) -> CoreMapX a -> Maybe a
forall a b c. (a -> b) -> (b -> c) -> a -> c
>.> Key CoreMapX -> CoreMapG (TickishMap a) -> Maybe (TickishMap a)
forall (m :: * -> *) a.
(Eq (Key m), TrieMap m) =>
Key m -> GenMap m a -> Maybe a
lkG (CmEnv -> CoreExpr -> DeBruijn CoreExpr
forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env CoreExpr
e) (CoreMapG (TickishMap a) -> Maybe (TickishMap a))
-> (TickishMap a -> Maybe a) -> CoreMapG (TickishMap a) -> Maybe a
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> CoreTickish -> TickishMap a -> Maybe a
forall a. CoreTickish -> TickishMap a -> Maybe a
lkTickish CoreTickish
tickish
    go (App CoreExpr
e1 CoreExpr
e2)          = CoreMapX a -> CoreMapG (CoreMapG a)
forall a. CoreMapX a -> CoreMapG (CoreMapG a)
cm_app  (CoreMapX a -> CoreMapG (CoreMapG a))
-> (CoreMapG (CoreMapG a) -> Maybe a) -> CoreMapX a -> Maybe a
forall a b c. (a -> b) -> (b -> c) -> a -> c
>.> Key CoreMapX -> CoreMapG (CoreMapG a) -> Maybe (CoreMapG a)
forall (m :: * -> *) a.
(Eq (Key m), TrieMap m) =>
Key m -> GenMap m a -> Maybe a
lkG (CmEnv -> CoreExpr -> DeBruijn CoreExpr
forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env CoreExpr
e2) (CoreMapG (CoreMapG a) -> Maybe (CoreMapG a))
-> (CoreMapG a -> Maybe a) -> CoreMapG (CoreMapG a) -> Maybe a
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Key CoreMapX -> CoreMapG a -> Maybe a
forall (m :: * -> *) a.
(Eq (Key m), TrieMap m) =>
Key m -> GenMap m a -> Maybe a
lkG (CmEnv -> CoreExpr -> DeBruijn CoreExpr
forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env CoreExpr
e1)
    go (Lam Id
v CoreExpr
e)            = CoreMapX a -> CoreMapG (BndrMap a)
forall a. CoreMapX a -> CoreMapG (BndrMap a)
cm_lam  (CoreMapX a -> CoreMapG (BndrMap a))
-> (CoreMapG (BndrMap a) -> Maybe a) -> CoreMapX a -> Maybe a
forall a b c. (a -> b) -> (b -> c) -> a -> c
>.> Key CoreMapX -> CoreMapG (BndrMap a) -> Maybe (BndrMap a)
forall (m :: * -> *) a.
(Eq (Key m), TrieMap m) =>
Key m -> GenMap m a -> Maybe a
lkG (CmEnv -> CoreExpr -> DeBruijn CoreExpr
forall a. CmEnv -> a -> DeBruijn a
D (CmEnv -> Id -> CmEnv
extendCME CmEnv
env Id
v) CoreExpr
e)
                              (CoreMapG (BndrMap a) -> Maybe (BndrMap a))
-> (BndrMap a -> Maybe a) -> CoreMapG (BndrMap a) -> Maybe a
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> CmEnv -> Id -> BndrMap a -> Maybe a
forall a. CmEnv -> Id -> BndrMap a -> Maybe a
lkBndr CmEnv
env Id
v
    go (Let (NonRec Id
b CoreExpr
r) CoreExpr
e) = CoreMapX a -> CoreMapG (CoreMapG (BndrMap a))
forall a. CoreMapX a -> CoreMapG (CoreMapG (BndrMap a))
cm_letn (CoreMapX a -> CoreMapG (CoreMapG (BndrMap a)))
-> (CoreMapG (CoreMapG (BndrMap a)) -> Maybe a)
-> CoreMapX a
-> Maybe a
forall a b c. (a -> b) -> (b -> c) -> a -> c
>.> Key CoreMapX
-> CoreMapG (CoreMapG (BndrMap a)) -> Maybe (CoreMapG (BndrMap a))
forall (m :: * -> *) a.
(Eq (Key m), TrieMap m) =>
Key m -> GenMap m a -> Maybe a
lkG (CmEnv -> CoreExpr -> DeBruijn CoreExpr
forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env CoreExpr
r)
                              (CoreMapG (CoreMapG (BndrMap a)) -> Maybe (CoreMapG (BndrMap a)))
-> (CoreMapG (BndrMap a) -> Maybe a)
-> CoreMapG (CoreMapG (BndrMap a))
-> Maybe a
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Key CoreMapX -> CoreMapG (BndrMap a) -> Maybe (BndrMap a)
forall (m :: * -> *) a.
(Eq (Key m), TrieMap m) =>
Key m -> GenMap m a -> Maybe a
lkG (CmEnv -> CoreExpr -> DeBruijn CoreExpr
forall a. CmEnv -> a -> DeBruijn a
D (CmEnv -> Id -> CmEnv
extendCME CmEnv
env Id
b) CoreExpr
e) (CoreMapG (BndrMap a) -> Maybe (BndrMap a))
-> (BndrMap a -> Maybe a) -> CoreMapG (BndrMap a) -> Maybe a
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> CmEnv -> Id -> BndrMap a -> Maybe a
forall a. CmEnv -> Id -> BndrMap a -> Maybe a
lkBndr CmEnv
env Id
b
    go (Let (Rec [(Id, CoreExpr)]
prs) CoreExpr
e)    = let ([Id]
bndrs,[CoreExpr]
rhss) = [(Id, CoreExpr)] -> ([Id], [CoreExpr])
forall a b. [(a, b)] -> ([a], [b])
unzip [(Id, CoreExpr)]
prs
                                  env1 :: CmEnv
env1 = CmEnv -> [Id] -> CmEnv
extendCMEs CmEnv
env [Id]
bndrs
                              in CoreMapX a
-> ListMap (GenMap CoreMapX) (CoreMapG (ListMap BndrMap a))
forall a.
CoreMapX a
-> ListMap (GenMap CoreMapX) (CoreMapG (ListMap BndrMap a))
cm_letr
                                 (CoreMapX a
 -> ListMap (GenMap CoreMapX) (CoreMapG (ListMap BndrMap a)))
-> (ListMap (GenMap CoreMapX) (CoreMapG (ListMap BndrMap a))
    -> Maybe a)
-> CoreMapX a
-> Maybe a
forall a b c. (a -> b) -> (b -> c) -> a -> c
>.> (forall b. CoreExpr -> CoreMapG b -> Maybe b)
-> [CoreExpr]
-> ListMap (GenMap CoreMapX) (CoreMapG (ListMap BndrMap a))
-> Maybe (CoreMapG (ListMap BndrMap a))
forall (m :: * -> *) k a.
TrieMap m =>
(forall b. k -> m b -> Maybe b) -> [k] -> ListMap m a -> Maybe a
lkList (DeBruijn CoreExpr -> GenMap CoreMapX b -> Maybe b
forall (m :: * -> *) a.
(Eq (Key m), TrieMap m) =>
Key m -> GenMap m a -> Maybe a
lkG (DeBruijn CoreExpr -> GenMap CoreMapX b -> Maybe b)
-> (CoreExpr -> DeBruijn CoreExpr)
-> CoreExpr
-> GenMap CoreMapX b
-> Maybe b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CmEnv -> CoreExpr -> DeBruijn CoreExpr
forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env1) [CoreExpr]
rhss
                                 (ListMap (GenMap CoreMapX) (CoreMapG (ListMap BndrMap a))
 -> Maybe (CoreMapG (ListMap BndrMap a)))
-> (CoreMapG (ListMap BndrMap a) -> Maybe a)
-> ListMap (GenMap CoreMapX) (CoreMapG (ListMap BndrMap a))
-> Maybe a
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Key CoreMapX
-> CoreMapG (ListMap BndrMap a) -> Maybe (ListMap BndrMap a)
forall (m :: * -> *) a.
(Eq (Key m), TrieMap m) =>
Key m -> GenMap m a -> Maybe a
lkG (CmEnv -> CoreExpr -> DeBruijn CoreExpr
forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env1 CoreExpr
e)
                                 (CoreMapG (ListMap BndrMap a) -> Maybe (ListMap BndrMap a))
-> (ListMap BndrMap a -> Maybe a)
-> CoreMapG (ListMap BndrMap a)
-> Maybe a
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (forall b. Id -> BndrMap b -> Maybe b)
-> [Id] -> ListMap BndrMap a -> Maybe a
forall (m :: * -> *) k a.
TrieMap m =>
(forall b. k -> m b -> Maybe b) -> [k] -> ListMap m a -> Maybe a
lkList (CmEnv -> Id -> BndrMap b -> Maybe b
forall a. CmEnv -> Id -> BndrMap a -> Maybe a
lkBndr CmEnv
env1) [Id]
bndrs
    go (Case CoreExpr
e Id
b Type
ty [CoreAlt]
as)     -- See Note [Empty case alternatives]
               | [CoreAlt] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [CoreAlt]
as    = CoreMapX a -> CoreMapG (TypeMapG a)
forall a. CoreMapX a -> CoreMapG (TypeMapG a)
cm_ecase (CoreMapX a -> CoreMapG (TypeMapG a))
-> (CoreMapG (TypeMapG a) -> Maybe a) -> CoreMapX a -> Maybe a
forall a b c. (a -> b) -> (b -> c) -> a -> c
>.> Key CoreMapX -> CoreMapG (TypeMapG a) -> Maybe (TypeMapG a)
forall (m :: * -> *) a.
(Eq (Key m), TrieMap m) =>
Key m -> GenMap m a -> Maybe a
lkG (CmEnv -> CoreExpr -> DeBruijn CoreExpr
forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env CoreExpr
e) (CoreMapG (TypeMapG a) -> Maybe (TypeMapG a))
-> (TypeMapG a -> Maybe a) -> CoreMapG (TypeMapG a) -> Maybe a
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Key TypeMapX -> TypeMapG a -> Maybe a
forall (m :: * -> *) a.
(Eq (Key m), TrieMap m) =>
Key m -> GenMap m a -> Maybe a
lkG (CmEnv -> Type -> DeBruijn Type
forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env Type
ty)
               | Bool
otherwise  = CoreMapX a -> CoreMapG (ListMap AltMap a)
forall a. CoreMapX a -> CoreMapG (ListMap AltMap a)
cm_case (CoreMapX a -> CoreMapG (ListMap AltMap a))
-> (CoreMapG (ListMap AltMap a) -> Maybe a)
-> CoreMapX a
-> Maybe a
forall a b c. (a -> b) -> (b -> c) -> a -> c
>.> Key CoreMapX
-> CoreMapG (ListMap AltMap a) -> Maybe (ListMap AltMap a)
forall (m :: * -> *) a.
(Eq (Key m), TrieMap m) =>
Key m -> GenMap m a -> Maybe a
lkG (CmEnv -> CoreExpr -> DeBruijn CoreExpr
forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env CoreExpr
e)
                              (CoreMapG (ListMap AltMap a) -> Maybe (ListMap AltMap a))
-> (ListMap AltMap a -> Maybe a)
-> CoreMapG (ListMap AltMap a)
-> Maybe a
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (forall b. CoreAlt -> AltMap b -> Maybe b)
-> [CoreAlt] -> ListMap AltMap a -> Maybe a
forall (m :: * -> *) k a.
TrieMap m =>
(forall b. k -> m b -> Maybe b) -> [k] -> ListMap m a -> Maybe a
lkList (CmEnv -> CoreAlt -> AltMap b -> Maybe b
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  = CoreMapX a -> VarMap a
forall a. CoreMapX a -> VarMap a
cm_var CoreMapX a
m
                                                 VarMap a -> (VarMap a -> VarMap a) -> VarMap a
forall a b. a -> (a -> b) -> b
|> CmEnv -> Id -> XT a -> VarMap a -> VarMap a
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 = CoreMapX a -> TypeMapG a
forall a. CoreMapX a -> TypeMapG a
cm_type CoreMapX a
m
                                                 TypeMapG a -> (TypeMapG a -> TypeMapG a) -> TypeMapG a
forall a b. a -> (a -> b) -> b
|> Key TypeMapX -> XT a -> TypeMapG a -> TypeMapG a
forall (m :: * -> *) a.
(Eq (Key m), TrieMap m) =>
Key m -> XT a -> GenMap m a -> GenMap m a
xtG (CmEnv -> Type -> DeBruijn Type
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   = CoreMapX a -> CoercionMapG a
forall a. CoreMapX a -> CoercionMapG a
cm_co CoreMapX a
m
                                                 CoercionMapG a
-> (CoercionMapG a -> CoercionMapG a) -> CoercionMapG a
forall a b. a -> (a -> b) -> b
|> Key CoercionMapX -> XT a -> CoercionMapG a -> CoercionMapG a
forall (m :: * -> *) a.
(Eq (Key m), TrieMap m) =>
Key m -> XT a -> GenMap m a -> GenMap m a
xtG (CmEnv -> Coercion -> DeBruijn Coercion
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  = CoreMapX a -> LiteralMap a
forall a. CoreMapX a -> LiteralMap a
cm_lit CoreMapX a
m  LiteralMap a -> (LiteralMap a -> LiteralMap a) -> LiteralMap a
forall a b. a -> (a -> b) -> b
|> Key (Map Literal) -> XT a -> LiteralMap a -> LiteralMap a
forall (m :: * -> *) b. TrieMap m => Key m -> XT b -> m b -> m b
alterTM Literal
Key (Map 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 = CoreMapX a -> CoreMapG (CoercionMapG a)
forall a. CoreMapX a -> CoreMapG (CoercionMapG a)
cm_cast CoreMapX a
m CoreMapG (CoercionMapG a)
-> (CoreMapG (CoercionMapG a) -> CoreMapG (CoercionMapG a))
-> CoreMapG (CoercionMapG a)
forall a b. a -> (a -> b) -> b
|> Key CoreMapX
-> XT (CoercionMapG a)
-> CoreMapG (CoercionMapG a)
-> CoreMapG (CoercionMapG a)
forall (m :: * -> *) a.
(Eq (Key m), TrieMap m) =>
Key m -> XT a -> GenMap m a -> GenMap m a
xtG (CmEnv -> CoreExpr -> DeBruijn CoreExpr
forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env CoreExpr
e)
                                                 (XT (CoercionMapG a)
 -> CoreMapG (CoercionMapG a) -> CoreMapG (CoercionMapG a))
-> (CoercionMapG a -> CoercionMapG a)
-> CoreMapG (CoercionMapG a)
-> CoreMapG (CoercionMapG a)
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)
|>> Key CoercionMapX -> XT a -> CoercionMapG a -> CoercionMapG a
forall (m :: * -> *) a.
(Eq (Key m), TrieMap m) =>
Key m -> XT a -> GenMap m a -> GenMap m a
xtG (CmEnv -> Coercion -> DeBruijn Coercion
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 = CoreMapX a -> CoreMapG (TickishMap a)
forall a. CoreMapX a -> CoreMapG (TickishMap a)
cm_tick CoreMapX a
m CoreMapG (TickishMap a)
-> (CoreMapG (TickishMap a) -> CoreMapG (TickishMap a))
-> CoreMapG (TickishMap a)
forall a b. a -> (a -> b) -> b
|> Key CoreMapX
-> XT (TickishMap a)
-> CoreMapG (TickishMap a)
-> CoreMapG (TickishMap a)
forall (m :: * -> *) a.
(Eq (Key m), TrieMap m) =>
Key m -> XT a -> GenMap m a -> GenMap m a
xtG (CmEnv -> CoreExpr -> DeBruijn CoreExpr
forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env CoreExpr
e)
                                                 (XT (TickishMap a)
 -> CoreMapG (TickishMap a) -> CoreMapG (TickishMap a))
-> (TickishMap a -> TickishMap a)
-> CoreMapG (TickishMap a)
-> CoreMapG (TickishMap a)
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)
|>> CoreTickish -> XT a -> TickishMap a -> TickishMap 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 = CoreMapX a -> CoreMapG (CoreMapG a)
forall a. CoreMapX a -> CoreMapG (CoreMapG a)
cm_app CoreMapX a
m CoreMapG (CoreMapG a)
-> (CoreMapG (CoreMapG a) -> CoreMapG (CoreMapG a))
-> CoreMapG (CoreMapG a)
forall a b. a -> (a -> b) -> b
|> Key CoreMapX
-> XT (CoreMapG a)
-> CoreMapG (CoreMapG a)
-> CoreMapG (CoreMapG a)
forall (m :: * -> *) a.
(Eq (Key m), TrieMap m) =>
Key m -> XT a -> GenMap m a -> GenMap m a
xtG (CmEnv -> CoreExpr -> DeBruijn CoreExpr
forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env CoreExpr
e2)
                                                 (XT (CoreMapG a) -> CoreMapG (CoreMapG a) -> CoreMapG (CoreMapG a))
-> (CoreMapG a -> CoreMapG a)
-> CoreMapG (CoreMapG a)
-> CoreMapG (CoreMapG a)
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)
|>> Key CoreMapX -> XT a -> CoreMapG a -> CoreMapG a
forall (m :: * -> *) a.
(Eq (Key m), TrieMap m) =>
Key m -> XT a -> GenMap m a -> GenMap m a
xtG (CmEnv -> CoreExpr -> DeBruijn CoreExpr
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 = CoreMapX a -> CoreMapG (BndrMap a)
forall a. CoreMapX a -> CoreMapG (BndrMap a)
cm_lam CoreMapX a
m
                                                 CoreMapG (BndrMap a)
-> (CoreMapG (BndrMap a) -> CoreMapG (BndrMap a))
-> CoreMapG (BndrMap a)
forall a b. a -> (a -> b) -> b
|> Key CoreMapX
-> XT (BndrMap a) -> CoreMapG (BndrMap a) -> CoreMapG (BndrMap a)
forall (m :: * -> *) a.
(Eq (Key m), TrieMap m) =>
Key m -> XT a -> GenMap m a -> GenMap m a
xtG (CmEnv -> CoreExpr -> DeBruijn CoreExpr
forall a. CmEnv -> a -> DeBruijn a
D (CmEnv -> Id -> CmEnv
extendCME CmEnv
env Id
v) CoreExpr
e)
                                                 (XT (BndrMap a) -> CoreMapG (BndrMap a) -> CoreMapG (BndrMap a))
-> (BndrMap a -> BndrMap a)
-> CoreMapG (BndrMap a)
-> CoreMapG (BndrMap a)
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)
|>> CmEnv -> Id -> XT a -> BndrMap a -> BndrMap 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 = CoreMapX a -> CoreMapG (CoreMapG (BndrMap a))
forall a. CoreMapX a -> CoreMapG (CoreMapG (BndrMap a))
cm_letn CoreMapX a
m
                                                 CoreMapG (CoreMapG (BndrMap a))
-> (CoreMapG (CoreMapG (BndrMap a))
    -> CoreMapG (CoreMapG (BndrMap a)))
-> CoreMapG (CoreMapG (BndrMap a))
forall a b. a -> (a -> b) -> b
|> Key CoreMapX
-> XT (CoreMapG (BndrMap a))
-> CoreMapG (CoreMapG (BndrMap a))
-> CoreMapG (CoreMapG (BndrMap a))
forall (m :: * -> *) a.
(Eq (Key m), TrieMap m) =>
Key m -> XT a -> GenMap m a -> GenMap m a
xtG (CmEnv -> CoreExpr -> DeBruijn CoreExpr
forall a. CmEnv -> a -> DeBruijn a
D (CmEnv -> Id -> CmEnv
extendCME CmEnv
env Id
b) CoreExpr
e)
                                                 (XT (CoreMapG (BndrMap a))
 -> CoreMapG (CoreMapG (BndrMap a))
 -> CoreMapG (CoreMapG (BndrMap a)))
-> (CoreMapG (BndrMap a) -> CoreMapG (BndrMap a))
-> CoreMapG (CoreMapG (BndrMap a))
-> CoreMapG (CoreMapG (BndrMap a))
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)
|>> Key CoreMapX
-> XT (BndrMap a) -> CoreMapG (BndrMap a) -> CoreMapG (BndrMap a)
forall (m :: * -> *) a.
(Eq (Key m), TrieMap m) =>
Key m -> XT a -> GenMap m a -> GenMap m a
xtG (CmEnv -> CoreExpr -> DeBruijn CoreExpr
forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env CoreExpr
r)
                                                 (XT (BndrMap a) -> CoreMapG (BndrMap a) -> CoreMapG (BndrMap a))
-> (BndrMap a -> BndrMap a)
-> CoreMapG (BndrMap a)
-> CoreMapG (BndrMap a)
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)
|>> CmEnv -> Id -> XT a -> BndrMap a -> BndrMap 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) = [(Id, CoreExpr)] -> ([Id], [CoreExpr])
forall a b. [(a, b)] -> ([a], [b])
unzip [(Id, CoreExpr)]
prs
                                                  env1 :: CmEnv
env1 = CmEnv -> [Id] -> CmEnv
extendCMEs CmEnv
env [Id]
bndrs
                                              in CoreMapX a
-> ListMap (GenMap CoreMapX) (CoreMapG (ListMap BndrMap a))
forall a.
CoreMapX a
-> ListMap (GenMap CoreMapX) (CoreMapG (ListMap BndrMap a))
cm_letr CoreMapX a
m
                                                 ListMap (GenMap CoreMapX) (CoreMapG (ListMap BndrMap a))
-> (ListMap (GenMap CoreMapX) (CoreMapG (ListMap BndrMap a))
    -> ListMap (GenMap CoreMapX) (CoreMapG (ListMap BndrMap a)))
-> ListMap (GenMap CoreMapX) (CoreMapG (ListMap BndrMap a))
forall a b. a -> (a -> b) -> b
|>  (forall b. CoreExpr -> XT b -> CoreMapG b -> CoreMapG b)
-> [CoreExpr]
-> XT (CoreMapG (ListMap BndrMap a))
-> ListMap (GenMap CoreMapX) (CoreMapG (ListMap BndrMap a))
-> ListMap (GenMap CoreMapX) (CoreMapG (ListMap BndrMap 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 (DeBruijn CoreExpr
-> (Maybe b -> Maybe b) -> GenMap CoreMapX b -> GenMap CoreMapX b
forall (m :: * -> *) a.
(Eq (Key m), TrieMap m) =>
Key m -> XT a -> GenMap m a -> GenMap m a
xtG (DeBruijn CoreExpr
 -> (Maybe b -> Maybe b) -> GenMap CoreMapX b -> GenMap CoreMapX b)
-> (CoreExpr -> DeBruijn CoreExpr)
-> CoreExpr
-> (Maybe b -> Maybe b)
-> GenMap CoreMapX b
-> GenMap CoreMapX b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CmEnv -> CoreExpr -> DeBruijn CoreExpr
forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env1) [CoreExpr]
rhss
                                                 (XT (CoreMapG (ListMap BndrMap a))
 -> ListMap (GenMap CoreMapX) (CoreMapG (ListMap BndrMap a))
 -> ListMap (GenMap CoreMapX) (CoreMapG (ListMap BndrMap a)))
-> (CoreMapG (ListMap BndrMap a) -> CoreMapG (ListMap BndrMap a))
-> ListMap (GenMap CoreMapX) (CoreMapG (ListMap BndrMap a))
-> ListMap (GenMap CoreMapX) (CoreMapG (ListMap BndrMap a))
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)
|>> Key CoreMapX
-> XT (ListMap BndrMap a)
-> CoreMapG (ListMap BndrMap a)
-> CoreMapG (ListMap BndrMap a)
forall (m :: * -> *) a.
(Eq (Key m), TrieMap m) =>
Key m -> XT a -> GenMap m a -> GenMap m a
xtG (CmEnv -> CoreExpr -> DeBruijn CoreExpr
forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env1 CoreExpr
e)
                                                 (XT (ListMap BndrMap a)
 -> CoreMapG (ListMap BndrMap a) -> CoreMapG (ListMap BndrMap a))
-> (ListMap BndrMap a -> ListMap BndrMap a)
-> CoreMapG (ListMap BndrMap a)
-> CoreMapG (ListMap BndrMap a)
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 b. Id -> XT b -> BndrMap b -> BndrMap b)
-> [Id] -> XT a -> ListMap BndrMap a -> ListMap BndrMap 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 (CmEnv -> Id -> XT b -> BndrMap b -> BndrMap b
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
                     | [CoreAlt] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [CoreAlt]
as   = CoreMapX a
m { cm_ecase :: CoreMapG (TypeMapG a)
cm_ecase = CoreMapX a -> CoreMapG (TypeMapG a)
forall a. CoreMapX a -> CoreMapG (TypeMapG a)
cm_ecase CoreMapX a
m CoreMapG (TypeMapG a)
-> (CoreMapG (TypeMapG a) -> CoreMapG (TypeMapG a))
-> CoreMapG (TypeMapG a)
forall a b. a -> (a -> b) -> b
|> Key CoreMapX
-> XT (TypeMapG a)
-> CoreMapG (TypeMapG a)
-> CoreMapG (TypeMapG a)
forall (m :: * -> *) a.
(Eq (Key m), TrieMap m) =>
Key m -> XT a -> GenMap m a -> GenMap m a
xtG (CmEnv -> CoreExpr -> DeBruijn CoreExpr
forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env CoreExpr
e)
                                                 (XT (TypeMapG a) -> CoreMapG (TypeMapG a) -> CoreMapG (TypeMapG a))
-> (TypeMapG a -> TypeMapG a)
-> CoreMapG (TypeMapG a)
-> CoreMapG (TypeMapG a)
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)
|>> Key TypeMapX -> XT a -> TypeMapG a -> TypeMapG a
forall (m :: * -> *) a.
(Eq (Key m), TrieMap m) =>
Key m -> XT a -> GenMap m a -> GenMap m a
xtG (CmEnv -> Type -> DeBruijn Type
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 = CoreMapX a -> CoreMapG (ListMap AltMap a)
forall a. CoreMapX a -> CoreMapG (ListMap AltMap a)
cm_case CoreMapX a
m CoreMapG (ListMap AltMap a)
-> (CoreMapG (ListMap AltMap a) -> CoreMapG (ListMap AltMap a))
-> CoreMapG (ListMap AltMap a)
forall a b. a -> (a -> b) -> b
|> Key CoreMapX
-> XT (ListMap AltMap a)
-> CoreMapG (ListMap AltMap a)
-> CoreMapG (ListMap AltMap a)
forall (m :: * -> *) a.
(Eq (Key m), TrieMap m) =>
Key m -> XT a -> GenMap m a -> GenMap m a
xtG (CmEnv -> CoreExpr -> DeBruijn CoreExpr
forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env CoreExpr
e)
                                                 (XT (ListMap AltMap a)
 -> CoreMapG (ListMap AltMap a) -> CoreMapG (ListMap AltMap a))
-> (ListMap AltMap a -> ListMap AltMap a)
-> CoreMapG (ListMap AltMap a)
-> CoreMapG (ListMap AltMap a)
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 b. CoreAlt -> XT b -> AltMap b -> AltMap b)
-> [CoreAlt] -> XT a -> ListMap AltMap a -> ListMap AltMap 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 (CmEnv -> CoreAlt -> XT b -> AltMap b -> AltMap b
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 = CoreTickish -> Map CoreTickish a -> Maybe a
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 = CoreTickish
-> (Maybe a -> Maybe a) -> Map CoreTickish a -> Map CoreTickish a
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 = CoreMapG a
forall (m :: * -> *) a. TrieMap m => m a
emptyTM
                 , am_data :: DNameEnv (CoreMapG a)
am_data = DNameEnv (CoreMapG a)
forall a. DNameEnv a
emptyDNameEnv
                 , am_lit :: LiteralMap (CoreMapG a)
am_lit  = LiteralMap (CoreMapG a)
forall (m :: * -> *) a. TrieMap m => m a
emptyTM }
   lookupTM :: forall b. Key AltMap -> AltMap b -> Maybe b
lookupTM = CmEnv -> CoreAlt -> AltMap b -> Maybe b
forall a. CmEnv -> CoreAlt -> AltMap a -> Maybe a
lkA CmEnv
emptyCME
   alterTM :: forall b. Key AltMap -> XT b -> AltMap b -> AltMap b
alterTM  = CmEnv -> CoreAlt -> (Maybe b -> Maybe b) -> AltMap b -> AltMap b
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   = (a -> b -> b) -> AltMap a -> b -> b
forall a b. (a -> b -> b) -> AltMap a -> b -> b
fdA
   mapTM :: forall a b. (a -> b) -> AltMap a -> AltMap b
mapTM    = (a -> b) -> AltMap a -> AltMap b
forall a b. (a -> b) -> AltMap a -> AltMap b
mapA
   filterTM :: forall a. (a -> Bool) -> AltMap a -> AltMap a
filterTM = (a -> Bool) -> AltMap a -> AltMap a
forall a. (a -> Bool) -> AltMap a -> AltMap a
ftA

instance Eq (DeBruijn CoreAlt) where
  D CmEnv
env1 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)
        = CmEnv -> CoreExpr -> DeBruijn CoreExpr
forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env1 CoreExpr
rhs1 DeBruijn CoreExpr -> DeBruijn CoreExpr -> Bool
forall a. Eq a => a -> a -> Bool
== CmEnv -> CoreExpr -> DeBruijn CoreExpr
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 Literal -> Literal -> Bool
forall a. Eq a => a -> a -> Bool
== Literal
lit2 Bool -> Bool -> Bool
&& CmEnv -> CoreExpr -> DeBruijn CoreExpr
forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env1 CoreExpr
rhs1 DeBruijn CoreExpr -> DeBruijn CoreExpr -> Bool
forall a. Eq a => a -> a -> Bool
== CmEnv -> CoreExpr -> DeBruijn CoreExpr
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 DataCon -> DataCon -> Bool
forall a. Eq a => a -> a -> Bool
== DataCon
dc2 Bool -> Bool -> Bool
&&
          CmEnv -> CoreExpr -> DeBruijn CoreExpr
forall a. CmEnv -> a -> DeBruijn a
D (CmEnv -> [Id] -> CmEnv
extendCMEs CmEnv
env1 [Id]
bs1) CoreExpr
rhs1 DeBruijn CoreExpr -> DeBruijn CoreExpr -> Bool
forall a. Eq a => a -> a -> Bool
== CmEnv -> CoreExpr -> DeBruijn CoreExpr
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 = (a -> b) -> CoreMapG a -> CoreMapG b
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 = (CoreMapG a -> CoreMapG b)
-> DNameEnv (CoreMapG a) -> DNameEnv (CoreMapG b)
forall (m :: * -> *) a b. TrieMap m => (a -> b) -> m a -> m b
mapTM ((a -> b) -> CoreMapG a -> CoreMapG b
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 = (CoreMapG a -> CoreMapG b)
-> LiteralMap (CoreMapG a) -> LiteralMap (CoreMapG b)
forall (m :: * -> *) a b. TrieMap m => (a -> b) -> m a -> m b
mapTM ((a -> b) -> CoreMapG a -> CoreMapG b
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 = (a -> Bool) -> CoreMapG a -> CoreMapG a
forall (m :: * -> *) a. TrieMap m => (a -> Bool) -> m a -> m a
filterTM a -> Bool
f CoreMapG a
adeflt
       , am_data :: DNameEnv (CoreMapG a)
am_data = (CoreMapG a -> CoreMapG a)
-> DNameEnv (CoreMapG a) -> DNameEnv (CoreMapG a)
forall (m :: * -> *) a b. TrieMap m => (a -> b) -> m a -> m b
mapTM ((a -> Bool) -> CoreMapG a -> CoreMapG a
forall (m :: * -> *) a. TrieMap m => (a -> Bool) -> m a -> m a
filterTM a -> Bool
f) DNameEnv (CoreMapG a)
adata
       , am_lit :: LiteralMap (CoreMapG a)
am_lit = (CoreMapG a -> CoreMapG a)
-> LiteralMap (CoreMapG a) -> LiteralMap (CoreMapG a)
forall (m :: * -> *) a b. TrieMap m => (a -> b) -> m a -> m b
mapTM ((a -> Bool) -> CoreMapG a -> CoreMapG a
forall (m :: * -> *) a. TrieMap m => (a -> Bool) -> m a -> m a
filterTM a -> Bool
f) LiteralMap (CoreMapG a)
alit }

lkA :: CmEnv -> CoreAlt -> AltMap a -> Maybe a
lkA :: forall a. CmEnv -> CoreAlt -> AltMap a -> Maybe a
lkA CmEnv
env (Alt AltCon
DEFAULT      [Id]
_  CoreExpr
rhs) = AltMap a -> CoreMapG a
forall a. AltMap a -> CoreMapG a
am_deflt (AltMap a -> CoreMapG a)
-> (CoreMapG a -> Maybe a) -> AltMap a -> Maybe a
forall a b c. (a -> b) -> (b -> c) -> a -> c
>.> Key CoreMapX -> CoreMapG a -> Maybe a
forall (m :: * -> *) a.
(Eq (Key m), TrieMap m) =>
Key m -> GenMap m a -> Maybe a
lkG (CmEnv -> CoreExpr -> DeBruijn CoreExpr
forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env CoreExpr
rhs)
lkA CmEnv
env (Alt (LitAlt Literal
lit) [Id]
_  CoreExpr
rhs) = AltMap a -> LiteralMap (CoreMapG a)
forall a. AltMap a -> LiteralMap (CoreMapG a)
am_lit (AltMap a -> LiteralMap (CoreMapG a))
-> (LiteralMap (CoreMapG a) -> Maybe a) -> AltMap a -> Maybe a
forall a b c. (a -> b) -> (b -> c) -> a -> c
>.> Key (Map Literal) -> LiteralMap (CoreMapG a) -> Maybe (CoreMapG a)
forall (m :: * -> *) b. TrieMap m => Key m -> m b -> Maybe b
lookupTM Literal
Key (Map Literal)
lit (LiteralMap (CoreMapG a) -> Maybe (CoreMapG a))
-> (CoreMapG a -> Maybe a) -> LiteralMap (CoreMapG a) -> Maybe a
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Key CoreMapX -> CoreMapG a -> Maybe a
forall (m :: * -> *) a.
(Eq (Key m), TrieMap m) =>
Key m -> GenMap m a -> Maybe a
lkG (CmEnv -> CoreExpr -> DeBruijn CoreExpr
forall a. CmEnv -> a -> DeBruijn a
D CmEnv
env CoreExpr
rhs)
lkA CmEnv
env (Alt (DataAlt DataCon
dc) [Id]
bs CoreExpr
rhs) = AltMap a -> DNameEnv (CoreMapG a)
forall a. AltMap a -> DNameEnv (CoreMapG a)
am_data (AltMap a -> DNameEnv (CoreMapG a))
-> (DNameEnv (CoreMapG a) -> Maybe a) -> AltMap a -> Maybe a
forall a b c. (a -> b) -> (b -> c) -> a -> c
>.> DataCon -> DNameEnv (CoreMapG a) -> Maybe (CoreMapG a)
forall n a. NamedThing n => n -> DNameEnv a -> Maybe a
lkDNamed DataCon
dc
                                        (DNameEnv (CoreMapG a) -> Maybe (CoreMapG a))
-> (CoreMapG a -> Maybe a) -> DNameEnv (CoreMapG a) -> Maybe a
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Key CoreMapX -> CoreMapG a -> Maybe a
forall (m :: * -> *) a.
(Eq (Key m), TrieMap m) =>
Key m -> GenMap m a -> Maybe a
lkG (CmEnv -> CoreExpr -> DeBruijn CoreExpr
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 = AltMap a -> CoreMapG a
forall a. AltMap a -> CoreMapG a
am_deflt AltMap a
m CoreMapG a -> (CoreMapG a -> CoreMapG a) -> CoreMapG a
forall a b. a -> (a -> b) -> b
|> Key CoreMapX -> XT a -> CoreMapG a -> CoreMapG a
forall (m :: * -> *) a.
(Eq (Key m), TrieMap m) =>
Key m -> XT a -> GenMap m a -> GenMap m a
xtG (CmEnv -> CoreExpr -> DeBruijn CoreExpr
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   = AltMap a -> LiteralMap (CoreMapG a)
forall a. AltMap a -> LiteralMap (CoreMapG a)
am_lit AltMap a
m   LiteralMap (CoreMapG a)
-> (LiteralMap (CoreMapG a) -> LiteralMap (CoreMapG a))
-> LiteralMap (CoreMapG a)
forall a b. a -> (a -> b) -> b
|> Key (Map Literal)
-> XT (CoreMapG a)
-> LiteralMap (CoreMapG a)
-> LiteralMap (CoreMapG a)
forall (m :: * -> *) b. TrieMap m => Key m -> XT b -> m b -> m b
alterTM Literal
Key (Map Literal)
l (XT (CoreMapG a)
 -> LiteralMap (CoreMapG a) -> LiteralMap (CoreMapG a))
-> (CoreMapG a -> CoreMapG a)
-> LiteralMap (CoreMapG a)
-> LiteralMap (CoreMapG a)
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)
|>> Key CoreMapX -> XT a -> CoreMapG a -> CoreMapG a
forall (m :: * -> *) a.
(Eq (Key m), TrieMap m) =>
Key m -> XT a -> GenMap m a -> GenMap m a
xtG (CmEnv -> CoreExpr -> DeBruijn CoreExpr
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  = AltMap a -> DNameEnv (CoreMapG a)
forall a. AltMap a -> DNameEnv (CoreMapG a)
am_data AltMap a
m  DNameEnv (CoreMapG a)
-> (DNameEnv (CoreMapG a) -> DNameEnv (CoreMapG a))
-> DNameEnv (CoreMapG a)
forall a b. a -> (a -> b) -> b
|> DataCon
-> XT (CoreMapG a)
-> DNameEnv (CoreMapG a)
-> DNameEnv (CoreMapG a)
forall n a. NamedThing n => n -> XT a -> DNameEnv a -> DNameEnv a
xtDNamed DataCon
d
                             (XT (CoreMapG a) -> DNameEnv (CoreMapG a) -> DNameEnv (CoreMapG a))
-> (CoreMapG a -> CoreMapG a)
-> DNameEnv (CoreMapG a)
-> DNameEnv (CoreMapG a)
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)
|>> Key CoreMapX -> XT a -> CoreMapG a -> CoreMapG a
forall (m :: * -> *) a.
(Eq (Key m), TrieMap m) =>
Key m -> XT a -> GenMap m a -> GenMap m a
xtG (CmEnv -> CoreExpr -> DeBruijn CoreExpr
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 = (a -> b -> b) -> GenMap CoreMapX a -> b -> b
forall (m :: * -> *) a b.
TrieMap m =>
(a -> b -> b) -> m a -> b -> b
foldTM a -> b -> b
k (AltMap a -> GenMap CoreMapX a
forall a. AltMap a -> CoreMapG a
am_deflt AltMap a
m)
        (b -> b) -> (b -> b) -> b -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GenMap CoreMapX a -> b -> b)
-> UniqDFM Name (GenMap CoreMapX a) -> b -> b
forall (m :: * -> *) a b.
TrieMap m =>
(a -> b -> b) -> m a -> b -> b
foldTM ((a -> b -> b) -> GenMap CoreMapX a -> b -> b
forall (m :: * -> *) a b.
TrieMap m =>
(a -> b -> b) -> m a -> b -> b
foldTM a -> b -> b
k) (AltMap a -> UniqDFM Name (GenMap CoreMapX a)
forall a. AltMap a -> DNameEnv (CoreMapG a)
am_data AltMap a
m)
        (b -> b) -> (b -> b) -> b -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GenMap CoreMapX a -> b -> b)
-> Map Literal (GenMap CoreMapX a) -> b -> b
forall (m :: * -> *) a b.
TrieMap m =>
(a -> b -> b) -> m a -> b -> b
foldTM ((a -> b -> b) -> GenMap CoreMapX a -> b -> b
forall (m :: * -> *) a b.
TrieMap m =>
(a -> b -> b) -> m a -> b -> b
foldTM a -> b -> b
k) (AltMap a -> Map Literal (GenMap CoreMapX a)
forall a. AltMap a -> LiteralMap (CoreMapG a)
am_lit AltMap a
m)