{-# LANGUAGE CPP, FlexibleContexts #-}
module Test.Inspection.Core
( slice
, pprSlice
, pprSliceDifference
, eqSlice
, freeOfType
, freeOfTerm
, doesNotAllocate
, doesNotContainTypeClasses
) where
import CoreSyn
import CoreUtils
import TyCoRep
import Type
import Var
import Id
import Name
import VarEnv
import Outputable
import PprCore
import Coercion
import Util
import DataCon
import TyCon (TyCon, isClassTyCon)
import qualified Data.Set as S
import Control.Monad.State.Strict
import Control.Monad.Trans.Maybe
import Data.List (nub)
import Data.Maybe
type Slice = [(Var, CoreExpr)]
slice :: [(Var, CoreExpr)] -> Var -> Slice
slice :: [(Var, CoreExpr)] -> Var -> [(Var, CoreExpr)]
slice binds :: [(Var, CoreExpr)]
binds v :: Var
v
| Just e :: CoreExpr
e <- Var -> [(Var, CoreExpr)] -> Maybe CoreExpr
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Var
v [(Var, CoreExpr)]
binds
= (Var
v,CoreExpr
e) (Var, CoreExpr) -> [(Var, CoreExpr)] -> [(Var, CoreExpr)]
forall a. a -> [a] -> [a]
: [(Var
v',CoreExpr
e) | (v' :: Var
v',e :: CoreExpr
e) <- [(Var, CoreExpr)]
binds, Var
v' Var -> Var -> Bool
forall a. Eq a => a -> a -> Bool
/= Var
v, Var
v' Var -> Set Var -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set Var
used ]
| Bool
otherwise
= [Char] -> [(Var, CoreExpr)]
forall a. HasCallStack => [Char] -> a
error "slice: cannot find given variable in bindings"
where
used :: Set Var
used = State (Set Var) () -> Set Var -> Set Var
forall s a. State s a -> s -> s
execState (Var -> State (Set Var) ()
forall (m :: * -> *). MonadState (Set Var) m => Var -> m ()
goV Var
v) Set Var
forall a. Set a
S.empty
local :: Set Var
local = [Var] -> Set Var
forall a. Ord a => [a] -> Set a
S.fromList (((Var, CoreExpr) -> Var) -> [(Var, CoreExpr)] -> [Var]
forall a b. (a -> b) -> [a] -> [b]
map (Var, CoreExpr) -> Var
forall a b. (a, b) -> a
fst [(Var, CoreExpr)]
binds)
goV :: Var -> m ()
goV v :: Var
v | Var
v Var -> Set Var -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set Var
local = do
Bool
seen <- (Set Var -> Bool) -> m Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (Var
v Var -> Set Var -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member`)
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
seen (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
(Set Var -> Set Var) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (Var -> Set Var -> Set Var
forall a. Ord a => a -> Set a -> Set a
S.insert Var
v)
let Just e :: CoreExpr
e = Var -> [(Var, CoreExpr)] -> Maybe CoreExpr
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Var
v [(Var, CoreExpr)]
binds
CoreExpr -> m ()
go CoreExpr
e
| Bool
otherwise = () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
go :: CoreExpr -> m ()
go (Var v :: Var
v) = Var -> m ()
goV Var
v
go (Lit _ ) = () -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
go (App e :: CoreExpr
e arg :: CoreExpr
arg) | CoreExpr -> Bool
forall b. Expr b -> Bool
isTyCoArg CoreExpr
arg = CoreExpr -> m ()
go CoreExpr
e
go (App e :: CoreExpr
e arg :: CoreExpr
arg) = CoreExpr -> m ()
go CoreExpr
e m () -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> CoreExpr -> m ()
go CoreExpr
arg
go (Lam _ e :: CoreExpr
e) = CoreExpr -> m ()
go CoreExpr
e
go (Let bind :: Bind Var
bind body :: CoreExpr
body) = (CoreExpr -> m ()) -> [CoreExpr] -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ CoreExpr -> m ()
go (Bind Var -> [CoreExpr]
forall b. Bind b -> [Expr b]
rhssOfBind Bind Var
bind) m () -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> CoreExpr -> m ()
go CoreExpr
body
go (Case s :: CoreExpr
s _ _ alts :: [Alt Var]
alts) = CoreExpr -> m ()
go CoreExpr
s m () -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Alt Var -> m ()) -> [Alt Var] -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Alt Var -> m ()
goA [Alt Var]
alts
go (Cast e :: CoreExpr
e _) = CoreExpr -> m ()
go CoreExpr
e
go (Tick _ e :: CoreExpr
e) = CoreExpr -> m ()
go CoreExpr
e
go (Type _) = () -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
go (Coercion _) = () -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
goA :: Alt Var -> m ()
goA (_, _, e :: CoreExpr
e) = CoreExpr -> m ()
go CoreExpr
e
pprSlice :: Slice -> SDoc
pprSlice :: [(Var, CoreExpr)] -> SDoc
pprSlice slice :: [(Var, CoreExpr)]
slice =
SDoc -> SDoc
withLessDetail (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ [Bind Var] -> SDoc
forall b. OutputableBndr b => [Bind b] -> SDoc
pprCoreBindings [ Var -> CoreExpr -> Bind Var
forall b. b -> Expr b -> Bind b
NonRec Var
v CoreExpr
e | (v :: Var
v,e :: CoreExpr
e) <- [(Var, CoreExpr)]
slice ]
pprSliceDifference :: Slice -> Slice -> SDoc
pprSliceDifference :: [(Var, CoreExpr)] -> [(Var, CoreExpr)] -> SDoc
pprSliceDifference slice1 :: [(Var, CoreExpr)]
slice1 slice2 :: [(Var, CoreExpr)]
slice2 =
Int -> SDoc -> SDoc
nest 4 (SDoc -> Int -> SDoc -> SDoc
hang ([Char] -> SDoc
text "LHS" SDoc -> SDoc -> SDoc
Outputable.<> SDoc
colon) 4 ([(Var, CoreExpr)] -> SDoc
pprSlice [(Var, CoreExpr)]
slice1')) SDoc -> SDoc -> SDoc
$$
Int -> SDoc -> SDoc
nest 4 (SDoc -> Int -> SDoc -> SDoc
hang ([Char] -> SDoc
text "RHS" SDoc -> SDoc -> SDoc
Outputable.<> SDoc
colon) 4 ([(Var, CoreExpr)] -> SDoc
pprSlice [(Var, CoreExpr)]
slice2'))
where
both :: Set Var
both = Set Var -> Set Var -> Set Var
forall a. Ord a => Set a -> Set a -> Set a
S.intersection ([Var] -> Set Var
forall a. Ord a => [a] -> Set a
S.fromList (((Var, CoreExpr) -> Var) -> [(Var, CoreExpr)] -> [Var]
forall a b. (a -> b) -> [a] -> [b]
map (Var, CoreExpr) -> Var
forall a b. (a, b) -> a
fst [(Var, CoreExpr)]
slice1)) ([Var] -> Set Var
forall a. Ord a => [a] -> Set a
S.fromList (((Var, CoreExpr) -> Var) -> [(Var, CoreExpr)] -> [Var]
forall a b. (a -> b) -> [a] -> [b]
map (Var, CoreExpr) -> Var
forall a b. (a, b) -> a
fst [(Var, CoreExpr)]
slice2))
slice1' :: [(Var, CoreExpr)]
slice1' = ((Var, CoreExpr) -> Bool) -> [(Var, CoreExpr)] -> [(Var, CoreExpr)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(v :: Var
v,_) -> Var
v Var -> Set Var -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.notMember` Set Var
both) [(Var, CoreExpr)]
slice1
slice2' :: [(Var, CoreExpr)]
slice2' = ((Var, CoreExpr) -> Bool) -> [(Var, CoreExpr)] -> [(Var, CoreExpr)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(v :: Var
v,_) -> Var
v Var -> Set Var -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.notMember` Set Var
both) [(Var, CoreExpr)]
slice2
withLessDetail :: SDoc -> SDoc
#if MIN_VERSION_GLASGOW_HASKELL(8,2,0,0)
withLessDetail :: SDoc -> SDoc
withLessDetail sdoc :: SDoc
sdoc = (DynFlags -> SDoc) -> SDoc
sdocWithDynFlags ((DynFlags -> SDoc) -> SDoc) -> (DynFlags -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \dflags :: DynFlags
dflags ->
PprStyle -> SDoc -> SDoc
withPprStyle (DynFlags -> PprStyle
defaultUserStyle DynFlags
dflags) SDoc
sdoc
#else
withLessDetail sdoc = withPprStyle defaultUserStyle sdoc
#endif
type VarPair = (Var, Var)
type VarPairSet = S.Set VarPair
eqSlice :: Bool -> Slice -> Slice -> Bool
eqSlice :: Bool -> [(Var, CoreExpr)] -> [(Var, CoreExpr)] -> Bool
eqSlice _ slice1 :: [(Var, CoreExpr)]
slice1 slice2 :: [(Var, CoreExpr)]
slice2 | [(Var, CoreExpr)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Var, CoreExpr)]
slice1 Bool -> Bool -> Bool
|| [(Var, CoreExpr)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Var, CoreExpr)]
slice2 = [(Var, CoreExpr)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Var, CoreExpr)]
slice1 Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== [(Var, CoreExpr)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Var, CoreExpr)]
slice2
eqSlice it :: Bool
it slice1 :: [(Var, CoreExpr)]
slice1 slice2 :: [(Var, CoreExpr)]
slice2
= VarPairSet -> VarPairSet -> Bool
step ((Var, Var) -> VarPairSet
forall a. a -> Set a
S.singleton ((Var, CoreExpr) -> Var
forall a b. (a, b) -> a
fst ([(Var, CoreExpr)] -> (Var, CoreExpr)
forall a. [a] -> a
head [(Var, CoreExpr)]
slice1), (Var, CoreExpr) -> Var
forall a b. (a, b) -> a
fst ([(Var, CoreExpr)] -> (Var, CoreExpr)
forall a. [a] -> a
head [(Var, CoreExpr)]
slice2))) VarPairSet
forall a. Set a
S.empty
where
step :: VarPairSet -> VarPairSet -> Bool
step :: VarPairSet -> VarPairSet -> Bool
step wanted :: VarPairSet
wanted done :: VarPairSet
done
| VarPairSet
wanted VarPairSet -> VarPairSet -> Bool
forall a. Ord a => Set a -> Set a -> Bool
`S.isSubsetOf` VarPairSet
done
= Bool
True
| (x :: Var
x,y :: Var
y) : _ <- VarPairSet -> [(Var, Var)]
forall a. Set a -> [a]
S.toList (VarPairSet
wanted VarPairSet -> VarPairSet -> VarPairSet
forall a. Ord a => Set a -> Set a -> Set a
`S.difference` VarPairSet
done)
, (Just _, wanted' :: VarPairSet
wanted') <- State VarPairSet (Maybe ()) -> VarPairSet -> (Maybe (), VarPairSet)
forall s a. State s a -> s -> (a, s)
runState (MaybeT (State VarPairSet) () -> State VarPairSet (Maybe ())
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (Var -> Var -> MaybeT (State VarPairSet) ()
equate Var
x Var
y)) VarPairSet
wanted
= VarPairSet -> VarPairSet -> Bool
step VarPairSet
wanted' ((Var, Var) -> VarPairSet -> VarPairSet
forall a. Ord a => a -> Set a -> Set a
S.insert (Var
x,Var
y) VarPairSet
done)
| Bool
otherwise
= Bool
False
equate :: Var -> Var -> MaybeT (State VarPairSet) ()
equate :: Var -> Var -> MaybeT (State VarPairSet) ()
equate x :: Var
x y :: Var
y
| Just e1 :: CoreExpr
e1 <- Var -> [(Var, CoreExpr)] -> Maybe CoreExpr
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Var
x [(Var, CoreExpr)]
slice1
, Just x' :: Var
x' <- CoreExpr -> Maybe Var
essentiallyVar CoreExpr
e1
, Var
x' Var -> [Var] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ((Var, CoreExpr) -> Var) -> [(Var, CoreExpr)] -> [Var]
forall a b. (a -> b) -> [a] -> [b]
map (Var, CoreExpr) -> Var
forall a b. (a, b) -> a
fst [(Var, CoreExpr)]
slice1
= State VarPairSet () -> MaybeT (State VarPairSet) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (State VarPairSet () -> MaybeT (State VarPairSet) ())
-> State VarPairSet () -> MaybeT (State VarPairSet) ()
forall a b. (a -> b) -> a -> b
$ (VarPairSet -> VarPairSet) -> State VarPairSet ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((Var, Var) -> VarPairSet -> VarPairSet
forall a. Ord a => a -> Set a -> Set a
S.insert (Var
x',Var
y))
| Just e2 :: CoreExpr
e2 <- Var -> [(Var, CoreExpr)] -> Maybe CoreExpr
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Var
y [(Var, CoreExpr)]
slice2
, Just y' :: Var
y' <- CoreExpr -> Maybe Var
essentiallyVar CoreExpr
e2
, Var
y' Var -> [Var] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ((Var, CoreExpr) -> Var) -> [(Var, CoreExpr)] -> [Var]
forall a b. (a -> b) -> [a] -> [b]
map (Var, CoreExpr) -> Var
forall a b. (a, b) -> a
fst [(Var, CoreExpr)]
slice2
= State VarPairSet () -> MaybeT (State VarPairSet) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (State VarPairSet () -> MaybeT (State VarPairSet) ())
-> State VarPairSet () -> MaybeT (State VarPairSet) ()
forall a b. (a -> b) -> a -> b
$ (VarPairSet -> VarPairSet) -> State VarPairSet ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((Var, Var) -> VarPairSet -> VarPairSet
forall a. Ord a => a -> Set a -> Set a
S.insert (Var
x,Var
y'))
| Just e1 :: CoreExpr
e1 <- Var -> [(Var, CoreExpr)] -> Maybe CoreExpr
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Var
x [(Var, CoreExpr)]
slice1
, Just e2 :: CoreExpr
e2 <- Var -> [(Var, CoreExpr)] -> Maybe CoreExpr
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Var
y [(Var, CoreExpr)]
slice2
= RnEnv2 -> CoreExpr -> CoreExpr -> MaybeT (State VarPairSet) ()
go (InScopeSet -> RnEnv2
mkRnEnv2 InScopeSet
emptyInScopeSet) CoreExpr
e1 CoreExpr
e2
equate _ _ = MaybeT (State VarPairSet) ()
forall (m :: * -> *) a. MonadPlus m => m a
mzero
equated :: Var -> Var -> MaybeT (State VarPairSet) ()
equated :: Var -> Var -> MaybeT (State VarPairSet) ()
equated x :: Var
x y :: Var
y | Var
x Var -> Var -> Bool
forall a. Eq a => a -> a -> Bool
== Var
y = () -> MaybeT (State VarPairSet) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
equated x :: Var
x y :: Var
y = State VarPairSet () -> MaybeT (State VarPairSet) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (State VarPairSet () -> MaybeT (State VarPairSet) ())
-> State VarPairSet () -> MaybeT (State VarPairSet) ()
forall a b. (a -> b) -> a -> b
$ (VarPairSet -> VarPairSet) -> State VarPairSet ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((Var, Var) -> VarPairSet -> VarPairSet
forall a. Ord a => a -> Set a -> Set a
S.insert (Var
x,Var
y))
essentiallyVar :: CoreExpr -> Maybe Var
essentiallyVar :: CoreExpr -> Maybe Var
essentiallyVar (App e :: CoreExpr
e a :: CoreExpr
a) | Bool
it, CoreExpr -> Bool
forall b. Expr b -> Bool
isTyCoArg CoreExpr
a = CoreExpr -> Maybe Var
essentiallyVar CoreExpr
e
essentiallyVar (Lam v :: Var
v e :: CoreExpr
e) | Bool
it, Var -> Bool
isTyCoVar Var
v = CoreExpr -> Maybe Var
essentiallyVar CoreExpr
e
essentiallyVar (Cast e :: CoreExpr
e _) | Bool
it = CoreExpr -> Maybe Var
essentiallyVar CoreExpr
e
essentiallyVar (Var v :: Var
v) = Var -> Maybe Var
forall a. a -> Maybe a
Just Var
v
essentiallyVar _ = Maybe Var
forall a. Maybe a
Nothing
go :: RnEnv2 -> CoreExpr -> CoreExpr -> MaybeT (State (S.Set (Var,Var))) ()
go :: RnEnv2 -> CoreExpr -> CoreExpr -> MaybeT (State VarPairSet) ()
go env :: RnEnv2
env (Var v1 :: Var
v1) (Var v2 :: Var
v2) | RnEnv2 -> Var -> Var
rnOccL RnEnv2
env Var
v1 Var -> Var -> Bool
forall a. Eq a => a -> a -> Bool
== RnEnv2 -> Var -> Var
rnOccR RnEnv2
env Var
v2 = () -> MaybeT (State VarPairSet) ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
| Bool
otherwise = Var -> Var -> MaybeT (State VarPairSet) ()
equated Var
v1 Var
v2
go _ (Lit lit1 :: Literal
lit1) (Lit lit2 :: Literal
lit2) = Bool -> MaybeT (State VarPairSet) ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> MaybeT (State VarPairSet) ())
-> Bool -> MaybeT (State VarPairSet) ()
forall a b. (a -> b) -> a -> b
$ Literal
lit1 Literal -> Literal -> Bool
forall a. Eq a => a -> a -> Bool
== Literal
lit2
go env :: RnEnv2
env (Type t1 :: Type
t1) (Type t2 :: Type
t2) = Bool -> MaybeT (State VarPairSet) ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> MaybeT (State VarPairSet) ())
-> Bool -> MaybeT (State VarPairSet) ()
forall a b. (a -> b) -> a -> b
$ RnEnv2 -> Type -> Type -> Bool
eqTypeX RnEnv2
env Type
t1 Type
t2
go env :: RnEnv2
env (Coercion co1 :: Coercion
co1) (Coercion co2 :: Coercion
co2) = Bool -> MaybeT (State VarPairSet) ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> MaybeT (State VarPairSet) ())
-> Bool -> MaybeT (State VarPairSet) ()
forall a b. (a -> b) -> a -> b
$ RnEnv2 -> Coercion -> Coercion -> Bool
eqCoercionX RnEnv2
env Coercion
co1 Coercion
co2
go env :: RnEnv2
env (Cast e1 :: CoreExpr
e1 _) e2 :: CoreExpr
e2 | Bool
it = RnEnv2 -> CoreExpr -> CoreExpr -> MaybeT (State VarPairSet) ()
go RnEnv2
env CoreExpr
e1 CoreExpr
e2
go env :: RnEnv2
env e1 :: CoreExpr
e1 (Cast e2 :: CoreExpr
e2 _) | Bool
it = RnEnv2 -> CoreExpr -> CoreExpr -> MaybeT (State VarPairSet) ()
go RnEnv2
env CoreExpr
e1 CoreExpr
e2
go env :: RnEnv2
env (Cast e1 :: CoreExpr
e1 co1 :: Coercion
co1) (Cast e2 :: CoreExpr
e2 co2 :: Coercion
co2) = do Bool -> MaybeT (State VarPairSet) ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (RnEnv2 -> Coercion -> Coercion -> Bool
eqCoercionX RnEnv2
env Coercion
co1 Coercion
co2)
RnEnv2 -> CoreExpr -> CoreExpr -> MaybeT (State VarPairSet) ()
go RnEnv2
env CoreExpr
e1 CoreExpr
e2
go env :: RnEnv2
env (App e1 :: CoreExpr
e1 a :: CoreExpr
a) e2 :: CoreExpr
e2 | Bool
it, CoreExpr -> Bool
forall b. Expr b -> Bool
isTyCoArg CoreExpr
a = RnEnv2 -> CoreExpr -> CoreExpr -> MaybeT (State VarPairSet) ()
go RnEnv2
env CoreExpr
e1 CoreExpr
e2
go env :: RnEnv2
env e1 :: CoreExpr
e1 (App e2 :: CoreExpr
e2 a :: CoreExpr
a) | Bool
it, CoreExpr -> Bool
forall b. Expr b -> Bool
isTyCoArg CoreExpr
a = RnEnv2 -> CoreExpr -> CoreExpr -> MaybeT (State VarPairSet) ()
go RnEnv2
env CoreExpr
e1 CoreExpr
e2
go env :: RnEnv2
env (App f1 :: CoreExpr
f1 a1 :: CoreExpr
a1) (App f2 :: CoreExpr
f2 a2 :: CoreExpr
a2) = RnEnv2 -> CoreExpr -> CoreExpr -> MaybeT (State VarPairSet) ()
go RnEnv2
env CoreExpr
f1 CoreExpr
f2 MaybeT (State VarPairSet) ()
-> MaybeT (State VarPairSet) () -> MaybeT (State VarPairSet) ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> RnEnv2 -> CoreExpr -> CoreExpr -> MaybeT (State VarPairSet) ()
go RnEnv2
env CoreExpr
a1 CoreExpr
a2
go env :: RnEnv2
env (Tick n1 :: Tickish Var
n1 e1 :: CoreExpr
e1) (Tick n2 :: Tickish Var
n2 e2 :: CoreExpr
e2) = Bool -> MaybeT (State VarPairSet) ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (RnEnv2 -> Tickish Var -> Tickish Var -> Bool
go_tick RnEnv2
env Tickish Var
n1 Tickish Var
n2) MaybeT (State VarPairSet) ()
-> MaybeT (State VarPairSet) () -> MaybeT (State VarPairSet) ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> RnEnv2 -> CoreExpr -> CoreExpr -> MaybeT (State VarPairSet) ()
go RnEnv2
env CoreExpr
e1 CoreExpr
e2
go env :: RnEnv2
env (Lam b :: Var
b e1 :: CoreExpr
e1) e2 :: CoreExpr
e2 | Bool
it, Var -> Bool
isTyCoVar Var
b = RnEnv2 -> CoreExpr -> CoreExpr -> MaybeT (State VarPairSet) ()
go RnEnv2
env CoreExpr
e1 CoreExpr
e2
go env :: RnEnv2
env e1 :: CoreExpr
e1 (Lam b :: Var
b e2 :: CoreExpr
e2) | Bool
it, Var -> Bool
isTyCoVar Var
b = RnEnv2 -> CoreExpr -> CoreExpr -> MaybeT (State VarPairSet) ()
go RnEnv2
env CoreExpr
e1 CoreExpr
e2
go env :: RnEnv2
env (Lam b1 :: Var
b1 e1 :: CoreExpr
e1) (Lam b2 :: Var
b2 e2 :: CoreExpr
e2)
= do Bool -> MaybeT (State VarPairSet) ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool
it Bool -> Bool -> Bool
|| RnEnv2 -> Type -> Type -> Bool
eqTypeX RnEnv2
env (Var -> Type
varType Var
b1) (Var -> Type
varType Var
b2))
RnEnv2 -> CoreExpr -> CoreExpr -> MaybeT (State VarPairSet) ()
go (RnEnv2 -> Var -> Var -> RnEnv2
rnBndr2 RnEnv2
env Var
b1 Var
b2) CoreExpr
e1 CoreExpr
e2
go env :: RnEnv2
env (Let (NonRec v1 :: Var
v1 r1 :: CoreExpr
r1) e1 :: CoreExpr
e1) (Let (NonRec v2 :: Var
v2 r2 :: CoreExpr
r2) e2 :: CoreExpr
e2)
= do RnEnv2 -> CoreExpr -> CoreExpr -> MaybeT (State VarPairSet) ()
go RnEnv2
env CoreExpr
r1 CoreExpr
r2
RnEnv2 -> CoreExpr -> CoreExpr -> MaybeT (State VarPairSet) ()
go (RnEnv2 -> Var -> Var -> RnEnv2
rnBndr2 RnEnv2
env Var
v1 Var
v2) CoreExpr
e1 CoreExpr
e2
go env :: RnEnv2
env (Let (Rec ps1 :: [(Var, CoreExpr)]
ps1) e1 :: CoreExpr
e1) (Let (Rec ps2 :: [(Var, CoreExpr)]
ps2) e2 :: CoreExpr
e2)
= do Bool -> MaybeT (State VarPairSet) ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> MaybeT (State VarPairSet) ())
-> Bool -> MaybeT (State VarPairSet) ()
forall a b. (a -> b) -> a -> b
$ [(Var, CoreExpr)] -> [(Var, CoreExpr)] -> Bool
forall a b. [a] -> [b] -> Bool
equalLength [(Var, CoreExpr)]
ps1 [(Var, CoreExpr)]
ps2
[MaybeT (State VarPairSet) ()] -> MaybeT (State VarPairSet) ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ ([MaybeT (State VarPairSet) ()] -> MaybeT (State VarPairSet) ())
-> [MaybeT (State VarPairSet) ()] -> MaybeT (State VarPairSet) ()
forall a b. (a -> b) -> a -> b
$ (CoreExpr -> CoreExpr -> MaybeT (State VarPairSet) ())
-> [CoreExpr] -> [CoreExpr] -> [MaybeT (State VarPairSet) ()]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (RnEnv2 -> CoreExpr -> CoreExpr -> MaybeT (State VarPairSet) ()
go RnEnv2
env') [CoreExpr]
rs1 [CoreExpr]
rs2
RnEnv2 -> CoreExpr -> CoreExpr -> MaybeT (State VarPairSet) ()
go RnEnv2
env' CoreExpr
e1 CoreExpr
e2
where
(bs1 :: [Var]
bs1,rs1 :: [CoreExpr]
rs1) = [(Var, CoreExpr)] -> ([Var], [CoreExpr])
forall a b. [(a, b)] -> ([a], [b])
unzip [(Var, CoreExpr)]
ps1
(bs2 :: [Var]
bs2,rs2 :: [CoreExpr]
rs2) = [(Var, CoreExpr)] -> ([Var], [CoreExpr])
forall a b. [(a, b)] -> ([a], [b])
unzip [(Var, CoreExpr)]
ps2
env' :: RnEnv2
env' = RnEnv2 -> [Var] -> [Var] -> RnEnv2
rnBndrs2 RnEnv2
env [Var]
bs1 [Var]
bs2
go env :: RnEnv2
env (Case e1 :: CoreExpr
e1 b1 :: Var
b1 t1 :: Type
t1 a1 :: [Alt Var]
a1) (Case e2 :: CoreExpr
e2 b2 :: Var
b2 t2 :: Type
t2 a2 :: [Alt Var]
a2)
| [Alt Var] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Alt Var]
a1
= do Bool -> MaybeT (State VarPairSet) ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard ([Alt Var] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Alt Var]
a2)
RnEnv2 -> CoreExpr -> CoreExpr -> MaybeT (State VarPairSet) ()
go RnEnv2
env CoreExpr
e1 CoreExpr
e2
Bool -> MaybeT (State VarPairSet) ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool
it Bool -> Bool -> Bool
|| RnEnv2 -> Type -> Type -> Bool
eqTypeX RnEnv2
env Type
t1 Type
t2)
| Bool
otherwise
= do Bool -> MaybeT (State VarPairSet) ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> MaybeT (State VarPairSet) ())
-> Bool -> MaybeT (State VarPairSet) ()
forall a b. (a -> b) -> a -> b
$ [Alt Var] -> [Alt Var] -> Bool
forall a b. [a] -> [b] -> Bool
equalLength [Alt Var]
a1 [Alt Var]
a2
RnEnv2 -> CoreExpr -> CoreExpr -> MaybeT (State VarPairSet) ()
go RnEnv2
env CoreExpr
e1 CoreExpr
e2
[MaybeT (State VarPairSet) ()] -> MaybeT (State VarPairSet) ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ ([MaybeT (State VarPairSet) ()] -> MaybeT (State VarPairSet) ())
-> [MaybeT (State VarPairSet) ()] -> MaybeT (State VarPairSet) ()
forall a b. (a -> b) -> a -> b
$ (Alt Var -> Alt Var -> MaybeT (State VarPairSet) ())
-> [Alt Var] -> [Alt Var] -> [MaybeT (State VarPairSet) ()]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (RnEnv2 -> Alt Var -> Alt Var -> MaybeT (State VarPairSet) ()
forall a.
Eq a =>
RnEnv2
-> (a, [Var], CoreExpr)
-> (a, [Var], CoreExpr)
-> MaybeT (State VarPairSet) ()
go_alt (RnEnv2 -> Var -> Var -> RnEnv2
rnBndr2 RnEnv2
env Var
b1 Var
b2)) [Alt Var]
a1 [Alt Var]
a2
go _ _ _ = Bool -> MaybeT (State VarPairSet) ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard Bool
False
go_alt :: RnEnv2
-> (a, [Var], CoreExpr)
-> (a, [Var], CoreExpr)
-> MaybeT (State VarPairSet) ()
go_alt env :: RnEnv2
env (c1 :: a
c1, bs1 :: [Var]
bs1, e1 :: CoreExpr
e1) (c2 :: a
c2, bs2 :: [Var]
bs2, e2 :: CoreExpr
e2)
= Bool -> MaybeT (State VarPairSet) ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (a
c1 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
c2) MaybeT (State VarPairSet) ()
-> MaybeT (State VarPairSet) () -> MaybeT (State VarPairSet) ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> RnEnv2 -> CoreExpr -> CoreExpr -> MaybeT (State VarPairSet) ()
go (RnEnv2 -> [Var] -> [Var] -> RnEnv2
rnBndrs2 RnEnv2
env [Var]
bs1 [Var]
bs2) CoreExpr
e1 CoreExpr
e2
go_tick :: RnEnv2 -> Tickish Id -> Tickish Id -> Bool
go_tick :: RnEnv2 -> Tickish Var -> Tickish Var -> Bool
go_tick env :: RnEnv2
env (Breakpoint lid :: Int
lid lids :: [Var]
lids) (Breakpoint rid :: Int
rid rids :: [Var]
rids)
= Int
lid Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
rid Bool -> Bool -> Bool
&& (Var -> Var) -> [Var] -> [Var]
forall a b. (a -> b) -> [a] -> [b]
map (RnEnv2 -> Var -> Var
rnOccL RnEnv2
env) [Var]
lids [Var] -> [Var] -> Bool
forall a. Eq a => a -> a -> Bool
== (Var -> Var) -> [Var] -> [Var]
forall a b. (a -> b) -> [a] -> [b]
map (RnEnv2 -> Var -> Var
rnOccR RnEnv2
env) [Var]
rids
go_tick _ l :: Tickish Var
l r :: Tickish Var
r = Tickish Var
l Tickish Var -> Tickish Var -> Bool
forall a. Eq a => a -> a -> Bool
== Tickish Var
r
freeOfType :: Slice -> [Name] -> Maybe (Var, CoreExpr)
freeOfType :: [(Var, CoreExpr)] -> [Name] -> Maybe (Var, CoreExpr)
freeOfType slice :: [(Var, CoreExpr)]
slice tcNs :: [Name]
tcNs =
((Var, CoreExpr, [TyCon]) -> (Var, CoreExpr))
-> Maybe (Var, CoreExpr, [TyCon]) -> Maybe (Var, CoreExpr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(a :: Var
a,b :: CoreExpr
b,_) -> (Var
a,CoreExpr
b))
(Maybe (Var, CoreExpr, [TyCon]) -> Maybe (Var, CoreExpr))
-> Maybe (Var, CoreExpr, [TyCon]) -> Maybe (Var, CoreExpr)
forall a b. (a -> b) -> a -> b
$ (TyCon -> Bool)
-> [(Var, CoreExpr)] -> Maybe (Var, CoreExpr, [TyCon])
allTyCons (\tc :: TyCon
tc -> TyCon -> Name
forall a. NamedThing a => a -> Name
getName TyCon
tc Name -> [Name] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Name]
tcNs) [(Var, CoreExpr)]
slice
allTyCons :: (TyCon -> Bool) -> Slice -> Maybe (Var, CoreExpr, [TyCon])
allTyCons :: (TyCon -> Bool)
-> [(Var, CoreExpr)] -> Maybe (Var, CoreExpr, [TyCon])
allTyCons ignore :: TyCon -> Bool
ignore slice :: [(Var, CoreExpr)]
slice =
[(Var, CoreExpr, [TyCon])] -> Maybe (Var, CoreExpr, [TyCon])
forall a. [a] -> Maybe a
listToMaybe
[(Var
v, CoreExpr
e, [TyCon] -> [TyCon]
forall a. Eq a => [a] -> [a]
nub [TyCon]
tcs) | (v :: Var
v, e :: CoreExpr
e) <- [(Var, CoreExpr)]
slice, let tcs :: [TyCon]
tcs = CoreExpr -> [TyCon]
go CoreExpr
e, Bool -> Bool
not ([TyCon] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TyCon]
tcs)]
where
goV :: Var -> [TyCon]
goV v :: Var
v = Type -> [TyCon]
goT (Var -> Type
varType Var
v)
go :: CoreExpr -> [TyCon]
go (Var v :: Var
v) = Var -> [TyCon]
goV Var
v
go (Lit _) = []
go (App e :: CoreExpr
e a :: CoreExpr
a) = CoreExpr -> [TyCon]
go CoreExpr
e [TyCon] -> [TyCon] -> [TyCon]
forall a. [a] -> [a] -> [a]
++ CoreExpr -> [TyCon]
go CoreExpr
a
go (Lam b :: Var
b e :: CoreExpr
e) = Var -> [TyCon]
goV Var
b [TyCon] -> [TyCon] -> [TyCon]
forall a. [a] -> [a] -> [a]
++ CoreExpr -> [TyCon]
go CoreExpr
e
go (Let bind :: Bind Var
bind body :: CoreExpr
body) = ((Var, CoreExpr) -> [TyCon]) -> [(Var, CoreExpr)] -> [TyCon]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Var, CoreExpr) -> [TyCon]
goB ([Bind Var] -> [(Var, CoreExpr)]
forall b. [Bind b] -> [(b, Expr b)]
flattenBinds [Bind Var
bind]) [TyCon] -> [TyCon] -> [TyCon]
forall a. [a] -> [a] -> [a]
++ CoreExpr -> [TyCon]
go CoreExpr
body
go (Case s :: CoreExpr
s b :: Var
b _ alts :: [Alt Var]
alts) = CoreExpr -> [TyCon]
go CoreExpr
s [TyCon] -> [TyCon] -> [TyCon]
forall a. [a] -> [a] -> [a]
++ Var -> [TyCon]
goV Var
b [TyCon] -> [TyCon] -> [TyCon]
forall a. [a] -> [a] -> [a]
++ (Alt Var -> [TyCon]) -> [Alt Var] -> [TyCon]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Alt Var -> [TyCon]
goA [Alt Var]
alts
go (Cast e :: CoreExpr
e _) = CoreExpr -> [TyCon]
go CoreExpr
e
go (Tick _ e :: CoreExpr
e) = CoreExpr -> [TyCon]
go CoreExpr
e
go (Type t :: Type
t) = (Type -> [TyCon]
goT Type
t)
go (Coercion _) = []
goB :: (Var, CoreExpr) -> [TyCon]
goB (b :: Var
b, e :: CoreExpr
e) = Var -> [TyCon]
goV Var
b [TyCon] -> [TyCon] -> [TyCon]
forall a. [a] -> [a] -> [a]
++ CoreExpr -> [TyCon]
go CoreExpr
e
goA :: Alt Var -> [TyCon]
goA (_,pats :: [Var]
pats, e :: CoreExpr
e) = (Var -> [TyCon]) -> [Var] -> [TyCon]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Var -> [TyCon]
goV [Var]
pats [TyCon] -> [TyCon] -> [TyCon]
forall a. [a] -> [a] -> [a]
++ CoreExpr -> [TyCon]
go CoreExpr
e
goT :: Type -> [TyCon]
goT (TyVarTy _) = []
goT (AppTy t1 :: Type
t1 t2 :: Type
t2) = Type -> [TyCon]
goT Type
t1 [TyCon] -> [TyCon] -> [TyCon]
forall a. [a] -> [a] -> [a]
++ Type -> [TyCon]
goT Type
t2
goT (TyConApp tc :: TyCon
tc ts :: [Type]
ts) = [TyCon
tc | Bool -> Bool
not (TyCon -> Bool
ignore TyCon
tc)] [TyCon] -> [TyCon] -> [TyCon]
forall a. [a] -> [a] -> [a]
++ (Type -> [TyCon]) -> [Type] -> [TyCon]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Type -> [TyCon]
goT [Type]
ts
goT (ForAllTy _ t :: Type
t) = Type -> [TyCon]
goT Type
t
#if MIN_VERSION_GLASGOW_HASKELL(8,2,0,0)
goT (FunTy
# if MIN_VERSION_GLASGOW_HASKELL(8,9,0,0)
_
# endif
t1 :: Type
t1 t2 :: Type
t2) = Type -> [TyCon]
goT Type
t1 [TyCon] -> [TyCon] -> [TyCon]
forall a. [a] -> [a] -> [a]
++ Type -> [TyCon]
goT Type
t2
#endif
goT (LitTy _) = []
goT (CastTy t :: Type
t _) = Type -> [TyCon]
goT Type
t
goT (CoercionTy _) = []
freeOfTerm :: Slice -> [Name] -> Maybe (Var, CoreExpr)
freeOfTerm :: [(Var, CoreExpr)] -> [Name] -> Maybe (Var, CoreExpr)
freeOfTerm slice :: [(Var, CoreExpr)]
slice needles :: [Name]
needles = [(Var, CoreExpr)] -> Maybe (Var, CoreExpr)
forall a. [a] -> Maybe a
listToMaybe [ (Var
v,CoreExpr
e) | (v :: Var
v,e :: CoreExpr
e) <- [(Var, CoreExpr)]
slice, Bool -> Bool
not (CoreExpr -> Bool
forall b. Expr b -> Bool
go CoreExpr
e) ]
where
isNeedle :: Name -> Bool
isNeedle n :: Name
n = Name
n Name -> [Name] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Name]
needles
goV :: Var -> Bool
goV v :: Var
v | Name -> Bool
isNeedle (Var -> Name
Var.varName Var
v) = Bool
False
| Just dc :: DataCon
dc <- Var -> Maybe DataCon
isDataConId_maybe Var
v
, Name -> Bool
isNeedle (DataCon -> Name
dataConName DataCon
dc) = Bool
False
| Bool
otherwise = Bool
True
go :: Expr b -> Bool
go (Var v :: Var
v) = Var -> Bool
goV Var
v
go (Lit _ ) = Bool
True
go (App e :: Expr b
e a :: Expr b
a) = Expr b -> Bool
go Expr b
e Bool -> Bool -> Bool
&& Expr b -> Bool
go Expr b
a
go (Lam _ e :: Expr b
e) = Expr b -> Bool
go Expr b
e
go (Let bind :: Bind b
bind body :: Expr b
body) = ((b, Expr b) -> Bool) -> [(b, Expr b)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (b, Expr b) -> Bool
goB ([Bind b] -> [(b, Expr b)]
forall b. [Bind b] -> [(b, Expr b)]
flattenBinds [Bind b
bind]) Bool -> Bool -> Bool
&& Expr b -> Bool
go Expr b
body
go (Case s :: Expr b
s _ _ alts :: [Alt b]
alts) = Expr b -> Bool
go Expr b
s Bool -> Bool -> Bool
&& (Alt b -> Bool) -> [Alt b] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Alt b -> Bool
goA [Alt b]
alts
go (Cast e :: Expr b
e _) = Expr b -> Bool
go Expr b
e
go (Tick _ e :: Expr b
e) = Expr b -> Bool
go Expr b
e
go (Type _) = Bool
True
go (Coercion _) = Bool
True
goB :: (b, Expr b) -> Bool
goB (_, e :: Expr b
e) = Expr b -> Bool
go Expr b
e
goA :: Alt b -> Bool
goA (ac :: AltCon
ac, _, e :: Expr b
e) = AltCon -> Bool
goAltCon AltCon
ac Bool -> Bool -> Bool
&& Expr b -> Bool
go Expr b
e
goAltCon :: AltCon -> Bool
goAltCon (DataAlt dc :: DataCon
dc) | Name -> Bool
isNeedle (DataCon -> Name
dataConName DataCon
dc) = Bool
False
goAltCon _ = Bool
True
doesNotAllocate :: Slice -> Maybe (Var, CoreExpr)
doesNotAllocate :: [(Var, CoreExpr)] -> Maybe (Var, CoreExpr)
doesNotAllocate slice :: [(Var, CoreExpr)]
slice = [(Var, CoreExpr)] -> Maybe (Var, CoreExpr)
forall a. [a] -> Maybe a
listToMaybe [ (Var
v,CoreExpr
e) | (v :: Var
v,e :: CoreExpr
e) <- [(Var, CoreExpr)]
slice, Bool -> Bool
not (Int -> CoreExpr -> Bool
go (Var -> Int
idArity Var
v) CoreExpr
e) ]
where
go :: Int -> CoreExpr -> Bool
go _ (Var v :: Var
v)
| Var -> Bool
isDataConWorkId Var
v, Var -> Int
idArity Var
v Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0 = Bool
False
go a :: Int
a (Var v :: Var
v) = Int
a Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Var -> Int
idArity Var
v
go _ (Lit _ ) = Bool
True
go a :: Int
a (App e :: CoreExpr
e arg :: CoreExpr
arg) | CoreExpr -> Bool
forall b. Expr b -> Bool
isTypeArg CoreExpr
arg = Int -> CoreExpr -> Bool
go Int
a CoreExpr
e
go a :: Int
a (App e :: CoreExpr
e arg :: CoreExpr
arg) = Int -> CoreExpr -> Bool
go (Int
aInt -> Int -> Int
forall a. Num a => a -> a -> a
+1) CoreExpr
e Bool -> Bool -> Bool
&& CoreExpr -> Bool
goArg CoreExpr
arg
go a :: Int
a (Lam b :: Var
b e :: CoreExpr
e) | Var -> Bool
isTyVar Var
b = Int -> CoreExpr -> Bool
go Int
a CoreExpr
e
go 0 (Lam _ _) = Bool
False
go a :: Int
a (Lam _ e :: CoreExpr
e) = Int -> CoreExpr -> Bool
go (Int
aInt -> Int -> Int
forall a. Num a => a -> a -> a
-1) CoreExpr
e
go a :: Int
a (Let bind :: Bind Var
bind body :: CoreExpr
body) = ((Var, CoreExpr) -> Bool) -> [(Var, CoreExpr)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Var, CoreExpr) -> Bool
goB ([Bind Var] -> [(Var, CoreExpr)]
forall b. [Bind b] -> [(b, Expr b)]
flattenBinds [Bind Var
bind]) Bool -> Bool -> Bool
&& Int -> CoreExpr -> Bool
go Int
a CoreExpr
body
go a :: Int
a (Case s :: CoreExpr
s _ _ alts :: [Alt Var]
alts) = Int -> CoreExpr -> Bool
go 0 CoreExpr
s Bool -> Bool -> Bool
&& (Alt Var -> Bool) -> [Alt Var] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Int -> Alt Var -> Bool
goA Int
a) [Alt Var]
alts
go a :: Int
a (Cast e :: CoreExpr
e _) = Int -> CoreExpr -> Bool
go Int
a CoreExpr
e
go a :: Int
a (Tick _ e :: CoreExpr
e) = Int -> CoreExpr -> Bool
go Int
a CoreExpr
e
go _ (Type _) = Bool
True
go _ (Coercion _) = Bool
True
goArg :: CoreExpr -> Bool
goArg e :: CoreExpr
e | CoreExpr -> Bool
exprIsTrivial CoreExpr
e = Int -> CoreExpr -> Bool
go 0 CoreExpr
e
| HasDebugCallStack => Type -> Bool
Type -> Bool
isUnliftedType (CoreExpr -> Type
exprType CoreExpr
e) = Int -> CoreExpr -> Bool
go 0 CoreExpr
e
| Bool
otherwise = Bool
False
goB :: (Var, CoreExpr) -> Bool
goB (b :: Var
b, e :: CoreExpr
e)
#if MIN_VERSION_GLASGOW_HASKELL(8,2,0,0)
| Var -> Bool
isJoinId Var
b = Int -> CoreExpr -> Bool
go (Var -> Int
idArity Var
b) CoreExpr
e
#endif
| Type -> Bool
isFunTy (Var -> Type
idType Var
b) = Int -> CoreExpr -> Bool
go (Var -> Int
idArity Var
b) CoreExpr
e
| HasDebugCallStack => Type -> Bool
Type -> Bool
isUnliftedType (Var -> Type
idType Var
b) = Int -> CoreExpr -> Bool
go (Var -> Int
idArity Var
b) CoreExpr
e
| Bool
otherwise = Bool
False
goA :: Int -> Alt Var -> Bool
goA a :: Int
a (_,_, e :: CoreExpr
e) = Int -> CoreExpr -> Bool
go Int
a CoreExpr
e
doesNotContainTypeClasses :: Slice -> [Name] -> Maybe (Var, CoreExpr, [TyCon])
doesNotContainTypeClasses :: [(Var, CoreExpr)] -> [Name] -> Maybe (Var, CoreExpr, [TyCon])
doesNotContainTypeClasses slice :: [(Var, CoreExpr)]
slice tcNs :: [Name]
tcNs
= (TyCon -> Bool)
-> [(Var, CoreExpr)] -> Maybe (Var, CoreExpr, [TyCon])
allTyCons (\tc :: TyCon
tc -> Bool -> Bool
not (TyCon -> Bool
isClassTyCon TyCon
tc) Bool -> Bool -> Bool
|| (Name -> Bool) -> [Name] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (TyCon -> Name
forall a. NamedThing a => a -> Name
getName TyCon
tc Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
==) [Name]
tcNs) [(Var, CoreExpr)]
slice