{-# 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.SimplifiableLore,
    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.Lore
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.SimplifiableLore lore =>
  Engine.SimpleOps lore ->
  RuleBook (Engine.Wise lore) ->
  Engine.HoistBlockers lore ->
  Prog lore ->
  PassM (Prog lore)
simplifyProg :: forall lore.
SimplifiableLore lore =>
SimpleOps lore
-> RuleBook (Wise lore)
-> HoistBlockers lore
-> Prog lore
-> PassM (Prog lore)
simplifyProg SimpleOps lore
simpl RuleBook (Wise lore)
rules HoistBlockers lore
blockers (Prog Stms lore
consts [FunDef lore]
funs) = do
  (SymbolTable (Wise lore)
consts_vtable, Stms lore
consts') <-
    UsageTable
-> (SymbolTable (Wise lore), Stms lore)
-> PassM (SymbolTable (Wise lore), Stms lore)
forall {m :: * -> *}.
MonadFreshNames m =>
UsageTable
-> (SymbolTable (Wise lore), Stms lore)
-> m (SymbolTable (Wise lore), Stms lore)
simplifyConsts
      (Names -> UsageTable
UT.usages (Names -> UsageTable) -> Names -> UsageTable
forall a b. (a -> b) -> a -> b
$ (FunDef lore -> Names) -> [FunDef lore] -> Names
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap FunDef lore -> Names
forall a. FreeIn a => a -> Names
freeIn [FunDef lore]
funs)
      (SymbolTable (Wise lore)
forall a. Monoid a => a
mempty, Stms lore
consts)

  [FunDef lore]
funs' <- (FunDef lore -> PassM (FunDef lore))
-> [FunDef lore] -> PassM [FunDef lore]
forall a b. (a -> PassM b) -> [a] -> PassM [b]
parPass (SymbolTable (Wise lore) -> FunDef lore -> PassM (FunDef lore)
forall {m :: * -> *}.
MonadFreshNames m =>
SymbolTable (Wise lore) -> FunDef lore -> m (FunDef lore)
simplifyFun' SymbolTable (Wise lore)
consts_vtable) [FunDef lore]
funs
  let funs_uses :: UsageTable
funs_uses = Names -> UsageTable
UT.usages (Names -> UsageTable) -> Names -> UsageTable
forall a b. (a -> b) -> a -> b
$ (FunDef lore -> Names) -> [FunDef lore] -> Names
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap FunDef lore -> Names
forall a. FreeIn a => a -> Names
freeIn [FunDef lore]
funs'

  (SymbolTable (Wise lore)
_, Stms lore
consts'') <- UsageTable
-> (SymbolTable (Wise lore), Stms lore)
-> PassM (SymbolTable (Wise lore), Stms lore)
forall {m :: * -> *}.
MonadFreshNames m =>
UsageTable
-> (SymbolTable (Wise lore), Stms lore)
-> m (SymbolTable (Wise lore), Stms lore)
simplifyConsts UsageTable
funs_uses (SymbolTable (Wise lore)
forall a. Monoid a => a
mempty, Stms lore
consts')

  Prog lore -> PassM (Prog lore)
forall (m :: * -> *) a. Monad m => a -> m a
return (Prog lore -> PassM (Prog lore)) -> Prog lore -> PassM (Prog lore)
forall a b. (a -> b) -> a -> b
$ Stms lore -> [FunDef lore] -> Prog lore
forall lore. Stms lore -> [FunDef lore] -> Prog lore
Prog Stms lore
consts'' [FunDef lore]
funs'
  where
    simplifyFun' :: SymbolTable (Wise lore) -> FunDef lore -> m (FunDef lore)
simplifyFun' SymbolTable (Wise lore)
consts_vtable =
      (FunDef lore -> SimpleM lore (FunDef (Wise lore)))
-> (FunDef (Wise lore) -> FunDef lore)
-> SimpleOps lore
-> RuleBook (Wise lore)
-> HoistBlockers lore
-> SymbolTable (Wise lore)
-> FunDef lore
-> m (FunDef lore)
forall (m :: * -> *) lore a b.
(MonadFreshNames m, SimplifiableLore lore) =>
(a -> SimpleM lore b)
-> (b -> a)
-> SimpleOps lore
-> RuleBook (Wise lore)
-> HoistBlockers lore
-> SymbolTable (Wise lore)
-> a
-> m a
simplifySomething
        ((SymbolTable (Wise lore) -> SymbolTable (Wise lore))
-> SimpleM lore (FunDef (Wise lore))
-> SimpleM lore (FunDef (Wise lore))
forall lore a.
(SymbolTable (Wise lore) -> SymbolTable (Wise lore))
-> SimpleM lore a -> SimpleM lore a
Engine.localVtable (SymbolTable (Wise lore)
consts_vtable SymbolTable (Wise lore)
-> SymbolTable (Wise lore) -> SymbolTable (Wise lore)
forall a. Semigroup a => a -> a -> a
<>) (SimpleM lore (FunDef (Wise lore))
 -> SimpleM lore (FunDef (Wise lore)))
-> (FunDef lore -> SimpleM lore (FunDef (Wise lore)))
-> FunDef lore
-> SimpleM lore (FunDef (Wise lore))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FunDef lore -> SimpleM lore (FunDef (Wise lore))
forall lore.
SimplifiableLore lore =>
FunDef lore -> SimpleM lore (FunDef (Wise lore))
Engine.simplifyFun)
        FunDef (Wise lore) -> FunDef lore
forall lore.
CanBeWise (Op lore) =>
FunDef (Wise lore) -> FunDef lore
removeFunDefWisdom
        SimpleOps lore
simpl
        RuleBook (Wise lore)
rules
        HoistBlockers lore
blockers
        SymbolTable (Wise lore)
forall a. Monoid a => a
mempty

    simplifyConsts :: UsageTable
-> (SymbolTable (Wise lore), Stms lore)
-> m (SymbolTable (Wise lore), Stms lore)
simplifyConsts UsageTable
uses =
      ((SymbolTable (Wise lore), Stms lore)
 -> SimpleM lore (SymbolTable (Wise lore), Stms (Wise lore)))
-> ((SymbolTable (Wise lore), Stms (Wise lore))
    -> (SymbolTable (Wise lore), Stms lore))
-> SimpleOps lore
-> RuleBook (Wise lore)
-> HoistBlockers lore
-> SymbolTable (Wise lore)
-> (SymbolTable (Wise lore), Stms lore)
-> m (SymbolTable (Wise lore), Stms lore)
forall (m :: * -> *) lore a b.
(MonadFreshNames m, SimplifiableLore lore) =>
(a -> SimpleM lore b)
-> (b -> a)
-> SimpleOps lore
-> RuleBook (Wise lore)
-> HoistBlockers lore
-> SymbolTable (Wise lore)
-> a
-> m a
simplifySomething
        (UsageTable
-> Stms lore
-> SimpleM lore (SymbolTable (Wise lore), Stms (Wise lore))
onConsts UsageTable
uses (Stms lore
 -> SimpleM lore (SymbolTable (Wise lore), Stms (Wise lore)))
-> ((SymbolTable (Wise lore), Stms lore) -> Stms lore)
-> (SymbolTable (Wise lore), Stms lore)
-> SimpleM lore (SymbolTable (Wise lore), Stms (Wise lore))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SymbolTable (Wise lore), Stms lore) -> Stms lore
forall a b. (a, b) -> b
snd)
        ((Stms (Wise lore) -> Stms lore)
-> (SymbolTable (Wise lore), Stms (Wise lore))
-> (SymbolTable (Wise lore), Stms lore)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (Stm (Wise lore) -> Stm lore
forall lore. CanBeWise (Op lore) => Stm (Wise lore) -> Stm lore
removeStmWisdom (Stm (Wise lore) -> Stm lore) -> Stms (Wise lore) -> Stms lore
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>))
        SimpleOps lore
simpl
        RuleBook (Wise lore)
rules
        HoistBlockers lore
blockers
        SymbolTable (Wise lore)
forall a. Monoid a => a
mempty

    onConsts :: UsageTable
-> Stms lore
-> SimpleM lore (SymbolTable (Wise lore), Stms (Wise lore))
onConsts UsageTable
uses Stms lore
consts' = do
      (()
_, Stms (Wise lore)
consts'') <-
        Stms lore
-> SimpleM lore ((), Stms (Wise lore))
-> SimpleM lore ((), Stms (Wise lore))
forall lore a.
SimplifiableLore lore =>
Stms lore
-> SimpleM lore (a, Stms (Wise lore))
-> SimpleM lore (a, Stms (Wise lore))
Engine.simplifyStms Stms lore
consts' (((), Stms (Wise lore)) -> SimpleM lore ((), Stms (Wise lore))
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((), Stms (Wise lore)
forall a. Monoid a => a
mempty))
      (Stms (Wise lore)
consts''', Stms (Wise lore)
_) <-
        RuleBook (Wise lore)
-> BlockPred (Wise lore)
-> SymbolTable (Wise lore)
-> UsageTable
-> Stms (Wise lore)
-> SimpleM lore (Stms (Wise lore), Stms (Wise lore))
forall lore.
SimplifiableLore lore =>
RuleBook (Wise lore)
-> BlockPred (Wise lore)
-> SymbolTable (Wise lore)
-> UsageTable
-> Stms (Wise lore)
-> SimpleM lore (Stms (Wise lore), Stms (Wise lore))
Engine.hoistStms RuleBook (Wise lore)
rules (Bool -> BlockPred (Wise lore)
forall lore. Bool -> BlockPred lore
Engine.isFalse Bool
False) SymbolTable (Wise lore)
forall a. Monoid a => a
mempty UsageTable
uses Stms (Wise lore)
consts''
      (SymbolTable (Wise lore), Stms (Wise lore))
-> SimpleM lore (SymbolTable (Wise lore), Stms (Wise lore))
forall (m :: * -> *) a. Monad m => a -> m a
return (Stms (Wise lore)
-> SymbolTable (Wise lore) -> SymbolTable (Wise lore)
forall lore.
(ASTLore lore, IndexOp (Op lore), Aliased lore) =>
Stms lore -> SymbolTable lore -> SymbolTable lore
ST.insertStms Stms (Wise lore)
consts''' SymbolTable (Wise lore)
forall a. Monoid a => a
mempty, Stms (Wise lore)
consts''')

-- | Run a simplification operation to convergence.
simplifySomething ::
  (MonadFreshNames m, Engine.SimplifiableLore lore) =>
  (a -> Engine.SimpleM lore b) ->
  (b -> a) ->
  Engine.SimpleOps lore ->
  RuleBook (Wise lore) ->
  Engine.HoistBlockers lore ->
  ST.SymbolTable (Wise lore) ->
  a ->
  m a
simplifySomething :: forall (m :: * -> *) lore a b.
(MonadFreshNames m, SimplifiableLore lore) =>
(a -> SimpleM lore b)
-> (b -> a)
-> SimpleOps lore
-> RuleBook (Wise lore)
-> HoistBlockers lore
-> SymbolTable (Wise lore)
-> a
-> m a
simplifySomething a -> SimpleM lore b
f b -> a
g SimpleOps lore
simpl RuleBook (Wise lore)
rules HoistBlockers lore
blockers SymbolTable (Wise lore)
vtable a
x = do
  let f' :: a -> SimpleM lore b
f' a
x' = (SymbolTable (Wise lore) -> SymbolTable (Wise lore))
-> SimpleM lore b -> SimpleM lore b
forall lore a.
(SymbolTable (Wise lore) -> SymbolTable (Wise lore))
-> SimpleM lore a -> SimpleM lore a
Engine.localVtable (SymbolTable (Wise lore)
vtable SymbolTable (Wise lore)
-> SymbolTable (Wise lore) -> SymbolTable (Wise lore)
forall a. Semigroup a => a -> a -> a
<>) (SimpleM lore b -> SimpleM lore b)
-> SimpleM lore b -> SimpleM lore b
forall a b. (a -> b) -> a -> b
$ a -> SimpleM lore b
f a
x'
  Env lore
-> SimpleOps lore -> (a -> SimpleM lore b) -> (b -> a) -> a -> m a
forall (m :: * -> *) lore a b.
(MonadFreshNames m, SimplifiableLore lore) =>
Env lore
-> SimpleOps lore -> (a -> SimpleM lore b) -> (b -> a) -> a -> m a
loopUntilConvergence Env lore
env SimpleOps lore
simpl a -> SimpleM lore b
f' b -> a
g a
x
  where
    env :: Env lore
env = RuleBook (Wise lore) -> HoistBlockers lore -> Env lore
forall lore. RuleBook (Wise lore) -> HoistBlockers lore -> Env lore
Engine.emptyEnv RuleBook (Wise lore)
rules HoistBlockers lore
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.SimplifiableLore lore) =>
  Engine.SimpleOps lore ->
  RuleBook (Engine.Wise lore) ->
  Engine.HoistBlockers lore ->
  ST.SymbolTable (Wise lore) ->
  FunDef lore ->
  m (FunDef lore)
simplifyFun :: forall (m :: * -> *) lore.
(MonadFreshNames m, SimplifiableLore lore) =>
SimpleOps lore
-> RuleBook (Wise lore)
-> HoistBlockers lore
-> SymbolTable (Wise lore)
-> FunDef lore
-> m (FunDef lore)
simplifyFun = (FunDef lore -> SimpleM lore (FunDef (Wise lore)))
-> (FunDef (Wise lore) -> FunDef lore)
-> SimpleOps lore
-> RuleBook (Wise lore)
-> HoistBlockers lore
-> SymbolTable (Wise lore)
-> FunDef lore
-> m (FunDef lore)
forall (m :: * -> *) lore a b.
(MonadFreshNames m, SimplifiableLore lore) =>
(a -> SimpleM lore b)
-> (b -> a)
-> SimpleOps lore
-> RuleBook (Wise lore)
-> HoistBlockers lore
-> SymbolTable (Wise lore)
-> a
-> m a
simplifySomething FunDef lore -> SimpleM lore (FunDef (Wise lore))
forall lore.
SimplifiableLore lore =>
FunDef lore -> SimpleM lore (FunDef (Wise lore))
Engine.simplifyFun FunDef (Wise lore) -> FunDef lore
forall lore.
CanBeWise (Op lore) =>
FunDef (Wise lore) -> FunDef lore
removeFunDefWisdom

-- | Simplify just a single t'Lambda'.
simplifyLambda ::
  ( MonadFreshNames m,
    HasScope lore m,
    Engine.SimplifiableLore lore
  ) =>
  Engine.SimpleOps lore ->
  RuleBook (Engine.Wise lore) ->
  Engine.HoistBlockers lore ->
  Lambda lore ->
  m (Lambda lore)
simplifyLambda :: forall (m :: * -> *) lore.
(MonadFreshNames m, HasScope lore m, SimplifiableLore lore) =>
SimpleOps lore
-> RuleBook (Wise lore)
-> HoistBlockers lore
-> Lambda lore
-> m (Lambda lore)
simplifyLambda SimpleOps lore
simpl RuleBook (Wise lore)
rules HoistBlockers lore
blockers Lambda lore
orig_lam = do
  SymbolTable (Wise lore)
vtable <- Scope (Wise lore) -> SymbolTable (Wise lore)
forall lore. ASTLore lore => Scope lore -> SymbolTable lore
ST.fromScope (Scope (Wise lore) -> SymbolTable (Wise lore))
-> (Scope lore -> Scope (Wise lore))
-> Scope lore
-> SymbolTable (Wise lore)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Scope lore -> Scope (Wise lore)
forall lore. Scope lore -> Scope (Wise lore)
addScopeWisdom (Scope lore -> SymbolTable (Wise lore))
-> m (Scope lore) -> m (SymbolTable (Wise lore))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (Scope lore)
forall lore (m :: * -> *). HasScope lore m => m (Scope lore)
askScope
  (Lambda lore -> SimpleM lore (Lambda (Wise lore)))
-> (Lambda (Wise lore) -> Lambda lore)
-> SimpleOps lore
-> RuleBook (Wise lore)
-> HoistBlockers lore
-> SymbolTable (Wise lore)
-> Lambda lore
-> m (Lambda lore)
forall (m :: * -> *) lore a b.
(MonadFreshNames m, SimplifiableLore lore) =>
(a -> SimpleM lore b)
-> (b -> a)
-> SimpleOps lore
-> RuleBook (Wise lore)
-> HoistBlockers lore
-> SymbolTable (Wise lore)
-> a
-> m a
simplifySomething
    Lambda lore -> SimpleM lore (Lambda (Wise lore))
forall lore.
SimplifiableLore lore =>
Lambda lore -> SimpleM lore (Lambda (Wise lore))
Engine.simplifyLambdaNoHoisting
    Lambda (Wise lore) -> Lambda lore
forall lore.
CanBeWise (Op lore) =>
Lambda (Wise lore) -> Lambda lore
removeLambdaWisdom
    SimpleOps lore
simpl
    RuleBook (Wise lore)
rules
    HoistBlockers lore
blockers
    SymbolTable (Wise lore)
vtable
    Lambda lore
orig_lam

-- | Simplify a sequence of 'Stm's.
simplifyStms ::
  (MonadFreshNames m, Engine.SimplifiableLore lore) =>
  Engine.SimpleOps lore ->
  RuleBook (Engine.Wise lore) ->
  Engine.HoistBlockers lore ->
  Scope lore ->
  Stms lore ->
  m (ST.SymbolTable (Wise lore), Stms lore)
simplifyStms :: forall (m :: * -> *) lore.
(MonadFreshNames m, SimplifiableLore lore) =>
SimpleOps lore
-> RuleBook (Wise lore)
-> HoistBlockers lore
-> Scope lore
-> Stms lore
-> m (SymbolTable (Wise lore), Stms lore)
simplifyStms SimpleOps lore
simpl RuleBook (Wise lore)
rules HoistBlockers lore
blockers Scope lore
scope =
  ((SymbolTable (Wise lore), Stms lore)
 -> SimpleM lore (SymbolTable (Wise lore), Stms (Wise lore)))
-> ((SymbolTable (Wise lore), Stms (Wise lore))
    -> (SymbolTable (Wise lore), Stms lore))
-> SimpleOps lore
-> RuleBook (Wise lore)
-> HoistBlockers lore
-> SymbolTable (Wise lore)
-> (SymbolTable (Wise lore), Stms lore)
-> m (SymbolTable (Wise lore), Stms lore)
forall (m :: * -> *) lore a b.
(MonadFreshNames m, SimplifiableLore lore) =>
(a -> SimpleM lore b)
-> (b -> a)
-> SimpleOps lore
-> RuleBook (Wise lore)
-> HoistBlockers lore
-> SymbolTable (Wise lore)
-> a
-> m a
simplifySomething (SymbolTable (Wise lore), Stms lore)
-> SimpleM lore (SymbolTable (Wise lore), Stms (Wise lore))
forall {lore} {a}.
(ASTLore lore, Simplifiable (LetDec lore),
 Simplifiable (FParamInfo lore), Simplifiable (LParamInfo lore),
 Simplifiable (RetType lore), Simplifiable (BranchType lore),
 CanBeWise (Op lore), IndexOp (OpWithWisdom (Op lore)),
 BinderOps (Wise lore)) =>
(a, Stms lore)
-> SimpleM lore (SymbolTable (Wise lore), Stms (Wise lore))
f (SymbolTable (Wise lore), Stms (Wise lore))
-> (SymbolTable (Wise lore), Stms lore)
forall {a}. (a, Stms (Wise lore)) -> (a, Stms lore)
g SimpleOps lore
simpl RuleBook (Wise lore)
rules HoistBlockers lore
blockers SymbolTable (Wise lore)
vtable ((SymbolTable (Wise lore), Stms lore)
 -> m (SymbolTable (Wise lore), Stms lore))
-> (Stms lore -> (SymbolTable (Wise lore), Stms lore))
-> Stms lore
-> m (SymbolTable (Wise lore), Stms lore)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SymbolTable (Wise lore)
forall a. Monoid a => a
mempty,)
  where
    vtable :: SymbolTable (Wise lore)
vtable = Scope (Wise lore) -> SymbolTable (Wise lore)
forall lore. ASTLore lore => Scope lore -> SymbolTable lore
ST.fromScope (Scope (Wise lore) -> SymbolTable (Wise lore))
-> Scope (Wise lore) -> SymbolTable (Wise lore)
forall a b. (a -> b) -> a -> b
$ Scope lore -> Scope (Wise lore)
forall lore. Scope lore -> Scope (Wise lore)
addScopeWisdom Scope lore
scope
    f :: (a, Stms lore)
-> SimpleM lore (SymbolTable (Wise lore), Stms (Wise lore))
f (a
_, Stms lore
stms) =
      Stms lore
-> SimpleM lore (SymbolTable (Wise lore), Stms (Wise lore))
-> SimpleM lore (SymbolTable (Wise lore), Stms (Wise lore))
forall lore a.
SimplifiableLore lore =>
Stms lore
-> SimpleM lore (a, Stms (Wise lore))
-> SimpleM lore (a, Stms (Wise lore))
Engine.simplifyStms Stms lore
stms ((,Stms (Wise lore)
forall a. Monoid a => a
mempty) (SymbolTable (Wise lore)
 -> (SymbolTable (Wise lore), Stms (Wise lore)))
-> SimpleM lore (SymbolTable (Wise lore))
-> SimpleM lore (SymbolTable (Wise lore), Stms (Wise lore))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SimpleM lore (SymbolTable (Wise lore))
forall lore. SimpleM lore (SymbolTable (Wise lore))
Engine.askVtable)
    g :: (a, Stms (Wise lore)) -> (a, Stms lore)
g = (Stms (Wise lore) -> Stms lore)
-> (a, Stms (Wise lore)) -> (a, Stms lore)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second ((Stms (Wise lore) -> Stms lore)
 -> (a, Stms (Wise lore)) -> (a, Stms lore))
-> (Stms (Wise lore) -> Stms lore)
-> (a, Stms (Wise lore))
-> (a, Stms lore)
forall a b. (a -> b) -> a -> b
$ (Stm (Wise lore) -> Stm lore) -> Stms (Wise lore) -> Stms lore
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Stm (Wise lore) -> Stm lore
forall lore. CanBeWise (Op lore) => Stm (Wise lore) -> Stm lore
removeStmWisdom

loopUntilConvergence ::
  (MonadFreshNames m, Engine.SimplifiableLore lore) =>
  Engine.Env lore ->
  Engine.SimpleOps lore ->
  (a -> Engine.SimpleM lore b) ->
  (b -> a) ->
  a ->
  m a
loopUntilConvergence :: forall (m :: * -> *) lore a b.
(MonadFreshNames m, SimplifiableLore lore) =>
Env lore
-> SimpleOps lore -> (a -> SimpleM lore b) -> (b -> a) -> a -> m a
loopUntilConvergence Env lore
env SimpleOps lore
simpl a -> SimpleM lore 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 lore b
-> SimpleOps lore
-> Env lore
-> VNameSource
-> ((b, Bool), VNameSource)
forall lore a.
SimpleM lore a
-> SimpleOps lore
-> Env lore
-> VNameSource
-> ((a, Bool), VNameSource)
Engine.runSimpleM (a -> SimpleM lore b
f a
x) SimpleOps lore
simpl Env lore
env
  if Bool
changed then Env lore
-> SimpleOps lore -> (a -> SimpleM lore b) -> (b -> a) -> a -> m a
forall (m :: * -> *) lore a b.
(MonadFreshNames m, SimplifiableLore lore) =>
Env lore
-> SimpleOps lore -> (a -> SimpleM lore b) -> (b -> a) -> a -> m a
loopUntilConvergence Env lore
env SimpleOps lore
simpl a -> SimpleM lore 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'