{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Language.Haskell.Liquid.Transforms.Rec (
transformRecExpr, transformScope
, outerScTr , innerScTr
, isIdTRecBound, setIdTRecBound
) where
import Control.Arrow (second)
import Control.Monad.State
import qualified Data.HashMap.Strict as M
import Data.Hashable
import Liquid.GHC.API as Ghc hiding (panic)
import Language.Haskell.Liquid.GHC.Misc
import Language.Haskell.Liquid.GHC.Play
import Language.Haskell.Liquid.Misc (mapSndM)
import Language.Fixpoint.Misc (mapSnd)
import Language.Haskell.Liquid.Types.Errors
import Prelude hiding (error)
import qualified Data.List as L
transformRecExpr :: CoreProgram -> CoreProgram
transformRecExpr :: CoreProgram -> CoreProgram
transformRecExpr CoreProgram
cbs = CoreProgram
pg
where
pg :: CoreProgram
pg = CoreProgram -> CoreProgram
inlineFailCases CoreProgram
pg0
pg0 :: CoreProgram
pg0 = State TrEnv CoreProgram -> TrEnv -> CoreProgram
forall s a. State s a -> s -> a
evalState (CoreProgram -> State TrEnv CoreProgram
forall (t :: * -> *).
Traversable t =>
t (Bind Var) -> State TrEnv (t (Bind Var))
transPg (Bind Var -> Bind Var
inlineLoopBreaker (Bind Var -> Bind Var) -> CoreProgram -> CoreProgram
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CoreProgram
cbs)) TrEnv
initEnv
inlineLoopBreaker :: Bind Id -> Bind Id
inlineLoopBreaker :: Bind Var -> Bind Var
inlineLoopBreaker (NonRec Var
x Expr Var
e) | Just (Var
lbx, Expr Var
lbe) <- Expr Var -> Maybe (Var, Expr Var)
hasLoopBreaker Expr Var
be
= [(Var, Expr Var)] -> Bind Var
forall b. [(b, Expr b)] -> Bind b
Rec [(Var
x, (Var -> Expr Var -> Expr Var) -> Expr Var -> [Var] -> Expr Var
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Var -> Expr Var -> Expr Var
forall b. b -> Expr b -> Expr b
Lam (HashMap Var (Expr Var) -> Expr Var -> Expr Var
forall a. Subable a => HashMap Var (Expr Var) -> a -> a
sub (Var -> Expr Var -> HashMap Var (Expr Var)
forall k v. Hashable k => k -> v -> HashMap k v
M.singleton Var
lbx Expr Var
forall {b}. Expr b
e') Expr Var
lbe) ([Var]
αs [Var] -> [Var] -> [Var]
forall a. [a] -> [a] -> [a]
++ [Var]
as))]
where
([Var]
αs, [Var]
as, Expr Var
be) = Expr Var -> ([Var], [Var], Expr Var)
collectTyAndValBinders Expr Var
e
e' :: Expr b
e' = (Expr b -> Expr b -> Expr b) -> Expr b -> [Expr b] -> Expr b
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
L.foldl' Expr b -> Expr b -> Expr b
forall b. Expr b -> Expr b -> Expr b
App ((Expr b -> Expr b -> Expr b) -> Expr b -> [Expr b] -> Expr b
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
L.foldl' Expr b -> Expr b -> Expr b
forall b. Expr b -> Expr b -> Expr b
App (Var -> Expr b
forall b. Var -> Expr b
Var Var
x) (Type -> Expr b
forall b. Type -> Expr b
Type (Type -> Expr b) -> (Var -> Type) -> Var -> Expr b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Var -> Type
TyVarTy (Var -> Expr b) -> [Var] -> [Expr b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Var]
αs)) (Var -> Expr b
forall b. Var -> Expr b
Var (Var -> Expr b) -> [Var] -> [Expr b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Var]
as)
hasLoopBreaker :: Expr Var -> Maybe (Var, Expr Var)
hasLoopBreaker (Let (Rec [(Var
x1, Expr Var
e1)]) (Var Var
x2)) | Var -> Bool
isLoopBreaker Var
x1 Bool -> Bool -> Bool
&& Var
x1 Var -> Var -> Bool
forall a. Eq a => a -> a -> Bool
== Var
x2 = (Var, Expr Var) -> Maybe (Var, Expr Var)
forall a. a -> Maybe a
Just (Var
x1, Expr Var
e1)
hasLoopBreaker Expr Var
_ = Maybe (Var, Expr Var)
forall a. Maybe a
Nothing
isLoopBreaker :: Var -> Bool
isLoopBreaker = OccInfo -> Bool
isStrongLoopBreaker (OccInfo -> Bool) -> (Var -> OccInfo) -> Var -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IdInfo -> OccInfo
occInfo (IdInfo -> OccInfo) -> (Var -> IdInfo) -> Var -> OccInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (() :: Constraint) => Var -> IdInfo
Var -> IdInfo
idInfo
inlineLoopBreaker Bind Var
bs
= Bind Var
bs
inlineFailCases :: CoreProgram -> CoreProgram
inlineFailCases :: CoreProgram -> CoreProgram
inlineFailCases = ([(Var, Expr Var)] -> Bind Var -> Bind Var
go [] (Bind Var -> Bind Var) -> CoreProgram -> CoreProgram
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>)
where
go :: [(Var, Expr Var)] -> Bind Var -> Bind Var
go [(Var, Expr Var)]
su (Rec [(Var, Expr Var)]
xes) = [(Var, Expr Var)] -> Bind Var
forall b. [(b, Expr b)] -> Bind b
Rec ((Expr Var -> Expr Var) -> (Var, Expr Var) -> (Var, Expr Var)
forall b c a. (b -> c) -> (a, b) -> (a, c)
mapSnd ([(Var, Expr Var)] -> Expr Var -> Expr Var
go' [(Var, Expr Var)]
su) ((Var, Expr Var) -> (Var, Expr Var))
-> [(Var, Expr Var)] -> [(Var, Expr Var)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Var, Expr Var)]
xes)
go [(Var, Expr Var)]
su (NonRec Var
x Expr Var
e) = Var -> Expr Var -> Bind Var
forall b. b -> Expr b -> Bind b
NonRec Var
x ([(Var, Expr Var)] -> Expr Var -> Expr Var
go' [(Var, Expr Var)]
su Expr Var
e)
go' :: [(Var, Expr Var)] -> Expr Var -> Expr Var
go' [(Var, Expr Var)]
su (App (Var Var
x) Expr Var
_) | Var -> Bool
isFailId Var
x, Just Expr Var
e <- Var -> [(Var, Expr Var)] -> Maybe (Expr Var)
forall {a} {b}. Eq a => a -> [(a, b)] -> Maybe b
getFailExpr Var
x [(Var, Expr Var)]
su = Expr Var
e
go' [(Var, Expr Var)]
su (Let (NonRec Var
x Expr Var
ex) Expr Var
e) | Var -> Bool
isFailId Var
x = [(Var, Expr Var)] -> Expr Var -> Expr Var
go' (Var -> Expr Var -> [(Var, Expr Var)] -> [(Var, Expr Var)]
forall {a} {b}. a -> Expr b -> [(a, Expr b)] -> [(a, Expr b)]
addFailExpr Var
x ([(Var, Expr Var)] -> Expr Var -> Expr Var
go' [(Var, Expr Var)]
su Expr Var
ex) [(Var, Expr Var)]
su) Expr Var
e
go' [(Var, Expr Var)]
su (App Expr Var
e1 Expr Var
e2) = Expr Var -> Expr Var -> Expr Var
forall b. Expr b -> Expr b -> Expr b
App ([(Var, Expr Var)] -> Expr Var -> Expr Var
go' [(Var, Expr Var)]
su Expr Var
e1) ([(Var, Expr Var)] -> Expr Var -> Expr Var
go' [(Var, Expr Var)]
su Expr Var
e2)
go' [(Var, Expr Var)]
su (Lam Var
x Expr Var
e) = Var -> Expr Var -> Expr Var
forall b. b -> Expr b -> Expr b
Lam Var
x ([(Var, Expr Var)] -> Expr Var -> Expr Var
go' [(Var, Expr Var)]
su Expr Var
e)
go' [(Var, Expr Var)]
su (Let Bind Var
xs Expr Var
e) = Bind Var -> Expr Var -> Expr Var
forall b. Bind b -> Expr b -> Expr b
Let ([(Var, Expr Var)] -> Bind Var -> Bind Var
go [(Var, Expr Var)]
su Bind Var
xs) ([(Var, Expr Var)] -> Expr Var -> Expr Var
go' [(Var, Expr Var)]
su Expr Var
e)
go' [(Var, Expr Var)]
su (Case Expr Var
e Var
x Type
t [Alt Var]
alt) = Expr Var -> Var -> Type -> [Alt Var] -> Expr Var
forall b. Expr b -> b -> Type -> [Alt b] -> Expr b
Case ([(Var, Expr Var)] -> Expr Var -> Expr Var
go' [(Var, Expr Var)]
su Expr Var
e) Var
x Type
t ([(Var, Expr Var)] -> Alt Var -> Alt Var
goalt [(Var, Expr Var)]
su (Alt Var -> Alt Var) -> [Alt Var] -> [Alt Var]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Alt Var]
alt)
go' [(Var, Expr Var)]
su (Cast Expr Var
e CoercionR
c) = Expr Var -> CoercionR -> Expr Var
forall b. Expr b -> CoercionR -> Expr b
Cast ([(Var, Expr Var)] -> Expr Var -> Expr Var
go' [(Var, Expr Var)]
su Expr Var
e) CoercionR
c
go' [(Var, Expr Var)]
su (Tick CoreTickish
t Expr Var
e) = CoreTickish -> Expr Var -> Expr Var
forall b. CoreTickish -> Expr b -> Expr b
Tick CoreTickish
t ([(Var, Expr Var)] -> Expr Var -> Expr Var
go' [(Var, Expr Var)]
su Expr Var
e)
go' [(Var, Expr Var)]
_ Expr Var
e = Expr Var
e
goalt :: [(Var, Expr Var)] -> Alt Var -> Alt Var
goalt [(Var, Expr Var)]
su (Alt AltCon
c [Var]
xs Expr Var
e) = AltCon -> [Var] -> Expr Var -> Alt Var
forall b. AltCon -> [b] -> Expr b -> Alt b
Alt AltCon
c [Var]
xs ([(Var, Expr Var)] -> Expr Var -> Expr Var
go' [(Var, Expr Var)]
su Expr Var
e)
isFailId :: Var -> Bool
isFailId Var
x = Var -> Bool
isLocalId Var
x Bool -> Bool -> Bool
&& Name -> Bool
isSystemName (Var -> Name
varName Var
x) Bool -> Bool -> Bool
&& [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
L.isPrefixOf [Char]
"fail" (Var -> [Char]
forall a. Show a => a -> [Char]
show Var
x)
getFailExpr :: a -> [(a, b)] -> Maybe b
getFailExpr = a -> [(a, b)] -> Maybe b
forall {a} {b}. Eq a => a -> [(a, b)] -> Maybe b
L.lookup
addFailExpr :: a -> Expr b -> [(a, Expr b)] -> [(a, Expr b)]
addFailExpr a
x (Lam b
_ Expr b
e) [(a, Expr b)]
su = (a
x, Expr b
e)(a, Expr b) -> [(a, Expr b)] -> [(a, Expr b)]
forall a. a -> [a] -> [a]
:[(a, Expr b)]
su
addFailExpr a
_ Expr b
_ [(a, Expr b)]
_ = Maybe SrcSpan -> [Char] -> [(a, Expr b)]
forall a. Maybe SrcSpan -> [Char] -> a
impossible Maybe SrcSpan
forall a. Maybe a
Nothing [Char]
"internal error"
transformScope :: [Bind Id] -> [Bind Id]
transformScope :: CoreProgram -> CoreProgram
transformScope = CoreProgram -> CoreProgram
outerScTr (CoreProgram -> CoreProgram)
-> (CoreProgram -> CoreProgram) -> CoreProgram -> CoreProgram
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CoreProgram -> CoreProgram
forall (f :: * -> *). Functor f => f (Bind Var) -> f (Bind Var)
innerScTr
outerScTr :: [Bind Id] -> [Bind Id]
outerScTr :: CoreProgram -> CoreProgram
outerScTr = (Var -> CoreProgram -> CoreProgram) -> CoreProgram -> CoreProgram
forall b. (b -> [Bind b] -> [Bind b]) -> [Bind b] -> [Bind b]
mapNonRec (CoreProgram -> Var -> CoreProgram -> CoreProgram
forall {t}. [Bind t] -> Var -> [Bind t] -> [Bind t]
go [])
where
go :: [Bind t] -> Var -> [Bind t] -> [Bind t]
go [Bind t]
ack Var
x (Bind t
xe : [Bind t]
xes) | Var -> Bind t -> Bool
forall t. Var -> Bind t -> Bool
isCaseArg Var
x Bind t
xe = [Bind t] -> Var -> [Bind t] -> [Bind t]
go (Bind t
xeBind t -> [Bind t] -> [Bind t]
forall a. a -> [a] -> [a]
:[Bind t]
ack) Var
x [Bind t]
xes
go [Bind t]
ack Var
_ [Bind t]
xes = [Bind t]
ack [Bind t] -> [Bind t] -> [Bind t]
forall a. [a] -> [a] -> [a]
++ [Bind t]
xes
isCaseArg :: Id -> Bind t -> Bool
isCaseArg :: forall t. Var -> Bind t -> Bool
isCaseArg Var
x (NonRec t
_ (Case (Var Var
z) t
_ Type
_ [Alt t]
_)) = Var
z Var -> Var -> Bool
forall a. Eq a => a -> a -> Bool
== Var
x
isCaseArg Var
_ Bind t
_ = Bool
False
innerScTr :: Functor f => f (Bind Id) -> f (Bind Id)
innerScTr :: forall (f :: * -> *). Functor f => f (Bind Var) -> f (Bind Var)
innerScTr = ((Var -> Expr Var -> Expr Var) -> Bind Var -> Bind Var
forall b. (b -> Expr b -> Expr b) -> Bind b -> Bind b
mapBnd Var -> Expr Var -> Expr Var
scTrans (Bind Var -> Bind Var) -> f (Bind Var) -> f (Bind Var)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>)
scTrans :: Id -> Expr Id -> Expr Id
scTrans :: Var -> Expr Var -> Expr Var
scTrans Var
id' Expr Var
expr = (Var -> Expr Var -> Expr Var) -> Expr Var -> Expr Var
forall b. (b -> Expr b -> Expr b) -> Expr b -> Expr b
mapExpr Var -> Expr Var -> Expr Var
scTrans (Expr Var -> Expr Var) -> Expr Var -> Expr Var
forall a b. (a -> b) -> a -> b
$ (Bind Var -> Expr Var -> Expr Var)
-> Expr Var -> CoreProgram -> Expr Var
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Bind Var -> Expr Var -> Expr Var
forall b. Bind b -> Expr b -> Expr b
Let Expr Var
e0 CoreProgram
bindIds
where (CoreProgram
bindIds, Expr Var
e0) = CoreProgram -> Var -> Expr Var -> (CoreProgram, Expr Var)
forall {b}. [Bind b] -> Var -> Expr b -> ([Bind b], Expr b)
go [] Var
id' Expr Var
expr
go :: [Bind b] -> Var -> Expr b -> ([Bind b], Expr b)
go [Bind b]
bs Var
x (Let Bind b
b Expr b
e) | Var -> Bind b -> Bool
forall t. Var -> Bind t -> Bool
isCaseArg Var
x Bind b
b = [Bind b] -> Var -> Expr b -> ([Bind b], Expr b)
go (Bind b
bBind b -> [Bind b] -> [Bind b]
forall a. a -> [a] -> [a]
:[Bind b]
bs) Var
x Expr b
e
go [Bind b]
bs Var
x (Tick CoreTickish
t Expr b
e) = (Expr b -> Expr b) -> ([Bind b], Expr b) -> ([Bind b], Expr b)
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second (CoreTickish -> Expr b -> Expr b
forall b. CoreTickish -> Expr b -> Expr b
Tick CoreTickish
t) (([Bind b], Expr b) -> ([Bind b], Expr b))
-> ([Bind b], Expr b) -> ([Bind b], Expr b)
forall a b. (a -> b) -> a -> b
$ [Bind b] -> Var -> Expr b -> ([Bind b], Expr b)
go [Bind b]
bs Var
x Expr b
e
go [Bind b]
bs Var
_ Expr b
e = ([Bind b]
bs, Expr b
e)
type TE = State TrEnv
data TrEnv = Tr { TrEnv -> Int
freshIndex :: !Int
, TrEnv -> SrcSpan
_loc :: SrcSpan
}
initEnv :: TrEnv
initEnv :: TrEnv
initEnv = Int -> SrcSpan -> TrEnv
Tr Int
0 SrcSpan
noSrcSpan
transPg :: Traversable t
=> t (Bind CoreBndr)
-> State TrEnv (t (Bind CoreBndr))
transPg :: forall (t :: * -> *).
Traversable t =>
t (Bind Var) -> State TrEnv (t (Bind Var))
transPg = (Bind Var -> StateT TrEnv Identity (Bind Var))
-> t (Bind Var) -> StateT TrEnv Identity (t (Bind Var))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> t a -> m (t b)
mapM Bind Var -> StateT TrEnv Identity (Bind Var)
transBd
transBd :: Bind CoreBndr
-> State TrEnv (Bind CoreBndr)
transBd :: Bind Var -> StateT TrEnv Identity (Bind Var)
transBd (NonRec Var
x Expr Var
e) = (Expr Var -> Bind Var)
-> StateT TrEnv Identity (Expr Var)
-> StateT TrEnv Identity (Bind Var)
forall a b.
(a -> b) -> StateT TrEnv Identity a -> StateT TrEnv Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Var -> Expr Var -> Bind Var
forall b. b -> Expr b -> Bind b
NonRec Var
x) (Expr Var -> StateT TrEnv Identity (Expr Var)
transExpr (Expr Var -> StateT TrEnv Identity (Expr Var))
-> StateT TrEnv Identity (Expr Var)
-> StateT TrEnv Identity (Expr Var)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Bind Var -> StateT TrEnv Identity (Bind Var))
-> Expr Var -> StateT TrEnv Identity (Expr Var)
forall (m :: * -> *) t a. Monad m => t -> a -> m a
mapBdM Bind Var -> StateT TrEnv Identity (Bind Var)
transBd Expr Var
e)
transBd (Rec [(Var, Expr Var)]
xes) = [(Var, Expr Var)] -> Bind Var
forall b. [(b, Expr b)] -> Bind b
Rec ([(Var, Expr Var)] -> Bind Var)
-> StateT TrEnv Identity [(Var, Expr Var)]
-> StateT TrEnv Identity (Bind Var)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Var, Expr Var) -> StateT TrEnv Identity (Var, Expr Var))
-> [(Var, Expr Var)] -> StateT TrEnv Identity [(Var, Expr Var)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((Expr Var -> StateT TrEnv Identity (Expr Var))
-> (Var, Expr Var) -> StateT TrEnv Identity (Var, Expr Var)
forall (m :: * -> *) b c a.
Applicative m =>
(b -> m c) -> (a, b) -> m (a, c)
mapSndM ((Bind Var -> StateT TrEnv Identity (Bind Var))
-> Expr Var -> StateT TrEnv Identity (Expr Var)
forall (m :: * -> *) t a. Monad m => t -> a -> m a
mapBdM Bind Var -> StateT TrEnv Identity (Bind Var)
transBd)) [(Var, Expr Var)]
xes
transExpr :: CoreExpr -> TE CoreExpr
transExpr :: Expr Var -> StateT TrEnv Identity (Expr Var)
transExpr Expr Var
e
| Expr Var -> Bool
isNonPolyRec Expr Var
e' Bool -> Bool -> Bool
&& Bool -> Bool
not ([Var] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Var]
tvs)
= [Var]
-> [Var]
-> CoreProgram
-> Expr Var
-> StateT TrEnv Identity (Expr Var)
forall (t :: * -> *).
Foldable t =>
[Var]
-> [Var]
-> t (Bind Var)
-> Expr Var
-> StateT TrEnv Identity (Expr Var)
trans [Var]
tvs [Var]
ids CoreProgram
bs Expr Var
e'
| Bool
otherwise
= Expr Var -> StateT TrEnv Identity (Expr Var)
forall a. a -> StateT TrEnv Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Expr Var
e
where ([Var]
tvs, [Var]
ids, Expr Var
e'') = Expr Var -> ([Var], [Var], Expr Var)
collectTyAndValBinders Expr Var
e
(CoreProgram
bs, Expr Var
e') = Expr Var -> (CoreProgram, Expr Var)
forall t. Expr t -> ([Bind t], Expr t)
collectNonRecLets Expr Var
e''
isNonPolyRec :: Expr CoreBndr -> Bool
isNonPolyRec :: Expr Var -> Bool
isNonPolyRec (Let (Rec [(Var, Expr Var)]
xes) Expr Var
_) = (Expr Var -> Bool) -> [Expr Var] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Expr Var -> Bool
nonPoly ((Var, Expr Var) -> Expr Var
forall a b. (a, b) -> b
snd ((Var, Expr Var) -> Expr Var) -> [(Var, Expr Var)] -> [Expr Var]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Var, Expr Var)]
xes)
isNonPolyRec Expr Var
_ = Bool
False
nonPoly :: CoreExpr -> Bool
nonPoly :: Expr Var -> Bool
nonPoly = [Var] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Var] -> Bool) -> (Expr Var -> [Var]) -> Expr Var -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Var], Type) -> [Var]
forall a b. (a, b) -> a
fst (([Var], Type) -> [Var])
-> (Expr Var -> ([Var], Type)) -> Expr Var -> [Var]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Type -> ([Var], Type)
splitForAllTyCoVars (Type -> ([Var], Type))
-> (Expr Var -> Type) -> Expr Var -> ([Var], Type)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (() :: Constraint) => Expr Var -> Type
Expr Var -> Type
exprType
collectNonRecLets :: Expr t -> ([Bind t], Expr t)
collectNonRecLets :: forall t. Expr t -> ([Bind t], Expr t)
collectNonRecLets = [Bind t] -> Expr t -> ([Bind t], Expr t)
forall {b}. [Bind b] -> Expr b -> ([Bind b], Expr b)
go []
where go :: [Bind b] -> Expr b -> ([Bind b], Expr b)
go [Bind b]
bs (Let b :: Bind b
b@(NonRec b
_ Expr b
_) Expr b
e') = [Bind b] -> Expr b -> ([Bind b], Expr b)
go (Bind b
bBind b -> [Bind b] -> [Bind b]
forall a. a -> [a] -> [a]
:[Bind b]
bs) Expr b
e'
go [Bind b]
bs Expr b
e' = ([Bind b] -> [Bind b]
forall a. [a] -> [a]
reverse [Bind b]
bs, Expr b
e')
appTysAndIds :: [Var] -> [Id] -> Id -> Expr b
appTysAndIds :: forall b. [Var] -> [Var] -> Var -> Expr b
appTysAndIds [Var]
tvs [Var]
ids Var
x = Expr b -> [Expr b] -> Expr b
forall b. Expr b -> [Expr b] -> Expr b
mkApps (Expr b -> [Type] -> Expr b
forall b. Expr b -> [Type] -> Expr b
mkTyApps (Var -> Expr b
forall b. Var -> Expr b
Var Var
x) ((Var -> Type) -> [Var] -> [Type]
forall a b. (a -> b) -> [a] -> [b]
map Var -> Type
TyVarTy [Var]
tvs)) ((Var -> Expr b) -> [Var] -> [Expr b]
forall a b. (a -> b) -> [a] -> [b]
map Var -> Expr b
forall b. Var -> Expr b
Var [Var]
ids)
trans :: Foldable t
=> [TyVar]
-> [Var]
-> t (Bind Id)
-> Expr Var
-> State TrEnv (Expr Id)
trans :: forall (t :: * -> *).
Foldable t =>
[Var]
-> [Var]
-> t (Bind Var)
-> Expr Var
-> StateT TrEnv Identity (Expr Var)
trans [Var]
vs [Var]
ids t (Bind Var)
bs (Let (Rec [(Var, Expr Var)]
xes) Expr Var
expr)
= (Expr Var -> Expr Var)
-> StateT TrEnv Identity (Expr Var)
-> StateT TrEnv Identity (Expr Var)
forall a b.
(a -> b) -> StateT TrEnv Identity a -> StateT TrEnv Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Expr Var -> Expr Var
mkLam (Expr Var -> Expr Var)
-> (Expr Var -> Expr Var) -> Expr Var -> Expr Var
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr Var -> Expr Var
mkLet') ([Var] -> [Var] -> Expr Var -> StateT TrEnv Identity (Expr Var)
makeTrans [Var]
vs [Var]
liveIds Expr Var
e')
where liveIds :: [Var]
liveIds = Var -> Var
mkAlive (Var -> Var) -> [Var] -> [Var]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Var]
ids
mkLet' :: Expr Var -> Expr Var
mkLet' Expr Var
e = (Bind Var -> Expr Var -> Expr Var)
-> Expr Var -> t (Bind Var) -> Expr Var
forall a b. (a -> b -> b) -> b -> t a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Bind Var -> Expr Var -> Expr Var
forall b. Bind b -> Expr b -> Expr b
Let Expr Var
e t (Bind Var)
bs
mkLam :: Expr Var -> Expr Var
mkLam Expr Var
e = (Var -> Expr Var -> Expr Var) -> Expr Var -> [Var] -> Expr Var
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Var -> Expr Var -> Expr Var
forall b. b -> Expr b -> Expr b
Lam Expr Var
e ([Var] -> Expr Var) -> [Var] -> Expr Var
forall a b. (a -> b) -> a -> b
$ [Var]
vs [Var] -> [Var] -> [Var]
forall a. [a] -> [a] -> [a]
++ [Var]
liveIds
e' :: Expr Var
e' = Bind Var -> Expr Var -> Expr Var
forall b. Bind b -> Expr b -> Expr b
Let ([(Var, Expr Var)] -> Bind Var
forall b. [(b, Expr b)] -> Bind b
Rec [(Var, Expr Var)]
xes') Expr Var
expr
xes' :: [(Var, Expr Var)]
xes' = (Expr Var -> Expr Var) -> (Var, Expr Var) -> (Var, Expr Var)
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second Expr Var -> Expr Var
mkLet' ((Var, Expr Var) -> (Var, Expr Var))
-> [(Var, Expr Var)] -> [(Var, Expr Var)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Var, Expr Var)]
xes
trans [Var]
_ [Var]
_ t (Bind Var)
_ Expr Var
_ = Maybe SrcSpan -> [Char] -> StateT TrEnv Identity (Expr Var)
forall a. Maybe SrcSpan -> [Char] -> a
panic Maybe SrcSpan
forall a. Maybe a
Nothing [Char]
"TransformRec.trans called with invalid input"
makeTrans :: [TyVar]
-> [Var]
-> Expr Var
-> State TrEnv (Expr Var)
makeTrans :: [Var] -> [Var] -> Expr Var -> StateT TrEnv Identity (Expr Var)
makeTrans [Var]
vs [Var]
ids (Let (Rec [(Var, Expr Var)]
xes) Expr Var
e)
= do [([Var], Var)]
fids <- (Var -> StateT TrEnv Identity ([Var], Var))
-> [Var] -> StateT TrEnv Identity [([Var], Var)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ([Var] -> [Var] -> Var -> StateT TrEnv Identity ([Var], Var)
mkFreshIds [Var]
vs [Var]
ids) [Var]
xs
let ([[Var]]
ids', [Var]
ys) = [([Var], Var)] -> ([[Var]], [Var])
forall a b. [(a, b)] -> ([a], [b])
unzip [([Var], Var)]
fids
let yes :: [Expr b]
yes = [Var] -> [Var] -> Var -> Expr b
forall b. [Var] -> [Var] -> Var -> Expr b
appTysAndIds [Var]
vs [Var]
ids (Var -> Expr b) -> [Var] -> [Expr b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Var]
ys
[Var]
ys' <- (Var -> StateT TrEnv Identity Var)
-> [Var] -> StateT TrEnv Identity [Var]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Var -> StateT TrEnv Identity Var
forall a. Freshable a => a -> TE a
fresh [Var]
xs
let su :: HashMap Var (Expr b)
su = [(Var, Expr b)] -> HashMap Var (Expr b)
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
M.fromList ([(Var, Expr b)] -> HashMap Var (Expr b))
-> [(Var, Expr b)] -> HashMap Var (Expr b)
forall a b. (a -> b) -> a -> b
$ [Var] -> [Expr b] -> [(Var, Expr b)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Var]
xs (Var -> Expr b
forall b. Var -> Expr b
Var (Var -> Expr b) -> [Var] -> [Expr b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Var]
ys')
let rs :: [(Var, Expr b)]
rs = [Var] -> [Expr b] -> [(Var, Expr b)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Var]
ys' [Expr b]
forall {b}. [Expr b]
yes
let es' :: [Expr Var]
es' = ([Var] -> Expr Var -> Expr Var)
-> [[Var]] -> [Expr Var] -> [Expr Var]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith ([Var] -> [Var] -> Expr Var -> Expr Var
mkE [Var]
ys) [[Var]]
ids' [Expr Var]
es
let xes' :: [(Var, Expr Var)]
xes' = [Var] -> [Expr Var] -> [(Var, Expr Var)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Var]
ys [Expr Var]
es'
Expr Var -> StateT TrEnv Identity (Expr Var)
forall a. a -> StateT TrEnv Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr Var -> StateT TrEnv Identity (Expr Var))
-> Expr Var -> StateT TrEnv Identity (Expr Var)
forall a b. (a -> b) -> a -> b
$ [(Var, Expr Var)] -> Bind Var -> Expr Var -> Expr Var
forall b. [(b, Expr b)] -> Bind b -> Expr b -> Expr b
mkRecBinds [(Var, Expr Var)]
forall {b}. [(Var, Expr b)]
rs ([(Var, Expr Var)] -> Bind Var
forall b. [(b, Expr b)] -> Bind b
Rec [(Var, Expr Var)]
xes') (HashMap Var (Expr Var) -> Expr Var -> Expr Var
forall a. Subable a => HashMap Var (Expr Var) -> a -> a
sub HashMap Var (Expr Var)
forall {b}. HashMap Var (Expr b)
su Expr Var
e)
where
([Var]
xs, [Expr Var]
es) = [(Var, Expr Var)] -> ([Var], [Expr Var])
forall a b. [(a, b)] -> ([a], [b])
unzip [(Var, Expr Var)]
xes
mkSu :: [Var] -> [Var] -> HashMap Var (Expr b)
mkSu [Var]
ys [Var]
ids' = [Var] -> [Var] -> [Var] -> [(Var, Var)] -> HashMap Var (Expr b)
forall k b.
(Eq k, Hashable k) =>
[k] -> [Var] -> [Var] -> [(k, Var)] -> HashMap k (Expr b)
mkSubs [Var]
ids [Var]
vs [Var]
ids' ([Var] -> [Var] -> [(Var, Var)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Var]
xs [Var]
ys)
mkE :: [Var] -> [Var] -> Expr Var -> Expr Var
mkE [Var]
ys [Var]
ids' Expr Var
e' = [Var] -> Expr Var -> Expr Var
mkCoreLams ([Var]
vs [Var] -> [Var] -> [Var]
forall a. [a] -> [a] -> [a]
++ [Var]
ids') (HashMap Var (Expr Var) -> Expr Var -> Expr Var
forall a. Subable a => HashMap Var (Expr Var) -> a -> a
sub ([Var] -> [Var] -> HashMap Var (Expr Var)
forall {b}. [Var] -> [Var] -> HashMap Var (Expr b)
mkSu [Var]
ys [Var]
ids') Expr Var
e')
makeTrans [Var]
_ [Var]
_ Expr Var
_ = Maybe SrcSpan -> [Char] -> StateT TrEnv Identity (Expr Var)
forall a. Maybe SrcSpan -> [Char] -> a
panic Maybe SrcSpan
forall a. Maybe a
Nothing [Char]
"TransformRec.makeTrans called with invalid input"
mkRecBinds :: [(b, Expr b)] -> Bind b -> Expr b -> Expr b
mkRecBinds :: forall b. [(b, Expr b)] -> Bind b -> Expr b -> Expr b
mkRecBinds [(b, Expr b)]
xes Bind b
rs Expr b
expr = Bind b -> Expr b -> Expr b
forall b. Bind b -> Expr b -> Expr b
Let Bind b
rs ((Expr b -> (b, Expr b) -> Expr b)
-> Expr b -> [(b, Expr b)] -> Expr b
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
L.foldl' Expr b -> (b, Expr b) -> Expr b
forall {b}. Expr b -> (b, Expr b) -> Expr b
f Expr b
expr [(b, Expr b)]
xes)
where f :: Expr b -> (b, Expr b) -> Expr b
f Expr b
e (b
x, Expr b
xe) = Bind b -> Expr b -> Expr b
forall b. Bind b -> Expr b -> Expr b
Let (b -> Expr b -> Bind b
forall b. b -> Expr b -> Bind b
NonRec b
x Expr b
xe) Expr b
e
mkSubs :: (Eq k, Hashable k)
=> [k] -> [Var] -> [Id] -> [(k, Id)] -> M.HashMap k (Expr b)
mkSubs :: forall k b.
(Eq k, Hashable k) =>
[k] -> [Var] -> [Var] -> [(k, Var)] -> HashMap k (Expr b)
mkSubs [k]
ids [Var]
tvs [Var]
xs [(k, Var)]
ys = [(k, Expr b)] -> HashMap k (Expr b)
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
M.fromList ([(k, Expr b)] -> HashMap k (Expr b))
-> [(k, Expr b)] -> HashMap k (Expr b)
forall a b. (a -> b) -> a -> b
$ [(k, Expr b)]
forall {b}. [(k, Expr b)]
s1 [(k, Expr b)] -> [(k, Expr b)] -> [(k, Expr b)]
forall a. [a] -> [a] -> [a]
++ [(k, Expr b)]
forall {b}. [(k, Expr b)]
s2
where s1 :: [(k, Expr b)]
s1 = (Var -> Expr b) -> (k, Var) -> (k, Expr b)
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second ([Var] -> [Var] -> Var -> Expr b
forall b. [Var] -> [Var] -> Var -> Expr b
appTysAndIds [Var]
tvs [Var]
xs) ((k, Var) -> (k, Expr b)) -> [(k, Var)] -> [(k, Expr b)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(k, Var)]
ys
s2 :: [(k, Expr b)]
s2 = [k] -> [Expr b] -> [(k, Expr b)]
forall a b. [a] -> [b] -> [(a, b)]
zip [k]
ids (Var -> Expr b
forall b. Var -> Expr b
Var (Var -> Expr b) -> [Var] -> [Expr b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Var]
xs)
mkFreshIds :: [TyVar]
-> [Var]
-> Var
-> State TrEnv ([Var], Id)
mkFreshIds :: [Var] -> [Var] -> Var -> StateT TrEnv Identity ([Var], Var)
mkFreshIds [Var]
tvs [Var]
origIds Var
var
= do [Var]
ids' <- (Var -> StateT TrEnv Identity Var)
-> [Var] -> StateT TrEnv Identity [Var]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Var -> StateT TrEnv Identity Var
forall a. Freshable a => a -> TE a
fresh [Var]
origIds
let ids'' :: [Var]
ids'' = (Var -> Var) -> [Var] -> [Var]
forall a b. (a -> b) -> [a] -> [b]
map Var -> Var
setIdTRecBound [Var]
ids'
let t :: Type
t = [ForAllTyBinder] -> Type -> Type
mkForAllTys ((Var -> ForAllTyFlag -> ForAllTyBinder
forall var argf. var -> argf -> VarBndr var argf
`Bndr` ForAllTyFlag
Required) (Var -> ForAllTyBinder) -> [Var] -> [ForAllTyBinder]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Var]
tvs) (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ [Var] -> Type -> Type
forall {t :: * -> *}. Foldable t => t Var -> Type -> Type
mkType ([Var] -> [Var]
forall a. [a] -> [a]
reverse [Var]
ids'') (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Var -> Type
varType Var
var
let x' :: Var
x' = Var -> Type -> Var
setVarType Var
var Type
t
([Var], Var) -> StateT TrEnv Identity ([Var], Var)
forall a. a -> StateT TrEnv Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Var]
ids'', Var
x')
where
mkType :: t Var -> Type -> Type
mkType t Var
ids Type
ty = (Type -> Var -> Type) -> Type -> t Var -> Type
forall b a. (b -> a -> b) -> b -> t a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\Type
t Var
x -> FunTyFlag -> Type -> Type -> Type -> Type
FunTy FunTyFlag
FTF_T_T Type
ManyTy (Var -> Type
varType Var
x) Type
t) Type
ty t Var
ids
setIdTRecBound :: Id -> Id
setIdTRecBound :: Var -> Var
setIdTRecBound = (() :: Constraint) => (IdInfo -> IdInfo) -> Var -> Var
(IdInfo -> IdInfo) -> Var -> Var
modifyIdInfo (IdInfo -> CafInfo -> IdInfo
`setCafInfo` CafInfo
NoCafRefs)
isIdTRecBound :: Id -> Bool
isIdTRecBound :: Var -> Bool
isIdTRecBound = Bool -> Bool
not (Bool -> Bool) -> (Var -> Bool) -> Var -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CafInfo -> Bool
mayHaveCafRefs (CafInfo -> Bool) -> (Var -> CafInfo) -> Var -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IdInfo -> CafInfo
cafInfo (IdInfo -> CafInfo) -> (Var -> IdInfo) -> Var -> CafInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (() :: Constraint) => Var -> IdInfo
Var -> IdInfo
idInfo
class Freshable a where
fresh :: a -> TE a
instance Freshable Int where
fresh :: Int -> TE Int
fresh Int
_ = TE Int
forall (m :: * -> *). MonadState TrEnv m => m Int
freshInt
instance Freshable Unique where
fresh :: Unique -> TE Unique
fresh Unique
_ = TE Unique
forall (m :: * -> *). MonadState TrEnv m => m Unique
freshUnique
instance Freshable Var where
fresh :: Var -> StateT TrEnv Identity Var
fresh Var
v = (Unique -> Var) -> TE Unique -> StateT TrEnv Identity Var
forall a b.
(a -> b) -> StateT TrEnv Identity a -> StateT TrEnv Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Var -> Unique -> Var
setVarUnique Var
v) TE Unique
forall (m :: * -> *). MonadState TrEnv m => m Unique
freshUnique
freshInt :: MonadState TrEnv m => m Int
freshInt :: forall (m :: * -> *). MonadState TrEnv m => m Int
freshInt
= do TrEnv
s <- m TrEnv
forall s (m :: * -> *). MonadState s m => m s
get
let n :: Int
n = TrEnv -> Int
freshIndex TrEnv
s
TrEnv -> m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put TrEnv
s{freshIndex = n+1}
Int -> m Int
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Int
n
freshUnique :: MonadState TrEnv m => m Unique
freshUnique :: forall (m :: * -> *). MonadState TrEnv m => m Unique
freshUnique = (Int -> Unique) -> m Int -> m Unique
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Char -> Int -> Unique
mkUnique Char
'X') m Int
forall (m :: * -> *). MonadState TrEnv m => m Int
freshInt
mapNonRec :: (b -> [Bind b] -> [Bind b]) -> [Bind b] -> [Bind b]
mapNonRec :: forall b. (b -> [Bind b] -> [Bind b]) -> [Bind b] -> [Bind b]
mapNonRec b -> [Bind b] -> [Bind b]
f (NonRec b
x Expr b
xe:[Bind b]
xes) = b -> Expr b -> Bind b
forall b. b -> Expr b -> Bind b
NonRec b
x Expr b
xe Bind b -> [Bind b] -> [Bind b]
forall a. a -> [a] -> [a]
: b -> [Bind b] -> [Bind b]
f b
x ((b -> [Bind b] -> [Bind b]) -> [Bind b] -> [Bind b]
forall b. (b -> [Bind b] -> [Bind b]) -> [Bind b] -> [Bind b]
mapNonRec b -> [Bind b] -> [Bind b]
f [Bind b]
xes)
mapNonRec b -> [Bind b] -> [Bind b]
f (Bind b
xe:[Bind b]
xes) = Bind b
xe Bind b -> [Bind b] -> [Bind b]
forall a. a -> [a] -> [a]
: (b -> [Bind b] -> [Bind b]) -> [Bind b] -> [Bind b]
forall b. (b -> [Bind b] -> [Bind b]) -> [Bind b] -> [Bind b]
mapNonRec b -> [Bind b] -> [Bind b]
f [Bind b]
xes
mapNonRec b -> [Bind b] -> [Bind b]
_ [] = []
mapBnd :: (b -> Expr b -> Expr b) -> Bind b -> Bind b
mapBnd :: forall b. (b -> Expr b -> Expr b) -> Bind b -> Bind b
mapBnd b -> Expr b -> Expr b
f (NonRec b
b Expr b
e) = b -> Expr b -> Bind b
forall b. b -> Expr b -> Bind b
NonRec b
b ((b -> Expr b -> Expr b) -> Expr b -> Expr b
forall b. (b -> Expr b -> Expr b) -> Expr b -> Expr b
mapExpr b -> Expr b -> Expr b
f Expr b
e)
mapBnd b -> Expr b -> Expr b
f (Rec [(b, Expr b)]
bs) = [(b, Expr b)] -> Bind b
forall b. [(b, Expr b)] -> Bind b
Rec (((b, Expr b) -> (b, Expr b)) -> [(b, Expr b)] -> [(b, Expr b)]
forall a b. (a -> b) -> [a] -> [b]
map ((Expr b -> Expr b) -> (b, Expr b) -> (b, Expr b)
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second ((b -> Expr b -> Expr b) -> Expr b -> Expr b
forall b. (b -> Expr b -> Expr b) -> Expr b -> Expr b
mapExpr b -> Expr b -> Expr b
f)) [(b, Expr b)]
bs)
mapExpr :: (b -> Expr b -> Expr b) -> Expr b -> Expr b
mapExpr :: forall b. (b -> Expr b -> Expr b) -> Expr b -> Expr b
mapExpr b -> Expr b -> Expr b
f (Let (NonRec b
x Expr b
ex) Expr b
e) = Bind b -> Expr b -> Expr b
forall b. Bind b -> Expr b -> Expr b
Let (b -> Expr b -> Bind b
forall b. b -> Expr b -> Bind b
NonRec b
x (b -> Expr b -> Expr b
f b
x Expr b
ex) ) (b -> Expr b -> Expr b
f b
x Expr b
e)
mapExpr b -> Expr b -> Expr b
f (App Expr b
e1 Expr b
e2) = Expr b -> Expr b -> Expr b
forall b. Expr b -> Expr b -> Expr b
App ((b -> Expr b -> Expr b) -> Expr b -> Expr b
forall b. (b -> Expr b -> Expr b) -> Expr b -> Expr b
mapExpr b -> Expr b -> Expr b
f Expr b
e1) ((b -> Expr b -> Expr b) -> Expr b -> Expr b
forall b. (b -> Expr b -> Expr b) -> Expr b -> Expr b
mapExpr b -> Expr b -> Expr b
f Expr b
e2)
mapExpr b -> Expr b -> Expr b
f (Lam b
b Expr b
e) = b -> Expr b -> Expr b
forall b. b -> Expr b -> Expr b
Lam b
b ((b -> Expr b -> Expr b) -> Expr b -> Expr b
forall b. (b -> Expr b -> Expr b) -> Expr b -> Expr b
mapExpr b -> Expr b -> Expr b
f Expr b
e)
mapExpr b -> Expr b -> Expr b
f (Let Bind b
bs Expr b
e) = Bind b -> Expr b -> Expr b
forall b. Bind b -> Expr b -> Expr b
Let ((b -> Expr b -> Expr b) -> Bind b -> Bind b
forall b. (b -> Expr b -> Expr b) -> Bind b -> Bind b
mapBnd b -> Expr b -> Expr b
f Bind b
bs) ((b -> Expr b -> Expr b) -> Expr b -> Expr b
forall b. (b -> Expr b -> Expr b) -> Expr b -> Expr b
mapExpr b -> Expr b -> Expr b
f Expr b
e)
mapExpr b -> Expr b -> Expr b
f (Case Expr b
e b
b Type
t [Alt b]
alt) = Expr b -> b -> Type -> [Alt b] -> Expr b
forall b. Expr b -> b -> Type -> [Alt b] -> Expr b
Case Expr b
e b
b Type
t ((Alt b -> Alt b) -> [Alt b] -> [Alt b]
forall a b. (a -> b) -> [a] -> [b]
map ((b -> Expr b -> Expr b) -> Alt b -> Alt b
forall b. (b -> Expr b -> Expr b) -> Alt b -> Alt b
mapAlt b -> Expr b -> Expr b
f) [Alt b]
alt)
mapExpr b -> Expr b -> Expr b
f (Tick CoreTickish
t Expr b
e) = CoreTickish -> Expr b -> Expr b
forall b. CoreTickish -> Expr b -> Expr b
Tick CoreTickish
t ((b -> Expr b -> Expr b) -> Expr b -> Expr b
forall b. (b -> Expr b -> Expr b) -> Expr b -> Expr b
mapExpr b -> Expr b -> Expr b
f Expr b
e)
mapExpr b -> Expr b -> Expr b
_ Expr b
e = Expr b
e
mapAlt :: (b -> Expr b -> Expr b) -> Alt b -> Alt b
mapAlt :: forall b. (b -> Expr b -> Expr b) -> Alt b -> Alt b
mapAlt b -> Expr b -> Expr b
f (Alt AltCon
d [b]
bs Expr b
e) = AltCon -> [b] -> Expr b -> Alt b
forall b. AltCon -> [b] -> Expr b -> Alt b
Alt AltCon
d [b]
bs ((b -> Expr b -> Expr b) -> Expr b -> Expr b
forall b. (b -> Expr b -> Expr b) -> Expr b -> Expr b
mapExpr b -> Expr b -> Expr b
f Expr b
e)
mapBdM :: Monad m => t -> a -> m a
mapBdM :: forall (m :: * -> *) t a. Monad m => t -> a -> m a
mapBdM t
_ = a -> m a
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return