{-# 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 :: 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 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 :: 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 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 :: 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 (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 :: forall (m :: * -> *) rep.
(MonadFreshNames m, SimplifiableRep rep) =>
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)) -> Seq (Stm rep))
-> m (Seq (Stm (Wise rep))) -> m (Seq (Stm rep))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Stm (Wise rep) -> Stm rep)
-> Seq (Stm (Wise rep)) -> Seq (Stm 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 (Seq (Stm rep)))
-> (Seq (Stm rep) -> m (Seq (Stm (Wise rep))))
-> Seq (Stm rep)
-> m (Seq (Stm 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))))
-> (Seq (Stm rep) -> Seq (Stm (Wise rep)))
-> Seq (Stm rep)
-> m (Seq (Stm (Wise rep)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq (Stm 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 :: 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 (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'