{-# 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 :: 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 :: (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 :: 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 :: 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 :: 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)),
BuilderOps (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 :: 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'