{-# 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

-- | Simplify the given program.  Even if the output differs from the
-- output, meaningful simplification may not have taken place - the
-- order of bindings may simply have been rearranged.
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)

  -- We deepen the vtable so it will look like the constants are in an
  -- "outer loop"; this communicates useful information to some
  -- simplification rules (e.g. seee issue #1302).
  [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''')

-- | Run a simplification operation to convergence.
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

-- | Simplify the given function.  Even if the output differs from the
-- output, meaningful simplification may not have taken place - the
-- order of bindings may simply have been rearranged.  Runs in a loop
-- until convergence.
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

-- | Simplify just a single t'Lambda'.
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

-- | Simplify a sequence of 'Stm's.
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'