{-# 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 :: 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 (BodyT lore -> Names
forall a. FreeIn a => a -> Names
freeIn (BodyT lore -> Names)
-> (FunDef lore -> BodyT lore) -> FunDef lore -> Names
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FunDef lore -> BodyT lore
forall lore. FunDef lore -> BodyT lore
funDefBody) [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 (BodyT lore -> Names
forall a. FreeIn a => a -> Names
freeIn (BodyT lore -> Names)
-> (FunDef lore -> BodyT lore) -> FunDef lore -> Names
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FunDef lore -> BodyT lore
forall lore. FunDef lore -> BodyT lore
funDefBody) [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 :: (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 :: 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 :: 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 :: 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 :: 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'