{-# 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 :: forall rep.
SimplifiableRep rep =>
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 :: 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 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 :: forall (m :: * -> *) rep.
(MonadFreshNames m, SimplifiableRep rep) =>
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 :: forall (m :: * -> *) rep.
(MonadFreshNames m, HasScope rep m, SimplifiableRep rep) =>
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 :: forall (m :: * -> *) rep.
(MonadFreshNames m, SimplifiableRep rep) =>
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)),
 BinderOps (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 :: 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 = 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'