{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE Strict #-}

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 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 rep
prog = do
  let consts :: Stms rep
consts = Prog rep -> Stms rep
forall rep. Prog rep -> Stms rep
progConsts Prog rep
prog
      funs :: [FunDef rep]
funs = Prog rep -> [FunDef rep]
forall rep. Prog rep -> [FunDef rep]
progFuns Prog rep
prog
  (SymbolTable (Wise rep)
consts_vtable, Stms (Wise rep)
consts') <-
    UsageTable
-> (SymbolTable (Wise rep), Stms (Wise rep))
-> PassM (SymbolTable (Wise rep), Stms (Wise rep))
forall (m :: * -> *).
MonadFreshNames m =>
UsageTable
-> (SymbolTable (Wise rep), Stms (Wise rep))
-> m (SymbolTable (Wise rep), Stms (Wise 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 -> Stms (Wise rep)
forall rep. Informing rep => Stms rep -> Stms (Wise rep)
informStms 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. see issue #1302).
  [FunDef (Wise rep)]
funs' <- (FunDef rep -> PassM (FunDef (Wise rep)))
-> [FunDef rep] -> PassM [FunDef (Wise rep)]
forall a b. (a -> PassM b) -> [a] -> PassM [b]
parPass (SymbolTable (Wise rep)
-> FunDef (Wise rep) -> PassM (FunDef (Wise rep))
forall (m :: * -> *).
MonadFreshNames m =>
SymbolTable (Wise rep)
-> FunDef (Wise rep) -> m (FunDef (Wise rep))
simplifyFun' (SymbolTable (Wise rep) -> SymbolTable (Wise rep)
forall rep. SymbolTable rep -> SymbolTable rep
ST.deepen SymbolTable (Wise rep)
consts_vtable) (FunDef (Wise rep) -> PassM (FunDef (Wise rep)))
-> (FunDef rep -> FunDef (Wise rep))
-> FunDef rep
-> PassM (FunDef (Wise rep))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FunDef rep -> FunDef (Wise rep)
forall rep. Informing rep => FunDef rep -> FunDef (Wise rep)
informFunDef) [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 (Wise rep) -> Names) -> [FunDef (Wise rep)] -> Names
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap FunDef (Wise rep) -> Names
forall a. FreeIn a => a -> Names
freeIn [FunDef (Wise rep)]
funs'

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

  Prog rep -> PassM (Prog rep)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Prog rep -> PassM (Prog rep)) -> Prog rep -> PassM (Prog rep)
forall a b. (a -> b) -> a -> b
$
    Prog rep
prog
      { progConsts :: Stms rep
progConsts = (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 Stms (Wise rep)
consts'',
        progFuns :: [FunDef rep]
progFuns = (FunDef (Wise rep) -> FunDef rep)
-> [FunDef (Wise rep)] -> [FunDef rep]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FunDef (Wise rep) -> FunDef rep
forall rep. CanBeWise (Op rep) => FunDef (Wise rep) -> FunDef rep
removeFunDefWisdom [FunDef (Wise rep)]
funs'
      }
  where
    simplifyFun' :: SymbolTable (Wise rep)
-> FunDef (Wise rep) -> m (FunDef (Wise rep))
simplifyFun' SymbolTable (Wise rep)
consts_vtable =
      (FunDef (Wise rep) -> SimpleM rep (FunDef (Wise rep)))
-> (FunDef (Wise rep) -> FunDef (Wise rep))
-> SimpleOps rep
-> RuleBook (Wise rep)
-> HoistBlockers rep
-> SymbolTable (Wise rep)
-> FunDef (Wise rep)
-> m (FunDef (Wise 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 (Wise rep) -> SimpleM rep (FunDef (Wise rep)))
-> FunDef (Wise rep)
-> SimpleM rep (FunDef (Wise rep))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FunDef (Wise rep) -> SimpleM rep (FunDef (Wise rep))
forall rep.
SimplifiableRep rep =>
FunDef (Wise rep) -> SimpleM rep (FunDef (Wise rep))
Engine.simplifyFun)
        FunDef (Wise rep) -> FunDef (Wise rep)
forall a. a -> a
id
        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 (Wise rep))
-> m (SymbolTable (Wise rep), Stms (Wise rep))
simplifyConsts UsageTable
uses =
      ((SymbolTable (Wise rep), Stms (Wise rep))
 -> SimpleM rep (SymbolTable (Wise rep), Stms (Wise rep)))
-> ((SymbolTable (Wise rep), Stms (Wise rep))
    -> (SymbolTable (Wise rep), Stms (Wise rep)))
-> SimpleOps rep
-> RuleBook (Wise rep)
-> HoistBlockers rep
-> SymbolTable (Wise rep)
-> (SymbolTable (Wise rep), Stms (Wise rep))
-> m (SymbolTable (Wise rep), Stms (Wise 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 (Wise rep)
-> SimpleM rep (SymbolTable (Wise rep), Stms (Wise rep))
forall rep.
(ASTRep rep, Simplifiable (LetDec rep),
 Simplifiable (FParamInfo rep), Simplifiable (LParamInfo rep),
 Simplifiable (RetType rep), Simplifiable (BranchType rep),
 TraverseOpStms (Wise rep), CanBeWise (Op rep),
 IndexOp (OpWithWisdom (Op rep)), BuilderOps (Wise rep)) =>
UsageTable
-> Stms (Wise rep)
-> SimpleM rep (SymbolTable (Wise rep), Stms (Wise rep))
onConsts UsageTable
uses (Stms (Wise rep)
 -> SimpleM rep (SymbolTable (Wise rep), Stms (Wise rep)))
-> ((SymbolTable (Wise rep), Stms (Wise rep)) -> Stms (Wise rep))
-> (SymbolTable (Wise rep), Stms (Wise rep))
-> SimpleM rep (SymbolTable (Wise rep), Stms (Wise rep))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SymbolTable (Wise rep), Stms (Wise rep)) -> Stms (Wise rep)
forall a b. (a, b) -> b
snd)
        (SymbolTable (Wise rep), Stms (Wise rep))
-> (SymbolTable (Wise rep), Stms (Wise rep))
forall a. a -> a
id
        SimpleOps rep
simpl
        RuleBook (Wise rep)
rules
        HoistBlockers rep
blockers
        SymbolTable (Wise rep)
forall a. Monoid a => a
mempty

    onConsts :: UsageTable
-> Stms (Wise rep)
-> SimpleM rep (SymbolTable (Wise rep), Stms (Wise rep))
onConsts UsageTable
uses Stms (Wise rep)
consts' = do
      Stms (Wise rep)
consts'' <- UsageTable -> Stms (Wise rep) -> SimpleM rep (Stms (Wise rep))
forall rep.
SimplifiableRep rep =>
UsageTable -> Stms (Wise rep) -> SimpleM rep (Stms (Wise rep))
Engine.simplifyStmsWithUsage UsageTable
uses Stms (Wise rep)
consts'
      (SymbolTable (Wise rep), Stms (Wise rep))
-> SimpleM rep (SymbolTable (Wise rep), Stms (Wise rep))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (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 SimpleOps rep
simpl RuleBook (Wise rep)
rules HoistBlockers rep
blockers SymbolTable (Wise rep)
vtable FunDef rep
fd =
  FunDef (Wise rep) -> FunDef rep
forall rep. CanBeWise (Op rep) => FunDef (Wise rep) -> FunDef rep
removeFunDefWisdom
    (FunDef (Wise rep) -> FunDef rep)
-> m (FunDef (Wise rep)) -> m (FunDef rep)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (FunDef (Wise rep) -> SimpleM rep (FunDef (Wise rep)))
-> (FunDef (Wise rep) -> FunDef (Wise rep))
-> SimpleOps rep
-> RuleBook (Wise rep)
-> HoistBlockers rep
-> SymbolTable (Wise rep)
-> FunDef (Wise rep)
-> m (FunDef (Wise 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 (Wise rep) -> SimpleM rep (FunDef (Wise rep))
forall rep.
SimplifiableRep rep =>
FunDef (Wise rep) -> SimpleM rep (FunDef (Wise rep))
Engine.simplifyFun
      FunDef (Wise rep) -> FunDef (Wise rep)
forall a. a -> a
id
      SimpleOps rep
simpl
      RuleBook (Wise rep)
rules
      HoistBlockers rep
blockers
      SymbolTable (Wise rep)
vtable
      (FunDef rep -> FunDef (Wise rep)
forall rep. Informing rep => FunDef rep -> FunDef (Wise rep)
informFunDef FunDef rep
fd)

-- | 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 (Wise rep) -> Lambda rep
forall rep. CanBeWise (Op rep) => Lambda (Wise rep) -> Lambda rep
removeLambdaWisdom
    (Lambda (Wise rep) -> Lambda rep)
-> m (Lambda (Wise rep)) -> m (Lambda rep)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Lambda (Wise rep) -> SimpleM rep (Lambda (Wise rep)))
-> (Lambda (Wise rep) -> Lambda (Wise rep))
-> SimpleOps rep
-> RuleBook (Wise rep)
-> HoistBlockers rep
-> SymbolTable (Wise rep)
-> Lambda (Wise rep)
-> m (Lambda (Wise 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 (Wise rep) -> SimpleM rep (Lambda (Wise rep))
forall rep.
SimplifiableRep rep =>
Lambda (Wise rep) -> SimpleM rep (Lambda (Wise rep))
Engine.simplifyLambdaNoHoisting
      Lambda (Wise rep) -> Lambda (Wise rep)
forall a. a -> a
id
      SimpleOps rep
simpl
      RuleBook (Wise rep)
rules
      HoistBlockers rep
blockers
      SymbolTable (Wise rep)
vtable
      (Lambda rep -> Lambda (Wise rep)
forall rep. Informing rep => Lambda rep -> Lambda (Wise rep)
informLambda 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 (Stms rep)
simplifyStms :: SimpleOps rep
-> RuleBook (Wise rep)
-> HoistBlockers rep
-> Scope rep
-> Stms rep
-> m (Stms rep)
simplifyStms SimpleOps rep
simpl RuleBook (Wise rep)
rules HoistBlockers rep
blockers Scope rep
scope =
  (Seq (Stm (Wise rep)) -> Stms rep)
-> m (Seq (Stm (Wise rep))) -> m (Stms rep)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Stm (Wise rep) -> Stm rep) -> Seq (Stm (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)
    (m (Seq (Stm (Wise rep))) -> m (Stms rep))
-> (Stms rep -> m (Seq (Stm (Wise rep))))
-> Stms rep
-> m (Stms rep)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Seq (Stm (Wise rep)) -> SimpleM rep (Seq (Stm (Wise rep))))
-> (Seq (Stm (Wise rep)) -> Seq (Stm (Wise rep)))
-> SimpleOps rep
-> RuleBook (Wise rep)
-> HoistBlockers rep
-> SymbolTable (Wise rep)
-> Seq (Stm (Wise rep))
-> m (Seq (Stm (Wise 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 Seq (Stm (Wise rep)) -> SimpleM rep (Seq (Stm (Wise rep)))
forall rep.
SimplifiableRep rep =>
Stms (Wise rep) -> SimpleM rep (Stms (Wise rep))
Engine.simplifyStms Seq (Stm (Wise rep)) -> Seq (Stm (Wise rep))
forall a. a -> a
id SimpleOps rep
simpl RuleBook (Wise rep)
rules HoistBlockers rep
blockers SymbolTable (Wise rep)
vtable
    (Seq (Stm (Wise rep)) -> m (Seq (Stm (Wise rep))))
-> (Stms rep -> Seq (Stm (Wise rep)))
-> Stms rep
-> m (Seq (Stm (Wise rep)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stms rep -> Seq (Stm (Wise rep))
forall rep. Informing rep => Stms rep -> Stms (Wise rep)
informStms
  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

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 (f :: * -> *) a. Applicative f => a -> f a
pure (a -> m a) -> a -> m a
forall a b. (a -> b) -> a -> b
$ b -> a
g b
x'