{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}

{-| Mutual recursion inlining.

Given a @let rec@ group, this pass identifies helper bindings — those not
used by the body (non-roots), not self-recursive, and safe to inline according
to the same size/cost heuristics as the main inliner — and inlines them into
their callers.
This works across independent subgroups within the same @let rec@, e.g.
@{even, odd, f, g}@ where @{even, odd}@ and @{f, g}@ are separate cycles.

No beta reduction is performed here; the resulting applications
are left for downstream passes to clean up. -}
module PlutusIR.Transform.RecInline
  ( recInline
  , recInlinePass
  , recInlinePassSC
  ) where

import Algebra.Graph.AdjacencyMap qualified as Graph
import Control.Lens (transformMOf, (^.))
import Control.Monad (guard)
import Data.List.NonEmpty qualified as NE
import Data.Map qualified as Map
import Data.Maybe (fromMaybe, mapMaybe)
import Data.Set qualified as Set
import PlutusCore qualified as PLC
import PlutusCore.Analysis.Usages qualified as Usages
import PlutusCore.Builtin qualified as PLC
import PlutusCore.Name.Unique qualified as Unique
import PlutusCore.Quote (MonadQuote)
import PlutusIR
import PlutusIR.Analysis.Builtins (BuiltinsInfo)
import PlutusIR.Analysis.VarInfo (termVarInfo)
import PlutusIR.Pass
import PlutusIR.Purity (isPure)
import PlutusIR.Subst (termUsages)
import PlutusIR.Transform.Inline.Utils (costIsAcceptable, sizeIsAcceptable)
import PlutusIR.Transform.Rename ()
import PlutusIR.TypeCheck qualified as TC

{-| A single term binding within a recursive group, carrying cached usage
information so we don't recompute it on every step. -}
data RecBinding uni fun a = RecBinding
  { forall (uni :: * -> *) fun a. RecBinding uni fun a -> a
rbAnn :: a
  , forall (uni :: * -> *) fun a. RecBinding uni fun a -> Strictness
rbStrictness :: Strictness
  , forall (uni :: * -> *) fun a.
RecBinding uni fun a -> VarDecl TyName Name uni a
rbDecl :: VarDecl TyName Name uni a
  , forall (uni :: * -> *) fun a.
RecBinding uni fun a -> Term TyName Name uni fun a
rbRhs :: Term TyName Name uni fun a
  , forall (uni :: * -> *) fun a. RecBinding uni fun a -> Usages
rbUsages :: Usages.Usages
  }

rbName :: RecBinding uni fun a -> Name
rbName :: forall (uni :: * -> *) fun a. RecBinding uni fun a -> Name
rbName RecBinding {rbDecl :: forall (uni :: * -> *) fun a.
RecBinding uni fun a -> VarDecl TyName Name uni a
rbDecl = VarDecl a
_ Name
n Type TyName uni a
_} = Name
n

{-| A recursive binding group together with its call graph.
"Roots" are the bindings actually referenced by the @let@ body. -}
data RecGroup uni fun a = RecGroup
  { forall (uni :: * -> *) fun a.
RecGroup uni fun a -> Map Unique (RecBinding uni fun a)
rgBindings :: Map.Map Unique.Unique (RecBinding uni fun a)
  , forall (uni :: * -> *) fun a. RecGroup uni fun a -> [Unique]
rgOrder :: [Unique.Unique]
  , forall (uni :: * -> *) fun a. RecGroup uni fun a -> Set Unique
rgRoots :: Set.Set Unique.Unique
  , forall (uni :: * -> *) fun a.
RecGroup uni fun a -> AdjacencyMap Unique
rgGraph :: Graph.AdjacencyMap Unique.Unique
  }

data InlineCandidate = InlineCandidate Unique.Unique Bool

recInlinePassSC
  :: (PLC.Typecheckable uni fun, PLC.GEq uni, MonadQuote m, Ord a)
  => BuiltinsInfo uni fun
  -> Bool
  -> TC.PirTCConfig uni fun
  -> Pass m TyName Name uni fun a
recInlinePassSC :: forall (uni :: * -> *) fun (m :: * -> *) a.
(Typecheckable uni fun, GEq uni, MonadQuote m, Ord a) =>
BuiltinsInfo uni fun
-> Bool -> PirTCConfig uni fun -> Pass m TyName Name uni fun a
recInlinePassSC BuiltinsInfo uni fun
binfo Bool
inlineConstants PirTCConfig uni fun
tcconfig =
  Pass m TyName Name uni fun a
forall name tyname (m :: * -> *) a (uni :: * -> *) fun.
(HasUnique name TermUnique, HasUnique tyname TypeUnique,
 MonadQuote m, Ord a) =>
Pass m tyname name uni fun a
renamePass Pass m TyName Name uni fun a
-> Pass m TyName Name uni fun a -> Pass m TyName Name uni fun a
forall a. Semigroup a => a -> a -> a
<> BuiltinsInfo uni fun
-> Bool -> PirTCConfig uni fun -> Pass m TyName Name uni fun a
forall (uni :: * -> *) fun (m :: * -> *) a.
(Typecheckable uni fun, GEq uni, MonadQuote m, Ord a) =>
BuiltinsInfo uni fun
-> Bool -> PirTCConfig uni fun -> Pass m TyName Name uni fun a
recInlinePass BuiltinsInfo uni fun
binfo Bool
inlineConstants PirTCConfig uni fun
tcconfig

recInlinePass
  :: (PLC.Typecheckable uni fun, PLC.GEq uni, MonadQuote m, Ord a)
  => BuiltinsInfo uni fun
  -> Bool
  -> TC.PirTCConfig uni fun
  -> Pass m TyName Name uni fun a
recInlinePass :: forall (uni :: * -> *) fun (m :: * -> *) a.
(Typecheckable uni fun, GEq uni, MonadQuote m, Ord a) =>
BuiltinsInfo uni fun
-> Bool -> PirTCConfig uni fun -> Pass m TyName Name uni fun a
recInlinePass BuiltinsInfo uni fun
binfo Bool
inlineConstants PirTCConfig uni fun
tcconfig =
  String
-> Pass m TyName Name uni fun a -> Pass m TyName Name uni fun a
forall (m :: * -> *) tyname name (uni :: * -> *) fun a.
String
-> Pass m tyname name uni fun a -> Pass m tyname name uni fun a
NamedPass String
"recursive inlining" (Pass m TyName Name uni fun a -> Pass m TyName Name uni fun a)
-> Pass m TyName Name uni fun a -> Pass m TyName Name uni fun a
forall a b. (a -> b) -> a -> b
$
    (Term TyName Name uni fun a -> m (Term TyName Name uni fun a))
-> [Condition TyName Name uni fun a]
-> [BiCondition TyName Name uni fun a]
-> Pass m TyName Name uni fun a
forall (m :: * -> *) tyname name (uni :: * -> *) fun a.
(Term tyname name uni fun a -> m (Term tyname name uni fun a))
-> [Condition tyname name uni fun a]
-> [BiCondition tyname name uni fun a]
-> Pass m tyname name uni fun a
Pass
      (BuiltinsInfo uni fun
-> Bool
-> Term TyName Name uni fun a
-> m (Term TyName Name uni fun a)
forall (uni :: * -> *) fun (m :: * -> *) a.
(ToBuiltinMeaning uni fun, MonadQuote m) =>
BuiltinsInfo uni fun
-> Bool
-> Term TyName Name uni fun a
-> m (Term TyName Name uni fun a)
recInline BuiltinsInfo uni fun
binfo Bool
inlineConstants)
      [PirTCConfig uni fun -> Condition TyName Name uni fun a
forall (uni :: * -> *) fun a.
(Typecheckable uni fun, GEq uni) =>
PirTCConfig uni fun -> Condition TyName Name uni fun a
Typechecks PirTCConfig uni fun
tcconfig, Condition TyName Name uni fun a
forall tyname name a (uni :: * -> *) fun.
(HasUnique tyname TypeUnique, HasUnique name TermUnique, Ord a) =>
Condition tyname name uni fun a
GloballyUniqueNames]
      [Condition TyName Name uni fun a
-> BiCondition TyName Name uni fun a
forall tyname name (uni :: * -> *) fun a.
Condition tyname name uni fun a
-> BiCondition tyname name uni fun a
ConstCondition (PirTCConfig uni fun -> Condition TyName Name uni fun a
forall (uni :: * -> *) fun a.
(Typecheckable uni fun, GEq uni) =>
PirTCConfig uni fun -> Condition TyName Name uni fun a
Typechecks PirTCConfig uni fun
tcconfig), Condition TyName Name uni fun a
-> BiCondition TyName Name uni fun a
forall tyname name (uni :: * -> *) fun a.
Condition tyname name uni fun a
-> BiCondition tyname name uni fun a
ConstCondition Condition TyName Name uni fun a
forall tyname name a (uni :: * -> *) fun.
(HasUnique tyname TypeUnique, HasUnique name TermUnique, Ord a) =>
Condition tyname name uni fun a
GloballyUniqueNames]

-- | Walk the term bottom-up, attempting to collapse each @let rec@ group.
recInline
  :: (PLC.ToBuiltinMeaning uni fun, MonadQuote m)
  => BuiltinsInfo uni fun
  -> Bool
  -> Term TyName Name uni fun a
  -> m (Term TyName Name uni fun a)
recInline :: forall (uni :: * -> *) fun (m :: * -> *) a.
(ToBuiltinMeaning uni fun, MonadQuote m) =>
BuiltinsInfo uni fun
-> Bool
-> Term TyName Name uni fun a
-> m (Term TyName Name uni fun a)
recInline BuiltinsInfo uni fun
binfo Bool
inlineConstants =
  LensLike
  (WrappedMonad m)
  (Term TyName Name uni fun a)
  (Term TyName Name uni fun a)
  (Term TyName Name uni fun a)
  (Term TyName Name uni fun a)
-> (Term TyName Name uni fun a -> m (Term TyName Name uni fun a))
-> Term TyName Name uni fun a
-> m (Term TyName Name uni fun a)
forall (m :: * -> *) a b.
Monad m =>
LensLike (WrappedMonad m) a b a b -> (b -> m b) -> a -> m b
transformMOf LensLike
  (WrappedMonad m)
  (Term TyName Name uni fun a)
  (Term TyName Name uni fun a)
  (Term TyName Name uni fun a)
  (Term TyName Name uni fun a)
forall tyname name (uni :: * -> *) fun a (f :: * -> *).
Applicative f =>
(Term tyname name uni fun a -> f (Term tyname name uni fun a))
-> Term tyname name uni fun a -> f (Term tyname name uni fun a)
termSubterms ((Term TyName Name uni fun a -> m (Term TyName Name uni fun a))
 -> Term TyName Name uni fun a -> m (Term TyName Name uni fun a))
-> (Term TyName Name uni fun a -> m (Term TyName Name uni fun a))
-> Term TyName Name uni fun a
-> m (Term TyName Name uni fun a)
forall a b. (a -> b) -> a -> b
$ \case
    Let a
ann Recursivity
Rec NonEmpty (Binding TyName Name uni fun a)
bs Term TyName Name uni fun a
body -> BuiltinsInfo uni fun
-> Bool
-> a
-> NonEmpty (Binding TyName Name uni fun a)
-> Term TyName Name uni fun a
-> m (Term TyName Name uni fun a)
forall (uni :: * -> *) fun (m :: * -> *) a.
(ToBuiltinMeaning uni fun, MonadQuote m) =>
BuiltinsInfo uni fun
-> Bool
-> a
-> NonEmpty (Binding TyName Name uni fun a)
-> Term TyName Name uni fun a
-> m (Term TyName Name uni fun a)
rewriteRecGroup BuiltinsInfo uni fun
binfo Bool
inlineConstants a
ann NonEmpty (Binding TyName Name uni fun a)
bs Term TyName Name uni fun a
body
    Term TyName Name uni fun a
term -> Term TyName Name uni fun a -> m (Term TyName Name uni fun a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term TyName Name uni fun a
term

{-| Try to collapse a recursive group by inlining helpers. If we manage to
eliminate at least one binding, emit the smaller group; otherwise return the
original term unchanged. -}
rewriteRecGroup
  :: (PLC.ToBuiltinMeaning uni fun, MonadQuote m)
  => BuiltinsInfo uni fun
  -> Bool
  -> a
  -> NE.NonEmpty (Binding TyName Name uni fun a)
  -> Term TyName Name uni fun a
  -> m (Term TyName Name uni fun a)
rewriteRecGroup :: forall (uni :: * -> *) fun (m :: * -> *) a.
(ToBuiltinMeaning uni fun, MonadQuote m) =>
BuiltinsInfo uni fun
-> Bool
-> a
-> NonEmpty (Binding TyName Name uni fun a)
-> Term TyName Name uni fun a
-> m (Term TyName Name uni fun a)
rewriteRecGroup BuiltinsInfo uni fun
binfo Bool
inlineConstants a
ann NonEmpty (Binding TyName Name uni fun a)
bs Term TyName Name uni fun a
body =
  case BuiltinsInfo uni fun
-> a
-> NonEmpty (Binding TyName Name uni fun a)
-> Term TyName Name uni fun a
-> Maybe (RecGroup uni fun a, [Binding TyName Name uni fun a])
forall (uni :: * -> *) fun a.
ToBuiltinMeaning uni fun =>
BuiltinsInfo uni fun
-> a
-> NonEmpty (Binding TyName Name uni fun a)
-> Term TyName Name uni fun a
-> Maybe (RecGroup uni fun a, [Binding TyName Name uni fun a])
mkRecGroup BuiltinsInfo uni fun
binfo a
ann NonEmpty (Binding TyName Name uni fun a)
bs Term TyName Name uni fun a
body of
    Maybe (RecGroup uni fun a, [Binding TyName Name uni fun a])
Nothing -> Term TyName Name uni fun a -> m (Term TyName Name uni fun a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term TyName Name uni fun a
original
    Just (RecGroup uni fun a
group, [Binding TyName Name uni fun a]
passthrough) -> do
      RecGroup uni fun a
collapsed <- Bool -> RecGroup uni fun a -> m (RecGroup uni fun a)
forall (m :: * -> *) (uni :: * -> *) fun a.
MonadQuote m =>
Bool -> RecGroup uni fun a -> m (RecGroup uni fun a)
collapseRecGroup Bool
inlineConstants RecGroup uni fun a
group
      Term TyName Name uni fun a -> m (Term TyName Name uni fun a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Term TyName Name uni fun a -> m (Term TyName Name uni fun a))
-> Term TyName Name uni fun a -> m (Term TyName Name uni fun a)
forall a b. (a -> b) -> a -> b
$ Term TyName Name uni fun a
-> Maybe (Term TyName Name uni fun a) -> Term TyName Name uni fun a
forall a. a -> Maybe a -> a
fromMaybe Term TyName Name uni fun a
original (RecGroup uni fun a
-> RecGroup uni fun a
-> [Binding TyName Name uni fun a]
-> Maybe (Term TyName Name uni fun a)
forall {uni :: * -> *} {fun} {a}.
RecGroup uni fun a
-> RecGroup uni fun a
-> [Binding TyName Name uni fun a]
-> Maybe (Term TyName Name uni fun a)
extractResult RecGroup uni fun a
group RecGroup uni fun a
collapsed [Binding TyName Name uni fun a]
passthrough)
  where
    original :: Term TyName Name uni fun a
original = a
-> Recursivity
-> NonEmpty (Binding TyName Name uni fun a)
-> Term TyName Name uni fun a
-> Term TyName Name uni fun a
forall tyname name (uni :: * -> *) fun a.
a
-> Recursivity
-> NonEmpty (Binding tyname name uni fun a)
-> Term tyname name uni fun a
-> Term tyname name uni fun a
Let a
ann Recursivity
Rec NonEmpty (Binding TyName Name uni fun a)
bs Term TyName Name uni fun a
body
    extractResult :: RecGroup uni fun a
-> RecGroup uni fun a
-> [Binding TyName Name uni fun a]
-> Maybe (Term TyName Name uni fun a)
extractResult RecGroup uni fun a
orig RecGroup uni fun a
col [Binding TyName Name uni fun a]
passthrough = do
      -- At least one helper was inlined away.
      Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard ([Unique] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (RecGroup uni fun a -> [Unique]
forall (uni :: * -> *) fun a. RecGroup uni fun a -> [Unique]
rgOrder RecGroup uni fun a
col) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< [Unique] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (RecGroup uni fun a -> [Unique]
forall (uni :: * -> *) fun a. RecGroup uni fun a -> [Unique]
rgOrder RecGroup uni fun a
orig))
      let collapsed :: [Binding TyName Name uni fun a]
collapsed =
            [ a
-> Strictness
-> VarDecl TyName Name uni a
-> Term TyName Name uni fun a
-> Binding TyName Name uni fun a
forall tyname name (uni :: * -> *) fun a.
a
-> Strictness
-> VarDecl tyname name uni a
-> Term tyname name uni fun a
-> Binding tyname name uni fun a
TermBind (RecBinding uni fun a -> a
forall (uni :: * -> *) fun a. RecBinding uni fun a -> a
rbAnn RecBinding uni fun a
b) (RecBinding uni fun a -> Strictness
forall (uni :: * -> *) fun a. RecBinding uni fun a -> Strictness
rbStrictness RecBinding uni fun a
b) (RecBinding uni fun a -> VarDecl TyName Name uni a
forall (uni :: * -> *) fun a.
RecBinding uni fun a -> VarDecl TyName Name uni a
rbDecl RecBinding uni fun a
b) (RecBinding uni fun a -> Term TyName Name uni fun a
forall (uni :: * -> *) fun a.
RecBinding uni fun a -> Term TyName Name uni fun a
rbRhs RecBinding uni fun a
b)
            | Unique
key <- RecGroup uni fun a -> [Unique]
forall (uni :: * -> *) fun a. RecGroup uni fun a -> [Unique]
rgOrder RecGroup uni fun a
col
            , Just RecBinding uni fun a
b <- [Unique
-> Map Unique (RecBinding uni fun a)
-> Maybe (RecBinding uni fun a)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Unique
key (RecGroup uni fun a -> Map Unique (RecBinding uni fun a)
forall (uni :: * -> *) fun a.
RecGroup uni fun a -> Map Unique (RecBinding uni fun a)
rgBindings RecGroup uni fun a
col)]
            ]
      NonEmpty (Binding TyName Name uni fun a)
bs' <- [Binding TyName Name uni fun a]
-> Maybe (NonEmpty (Binding TyName Name uni fun a))
forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty ([Binding TyName Name uni fun a]
collapsed [Binding TyName Name uni fun a]
-> [Binding TyName Name uni fun a]
-> [Binding TyName Name uni fun a]
forall a. [a] -> [a] -> [a]
++ [Binding TyName Name uni fun a]
passthrough)
      Term TyName Name uni fun a -> Maybe (Term TyName Name uni fun a)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Term TyName Name uni fun a -> Maybe (Term TyName Name uni fun a))
-> Term TyName Name uni fun a -> Maybe (Term TyName Name uni fun a)
forall a b. (a -> b) -> a -> b
$ a
-> Recursivity
-> NonEmpty (Binding TyName Name uni fun a)
-> Term TyName Name uni fun a
-> Term TyName Name uni fun a
forall tyname name (uni :: * -> *) fun a.
a
-> Recursivity
-> NonEmpty (Binding tyname name uni fun a)
-> Term tyname name uni fun a
-> Term tyname name uni fun a
Let a
ann Recursivity
Rec NonEmpty (Binding TyName Name uni fun a)
bs' Term TyName Name uni fun a
body

{-| Extract eligible function bindings from a @let rec@ group. Returns
the 'RecGroup' and any passthrough bindings (type bindings, datatype bindings,
effectful strict value bindings) that are left untouched. Returns 'Nothing' if
fewer than 2 safe term bindings are found. -}
mkRecGroup
  :: PLC.ToBuiltinMeaning uni fun
  => BuiltinsInfo uni fun
  -> a
  -> NE.NonEmpty (Binding TyName Name uni fun a)
  -> Term TyName Name uni fun a
  -> Maybe (RecGroup uni fun a, [Binding TyName Name uni fun a])
mkRecGroup :: forall (uni :: * -> *) fun a.
ToBuiltinMeaning uni fun =>
BuiltinsInfo uni fun
-> a
-> NonEmpty (Binding TyName Name uni fun a)
-> Term TyName Name uni fun a
-> Maybe (RecGroup uni fun a, [Binding TyName Name uni fun a])
mkRecGroup BuiltinsInfo uni fun
binfo a
ann NonEmpty (Binding TyName Name uni fun a)
bs Term TyName Name uni fun a
body = do
  let paired :: [(Binding TyName Name uni fun a, Maybe (RecBinding uni fun a))]
paired = [(Binding TyName Name uni fun a
b, Binding TyName Name uni fun a -> Maybe (RecBinding uni fun a)
asRecBinding Binding TyName Name uni fun a
b) | Binding TyName Name uni fun a
b <- NonEmpty (Binding TyName Name uni fun a)
-> [Binding TyName Name uni fun a]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty (Binding TyName Name uni fun a)
bs]
      -- Safe term bindings that we can try to collapse.
      eligible :: [RecBinding uni fun a]
eligible = [RecBinding uni fun a
rb | (Binding TyName Name uni fun a
_, Just RecBinding uni fun a
rb) <- [(Binding TyName Name uni fun a, Maybe (RecBinding uni fun a))]
paired]
      -- Everything else: type bindings, datatype bindings, and effectful
      -- strict value bindings.
      passthrough :: [Binding TyName Name uni fun a]
passthrough = [Binding TyName Name uni fun a
b | (Binding TyName Name uni fun a
b, Maybe (RecBinding uni fun a)
Nothing) <- [(Binding TyName Name uni fun a, Maybe (RecBinding uni fun a))]
paired]
  -- Need at least 2 bindings to have anything to collapse.
  Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard ([RecBinding uni fun a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [RecBinding uni fun a]
eligible Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1)
  let key :: RecBinding uni fun a -> Unique
key RecBinding uni fun a
b = RecBinding uni fun a -> Name
forall (uni :: * -> *) fun a. RecBinding uni fun a -> Name
rbName RecBinding uni fun a
b Name -> Getting Unique Name Unique -> Unique
forall s a. s -> Getting a s a -> a
^. Getting Unique Name Unique
forall name unique. HasUnique name unique => Lens' name Unique
Lens' Name Unique
Unique.theUnique
      bindingMap :: Map Unique (RecBinding uni fun a)
bindingMap = [(Unique, RecBinding uni fun a)]
-> Map Unique (RecBinding uni fun a)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(RecBinding uni fun a -> Unique
forall {uni :: * -> *} {fun} {a}. RecBinding uni fun a -> Unique
key RecBinding uni fun a
b, RecBinding uni fun a
b) | RecBinding uni fun a
b <- [RecBinding uni fun a]
eligible]
      -- Bindings used by the let body or by passthrough bindings are roots —
      -- inlining them away would break references from outside the group.
      bodyUsed :: Set Unique
bodyUsed = Usages -> Set Unique
Usages.allUsed (Term TyName Name uni fun a -> Usages
forall name tyname (uni :: * -> *) fun ann.
(HasUnique name TermUnique, HasUnique tyname TypeUnique) =>
Term tyname name uni fun ann -> Usages
termUsages Term TyName Name uni fun a
body)
      passthroughUsed :: Set Unique
passthroughUsed =
        [Set Unique] -> Set Unique
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions
          [ Usages -> Set Unique
Usages.allUsed (Term TyName Name uni fun a -> Usages
forall name tyname (uni :: * -> *) fun ann.
(HasUnique name TermUnique, HasUnique tyname TypeUnique) =>
Term tyname name uni fun ann -> Usages
termUsages Term TyName Name uni fun a
rhs)
          | TermBind a
_ Strictness
_ VarDecl TyName Name uni a
_ Term TyName Name uni fun a
rhs <- [Binding TyName Name uni fun a]
passthrough
          ]
      roots :: Set Unique
roots =
        Map Unique (RecBinding uni fun a) -> Set Unique
forall k a. Map k a -> Set k
Map.keysSet Map Unique (RecBinding uni fun a)
bindingMap
          Set Unique -> Set Unique -> Set Unique
forall a. Ord a => Set a -> Set a -> Set a
`Set.intersection` (Set Unique
bodyUsed Set Unique -> Set Unique -> Set Unique
forall a. Ord a => Set a -> Set a -> Set a
`Set.union` Set Unique
passthroughUsed)
  (RecGroup uni fun a, [Binding TyName Name uni fun a])
-> Maybe (RecGroup uni fun a, [Binding TyName Name uni fun a])
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Unique]
-> Map Unique (RecBinding uni fun a)
-> Set Unique
-> RecGroup uni fun a
forall (uni :: * -> *) fun a.
[Unique]
-> Map Unique (RecBinding uni fun a)
-> Set Unique
-> RecGroup uni fun a
buildGraph ((RecBinding uni fun a -> Unique)
-> [RecBinding uni fun a] -> [Unique]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap RecBinding uni fun a -> Unique
forall {uni :: * -> *} {fun} {a}. RecBinding uni fun a -> Unique
key [RecBinding uni fun a]
eligible) Map Unique (RecBinding uni fun a)
bindingMap Set Unique
roots, [Binding TyName Name uni fun a]
passthrough)
  where
    vinfo :: VarsInfo TyName Name uni a
vinfo = Term TyName Name uni fun a -> VarsInfo TyName Name uni a
forall name tyname (uni :: * -> *) fun a.
(HasUnique name TermUnique, HasUnique tyname TypeUnique) =>
Term tyname name uni fun a -> VarsInfo tyname name uni a
termVarInfo (a
-> Recursivity
-> NonEmpty (Binding TyName Name uni fun a)
-> Term TyName Name uni fun a
-> Term TyName Name uni fun a
forall tyname name (uni :: * -> *) fun a.
a
-> Recursivity
-> NonEmpty (Binding tyname name uni fun a)
-> Term tyname name uni fun a
-> Term tyname name uni fun a
Let a
ann Recursivity
Rec NonEmpty (Binding TyName Name uni fun a)
bs Term TyName Name uni fun a
body)

    asRecBinding :: Binding TyName Name uni fun a -> Maybe (RecBinding uni fun a)
asRecBinding = \case
      TermBind a
bindAnn Strictness
strictness VarDecl TyName Name uni a
decl Term TyName Name uni fun a
rhs
        | let rhsPure :: Bool
rhsPure = BuiltinsInfo uni fun
-> VarsInfo TyName Name uni a -> Term TyName Name uni fun a -> Bool
forall (uni :: * -> *) fun name tyname a.
(ToBuiltinMeaning uni fun, HasUnique name TermUnique) =>
BuiltinsInfo uni fun
-> VarsInfo tyname name uni a -> Term tyname name uni fun a -> Bool
isPure BuiltinsInfo uni fun
binfo VarsInfo TyName Name uni a
vinfo Term TyName Name uni fun a
rhs
        , Strictness
strictness Strictness -> Strictness -> Bool
forall a. Eq a => a -> a -> Bool
== Strictness
NonStrict Bool -> Bool -> Bool
|| Bool
rhsPure ->
            RecBinding uni fun a -> Maybe (RecBinding uni fun a)
forall a. a -> Maybe a
Just
              RecBinding
                { rbAnn :: a
rbAnn = a
bindAnn
                , rbStrictness :: Strictness
rbStrictness = Strictness
strictness
                , rbDecl :: VarDecl TyName Name uni a
rbDecl = VarDecl TyName Name uni a
decl
                , rbRhs :: Term TyName Name uni fun a
rbRhs = Term TyName Name uni fun a
rhs
                , rbUsages :: Usages
rbUsages = Term TyName Name uni fun a -> Usages
forall name tyname (uni :: * -> *) fun ann.
(HasUnique name TermUnique, HasUnique tyname TypeUnique) =>
Term tyname name uni fun ann -> Usages
termUsages Term TyName Name uni fun a
rhs
                }
      Binding TyName Name uni fun a
_ -> Maybe (RecBinding uni fun a)
forall a. Maybe a
Nothing

{-| Construct a 'RecGroup' by computing the intra-group call graph from the
cached usage information on each binding. -}
buildGraph
  :: [Unique.Unique]
  -> Map.Map Unique.Unique (RecBinding uni fun a)
  -> Set.Set Unique.Unique
  -> RecGroup uni fun a
buildGraph :: forall (uni :: * -> *) fun a.
[Unique]
-> Map Unique (RecBinding uni fun a)
-> Set Unique
-> RecGroup uni fun a
buildGraph [Unique]
order Map Unique (RecBinding uni fun a)
bindings Set Unique
roots =
  RecGroup {rgBindings :: Map Unique (RecBinding uni fun a)
rgBindings = Map Unique (RecBinding uni fun a)
bindings, rgOrder :: [Unique]
rgOrder = [Unique]
order, rgRoots :: Set Unique
rgRoots = Set Unique
roots, rgGraph :: AdjacencyMap Unique
rgGraph = AdjacencyMap Unique
graph}
  where
    graph :: AdjacencyMap Unique
graph =
      [(Unique, Set Unique)] -> AdjacencyMap Unique
forall a. Ord a => [(a, Set a)] -> AdjacencyMap a
Graph.fromAdjacencySets
        [ (Unique
key, Set Unique
keys Set Unique -> Set Unique -> Set Unique
forall a. Ord a => Set a -> Set a -> Set a
`Set.intersection` Usages -> Set Unique
Usages.allUsed (RecBinding uni fun a -> Usages
forall (uni :: * -> *) fun a. RecBinding uni fun a -> Usages
rbUsages RecBinding uni fun a
b))
        | (Unique
key, RecBinding uni fun a
b) <- Map Unique (RecBinding uni fun a)
-> [(Unique, RecBinding uni fun a)]
forall k a. Map k a -> [(k, a)]
Map.toList Map Unique (RecBinding uni fun a)
bindings
        ]
    keys :: Set Unique
keys = Map Unique (RecBinding uni fun a) -> Set Unique
forall k a. Map k a -> Set k
Map.keysSet Map Unique (RecBinding uni fun a)
bindings

{-| Iteratively inline helpers into their callers until no more candidates
remain. -}
collapseRecGroup
  :: MonadQuote m
  => Bool
  -> RecGroup uni fun a
  -> m (RecGroup uni fun a)
collapseRecGroup :: forall (m :: * -> *) (uni :: * -> *) fun a.
MonadQuote m =>
Bool -> RecGroup uni fun a -> m (RecGroup uni fun a)
collapseRecGroup Bool
inlineConstants RecGroup uni fun a
group = [InlineCandidate] -> m (RecGroup uni fun a)
forall {f :: * -> *}.
MonadQuote f =>
[InlineCandidate] -> f (RecGroup uni fun a)
tryCandidates (Bool -> RecGroup uni fun a -> [InlineCandidate]
forall (uni :: * -> *) fun a.
Bool -> RecGroup uni fun a -> [InlineCandidate]
findCandidates Bool
inlineConstants RecGroup uni fun a
group)
  where
    tryCandidates :: [InlineCandidate] -> f (RecGroup uni fun a)
tryCandidates [] = RecGroup uni fun a -> f (RecGroup uni fun a)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure RecGroup uni fun a
group
    tryCandidates (InlineCandidate
candidate : [InlineCandidate]
rest) =
      RecGroup uni fun a
-> InlineCandidate -> f (Maybe (RecGroup uni fun a))
forall (m :: * -> *) (uni :: * -> *) fun a.
MonadQuote m =>
RecGroup uni fun a
-> InlineCandidate -> m (Maybe (RecGroup uni fun a))
tryInline RecGroup uni fun a
group InlineCandidate
candidate f (Maybe (RecGroup uni fun a))
-> (Maybe (RecGroup uni fun a) -> f (RecGroup uni fun a))
-> f (RecGroup uni fun a)
forall a b. f a -> (a -> f b) -> f b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Just RecGroup uni fun a
group' -> Bool -> RecGroup uni fun a -> f (RecGroup uni fun a)
forall (m :: * -> *) (uni :: * -> *) fun a.
MonadQuote m =>
Bool -> RecGroup uni fun a -> m (RecGroup uni fun a)
collapseRecGroup Bool
inlineConstants RecGroup uni fun a
group'
        Maybe (RecGroup uni fun a)
Nothing -> [InlineCandidate] -> f (RecGroup uni fun a)
tryCandidates [InlineCandidate]
rest

{-| Find helpers eligible for inlining: not roots, not self-recursive, and
acceptable according to the main inliner's single-use/size/cost criteria. -}
findCandidates :: Bool -> RecGroup uni fun a -> [InlineCandidate]
findCandidates :: forall (uni :: * -> *) fun a.
Bool -> RecGroup uni fun a -> [InlineCandidate]
findCandidates Bool
inlineConstants RecGroup uni fun a
group = (Unique -> Maybe InlineCandidate) -> [Unique] -> [InlineCandidate]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Unique -> Maybe InlineCandidate
check (RecGroup uni fun a -> [Unique]
forall (uni :: * -> *) fun a. RecGroup uni fun a -> [Unique]
rgOrder RecGroup uni fun a
group)
  where
    check :: Unique -> Maybe InlineCandidate
check Unique
helper = do
      -- Roots are used by the let body — removing them would change semantics.
      Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Unique
helper Unique -> Set Unique -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.notMember` RecGroup uni fun a -> Set Unique
forall (uni :: * -> *) fun a. RecGroup uni fun a -> Set Unique
rgRoots RecGroup uni fun a
group)
      -- Self-recursive helpers can't be fully eliminated by inlining.
      Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Unique
helper Unique -> Set Unique -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.notMember` Unique -> AdjacencyMap Unique -> Set Unique
forall a. Ord a => a -> AdjacencyMap a -> Set a
Graph.postSet Unique
helper (RecGroup uni fun a -> AdjacencyMap Unique
forall (uni :: * -> *) fun a.
RecGroup uni fun a -> AdjacencyMap Unique
rgGraph RecGroup uni fun a
group))
      RecBinding uni fun a
helperBinding <- Unique
-> Map Unique (RecBinding uni fun a)
-> Maybe (RecBinding uni fun a)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Unique
helper (RecGroup uni fun a -> Map Unique (RecBinding uni fun a)
forall (uni :: * -> *) fun a.
RecGroup uni fun a -> Map Unique (RecBinding uni fun a)
rgBindings RecGroup uni fun a
group)
      let totalUses :: Int
totalUses =
            [Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum
              [ Name -> Usages -> Int
forall n unique. HasUnique n unique => n -> Usages -> Int
Usages.getUsageCount (RecBinding uni fun a -> Name
forall (uni :: * -> *) fun a. RecBinding uni fun a -> Name
rbName RecBinding uni fun a
helperBinding) (RecBinding uni fun a -> Usages
forall (uni :: * -> *) fun a. RecBinding uni fun a -> Usages
rbUsages RecBinding uni fun a
binding)
              | (Unique
key, RecBinding uni fun a
binding) <- Map Unique (RecBinding uni fun a)
-> [(Unique, RecBinding uni fun a)]
forall k a. Map k a -> [(k, a)]
Map.toList (RecGroup uni fun a -> Map Unique (RecBinding uni fun a)
forall (uni :: * -> *) fun a.
RecGroup uni fun a -> Map Unique (RecBinding uni fun a)
rgBindings RecGroup uni fun a
group)
              , Unique
key Unique -> Unique -> Bool
forall a. Eq a => a -> a -> Bool
/= Unique
helper
              ]
      Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Int
totalUses Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0)
      Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$
        Int
totalUses Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1
          Bool -> Bool -> Bool
|| ( Term TyName Name uni fun a -> Bool
forall tyname name (uni :: * -> *) fun ann.
Term tyname name uni fun ann -> Bool
costIsAcceptable (RecBinding uni fun a -> Term TyName Name uni fun a
forall (uni :: * -> *) fun a.
RecBinding uni fun a -> Term TyName Name uni fun a
rbRhs RecBinding uni fun a
helperBinding)
                 Bool -> Bool -> Bool
&& Bool -> Term TyName Name uni fun a -> Bool
forall tyname name (uni :: * -> *) fun ann.
Bool -> Term tyname name uni fun ann -> Bool
sizeIsAcceptable Bool
inlineConstants (RecBinding uni fun a -> Term TyName Name uni fun a
forall (uni :: * -> *) fun a.
RecBinding uni fun a -> Term TyName Name uni fun a
rbRhs RecBinding uni fun a
helperBinding)
             )
      InlineCandidate -> Maybe InlineCandidate
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (InlineCandidate -> Maybe InlineCandidate)
-> InlineCandidate -> Maybe InlineCandidate
forall a b. (a -> b) -> a -> b
$ Unique -> Bool -> InlineCandidate
InlineCandidate Unique
helper (Int
totalUses Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1)

{-| Inline all references to the helper within the rest of the recursive group.
If successful, remove the helper from the group. -}
tryInline
  :: MonadQuote m
  => RecGroup uni fun a
  -> InlineCandidate
  -> m (Maybe (RecGroup uni fun a))
tryInline :: forall (m :: * -> *) (uni :: * -> *) fun a.
MonadQuote m =>
RecGroup uni fun a
-> InlineCandidate -> m (Maybe (RecGroup uni fun a))
tryInline RecGroup uni fun a
group (InlineCandidate Unique
helperKey Bool
needsRename) =
  case Unique
-> Map Unique (RecBinding uni fun a)
-> Maybe (RecBinding uni fun a)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Unique
helperKey (RecGroup uni fun a -> Map Unique (RecBinding uni fun a)
forall (uni :: * -> *) fun a.
RecGroup uni fun a -> Map Unique (RecBinding uni fun a)
rgBindings RecGroup uni fun a
group) of
    Just RecBinding uni fun a
helper -> do
      let helperName :: Name
helperName = RecBinding uni fun a -> Name
forall (uni :: * -> *) fun a. RecBinding uni fun a -> Name
rbName RecBinding uni fun a
helper
      [(Unique, RecBinding uni fun a)]
updatedBindings <-
        ((Unique, RecBinding uni fun a)
 -> m (Unique, RecBinding uni fun a))
-> [(Unique, RecBinding uni fun a)]
-> m [(Unique, RecBinding uni fun a)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse
          (Name
-> Term TyName Name uni fun a
-> (Unique, RecBinding uni fun a)
-> m (Unique, RecBinding uni fun a)
forall {m :: * -> *} {uni :: * -> *} {fun} {a} {a}.
MonadQuote m =>
Name
-> Term TyName Name uni fun a
-> (a, RecBinding uni fun a)
-> m (a, RecBinding uni fun a)
updateBinding Name
helperName (RecBinding uni fun a -> Term TyName Name uni fun a
forall (uni :: * -> *) fun a.
RecBinding uni fun a -> Term TyName Name uni fun a
rbRhs RecBinding uni fun a
helper))
          (Map Unique (RecBinding uni fun a)
-> [(Unique, RecBinding uni fun a)]
forall k a. Map k a -> [(k, a)]
Map.toList (Map Unique (RecBinding uni fun a)
 -> [(Unique, RecBinding uni fun a)])
-> Map Unique (RecBinding uni fun a)
-> [(Unique, RecBinding uni fun a)]
forall a b. (a -> b) -> a -> b
$ Unique
-> Map Unique (RecBinding uni fun a)
-> Map Unique (RecBinding uni fun a)
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete Unique
helperKey (RecGroup uni fun a -> Map Unique (RecBinding uni fun a)
forall (uni :: * -> *) fun a.
RecGroup uni fun a -> Map Unique (RecBinding uni fun a)
rgBindings RecGroup uni fun a
group))
      let bindings :: Map Unique (RecBinding uni fun a)
bindings = [(Unique, RecBinding uni fun a)]
-> Map Unique (RecBinding uni fun a)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Unique, RecBinding uni fun a)]
updatedBindings
      Maybe (RecGroup uni fun a) -> m (Maybe (RecGroup uni fun a))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (RecGroup uni fun a) -> m (Maybe (RecGroup uni fun a)))
-> Maybe (RecGroup uni fun a) -> m (Maybe (RecGroup uni fun a))
forall a b. (a -> b) -> a -> b
$ do
        -- Verify all references were eliminated before removing the binding.
        Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$
          (RecBinding uni fun a -> Bool) -> [RecBinding uni fun a] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all
            ( \RecBinding uni fun a
binding ->
                Name -> Usages -> Int
forall n unique. HasUnique n unique => n -> Usages -> Int
Usages.getUsageCount Name
helperName (RecBinding uni fun a -> Usages
forall (uni :: * -> *) fun a. RecBinding uni fun a -> Usages
rbUsages RecBinding uni fun a
binding) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
            )
            (Map Unique (RecBinding uni fun a) -> [RecBinding uni fun a]
forall k a. Map k a -> [a]
Map.elems Map Unique (RecBinding uni fun a)
bindings)
        let order :: [Unique]
order = (Unique -> Bool) -> [Unique] -> [Unique]
forall a. (a -> Bool) -> [a] -> [a]
filter (Unique -> Unique -> Bool
forall a. Eq a => a -> a -> Bool
/= Unique
helperKey) (RecGroup uni fun a -> [Unique]
forall (uni :: * -> *) fun a. RecGroup uni fun a -> [Unique]
rgOrder RecGroup uni fun a
group)
        RecGroup uni fun a -> Maybe (RecGroup uni fun a)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RecGroup uni fun a -> Maybe (RecGroup uni fun a))
-> RecGroup uni fun a -> Maybe (RecGroup uni fun a)
forall a b. (a -> b) -> a -> b
$ [Unique]
-> Map Unique (RecBinding uni fun a)
-> Set Unique
-> RecGroup uni fun a
forall (uni :: * -> *) fun a.
[Unique]
-> Map Unique (RecBinding uni fun a)
-> Set Unique
-> RecGroup uni fun a
buildGraph [Unique]
order Map Unique (RecBinding uni fun a)
bindings (RecGroup uni fun a -> Set Unique
forall (uni :: * -> *) fun a. RecGroup uni fun a -> Set Unique
rgRoots RecGroup uni fun a
group)
    Maybe (RecBinding uni fun a)
_ -> Maybe (RecGroup uni fun a) -> m (Maybe (RecGroup uni fun a))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (RecGroup uni fun a)
forall a. Maybe a
Nothing
  where
    updateBinding :: Name
-> Term TyName Name uni fun a
-> (a, RecBinding uni fun a)
-> m (a, RecBinding uni fun a)
updateBinding Name
helperName Term TyName Name uni fun a
helperRhs (a
key, RecBinding uni fun a
binding) = do
      Term TyName Name uni fun a
rhs' <- Bool
-> Name
-> Term TyName Name uni fun a
-> Term TyName Name uni fun a
-> m (Term TyName Name uni fun a)
forall (m :: * -> *) (uni :: * -> *) fun a.
MonadQuote m =>
Bool
-> Name
-> Term TyName Name uni fun a
-> Term TyName Name uni fun a
-> m (Term TyName Name uni fun a)
inlineCallsOf Bool
needsRename Name
helperName Term TyName Name uni fun a
helperRhs (RecBinding uni fun a -> Term TyName Name uni fun a
forall (uni :: * -> *) fun a.
RecBinding uni fun a -> Term TyName Name uni fun a
rbRhs RecBinding uni fun a
binding)
      let updated :: RecBinding uni fun a
updated =
            RecBinding uni fun a
binding
              { rbRhs = rhs'
              , rbUsages = termUsages rhs'
              }
      (a, RecBinding uni fun a) -> m (a, RecBinding uni fun a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
key, RecBinding uni fun a
updated)

{-| Replace helper variables with the helper's RHS. Multi-use substitutions use
a fresh rename for each occurrence; single-use substitutions move the original
RHS so they do not perturb fresh-name allocation unnecessarily. -}
inlineCallsOf
  :: MonadQuote m
  => Bool
  -> Name
  -> Term TyName Name uni fun a
  -> Term TyName Name uni fun a
  -> m (Term TyName Name uni fun a)
inlineCallsOf :: forall (m :: * -> *) (uni :: * -> *) fun a.
MonadQuote m =>
Bool
-> Name
-> Term TyName Name uni fun a
-> Term TyName Name uni fun a
-> m (Term TyName Name uni fun a)
inlineCallsOf Bool
needsRename Name
helperName Term TyName Name uni fun a
helperRhs =
  LensLike
  (WrappedMonad m)
  (Term TyName Name uni fun a)
  (Term TyName Name uni fun a)
  (Term TyName Name uni fun a)
  (Term TyName Name uni fun a)
-> (Term TyName Name uni fun a -> m (Term TyName Name uni fun a))
-> Term TyName Name uni fun a
-> m (Term TyName Name uni fun a)
forall (m :: * -> *) a b.
Monad m =>
LensLike (WrappedMonad m) a b a b -> (b -> m b) -> a -> m b
transformMOf LensLike
  (WrappedMonad m)
  (Term TyName Name uni fun a)
  (Term TyName Name uni fun a)
  (Term TyName Name uni fun a)
  (Term TyName Name uni fun a)
forall tyname name (uni :: * -> *) fun a (f :: * -> *).
Applicative f =>
(Term tyname name uni fun a -> f (Term tyname name uni fun a))
-> Term tyname name uni fun a -> f (Term tyname name uni fun a)
termSubterms ((Term TyName Name uni fun a -> m (Term TyName Name uni fun a))
 -> Term TyName Name uni fun a -> m (Term TyName Name uni fun a))
-> (Term TyName Name uni fun a -> m (Term TyName Name uni fun a))
-> Term TyName Name uni fun a
-> m (Term TyName Name uni fun a)
forall a b. (a -> b) -> a -> b
$ \case
    Var a
_ Name
name
      | Name
name Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
helperName ->
          if Bool
needsRename
            then Term TyName Name uni fun a -> m (Term TyName Name uni fun a)
forall a (m :: * -> *). (Rename a, MonadQuote m) => a -> m a
forall (m :: * -> *).
MonadQuote m =>
Term TyName Name uni fun a -> m (Term TyName Name uni fun a)
PLC.rename Term TyName Name uni fun a
helperRhs
            else Term TyName Name uni fun a -> m (Term TyName Name uni fun a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term TyName Name uni fun a
helperRhs
    Term TyName Name uni fun a
term -> Term TyName Name uni fun a -> m (Term TyName Name uni fun a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term TyName Name uni fun a
term