{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE Strict #-}
{-# LANGUAGE TupleSections #-}
module Futhark.Optimise.Simplify
( simplifyProg,
simplifySomething,
simplifyFun,
simplifyLambda,
simplifyStms,
Engine.SimpleOps (..),
Engine.SimpleM,
Engine.SimplifyOp,
Engine.bindableSimpleOps,
Engine.noExtraHoistBlockers,
Engine.neverHoist,
Engine.SimplifiableRep,
Engine.HoistBlockers,
RuleBook,
)
where
import Data.Bifunctor (second)
import qualified Futhark.Analysis.SymbolTable as ST
import qualified Futhark.Analysis.UsageTable as UT
import Futhark.IR
import Futhark.MonadFreshNames
import qualified Futhark.Optimise.Simplify.Engine as Engine
import Futhark.Optimise.Simplify.Rep
import Futhark.Optimise.Simplify.Rule
import Futhark.Pass
simplifyProg ::
Engine.SimplifiableRep rep =>
Engine.SimpleOps rep ->
RuleBook (Engine.Wise rep) ->
Engine.HoistBlockers rep ->
Prog rep ->
PassM (Prog rep)
simplifyProg :: forall rep.
SimplifiableRep rep =>
SimpleOps rep
-> RuleBook (Wise rep)
-> HoistBlockers rep
-> Prog rep
-> PassM (Prog rep)
simplifyProg SimpleOps rep
simpl RuleBook (Wise rep)
rules HoistBlockers rep
blockers (Prog Stms rep
consts [FunDef rep]
funs) = do
(SymbolTable (Wise rep)
consts_vtable, Stms rep
consts') <-
UsageTable
-> (SymbolTable (Wise rep), Stms rep)
-> PassM (SymbolTable (Wise rep), Stms rep)
forall {m :: * -> *}.
MonadFreshNames m =>
UsageTable
-> (SymbolTable (Wise rep), Stms rep)
-> m (SymbolTable (Wise rep), Stms rep)
simplifyConsts
(Names -> UsageTable
UT.usages (Names -> UsageTable) -> Names -> UsageTable
forall a b. (a -> b) -> a -> b
$ (FunDef rep -> Names) -> [FunDef rep] -> Names
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap FunDef rep -> Names
forall a. FreeIn a => a -> Names
freeIn [FunDef rep]
funs)
(SymbolTable (Wise rep)
forall a. Monoid a => a
mempty, Stms rep
consts)
[FunDef rep]
funs' <- (FunDef rep -> PassM (FunDef rep))
-> [FunDef rep] -> PassM [FunDef rep]
forall a b. (a -> PassM b) -> [a] -> PassM [b]
parPass (SymbolTable (Wise rep) -> FunDef rep -> PassM (FunDef rep)
forall {m :: * -> *}.
MonadFreshNames m =>
SymbolTable (Wise rep) -> FunDef rep -> m (FunDef rep)
simplifyFun' (SymbolTable (Wise rep) -> FunDef rep -> PassM (FunDef rep))
-> SymbolTable (Wise rep) -> FunDef rep -> PassM (FunDef rep)
forall a b. (a -> b) -> a -> b
$ SymbolTable (Wise rep) -> SymbolTable (Wise rep)
forall rep. SymbolTable rep -> SymbolTable rep
ST.deepen SymbolTable (Wise rep)
consts_vtable) [FunDef rep]
funs
let funs_uses :: UsageTable
funs_uses = Names -> UsageTable
UT.usages (Names -> UsageTable) -> Names -> UsageTable
forall a b. (a -> b) -> a -> b
$ (FunDef rep -> Names) -> [FunDef rep] -> Names
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap FunDef rep -> Names
forall a. FreeIn a => a -> Names
freeIn [FunDef rep]
funs'
(SymbolTable (Wise rep)
_, Stms rep
consts'') <- UsageTable
-> (SymbolTable (Wise rep), Stms rep)
-> PassM (SymbolTable (Wise rep), Stms rep)
forall {m :: * -> *}.
MonadFreshNames m =>
UsageTable
-> (SymbolTable (Wise rep), Stms rep)
-> m (SymbolTable (Wise rep), Stms rep)
simplifyConsts UsageTable
funs_uses (SymbolTable (Wise rep)
forall a. Monoid a => a
mempty, Stms rep
consts')
Prog rep -> PassM (Prog rep)
forall (m :: * -> *) a. Monad m => a -> m a
return (Prog rep -> PassM (Prog rep)) -> Prog rep -> PassM (Prog rep)
forall a b. (a -> b) -> a -> b
$ Stms rep -> [FunDef rep] -> Prog rep
forall rep. Stms rep -> [FunDef rep] -> Prog rep
Prog Stms rep
consts'' [FunDef rep]
funs'
where
simplifyFun' :: SymbolTable (Wise rep) -> FunDef rep -> m (FunDef rep)
simplifyFun' SymbolTable (Wise rep)
consts_vtable =
(FunDef rep -> SimpleM rep (FunDef (Wise rep)))
-> (FunDef (Wise rep) -> FunDef rep)
-> SimpleOps rep
-> RuleBook (Wise rep)
-> HoistBlockers rep
-> SymbolTable (Wise rep)
-> FunDef rep
-> m (FunDef rep)
forall (m :: * -> *) rep a b.
(MonadFreshNames m, SimplifiableRep rep) =>
(a -> SimpleM rep b)
-> (b -> a)
-> SimpleOps rep
-> RuleBook (Wise rep)
-> HoistBlockers rep
-> SymbolTable (Wise rep)
-> a
-> m a
simplifySomething
((SymbolTable (Wise rep) -> SymbolTable (Wise rep))
-> SimpleM rep (FunDef (Wise rep))
-> SimpleM rep (FunDef (Wise rep))
forall rep a.
(SymbolTable (Wise rep) -> SymbolTable (Wise rep))
-> SimpleM rep a -> SimpleM rep a
Engine.localVtable (SymbolTable (Wise rep)
consts_vtable SymbolTable (Wise rep)
-> SymbolTable (Wise rep) -> SymbolTable (Wise rep)
forall a. Semigroup a => a -> a -> a
<>) (SimpleM rep (FunDef (Wise rep))
-> SimpleM rep (FunDef (Wise rep)))
-> (FunDef rep -> SimpleM rep (FunDef (Wise rep)))
-> FunDef rep
-> SimpleM rep (FunDef (Wise rep))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FunDef rep -> SimpleM rep (FunDef (Wise rep))
forall rep.
SimplifiableRep rep =>
FunDef rep -> SimpleM rep (FunDef (Wise rep))
Engine.simplifyFun)
FunDef (Wise rep) -> FunDef rep
forall rep. CanBeWise (Op rep) => FunDef (Wise rep) -> FunDef rep
removeFunDefWisdom
SimpleOps rep
simpl
RuleBook (Wise rep)
rules
HoistBlockers rep
blockers
SymbolTable (Wise rep)
forall a. Monoid a => a
mempty
simplifyConsts :: UsageTable
-> (SymbolTable (Wise rep), Stms rep)
-> m (SymbolTable (Wise rep), Stms rep)
simplifyConsts UsageTable
uses =
((SymbolTable (Wise rep), Stms rep)
-> SimpleM rep (SymbolTable (Wise rep), Stms (Wise rep)))
-> ((SymbolTable (Wise rep), Stms (Wise rep))
-> (SymbolTable (Wise rep), Stms rep))
-> SimpleOps rep
-> RuleBook (Wise rep)
-> HoistBlockers rep
-> SymbolTable (Wise rep)
-> (SymbolTable (Wise rep), Stms rep)
-> m (SymbolTable (Wise rep), Stms rep)
forall (m :: * -> *) rep a b.
(MonadFreshNames m, SimplifiableRep rep) =>
(a -> SimpleM rep b)
-> (b -> a)
-> SimpleOps rep
-> RuleBook (Wise rep)
-> HoistBlockers rep
-> SymbolTable (Wise rep)
-> a
-> m a
simplifySomething
(UsageTable
-> Stms rep
-> SimpleM rep (SymbolTable (Wise rep), Stms (Wise rep))
onConsts UsageTable
uses (Stms rep -> SimpleM rep (SymbolTable (Wise rep), Stms (Wise rep)))
-> ((SymbolTable (Wise rep), Stms rep) -> Stms rep)
-> (SymbolTable (Wise rep), Stms rep)
-> SimpleM rep (SymbolTable (Wise rep), Stms (Wise rep))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SymbolTable (Wise rep), Stms rep) -> Stms rep
forall a b. (a, b) -> b
snd)
((Stms (Wise rep) -> Stms rep)
-> (SymbolTable (Wise rep), Stms (Wise rep))
-> (SymbolTable (Wise rep), Stms rep)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (Stm (Wise rep) -> Stm rep
forall rep. CanBeWise (Op rep) => Stm (Wise rep) -> Stm rep
removeStmWisdom (Stm (Wise rep) -> Stm rep) -> Stms (Wise rep) -> Stms rep
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>))
SimpleOps rep
simpl
RuleBook (Wise rep)
rules
HoistBlockers rep
blockers
SymbolTable (Wise rep)
forall a. Monoid a => a
mempty
onConsts :: UsageTable
-> Stms rep
-> SimpleM rep (SymbolTable (Wise rep), Stms (Wise rep))
onConsts UsageTable
uses Stms rep
consts' = do
(()
_, Stms (Wise rep)
consts'') <-
Stms rep
-> SimpleM rep ((), Stms (Wise rep))
-> SimpleM rep ((), Stms (Wise rep))
forall rep a.
SimplifiableRep rep =>
Stms rep
-> SimpleM rep (a, Stms (Wise rep))
-> SimpleM rep (a, Stms (Wise rep))
Engine.simplifyStms Stms rep
consts' (((), Stms (Wise rep)) -> SimpleM rep ((), Stms (Wise rep))
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((), Stms (Wise rep)
forall a. Monoid a => a
mempty))
(Stms (Wise rep)
consts''', Stms (Wise rep)
_) <-
RuleBook (Wise rep)
-> BlockPred (Wise rep)
-> SymbolTable (Wise rep)
-> UsageTable
-> Stms (Wise rep)
-> SimpleM rep (Stms (Wise rep), Stms (Wise rep))
forall rep.
SimplifiableRep rep =>
RuleBook (Wise rep)
-> BlockPred (Wise rep)
-> SymbolTable (Wise rep)
-> UsageTable
-> Stms (Wise rep)
-> SimpleM rep (Stms (Wise rep), Stms (Wise rep))
Engine.hoistStms RuleBook (Wise rep)
rules (Bool -> BlockPred (Wise rep)
forall rep. Bool -> BlockPred rep
Engine.isFalse Bool
False) SymbolTable (Wise rep)
forall a. Monoid a => a
mempty UsageTable
uses Stms (Wise rep)
consts''
(SymbolTable (Wise rep), Stms (Wise rep))
-> SimpleM rep (SymbolTable (Wise rep), Stms (Wise rep))
forall (m :: * -> *) a. Monad m => a -> m a
return (Stms (Wise rep) -> SymbolTable (Wise rep) -> SymbolTable (Wise rep)
forall rep.
(ASTRep rep, IndexOp (Op rep), Aliased rep) =>
Stms rep -> SymbolTable rep -> SymbolTable rep
ST.insertStms Stms (Wise rep)
consts''' SymbolTable (Wise rep)
forall a. Monoid a => a
mempty, Stms (Wise rep)
consts''')
simplifySomething ::
(MonadFreshNames m, Engine.SimplifiableRep rep) =>
(a -> Engine.SimpleM rep b) ->
(b -> a) ->
Engine.SimpleOps rep ->
RuleBook (Wise rep) ->
Engine.HoistBlockers rep ->
ST.SymbolTable (Wise rep) ->
a ->
m a
simplifySomething :: forall (m :: * -> *) rep a b.
(MonadFreshNames m, SimplifiableRep rep) =>
(a -> SimpleM rep b)
-> (b -> a)
-> SimpleOps rep
-> RuleBook (Wise rep)
-> HoistBlockers rep
-> SymbolTable (Wise rep)
-> a
-> m a
simplifySomething a -> SimpleM rep b
f b -> a
g SimpleOps rep
simpl RuleBook (Wise rep)
rules HoistBlockers rep
blockers SymbolTable (Wise rep)
vtable a
x = do
let f' :: a -> SimpleM rep b
f' a
x' = (SymbolTable (Wise rep) -> SymbolTable (Wise rep))
-> SimpleM rep b -> SimpleM rep b
forall rep a.
(SymbolTable (Wise rep) -> SymbolTable (Wise rep))
-> SimpleM rep a -> SimpleM rep a
Engine.localVtable (SymbolTable (Wise rep)
vtable SymbolTable (Wise rep)
-> SymbolTable (Wise rep) -> SymbolTable (Wise rep)
forall a. Semigroup a => a -> a -> a
<>) (SimpleM rep b -> SimpleM rep b) -> SimpleM rep b -> SimpleM rep b
forall a b. (a -> b) -> a -> b
$ a -> SimpleM rep b
f a
x'
Env rep
-> SimpleOps rep -> (a -> SimpleM rep b) -> (b -> a) -> a -> m a
forall (m :: * -> *) rep a b.
(MonadFreshNames m, SimplifiableRep rep) =>
Env rep
-> SimpleOps rep -> (a -> SimpleM rep b) -> (b -> a) -> a -> m a
loopUntilConvergence Env rep
env SimpleOps rep
simpl a -> SimpleM rep b
f' b -> a
g a
x
where
env :: Env rep
env = RuleBook (Wise rep) -> HoistBlockers rep -> Env rep
forall rep. RuleBook (Wise rep) -> HoistBlockers rep -> Env rep
Engine.emptyEnv RuleBook (Wise rep)
rules HoistBlockers rep
blockers
simplifyFun ::
(MonadFreshNames m, Engine.SimplifiableRep rep) =>
Engine.SimpleOps rep ->
RuleBook (Engine.Wise rep) ->
Engine.HoistBlockers rep ->
ST.SymbolTable (Wise rep) ->
FunDef rep ->
m (FunDef rep)
simplifyFun :: forall (m :: * -> *) rep.
(MonadFreshNames m, SimplifiableRep rep) =>
SimpleOps rep
-> RuleBook (Wise rep)
-> HoistBlockers rep
-> SymbolTable (Wise rep)
-> FunDef rep
-> m (FunDef rep)
simplifyFun = (FunDef rep -> SimpleM rep (FunDef (Wise rep)))
-> (FunDef (Wise rep) -> FunDef rep)
-> SimpleOps rep
-> RuleBook (Wise rep)
-> HoistBlockers rep
-> SymbolTable (Wise rep)
-> FunDef rep
-> m (FunDef rep)
forall (m :: * -> *) rep a b.
(MonadFreshNames m, SimplifiableRep rep) =>
(a -> SimpleM rep b)
-> (b -> a)
-> SimpleOps rep
-> RuleBook (Wise rep)
-> HoistBlockers rep
-> SymbolTable (Wise rep)
-> a
-> m a
simplifySomething FunDef rep -> SimpleM rep (FunDef (Wise rep))
forall rep.
SimplifiableRep rep =>
FunDef rep -> SimpleM rep (FunDef (Wise rep))
Engine.simplifyFun FunDef (Wise rep) -> FunDef rep
forall rep. CanBeWise (Op rep) => FunDef (Wise rep) -> FunDef rep
removeFunDefWisdom
simplifyLambda ::
( MonadFreshNames m,
HasScope rep m,
Engine.SimplifiableRep rep
) =>
Engine.SimpleOps rep ->
RuleBook (Engine.Wise rep) ->
Engine.HoistBlockers rep ->
Lambda rep ->
m (Lambda rep)
simplifyLambda :: forall (m :: * -> *) rep.
(MonadFreshNames m, HasScope rep m, SimplifiableRep rep) =>
SimpleOps rep
-> RuleBook (Wise rep)
-> HoistBlockers rep
-> Lambda rep
-> m (Lambda rep)
simplifyLambda SimpleOps rep
simpl RuleBook (Wise rep)
rules HoistBlockers rep
blockers Lambda rep
orig_lam = do
SymbolTable (Wise rep)
vtable <- Scope (Wise rep) -> SymbolTable (Wise rep)
forall rep. ASTRep rep => Scope rep -> SymbolTable rep
ST.fromScope (Scope (Wise rep) -> SymbolTable (Wise rep))
-> (Scope rep -> Scope (Wise rep))
-> Scope rep
-> SymbolTable (Wise rep)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Scope rep -> Scope (Wise rep)
forall rep. Scope rep -> Scope (Wise rep)
addScopeWisdom (Scope rep -> SymbolTable (Wise rep))
-> m (Scope rep) -> m (SymbolTable (Wise rep))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (Scope rep)
forall rep (m :: * -> *). HasScope rep m => m (Scope rep)
askScope
(Lambda rep -> SimpleM rep (Lambda (Wise rep)))
-> (Lambda (Wise rep) -> Lambda rep)
-> SimpleOps rep
-> RuleBook (Wise rep)
-> HoistBlockers rep
-> SymbolTable (Wise rep)
-> Lambda rep
-> m (Lambda rep)
forall (m :: * -> *) rep a b.
(MonadFreshNames m, SimplifiableRep rep) =>
(a -> SimpleM rep b)
-> (b -> a)
-> SimpleOps rep
-> RuleBook (Wise rep)
-> HoistBlockers rep
-> SymbolTable (Wise rep)
-> a
-> m a
simplifySomething
Lambda rep -> SimpleM rep (Lambda (Wise rep))
forall rep.
SimplifiableRep rep =>
Lambda rep -> SimpleM rep (Lambda (Wise rep))
Engine.simplifyLambdaNoHoisting
Lambda (Wise rep) -> Lambda rep
forall rep. CanBeWise (Op rep) => Lambda (Wise rep) -> Lambda rep
removeLambdaWisdom
SimpleOps rep
simpl
RuleBook (Wise rep)
rules
HoistBlockers rep
blockers
SymbolTable (Wise rep)
vtable
Lambda rep
orig_lam
simplifyStms ::
(MonadFreshNames m, Engine.SimplifiableRep rep) =>
Engine.SimpleOps rep ->
RuleBook (Engine.Wise rep) ->
Engine.HoistBlockers rep ->
Scope rep ->
Stms rep ->
m (ST.SymbolTable (Wise rep), Stms rep)
simplifyStms :: forall (m :: * -> *) rep.
(MonadFreshNames m, SimplifiableRep rep) =>
SimpleOps rep
-> RuleBook (Wise rep)
-> HoistBlockers rep
-> Scope rep
-> Stms rep
-> m (SymbolTable (Wise rep), Stms rep)
simplifyStms SimpleOps rep
simpl RuleBook (Wise rep)
rules HoistBlockers rep
blockers Scope rep
scope =
((SymbolTable (Wise rep), Stms rep)
-> SimpleM rep (SymbolTable (Wise rep), Stms (Wise rep)))
-> ((SymbolTable (Wise rep), Stms (Wise rep))
-> (SymbolTable (Wise rep), Stms rep))
-> SimpleOps rep
-> RuleBook (Wise rep)
-> HoistBlockers rep
-> SymbolTable (Wise rep)
-> (SymbolTable (Wise rep), Stms rep)
-> m (SymbolTable (Wise rep), Stms rep)
forall (m :: * -> *) rep a b.
(MonadFreshNames m, SimplifiableRep rep) =>
(a -> SimpleM rep b)
-> (b -> a)
-> SimpleOps rep
-> RuleBook (Wise rep)
-> HoistBlockers rep
-> SymbolTable (Wise rep)
-> a
-> m a
simplifySomething (SymbolTable (Wise rep), Stms rep)
-> SimpleM rep (SymbolTable (Wise rep), Stms (Wise rep))
forall {rep} {a}.
(ASTRep rep, Simplifiable (LetDec rep),
Simplifiable (FParamInfo rep), Simplifiable (LParamInfo rep),
Simplifiable (RetType rep), Simplifiable (BranchType rep),
CanBeWise (Op rep), IndexOp (OpWithWisdom (Op rep)),
BinderOps (Wise rep)) =>
(a, Stms rep)
-> SimpleM rep (SymbolTable (Wise rep), Stms (Wise rep))
f (SymbolTable (Wise rep), Stms (Wise rep))
-> (SymbolTable (Wise rep), Stms rep)
forall {a}. (a, Stms (Wise rep)) -> (a, Stms rep)
g SimpleOps rep
simpl RuleBook (Wise rep)
rules HoistBlockers rep
blockers SymbolTable (Wise rep)
vtable ((SymbolTable (Wise rep), Stms rep)
-> m (SymbolTable (Wise rep), Stms rep))
-> (Stms rep -> (SymbolTable (Wise rep), Stms rep))
-> Stms rep
-> m (SymbolTable (Wise rep), Stms rep)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SymbolTable (Wise rep)
forall a. Monoid a => a
mempty,)
where
vtable :: SymbolTable (Wise rep)
vtable = Scope (Wise rep) -> SymbolTable (Wise rep)
forall rep. ASTRep rep => Scope rep -> SymbolTable rep
ST.fromScope (Scope (Wise rep) -> SymbolTable (Wise rep))
-> Scope (Wise rep) -> SymbolTable (Wise rep)
forall a b. (a -> b) -> a -> b
$ Scope rep -> Scope (Wise rep)
forall rep. Scope rep -> Scope (Wise rep)
addScopeWisdom Scope rep
scope
f :: (a, Stms rep)
-> SimpleM rep (SymbolTable (Wise rep), Stms (Wise rep))
f (a
_, Stms rep
stms) =
Stms rep
-> SimpleM rep (SymbolTable (Wise rep), Stms (Wise rep))
-> SimpleM rep (SymbolTable (Wise rep), Stms (Wise rep))
forall rep a.
SimplifiableRep rep =>
Stms rep
-> SimpleM rep (a, Stms (Wise rep))
-> SimpleM rep (a, Stms (Wise rep))
Engine.simplifyStms Stms rep
stms ((,Stms (Wise rep)
forall a. Monoid a => a
mempty) (SymbolTable (Wise rep)
-> (SymbolTable (Wise rep), Stms (Wise rep)))
-> SimpleM rep (SymbolTable (Wise rep))
-> SimpleM rep (SymbolTable (Wise rep), Stms (Wise rep))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SimpleM rep (SymbolTable (Wise rep))
forall rep. SimpleM rep (SymbolTable (Wise rep))
Engine.askVtable)
g :: (a, Stms (Wise rep)) -> (a, Stms rep)
g = (Stms (Wise rep) -> Stms rep)
-> (a, Stms (Wise rep)) -> (a, Stms rep)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second ((Stms (Wise rep) -> Stms rep)
-> (a, Stms (Wise rep)) -> (a, Stms rep))
-> (Stms (Wise rep) -> Stms rep)
-> (a, Stms (Wise rep))
-> (a, Stms rep)
forall a b. (a -> b) -> a -> b
$ (Stm (Wise rep) -> Stm rep) -> Stms (Wise rep) -> Stms rep
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Stm (Wise rep) -> Stm rep
forall rep. CanBeWise (Op rep) => Stm (Wise rep) -> Stm rep
removeStmWisdom
loopUntilConvergence ::
(MonadFreshNames m, Engine.SimplifiableRep rep) =>
Engine.Env rep ->
Engine.SimpleOps rep ->
(a -> Engine.SimpleM rep b) ->
(b -> a) ->
a ->
m a
loopUntilConvergence :: forall (m :: * -> *) rep a b.
(MonadFreshNames m, SimplifiableRep rep) =>
Env rep
-> SimpleOps rep -> (a -> SimpleM rep b) -> (b -> a) -> a -> m a
loopUntilConvergence Env rep
env SimpleOps rep
simpl a -> SimpleM rep b
f b -> a
g a
x = do
(b
x', Bool
changed) <- (VNameSource -> ((b, Bool), VNameSource)) -> m (b, Bool)
forall (m :: * -> *) a.
MonadFreshNames m =>
(VNameSource -> (a, VNameSource)) -> m a
modifyNameSource ((VNameSource -> ((b, Bool), VNameSource)) -> m (b, Bool))
-> (VNameSource -> ((b, Bool), VNameSource)) -> m (b, Bool)
forall a b. (a -> b) -> a -> b
$ SimpleM rep b
-> SimpleOps rep
-> Env rep
-> VNameSource
-> ((b, Bool), VNameSource)
forall rep a.
SimpleM rep a
-> SimpleOps rep
-> Env rep
-> VNameSource
-> ((a, Bool), VNameSource)
Engine.runSimpleM (a -> SimpleM rep b
f a
x) SimpleOps rep
simpl Env rep
env
if Bool
changed then Env rep
-> SimpleOps rep -> (a -> SimpleM rep b) -> (b -> a) -> a -> m a
forall (m :: * -> *) rep a b.
(MonadFreshNames m, SimplifiableRep rep) =>
Env rep
-> SimpleOps rep -> (a -> SimpleM rep b) -> (b -> a) -> a -> m a
loopUntilConvergence Env rep
env SimpleOps rep
simpl a -> SimpleM rep b
f b -> a
g (b -> a
g b
x') else a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> m a) -> a -> m a
forall a b. (a -> b) -> a -> b
$ b -> a
g b
x'