{-# LANGUAGE ConstraintKinds  #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs            #-}
{-# LANGUAGE LambdaCase       #-}
{-# LANGUAGE TemplateHaskell  #-}
{-# LANGUAGE TypeFamilies     #-}

{- | Types and their functions, and general utility (including heuristics) for inlining. -}

module PlutusIR.Transform.Inline.Utils where

import PlutusCore.Annotation
import PlutusCore.Builtin qualified as PLC
import PlutusCore.Name.Unique
import PlutusCore.Quote
import PlutusCore.Rename
import PlutusCore.Subst (typeSubstTyNamesM)
import PlutusIR
import PlutusIR.Analysis.Usages qualified as Usages
import PlutusIR.Purity (EvalTerm (..), Purity (..), isPure, termEvaluationOrder, unEvalOrder)
import PlutusIR.Transform.Rename ()
import PlutusPrelude

import Control.Lens hiding (Strict)
import Control.Monad.Extra
import Control.Monad.Reader
import Control.Monad.State

import Data.Semigroup.Generic (GenericSemigroupMonoid (..))
import PlutusCore.Name.UniqueMap (UniqueMap)
import PlutusCore.Name.UniqueMap qualified as UMap
import PlutusIR.Analysis.Builtins
import PlutusIR.Analysis.VarInfo qualified as VarInfo

-- General infra:

type ExternalConstraints tyname name uni fun m =
    ( HasUnique name TermUnique
    , HasUnique tyname TypeUnique
    , Eq name
    , Eq tyname
    , PLC.ToBuiltinMeaning uni fun
    , MonadQuote m
    )

type InliningConstraints tyname name uni fun =
    ( HasUnique name TermUnique
    , HasUnique tyname TypeUnique
    , Eq name
    , Eq tyname
    , PLC.ToBuiltinMeaning uni fun
    )

-- | Information used by the inliner that is constant across its operation.
-- This includes some contextual and configuration information, and also some
-- pre-computed information about the program.
--
-- See [Inlining and global uniqueness] for caveats about this information.
data InlineInfo tyname name uni fun ann = InlineInfo
    { forall tyname name (uni :: * -> *) fun ann.
InlineInfo tyname name uni fun ann -> VarsInfo tyname name uni ann
_iiVarInfo         :: VarInfo.VarsInfo tyname name uni ann
    -- ^ Is it strict? Only needed for PIR, not UPLC
    , forall tyname name (uni :: * -> *) fun ann.
InlineInfo tyname name uni fun ann -> Usages
_iiUsages          :: Usages.Usages
    -- ^ how many times is it used?
    , forall tyname name (uni :: * -> *) fun ann.
InlineInfo tyname name uni fun ann -> InlineHints name ann
_iiHints           :: InlineHints name ann
    -- ^ have we explicitly been told to inline?
    , forall tyname name (uni :: * -> *) fun ann.
InlineInfo tyname name uni fun ann -> BuiltinsInfo uni fun
_iiBuiltinsInfo    :: BuiltinsInfo uni fun
    -- ^ the semantics variant.
    , forall tyname name (uni :: * -> *) fun ann.
InlineInfo tyname name uni fun ann -> Bool
_iiInlineConstants :: Bool
    -- ^ should we inline constants?
    }
makeLenses ''InlineInfo

-- Using a concrete monad makes a very large difference to the performance of this module
-- (determined from profiling)
-- | The monad the inliner runs in.
type InlineM tyname name uni fun ann =
    ReaderT
      (InlineInfo tyname name uni fun ann)
      (StateT (InlinerState tyname name uni fun ann) Quote)
-- For unconditional inlining:

-- | Substitution range, 'SubstRng' in the paper but no 'Susp' case.
-- See Note [Inlining approach and 'Secrets of the GHC Inliner']
newtype InlineTerm tyname name uni fun ann =
    Done (Dupable (Term tyname name uni fun ann)) --out expressions

-- | Term substitution, 'Subst' in the paper.
-- A map of unprocessed variable and its substitution range.
newtype TermSubst tyname name uni fun ann =
    TermSubst { forall tyname name (uni :: * -> *) fun ann.
TermSubst tyname name uni fun ann
-> UniqueMap TermUnique (InlineTerm tyname name uni fun ann)
_unTermSubst :: UniqueMap TermUnique (InlineTerm tyname name uni fun ann) }
    deriving newtype (NonEmpty (TermSubst tyname name uni fun ann)
-> TermSubst tyname name uni fun ann
TermSubst tyname name uni fun ann
-> TermSubst tyname name uni fun ann
-> TermSubst tyname name uni fun ann
(TermSubst tyname name uni fun ann
 -> TermSubst tyname name uni fun ann
 -> TermSubst tyname name uni fun ann)
-> (NonEmpty (TermSubst tyname name uni fun ann)
    -> TermSubst tyname name uni fun ann)
-> (forall b.
    Integral b =>
    b
    -> TermSubst tyname name uni fun ann
    -> TermSubst tyname name uni fun ann)
-> Semigroup (TermSubst tyname name uni fun ann)
forall b.
Integral b =>
b
-> TermSubst tyname name uni fun ann
-> TermSubst tyname name uni fun ann
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
forall tyname name (uni :: * -> *) fun ann.
NonEmpty (TermSubst tyname name uni fun ann)
-> TermSubst tyname name uni fun ann
forall tyname name (uni :: * -> *) fun ann.
TermSubst tyname name uni fun ann
-> TermSubst tyname name uni fun ann
-> TermSubst tyname name uni fun ann
forall tyname name (uni :: * -> *) fun ann b.
Integral b =>
b
-> TermSubst tyname name uni fun ann
-> TermSubst tyname name uni fun ann
$c<> :: forall tyname name (uni :: * -> *) fun ann.
TermSubst tyname name uni fun ann
-> TermSubst tyname name uni fun ann
-> TermSubst tyname name uni fun ann
<> :: TermSubst tyname name uni fun ann
-> TermSubst tyname name uni fun ann
-> TermSubst tyname name uni fun ann
$csconcat :: forall tyname name (uni :: * -> *) fun ann.
NonEmpty (TermSubst tyname name uni fun ann)
-> TermSubst tyname name uni fun ann
sconcat :: NonEmpty (TermSubst tyname name uni fun ann)
-> TermSubst tyname name uni fun ann
$cstimes :: forall tyname name (uni :: * -> *) fun ann b.
Integral b =>
b
-> TermSubst tyname name uni fun ann
-> TermSubst tyname name uni fun ann
stimes :: forall b.
Integral b =>
b
-> TermSubst tyname name uni fun ann
-> TermSubst tyname name uni fun ann
Semigroup, Semigroup (TermSubst tyname name uni fun ann)
TermSubst tyname name uni fun ann
Semigroup (TermSubst tyname name uni fun ann) =>
TermSubst tyname name uni fun ann
-> (TermSubst tyname name uni fun ann
    -> TermSubst tyname name uni fun ann
    -> TermSubst tyname name uni fun ann)
-> ([TermSubst tyname name uni fun ann]
    -> TermSubst tyname name uni fun ann)
-> Monoid (TermSubst tyname name uni fun ann)
[TermSubst tyname name uni fun ann]
-> TermSubst tyname name uni fun ann
TermSubst tyname name uni fun ann
-> TermSubst tyname name uni fun ann
-> TermSubst tyname name uni fun ann
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
forall tyname name (uni :: * -> *) fun ann.
Semigroup (TermSubst tyname name uni fun ann)
forall tyname name (uni :: * -> *) fun ann.
TermSubst tyname name uni fun ann
forall tyname name (uni :: * -> *) fun ann.
[TermSubst tyname name uni fun ann]
-> TermSubst tyname name uni fun ann
forall tyname name (uni :: * -> *) fun ann.
TermSubst tyname name uni fun ann
-> TermSubst tyname name uni fun ann
-> TermSubst tyname name uni fun ann
$cmempty :: forall tyname name (uni :: * -> *) fun ann.
TermSubst tyname name uni fun ann
mempty :: TermSubst tyname name uni fun ann
$cmappend :: forall tyname name (uni :: * -> *) fun ann.
TermSubst tyname name uni fun ann
-> TermSubst tyname name uni fun ann
-> TermSubst tyname name uni fun ann
mappend :: TermSubst tyname name uni fun ann
-> TermSubst tyname name uni fun ann
-> TermSubst tyname name uni fun ann
$cmconcat :: forall tyname name (uni :: * -> *) fun ann.
[TermSubst tyname name uni fun ann]
-> TermSubst tyname name uni fun ann
mconcat :: [TermSubst tyname name uni fun ann]
-> TermSubst tyname name uni fun ann
Monoid)

-- | Type substitution, similar to `TermSubst` but for types.
-- A map of unprocessed type variable and its substitution range.
newtype TypeSubst tyname uni ann =
    TypeSubst { forall tyname (uni :: * -> *) ann.
TypeSubst tyname uni ann
-> UniqueMap TypeUnique (Dupable (Type tyname uni ann))
_unTypeSubst :: UniqueMap TypeUnique (Dupable (Type tyname uni ann)) }
    deriving newtype (NonEmpty (TypeSubst tyname uni ann) -> TypeSubst tyname uni ann
TypeSubst tyname uni ann
-> TypeSubst tyname uni ann -> TypeSubst tyname uni ann
(TypeSubst tyname uni ann
 -> TypeSubst tyname uni ann -> TypeSubst tyname uni ann)
-> (NonEmpty (TypeSubst tyname uni ann)
    -> TypeSubst tyname uni ann)
-> (forall b.
    Integral b =>
    b -> TypeSubst tyname uni ann -> TypeSubst tyname uni ann)
-> Semigroup (TypeSubst tyname uni ann)
forall b.
Integral b =>
b -> TypeSubst tyname uni ann -> TypeSubst tyname uni ann
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
forall tyname (uni :: * -> *) ann.
NonEmpty (TypeSubst tyname uni ann) -> TypeSubst tyname uni ann
forall tyname (uni :: * -> *) ann.
TypeSubst tyname uni ann
-> TypeSubst tyname uni ann -> TypeSubst tyname uni ann
forall tyname (uni :: * -> *) ann b.
Integral b =>
b -> TypeSubst tyname uni ann -> TypeSubst tyname uni ann
$c<> :: forall tyname (uni :: * -> *) ann.
TypeSubst tyname uni ann
-> TypeSubst tyname uni ann -> TypeSubst tyname uni ann
<> :: TypeSubst tyname uni ann
-> TypeSubst tyname uni ann -> TypeSubst tyname uni ann
$csconcat :: forall tyname (uni :: * -> *) ann.
NonEmpty (TypeSubst tyname uni ann) -> TypeSubst tyname uni ann
sconcat :: NonEmpty (TypeSubst tyname uni ann) -> TypeSubst tyname uni ann
$cstimes :: forall tyname (uni :: * -> *) ann b.
Integral b =>
b -> TypeSubst tyname uni ann -> TypeSubst tyname uni ann
stimes :: forall b.
Integral b =>
b -> TypeSubst tyname uni ann -> TypeSubst tyname uni ann
Semigroup, Semigroup (TypeSubst tyname uni ann)
TypeSubst tyname uni ann
Semigroup (TypeSubst tyname uni ann) =>
TypeSubst tyname uni ann
-> (TypeSubst tyname uni ann
    -> TypeSubst tyname uni ann -> TypeSubst tyname uni ann)
-> ([TypeSubst tyname uni ann] -> TypeSubst tyname uni ann)
-> Monoid (TypeSubst tyname uni ann)
[TypeSubst tyname uni ann] -> TypeSubst tyname uni ann
TypeSubst tyname uni ann
-> TypeSubst tyname uni ann -> TypeSubst tyname uni ann
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
forall tyname (uni :: * -> *) ann.
Semigroup (TypeSubst tyname uni ann)
forall tyname (uni :: * -> *) ann. TypeSubst tyname uni ann
forall tyname (uni :: * -> *) ann.
[TypeSubst tyname uni ann] -> TypeSubst tyname uni ann
forall tyname (uni :: * -> *) ann.
TypeSubst tyname uni ann
-> TypeSubst tyname uni ann -> TypeSubst tyname uni ann
$cmempty :: forall tyname (uni :: * -> *) ann. TypeSubst tyname uni ann
mempty :: TypeSubst tyname uni ann
$cmappend :: forall tyname (uni :: * -> *) ann.
TypeSubst tyname uni ann
-> TypeSubst tyname uni ann -> TypeSubst tyname uni ann
mappend :: TypeSubst tyname uni ann
-> TypeSubst tyname uni ann -> TypeSubst tyname uni ann
$cmconcat :: forall tyname (uni :: * -> *) ann.
[TypeSubst tyname uni ann] -> TypeSubst tyname uni ann
mconcat :: [TypeSubst tyname uni ann] -> TypeSubst tyname uni ann
Monoid)

-- For call site inlining:

-- | A mapping including all non-recursive in scope variables.
newtype NonRecInScopeSet tyname name uni fun ann =
    NonRecInScopeSet
        { forall tyname name (uni :: * -> *) fun ann.
NonRecInScopeSet tyname name uni fun ann
-> UniqueMap TermUnique (InlineVarInfo tyname name uni fun ann)
_unNonRecInScopeSet :: UniqueMap TermUnique (InlineVarInfo tyname name uni fun ann)}
    deriving newtype (NonEmpty (NonRecInScopeSet tyname name uni fun ann)
-> NonRecInScopeSet tyname name uni fun ann
NonRecInScopeSet tyname name uni fun ann
-> NonRecInScopeSet tyname name uni fun ann
-> NonRecInScopeSet tyname name uni fun ann
(NonRecInScopeSet tyname name uni fun ann
 -> NonRecInScopeSet tyname name uni fun ann
 -> NonRecInScopeSet tyname name uni fun ann)
-> (NonEmpty (NonRecInScopeSet tyname name uni fun ann)
    -> NonRecInScopeSet tyname name uni fun ann)
-> (forall b.
    Integral b =>
    b
    -> NonRecInScopeSet tyname name uni fun ann
    -> NonRecInScopeSet tyname name uni fun ann)
-> Semigroup (NonRecInScopeSet tyname name uni fun ann)
forall b.
Integral b =>
b
-> NonRecInScopeSet tyname name uni fun ann
-> NonRecInScopeSet tyname name uni fun ann
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
forall tyname name (uni :: * -> *) fun ann.
NonEmpty (NonRecInScopeSet tyname name uni fun ann)
-> NonRecInScopeSet tyname name uni fun ann
forall tyname name (uni :: * -> *) fun ann.
NonRecInScopeSet tyname name uni fun ann
-> NonRecInScopeSet tyname name uni fun ann
-> NonRecInScopeSet tyname name uni fun ann
forall tyname name (uni :: * -> *) fun ann b.
Integral b =>
b
-> NonRecInScopeSet tyname name uni fun ann
-> NonRecInScopeSet tyname name uni fun ann
$c<> :: forall tyname name (uni :: * -> *) fun ann.
NonRecInScopeSet tyname name uni fun ann
-> NonRecInScopeSet tyname name uni fun ann
-> NonRecInScopeSet tyname name uni fun ann
<> :: NonRecInScopeSet tyname name uni fun ann
-> NonRecInScopeSet tyname name uni fun ann
-> NonRecInScopeSet tyname name uni fun ann
$csconcat :: forall tyname name (uni :: * -> *) fun ann.
NonEmpty (NonRecInScopeSet tyname name uni fun ann)
-> NonRecInScopeSet tyname name uni fun ann
sconcat :: NonEmpty (NonRecInScopeSet tyname name uni fun ann)
-> NonRecInScopeSet tyname name uni fun ann
$cstimes :: forall tyname name (uni :: * -> *) fun ann b.
Integral b =>
b
-> NonRecInScopeSet tyname name uni fun ann
-> NonRecInScopeSet tyname name uni fun ann
stimes :: forall b.
Integral b =>
b
-> NonRecInScopeSet tyname name uni fun ann
-> NonRecInScopeSet tyname name uni fun ann
Semigroup, Semigroup (NonRecInScopeSet tyname name uni fun ann)
NonRecInScopeSet tyname name uni fun ann
Semigroup (NonRecInScopeSet tyname name uni fun ann) =>
NonRecInScopeSet tyname name uni fun ann
-> (NonRecInScopeSet tyname name uni fun ann
    -> NonRecInScopeSet tyname name uni fun ann
    -> NonRecInScopeSet tyname name uni fun ann)
-> ([NonRecInScopeSet tyname name uni fun ann]
    -> NonRecInScopeSet tyname name uni fun ann)
-> Monoid (NonRecInScopeSet tyname name uni fun ann)
[NonRecInScopeSet tyname name uni fun ann]
-> NonRecInScopeSet tyname name uni fun ann
NonRecInScopeSet tyname name uni fun ann
-> NonRecInScopeSet tyname name uni fun ann
-> NonRecInScopeSet tyname name uni fun ann
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
forall tyname name (uni :: * -> *) fun ann.
Semigroup (NonRecInScopeSet tyname name uni fun ann)
forall tyname name (uni :: * -> *) fun ann.
NonRecInScopeSet tyname name uni fun ann
forall tyname name (uni :: * -> *) fun ann.
[NonRecInScopeSet tyname name uni fun ann]
-> NonRecInScopeSet tyname name uni fun ann
forall tyname name (uni :: * -> *) fun ann.
NonRecInScopeSet tyname name uni fun ann
-> NonRecInScopeSet tyname name uni fun ann
-> NonRecInScopeSet tyname name uni fun ann
$cmempty :: forall tyname name (uni :: * -> *) fun ann.
NonRecInScopeSet tyname name uni fun ann
mempty :: NonRecInScopeSet tyname name uni fun ann
$cmappend :: forall tyname name (uni :: * -> *) fun ann.
NonRecInScopeSet tyname name uni fun ann
-> NonRecInScopeSet tyname name uni fun ann
-> NonRecInScopeSet tyname name uni fun ann
mappend :: NonRecInScopeSet tyname name uni fun ann
-> NonRecInScopeSet tyname name uni fun ann
-> NonRecInScopeSet tyname name uni fun ann
$cmconcat :: forall tyname name (uni :: * -> *) fun ann.
[NonRecInScopeSet tyname name uni fun ann]
-> NonRecInScopeSet tyname name uni fun ann
mconcat :: [NonRecInScopeSet tyname name uni fun ann]
-> NonRecInScopeSet tyname name uni fun ann
Monoid)

-- | Info attached to a let-binding needed for call site inlining.
data InlineVarInfo tyname name uni fun ann = MkVarInfo
    { forall tyname name (uni :: * -> *) fun ann.
InlineVarInfo tyname name uni fun ann -> Strictness
varStrictness :: Strictness
    , forall tyname name (uni :: * -> *) fun ann.
InlineVarInfo tyname name uni fun ann
-> InlineTerm tyname name uni fun ann
varRhs        :: InlineTerm tyname name uni fun ann
    -- ^ its definition, which has been processed, as an `InlineTerm`. To preserve
    -- global uniqueness, we rename before substituting in.
    }

-- | Inliner context for both unconditional inlining and call site inlining.
-- It includes substitution for both terms and types, which is similar to 'Subst' in the paper.
-- It also includes the non recursive in-scope set for call site inlining.
data InlinerState tyname name uni fun ann =
    InlinerState { forall tyname name (uni :: * -> *) fun ann.
InlinerState tyname name uni fun ann
-> TermSubst tyname name uni fun ann
_termSubst  :: TermSubst tyname name uni fun ann
           , forall tyname name (uni :: * -> *) fun ann.
InlinerState tyname name uni fun ann -> TypeSubst tyname uni ann
_typeSubst        :: TypeSubst tyname uni ann
           , forall tyname name (uni :: * -> *) fun ann.
InlinerState tyname name uni fun ann
-> NonRecInScopeSet tyname name uni fun ann
_nonRecInScopeSet :: NonRecInScopeSet tyname name uni fun ann
          }
    deriving stock ((forall x.
 InlinerState tyname name uni fun ann
 -> Rep (InlinerState tyname name uni fun ann) x)
-> (forall x.
    Rep (InlinerState tyname name uni fun ann) x
    -> InlinerState tyname name uni fun ann)
-> Generic (InlinerState tyname name uni fun ann)
forall x.
Rep (InlinerState tyname name uni fun ann) x
-> InlinerState tyname name uni fun ann
forall x.
InlinerState tyname name uni fun ann
-> Rep (InlinerState tyname name uni fun ann) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall tyname name (uni :: * -> *) fun ann x.
Rep (InlinerState tyname name uni fun ann) x
-> InlinerState tyname name uni fun ann
forall tyname name (uni :: * -> *) fun ann x.
InlinerState tyname name uni fun ann
-> Rep (InlinerState tyname name uni fun ann) x
$cfrom :: forall tyname name (uni :: * -> *) fun ann x.
InlinerState tyname name uni fun ann
-> Rep (InlinerState tyname name uni fun ann) x
from :: forall x.
InlinerState tyname name uni fun ann
-> Rep (InlinerState tyname name uni fun ann) x
$cto :: forall tyname name (uni :: * -> *) fun ann x.
Rep (InlinerState tyname name uni fun ann) x
-> InlinerState tyname name uni fun ann
to :: forall x.
Rep (InlinerState tyname name uni fun ann) x
-> InlinerState tyname name uni fun ann
Generic)
    deriving (NonEmpty (InlinerState tyname name uni fun ann)
-> InlinerState tyname name uni fun ann
InlinerState tyname name uni fun ann
-> InlinerState tyname name uni fun ann
-> InlinerState tyname name uni fun ann
(InlinerState tyname name uni fun ann
 -> InlinerState tyname name uni fun ann
 -> InlinerState tyname name uni fun ann)
-> (NonEmpty (InlinerState tyname name uni fun ann)
    -> InlinerState tyname name uni fun ann)
-> (forall b.
    Integral b =>
    b
    -> InlinerState tyname name uni fun ann
    -> InlinerState tyname name uni fun ann)
-> Semigroup (InlinerState tyname name uni fun ann)
forall b.
Integral b =>
b
-> InlinerState tyname name uni fun ann
-> InlinerState tyname name uni fun ann
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
forall tyname name (uni :: * -> *) fun ann.
NonEmpty (InlinerState tyname name uni fun ann)
-> InlinerState tyname name uni fun ann
forall tyname name (uni :: * -> *) fun ann.
InlinerState tyname name uni fun ann
-> InlinerState tyname name uni fun ann
-> InlinerState tyname name uni fun ann
forall tyname name (uni :: * -> *) fun ann b.
Integral b =>
b
-> InlinerState tyname name uni fun ann
-> InlinerState tyname name uni fun ann
$c<> :: forall tyname name (uni :: * -> *) fun ann.
InlinerState tyname name uni fun ann
-> InlinerState tyname name uni fun ann
-> InlinerState tyname name uni fun ann
<> :: InlinerState tyname name uni fun ann
-> InlinerState tyname name uni fun ann
-> InlinerState tyname name uni fun ann
$csconcat :: forall tyname name (uni :: * -> *) fun ann.
NonEmpty (InlinerState tyname name uni fun ann)
-> InlinerState tyname name uni fun ann
sconcat :: NonEmpty (InlinerState tyname name uni fun ann)
-> InlinerState tyname name uni fun ann
$cstimes :: forall tyname name (uni :: * -> *) fun ann b.
Integral b =>
b
-> InlinerState tyname name uni fun ann
-> InlinerState tyname name uni fun ann
stimes :: forall b.
Integral b =>
b
-> InlinerState tyname name uni fun ann
-> InlinerState tyname name uni fun ann
Semigroup, Semigroup (InlinerState tyname name uni fun ann)
InlinerState tyname name uni fun ann
Semigroup (InlinerState tyname name uni fun ann) =>
InlinerState tyname name uni fun ann
-> (InlinerState tyname name uni fun ann
    -> InlinerState tyname name uni fun ann
    -> InlinerState tyname name uni fun ann)
-> ([InlinerState tyname name uni fun ann]
    -> InlinerState tyname name uni fun ann)
-> Monoid (InlinerState tyname name uni fun ann)
[InlinerState tyname name uni fun ann]
-> InlinerState tyname name uni fun ann
InlinerState tyname name uni fun ann
-> InlinerState tyname name uni fun ann
-> InlinerState tyname name uni fun ann
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
forall tyname name (uni :: * -> *) fun ann.
Semigroup (InlinerState tyname name uni fun ann)
forall tyname name (uni :: * -> *) fun ann.
InlinerState tyname name uni fun ann
forall tyname name (uni :: * -> *) fun ann.
[InlinerState tyname name uni fun ann]
-> InlinerState tyname name uni fun ann
forall tyname name (uni :: * -> *) fun ann.
InlinerState tyname name uni fun ann
-> InlinerState tyname name uni fun ann
-> InlinerState tyname name uni fun ann
$cmempty :: forall tyname name (uni :: * -> *) fun ann.
InlinerState tyname name uni fun ann
mempty :: InlinerState tyname name uni fun ann
$cmappend :: forall tyname name (uni :: * -> *) fun ann.
InlinerState tyname name uni fun ann
-> InlinerState tyname name uni fun ann
-> InlinerState tyname name uni fun ann
mappend :: InlinerState tyname name uni fun ann
-> InlinerState tyname name uni fun ann
-> InlinerState tyname name uni fun ann
$cmconcat :: forall tyname name (uni :: * -> *) fun ann.
[InlinerState tyname name uni fun ann]
-> InlinerState tyname name uni fun ann
mconcat :: [InlinerState tyname name uni fun ann]
-> InlinerState tyname name uni fun ann
Monoid) via
        (GenericSemigroupMonoid (InlinerState tyname name uni fun ann))

makeLenses ''TermSubst
makeLenses ''TypeSubst
makeLenses ''NonRecInScopeSet
makeLenses ''InlinerState

-- Helper functions:

-- | Look up the unprocessed variable in the term substitution.
lookupTerm
    :: (HasUnique name TermUnique)
    => name -- ^ The name of the variable.
    -> InlinerState tyname name uni fun ann
    -> Maybe (InlineTerm tyname name uni fun ann)
lookupTerm :: forall name tyname (uni :: * -> *) fun ann.
HasUnique name TermUnique =>
name
-> InlinerState tyname name uni fun ann
-> Maybe (InlineTerm tyname name uni fun ann)
lookupTerm name
n InlinerState tyname name uni fun ann
s = name
-> UniqueMap TermUnique (InlineTerm tyname name uni fun ann)
-> Maybe (InlineTerm tyname name uni fun ann)
forall name unique a.
HasUnique name unique =>
name -> UniqueMap unique a -> Maybe a
UMap.lookupName name
n (UniqueMap TermUnique (InlineTerm tyname name uni fun ann)
 -> Maybe (InlineTerm tyname name uni fun ann))
-> UniqueMap TermUnique (InlineTerm tyname name uni fun ann)
-> Maybe (InlineTerm tyname name uni fun ann)
forall a b. (a -> b) -> a -> b
$ InlinerState tyname name uni fun ann
s InlinerState tyname name uni fun ann
-> Getting
     (UniqueMap TermUnique (InlineTerm tyname name uni fun ann))
     (InlinerState tyname name uni fun ann)
     (UniqueMap TermUnique (InlineTerm tyname name uni fun ann))
-> UniqueMap TermUnique (InlineTerm tyname name uni fun ann)
forall s a. s -> Getting a s a -> a
^. (TermSubst tyname name uni fun ann
 -> Const
      (UniqueMap TermUnique (InlineTerm tyname name uni fun ann))
      (TermSubst tyname name uni fun ann))
-> InlinerState tyname name uni fun ann
-> Const
     (UniqueMap TermUnique (InlineTerm tyname name uni fun ann))
     (InlinerState tyname name uni fun ann)
forall tyname name (uni :: * -> *) fun ann (f :: * -> *).
Functor f =>
(TermSubst tyname name uni fun ann
 -> f (TermSubst tyname name uni fun ann))
-> InlinerState tyname name uni fun ann
-> f (InlinerState tyname name uni fun ann)
termSubst ((TermSubst tyname name uni fun ann
  -> Const
       (UniqueMap TermUnique (InlineTerm tyname name uni fun ann))
       (TermSubst tyname name uni fun ann))
 -> InlinerState tyname name uni fun ann
 -> Const
      (UniqueMap TermUnique (InlineTerm tyname name uni fun ann))
      (InlinerState tyname name uni fun ann))
-> ((UniqueMap TermUnique (InlineTerm tyname name uni fun ann)
     -> Const
          (UniqueMap TermUnique (InlineTerm tyname name uni fun ann))
          (UniqueMap TermUnique (InlineTerm tyname name uni fun ann)))
    -> TermSubst tyname name uni fun ann
    -> Const
         (UniqueMap TermUnique (InlineTerm tyname name uni fun ann))
         (TermSubst tyname name uni fun ann))
-> Getting
     (UniqueMap TermUnique (InlineTerm tyname name uni fun ann))
     (InlinerState tyname name uni fun ann)
     (UniqueMap TermUnique (InlineTerm tyname name uni fun ann))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UniqueMap TermUnique (InlineTerm tyname name uni fun ann)
 -> Const
      (UniqueMap TermUnique (InlineTerm tyname name uni fun ann))
      (UniqueMap TermUnique (InlineTerm tyname name uni fun ann)))
-> TermSubst tyname name uni fun ann
-> Const
     (UniqueMap TermUnique (InlineTerm tyname name uni fun ann))
     (TermSubst tyname name uni fun ann)
forall tyname name (uni :: * -> *) fun ann tyname name
       (uni :: * -> *) fun ann (p :: * -> * -> *) (f :: * -> *).
(Profunctor p, Functor f) =>
p (UniqueMap TermUnique (InlineTerm tyname name uni fun ann))
  (f (UniqueMap TermUnique (InlineTerm tyname name uni fun ann)))
-> p (TermSubst tyname name uni fun ann)
     (f (TermSubst tyname name uni fun ann))
unTermSubst

-- | Insert the unprocessed variable into the term substitution.
extendTerm
    :: (HasUnique name TermUnique)
    => name -- ^ The name of the variable.
    -> InlineTerm tyname name uni fun ann -- ^ The substitution range.
    -> InlinerState tyname name uni fun ann
    -> InlinerState tyname name uni fun ann
extendTerm :: forall name tyname (uni :: * -> *) fun ann.
HasUnique name TermUnique =>
name
-> InlineTerm tyname name uni fun ann
-> InlinerState tyname name uni fun ann
-> InlinerState tyname name uni fun ann
extendTerm name
n InlineTerm tyname name uni fun ann
clos InlinerState tyname name uni fun ann
s = InlinerState tyname name uni fun ann
s InlinerState tyname name uni fun ann
-> (InlinerState tyname name uni fun ann
    -> InlinerState tyname name uni fun ann)
-> InlinerState tyname name uni fun ann
forall a b. a -> (a -> b) -> b
& (TermSubst tyname name uni fun ann
 -> Identity (TermSubst tyname name uni fun ann))
-> InlinerState tyname name uni fun ann
-> Identity (InlinerState tyname name uni fun ann)
forall tyname name (uni :: * -> *) fun ann (f :: * -> *).
Functor f =>
(TermSubst tyname name uni fun ann
 -> f (TermSubst tyname name uni fun ann))
-> InlinerState tyname name uni fun ann
-> f (InlinerState tyname name uni fun ann)
termSubst ((TermSubst tyname name uni fun ann
  -> Identity (TermSubst tyname name uni fun ann))
 -> InlinerState tyname name uni fun ann
 -> Identity (InlinerState tyname name uni fun ann))
-> ((UniqueMap TermUnique (InlineTerm tyname name uni fun ann)
     -> Identity
          (UniqueMap TermUnique (InlineTerm tyname name uni fun ann)))
    -> TermSubst tyname name uni fun ann
    -> Identity (TermSubst tyname name uni fun ann))
-> (UniqueMap TermUnique (InlineTerm tyname name uni fun ann)
    -> Identity
         (UniqueMap TermUnique (InlineTerm tyname name uni fun ann)))
-> InlinerState tyname name uni fun ann
-> Identity (InlinerState tyname name uni fun ann)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UniqueMap TermUnique (InlineTerm tyname name uni fun ann)
 -> Identity
      (UniqueMap TermUnique (InlineTerm tyname name uni fun ann)))
-> TermSubst tyname name uni fun ann
-> Identity (TermSubst tyname name uni fun ann)
forall tyname name (uni :: * -> *) fun ann tyname name
       (uni :: * -> *) fun ann (p :: * -> * -> *) (f :: * -> *).
(Profunctor p, Functor f) =>
p (UniqueMap TermUnique (InlineTerm tyname name uni fun ann))
  (f (UniqueMap TermUnique (InlineTerm tyname name uni fun ann)))
-> p (TermSubst tyname name uni fun ann)
     (f (TermSubst tyname name uni fun ann))
unTermSubst ((UniqueMap TermUnique (InlineTerm tyname name uni fun ann)
  -> Identity
       (UniqueMap TermUnique (InlineTerm tyname name uni fun ann)))
 -> InlinerState tyname name uni fun ann
 -> Identity (InlinerState tyname name uni fun ann))
-> (UniqueMap TermUnique (InlineTerm tyname name uni fun ann)
    -> UniqueMap TermUnique (InlineTerm tyname name uni fun ann))
-> InlinerState tyname name uni fun ann
-> InlinerState tyname name uni fun ann
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ name
-> InlineTerm tyname name uni fun ann
-> UniqueMap TermUnique (InlineTerm tyname name uni fun ann)
-> UniqueMap TermUnique (InlineTerm tyname name uni fun ann)
forall name unique a.
HasUnique name unique =>
name -> a -> UniqueMap unique a -> UniqueMap unique a
UMap.insertByName name
n InlineTerm tyname name uni fun ann
clos

-- | Look up the unprocessed type variable in the type substitution.
lookupType
    :: (HasUnique tyname TypeUnique)
    => tyname
    -> InlinerState tyname name uni fun ann
    -> Maybe (Dupable (Type tyname uni ann))
lookupType :: forall tyname name (uni :: * -> *) fun ann.
HasUnique tyname TypeUnique =>
tyname
-> InlinerState tyname name uni fun ann
-> Maybe (Dupable (Type tyname uni ann))
lookupType tyname
tn InlinerState tyname name uni fun ann
s = tyname
-> UniqueMap TypeUnique (Dupable (Type tyname uni ann))
-> Maybe (Dupable (Type tyname uni ann))
forall name unique a.
HasUnique name unique =>
name -> UniqueMap unique a -> Maybe a
UMap.lookupName tyname
tn (UniqueMap TypeUnique (Dupable (Type tyname uni ann))
 -> Maybe (Dupable (Type tyname uni ann)))
-> UniqueMap TypeUnique (Dupable (Type tyname uni ann))
-> Maybe (Dupable (Type tyname uni ann))
forall a b. (a -> b) -> a -> b
$ InlinerState tyname name uni fun ann
s InlinerState tyname name uni fun ann
-> Getting
     (UniqueMap TypeUnique (Dupable (Type tyname uni ann)))
     (InlinerState tyname name uni fun ann)
     (UniqueMap TypeUnique (Dupable (Type tyname uni ann)))
-> UniqueMap TypeUnique (Dupable (Type tyname uni ann))
forall s a. s -> Getting a s a -> a
^. (TypeSubst tyname uni ann
 -> Const
      (UniqueMap TypeUnique (Dupable (Type tyname uni ann)))
      (TypeSubst tyname uni ann))
-> InlinerState tyname name uni fun ann
-> Const
     (UniqueMap TypeUnique (Dupable (Type tyname uni ann)))
     (InlinerState tyname name uni fun ann)
forall tyname name (uni :: * -> *) fun ann (f :: * -> *).
Functor f =>
(TypeSubst tyname uni ann -> f (TypeSubst tyname uni ann))
-> InlinerState tyname name uni fun ann
-> f (InlinerState tyname name uni fun ann)
typeSubst ((TypeSubst tyname uni ann
  -> Const
       (UniqueMap TypeUnique (Dupable (Type tyname uni ann)))
       (TypeSubst tyname uni ann))
 -> InlinerState tyname name uni fun ann
 -> Const
      (UniqueMap TypeUnique (Dupable (Type tyname uni ann)))
      (InlinerState tyname name uni fun ann))
-> ((UniqueMap TypeUnique (Dupable (Type tyname uni ann))
     -> Const
          (UniqueMap TypeUnique (Dupable (Type tyname uni ann)))
          (UniqueMap TypeUnique (Dupable (Type tyname uni ann))))
    -> TypeSubst tyname uni ann
    -> Const
         (UniqueMap TypeUnique (Dupable (Type tyname uni ann)))
         (TypeSubst tyname uni ann))
-> Getting
     (UniqueMap TypeUnique (Dupable (Type tyname uni ann)))
     (InlinerState tyname name uni fun ann)
     (UniqueMap TypeUnique (Dupable (Type tyname uni ann)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UniqueMap TypeUnique (Dupable (Type tyname uni ann))
 -> Const
      (UniqueMap TypeUnique (Dupable (Type tyname uni ann)))
      (UniqueMap TypeUnique (Dupable (Type tyname uni ann))))
-> TypeSubst tyname uni ann
-> Const
     (UniqueMap TypeUnique (Dupable (Type tyname uni ann)))
     (TypeSubst tyname uni ann)
forall tyname (uni :: * -> *) ann tyname (uni :: * -> *) ann
       (p :: * -> * -> *) (f :: * -> *).
(Profunctor p, Functor f) =>
p (UniqueMap TypeUnique (Dupable (Type tyname uni ann)))
  (f (UniqueMap TypeUnique (Dupable (Type tyname uni ann))))
-> p (TypeSubst tyname uni ann) (f (TypeSubst tyname uni ann))
unTypeSubst

-- | Check if the type substitution is empty.
isTypeSubstEmpty :: InlinerState tyname name uni fun ann -> Bool
isTypeSubstEmpty :: forall tyname name (uni :: * -> *) fun ann.
InlinerState tyname name uni fun ann -> Bool
isTypeSubstEmpty (InlinerState TermSubst tyname name uni fun ann
_ (TypeSubst UniqueMap TypeUnique (Dupable (Type tyname uni ann))
tyEnv) NonRecInScopeSet tyname name uni fun ann
_) = UniqueMap TypeUnique (Dupable (Type tyname uni ann)) -> Bool
forall a. UniqueMap TypeUnique a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null UniqueMap TypeUnique (Dupable (Type tyname uni ann))
tyEnv

-- | Insert the unprocessed type variable into the type substitution.
extendType
    :: (HasUnique tyname TypeUnique)
    => tyname -- ^ The name of the type variable.
    -> Type tyname uni ann -- ^ Its type.
    -> InlinerState tyname name uni fun ann
    -> InlinerState tyname name uni fun ann
extendType :: forall tyname (uni :: * -> *) ann name fun.
HasUnique tyname TypeUnique =>
tyname
-> Type tyname uni ann
-> InlinerState tyname name uni fun ann
-> InlinerState tyname name uni fun ann
extendType tyname
tn Type tyname uni ann
ty InlinerState tyname name uni fun ann
s = InlinerState tyname name uni fun ann
s InlinerState tyname name uni fun ann
-> (InlinerState tyname name uni fun ann
    -> InlinerState tyname name uni fun ann)
-> InlinerState tyname name uni fun ann
forall a b. a -> (a -> b) -> b
&  (TypeSubst tyname uni ann -> Identity (TypeSubst tyname uni ann))
-> InlinerState tyname name uni fun ann
-> Identity (InlinerState tyname name uni fun ann)
forall tyname name (uni :: * -> *) fun ann (f :: * -> *).
Functor f =>
(TypeSubst tyname uni ann -> f (TypeSubst tyname uni ann))
-> InlinerState tyname name uni fun ann
-> f (InlinerState tyname name uni fun ann)
typeSubst ((TypeSubst tyname uni ann -> Identity (TypeSubst tyname uni ann))
 -> InlinerState tyname name uni fun ann
 -> Identity (InlinerState tyname name uni fun ann))
-> ((UniqueMap TypeUnique (Dupable (Type tyname uni ann))
     -> Identity (UniqueMap TypeUnique (Dupable (Type tyname uni ann))))
    -> TypeSubst tyname uni ann -> Identity (TypeSubst tyname uni ann))
-> (UniqueMap TypeUnique (Dupable (Type tyname uni ann))
    -> Identity (UniqueMap TypeUnique (Dupable (Type tyname uni ann))))
-> InlinerState tyname name uni fun ann
-> Identity (InlinerState tyname name uni fun ann)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UniqueMap TypeUnique (Dupable (Type tyname uni ann))
 -> Identity (UniqueMap TypeUnique (Dupable (Type tyname uni ann))))
-> TypeSubst tyname uni ann -> Identity (TypeSubst tyname uni ann)
forall tyname (uni :: * -> *) ann tyname (uni :: * -> *) ann
       (p :: * -> * -> *) (f :: * -> *).
(Profunctor p, Functor f) =>
p (UniqueMap TypeUnique (Dupable (Type tyname uni ann)))
  (f (UniqueMap TypeUnique (Dupable (Type tyname uni ann))))
-> p (TypeSubst tyname uni ann) (f (TypeSubst tyname uni ann))
unTypeSubst ((UniqueMap TypeUnique (Dupable (Type tyname uni ann))
  -> Identity (UniqueMap TypeUnique (Dupable (Type tyname uni ann))))
 -> InlinerState tyname name uni fun ann
 -> Identity (InlinerState tyname name uni fun ann))
-> (UniqueMap TypeUnique (Dupable (Type tyname uni ann))
    -> UniqueMap TypeUnique (Dupable (Type tyname uni ann)))
-> InlinerState tyname name uni fun ann
-> InlinerState tyname name uni fun ann
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ tyname
-> Dupable (Type tyname uni ann)
-> UniqueMap TypeUnique (Dupable (Type tyname uni ann))
-> UniqueMap TypeUnique (Dupable (Type tyname uni ann))
forall name unique a.
HasUnique name unique =>
name -> a -> UniqueMap unique a -> UniqueMap unique a
UMap.insertByName tyname
tn (Type tyname uni ann -> Dupable (Type tyname uni ann)
forall a. a -> Dupable a
dupable Type tyname uni ann
ty)

-- | Look up a variable in the in scope set.
lookupVarInfo
    :: (HasUnique name TermUnique)
    => name -- ^ The name of the variable.
    -> InlinerState tyname name uni fun ann
    -> Maybe (InlineVarInfo tyname name uni fun ann)
lookupVarInfo :: forall name tyname (uni :: * -> *) fun ann.
HasUnique name TermUnique =>
name
-> InlinerState tyname name uni fun ann
-> Maybe (InlineVarInfo tyname name uni fun ann)
lookupVarInfo name
n InlinerState tyname name uni fun ann
s = name
-> UniqueMap TermUnique (InlineVarInfo tyname name uni fun ann)
-> Maybe (InlineVarInfo tyname name uni fun ann)
forall name unique a.
HasUnique name unique =>
name -> UniqueMap unique a -> Maybe a
UMap.lookupName name
n (UniqueMap TermUnique (InlineVarInfo tyname name uni fun ann)
 -> Maybe (InlineVarInfo tyname name uni fun ann))
-> UniqueMap TermUnique (InlineVarInfo tyname name uni fun ann)
-> Maybe (InlineVarInfo tyname name uni fun ann)
forall a b. (a -> b) -> a -> b
$ InlinerState tyname name uni fun ann
s InlinerState tyname name uni fun ann
-> Getting
     (UniqueMap TermUnique (InlineVarInfo tyname name uni fun ann))
     (InlinerState tyname name uni fun ann)
     (UniqueMap TermUnique (InlineVarInfo tyname name uni fun ann))
-> UniqueMap TermUnique (InlineVarInfo tyname name uni fun ann)
forall s a. s -> Getting a s a -> a
^. (NonRecInScopeSet tyname name uni fun ann
 -> Const
      (UniqueMap TermUnique (InlineVarInfo tyname name uni fun ann))
      (NonRecInScopeSet tyname name uni fun ann))
-> InlinerState tyname name uni fun ann
-> Const
     (UniqueMap TermUnique (InlineVarInfo tyname name uni fun ann))
     (InlinerState tyname name uni fun ann)
forall tyname name (uni :: * -> *) fun ann (f :: * -> *).
Functor f =>
(NonRecInScopeSet tyname name uni fun ann
 -> f (NonRecInScopeSet tyname name uni fun ann))
-> InlinerState tyname name uni fun ann
-> f (InlinerState tyname name uni fun ann)
nonRecInScopeSet ((NonRecInScopeSet tyname name uni fun ann
  -> Const
       (UniqueMap TermUnique (InlineVarInfo tyname name uni fun ann))
       (NonRecInScopeSet tyname name uni fun ann))
 -> InlinerState tyname name uni fun ann
 -> Const
      (UniqueMap TermUnique (InlineVarInfo tyname name uni fun ann))
      (InlinerState tyname name uni fun ann))
-> ((UniqueMap TermUnique (InlineVarInfo tyname name uni fun ann)
     -> Const
          (UniqueMap TermUnique (InlineVarInfo tyname name uni fun ann))
          (UniqueMap TermUnique (InlineVarInfo tyname name uni fun ann)))
    -> NonRecInScopeSet tyname name uni fun ann
    -> Const
         (UniqueMap TermUnique (InlineVarInfo tyname name uni fun ann))
         (NonRecInScopeSet tyname name uni fun ann))
-> Getting
     (UniqueMap TermUnique (InlineVarInfo tyname name uni fun ann))
     (InlinerState tyname name uni fun ann)
     (UniqueMap TermUnique (InlineVarInfo tyname name uni fun ann))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UniqueMap TermUnique (InlineVarInfo tyname name uni fun ann)
 -> Const
      (UniqueMap TermUnique (InlineVarInfo tyname name uni fun ann))
      (UniqueMap TermUnique (InlineVarInfo tyname name uni fun ann)))
-> NonRecInScopeSet tyname name uni fun ann
-> Const
     (UniqueMap TermUnique (InlineVarInfo tyname name uni fun ann))
     (NonRecInScopeSet tyname name uni fun ann)
forall tyname name (uni :: * -> *) fun ann tyname name
       (uni :: * -> *) fun ann (p :: * -> * -> *) (f :: * -> *).
(Profunctor p, Functor f) =>
p (UniqueMap TermUnique (InlineVarInfo tyname name uni fun ann))
  (f (UniqueMap TermUnique (InlineVarInfo tyname name uni fun ann)))
-> p (NonRecInScopeSet tyname name uni fun ann)
     (f (NonRecInScopeSet tyname name uni fun ann))
unNonRecInScopeSet

-- | Insert a variable into the substitution.
extendVarInfo
    :: (HasUnique name TermUnique)
    => name -- ^ The name of the variable.
    -> InlineVarInfo tyname name uni fun ann -- ^ The variable's info.
    -> InlinerState tyname name uni fun ann
    -> InlinerState tyname name uni fun ann
extendVarInfo :: forall name tyname (uni :: * -> *) fun ann.
HasUnique name TermUnique =>
name
-> InlineVarInfo tyname name uni fun ann
-> InlinerState tyname name uni fun ann
-> InlinerState tyname name uni fun ann
extendVarInfo name
n InlineVarInfo tyname name uni fun ann
info InlinerState tyname name uni fun ann
s = InlinerState tyname name uni fun ann
s InlinerState tyname name uni fun ann
-> (InlinerState tyname name uni fun ann
    -> InlinerState tyname name uni fun ann)
-> InlinerState tyname name uni fun ann
forall a b. a -> (a -> b) -> b
& (NonRecInScopeSet tyname name uni fun ann
 -> Identity (NonRecInScopeSet tyname name uni fun ann))
-> InlinerState tyname name uni fun ann
-> Identity (InlinerState tyname name uni fun ann)
forall tyname name (uni :: * -> *) fun ann (f :: * -> *).
Functor f =>
(NonRecInScopeSet tyname name uni fun ann
 -> f (NonRecInScopeSet tyname name uni fun ann))
-> InlinerState tyname name uni fun ann
-> f (InlinerState tyname name uni fun ann)
nonRecInScopeSet ((NonRecInScopeSet tyname name uni fun ann
  -> Identity (NonRecInScopeSet tyname name uni fun ann))
 -> InlinerState tyname name uni fun ann
 -> Identity (InlinerState tyname name uni fun ann))
-> ((UniqueMap TermUnique (InlineVarInfo tyname name uni fun ann)
     -> Identity
          (UniqueMap TermUnique (InlineVarInfo tyname name uni fun ann)))
    -> NonRecInScopeSet tyname name uni fun ann
    -> Identity (NonRecInScopeSet tyname name uni fun ann))
-> (UniqueMap TermUnique (InlineVarInfo tyname name uni fun ann)
    -> Identity
         (UniqueMap TermUnique (InlineVarInfo tyname name uni fun ann)))
-> InlinerState tyname name uni fun ann
-> Identity (InlinerState tyname name uni fun ann)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UniqueMap TermUnique (InlineVarInfo tyname name uni fun ann)
 -> Identity
      (UniqueMap TermUnique (InlineVarInfo tyname name uni fun ann)))
-> NonRecInScopeSet tyname name uni fun ann
-> Identity (NonRecInScopeSet tyname name uni fun ann)
forall tyname name (uni :: * -> *) fun ann tyname name
       (uni :: * -> *) fun ann (p :: * -> * -> *) (f :: * -> *).
(Profunctor p, Functor f) =>
p (UniqueMap TermUnique (InlineVarInfo tyname name uni fun ann))
  (f (UniqueMap TermUnique (InlineVarInfo tyname name uni fun ann)))
-> p (NonRecInScopeSet tyname name uni fun ann)
     (f (NonRecInScopeSet tyname name uni fun ann))
unNonRecInScopeSet ((UniqueMap TermUnique (InlineVarInfo tyname name uni fun ann)
  -> Identity
       (UniqueMap TermUnique (InlineVarInfo tyname name uni fun ann)))
 -> InlinerState tyname name uni fun ann
 -> Identity (InlinerState tyname name uni fun ann))
-> (UniqueMap TermUnique (InlineVarInfo tyname name uni fun ann)
    -> UniqueMap TermUnique (InlineVarInfo tyname name uni fun ann))
-> InlinerState tyname name uni fun ann
-> InlinerState tyname name uni fun ann
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ name
-> InlineVarInfo tyname name uni fun ann
-> UniqueMap TermUnique (InlineVarInfo tyname name uni fun ann)
-> UniqueMap TermUnique (InlineVarInfo tyname name uni fun ann)
forall name unique a.
HasUnique name unique =>
name -> a -> UniqueMap unique a -> UniqueMap unique a
UMap.insertByName name
n InlineVarInfo tyname name uni fun ann
info


applyTypeSubstitution :: forall tyname name uni fun ann. InliningConstraints tyname name uni fun
    => Type tyname uni ann
    -> InlineM tyname name uni fun ann (Type tyname uni ann)
applyTypeSubstitution :: forall tyname name (uni :: * -> *) fun ann.
InliningConstraints tyname name uni fun =>
Type tyname uni ann
-> InlineM tyname name uni fun ann (Type tyname uni ann)
applyTypeSubstitution Type tyname uni ann
t = (InlinerState tyname name uni fun ann -> Bool)
-> ReaderT
     (InlineInfo tyname name uni fun ann)
     (StateT (InlinerState tyname name uni fun ann) Quote)
     Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets InlinerState tyname name uni fun ann -> Bool
forall tyname name (uni :: * -> *) fun ann.
InlinerState tyname name uni fun ann -> Bool
isTypeSubstEmpty ReaderT
  (InlineInfo tyname name uni fun ann)
  (StateT (InlinerState tyname name uni fun ann) Quote)
  Bool
-> (Bool
    -> ReaderT
         (InlineInfo tyname name uni fun ann)
         (StateT (InlinerState tyname name uni fun ann) Quote)
         (Type tyname uni ann))
-> ReaderT
     (InlineInfo tyname name uni fun ann)
     (StateT (InlinerState tyname name uni fun ann) Quote)
     (Type tyname uni ann)
forall a b.
ReaderT
  (InlineInfo tyname name uni fun ann)
  (StateT (InlinerState tyname name uni fun ann) Quote)
  a
-> (a
    -> ReaderT
         (InlineInfo tyname name uni fun ann)
         (StateT (InlinerState tyname name uni fun ann) Quote)
         b)
-> ReaderT
     (InlineInfo tyname name uni fun ann)
     (StateT (InlinerState tyname name uni fun ann) Quote)
     b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    -- The type substitution is very often empty, and there are lots of types in the program,
    -- so this saves a lot of work (determined from profiling)
    Bool
True -> Type tyname uni ann
-> ReaderT
     (InlineInfo tyname name uni fun ann)
     (StateT (InlinerState tyname name uni fun ann) Quote)
     (Type tyname uni ann)
forall a.
a
-> ReaderT
     (InlineInfo tyname name uni fun ann)
     (StateT (InlinerState tyname name uni fun ann) Quote)
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Type tyname uni ann
t
    Bool
_    -> (tyname
 -> ReaderT
      (InlineInfo tyname name uni fun ann)
      (StateT (InlinerState tyname name uni fun ann) Quote)
      (Maybe (Type tyname uni ann)))
-> Type tyname uni ann
-> ReaderT
     (InlineInfo tyname name uni fun ann)
     (StateT (InlinerState tyname name uni fun ann) Quote)
     (Type tyname uni ann)
forall (m :: * -> *) tyname (uni :: * -> *) ann.
Monad m =>
(tyname -> m (Maybe (Type tyname uni ann)))
-> Type tyname uni ann -> m (Type tyname uni ann)
typeSubstTyNamesM tyname
-> ReaderT
     (InlineInfo tyname name uni fun ann)
     (StateT (InlinerState tyname name uni fun ann) Quote)
     (Maybe (Type tyname uni ann))
forall tyname name (uni :: * -> *) fun ann.
InliningConstraints tyname name uni fun =>
tyname
-> InlineM tyname name uni fun ann (Maybe (Type tyname uni ann))
substTyName Type tyname uni ann
t

-- See Note [Inlining and global uniqueness]
substTyName :: forall tyname name uni fun ann. InliningConstraints tyname name uni fun
    => tyname
    -> InlineM tyname name uni fun ann (Maybe (Type tyname uni ann))
substTyName :: forall tyname name (uni :: * -> *) fun ann.
InliningConstraints tyname name uni fun =>
tyname
-> InlineM tyname name uni fun ann (Maybe (Type tyname uni ann))
substTyName tyname
tyname = (InlinerState tyname name uni fun ann
 -> Maybe (Dupable (Type tyname uni ann)))
-> ReaderT
     (InlineInfo tyname name uni fun ann)
     (StateT (InlinerState tyname name uni fun ann) Quote)
     (Maybe (Dupable (Type tyname uni ann)))
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (tyname
-> InlinerState tyname name uni fun ann
-> Maybe (Dupable (Type tyname uni ann))
forall tyname name (uni :: * -> *) fun ann.
HasUnique tyname TypeUnique =>
tyname
-> InlinerState tyname name uni fun ann
-> Maybe (Dupable (Type tyname uni ann))
lookupType tyname
tyname) ReaderT
  (InlineInfo tyname name uni fun ann)
  (StateT (InlinerState tyname name uni fun ann) Quote)
  (Maybe (Dupable (Type tyname uni ann)))
-> (Maybe (Dupable (Type tyname uni ann))
    -> ReaderT
         (InlineInfo tyname name uni fun ann)
         (StateT (InlinerState tyname name uni fun ann) Quote)
         (Maybe (Type tyname uni ann)))
-> ReaderT
     (InlineInfo tyname name uni fun ann)
     (StateT (InlinerState tyname name uni fun ann) Quote)
     (Maybe (Type tyname uni ann))
forall a b.
ReaderT
  (InlineInfo tyname name uni fun ann)
  (StateT (InlinerState tyname name uni fun ann) Quote)
  a
-> (a
    -> ReaderT
         (InlineInfo tyname name uni fun ann)
         (StateT (InlinerState tyname name uni fun ann) Quote)
         b)
-> ReaderT
     (InlineInfo tyname name uni fun ann)
     (StateT (InlinerState tyname name uni fun ann) Quote)
     b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Dupable (Type tyname uni ann)
 -> ReaderT
      (InlineInfo tyname name uni fun ann)
      (StateT (InlinerState tyname name uni fun ann) Quote)
      (Type tyname uni ann))
-> Maybe (Dupable (Type tyname uni ann))
-> ReaderT
     (InlineInfo tyname name uni fun ann)
     (StateT (InlinerState tyname name uni fun ann) Quote)
     (Maybe (Type tyname uni ann))
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) -> Maybe a -> f (Maybe b)
traverse Dupable (Type tyname uni ann)
-> ReaderT
     (InlineInfo tyname name uni fun ann)
     (StateT (InlinerState tyname name uni fun ann) Quote)
     (Type tyname uni ann)
forall (m :: * -> *) a.
(MonadQuote m, Rename a) =>
Dupable a -> m a
liftDupable

-- See Note [Inlining and global uniqueness]
substName :: forall tyname name uni fun ann. InliningConstraints tyname name uni fun
    => name
    -> InlineM tyname name uni fun ann (Maybe (Term tyname name uni fun ann))
substName :: forall tyname name (uni :: * -> *) fun ann.
InliningConstraints tyname name uni fun =>
name
-> InlineM
     tyname name uni fun ann (Maybe (Term tyname name uni fun ann))
substName name
name = (InlinerState tyname name uni fun ann
 -> Maybe (InlineTerm tyname name uni fun ann))
-> ReaderT
     (InlineInfo tyname name uni fun ann)
     (StateT (InlinerState tyname name uni fun ann) Quote)
     (Maybe (InlineTerm tyname name uni fun ann))
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (name
-> InlinerState tyname name uni fun ann
-> Maybe (InlineTerm tyname name uni fun ann)
forall name tyname (uni :: * -> *) fun ann.
HasUnique name TermUnique =>
name
-> InlinerState tyname name uni fun ann
-> Maybe (InlineTerm tyname name uni fun ann)
lookupTerm name
name) ReaderT
  (InlineInfo tyname name uni fun ann)
  (StateT (InlinerState tyname name uni fun ann) Quote)
  (Maybe (InlineTerm tyname name uni fun ann))
-> (Maybe (InlineTerm tyname name uni fun ann)
    -> ReaderT
         (InlineInfo tyname name uni fun ann)
         (StateT (InlinerState tyname name uni fun ann) Quote)
         (Maybe (Term tyname name uni fun ann)))
-> ReaderT
     (InlineInfo tyname name uni fun ann)
     (StateT (InlinerState tyname name uni fun ann) Quote)
     (Maybe (Term tyname name uni fun ann))
forall a b.
ReaderT
  (InlineInfo tyname name uni fun ann)
  (StateT (InlinerState tyname name uni fun ann) Quote)
  a
-> (a
    -> ReaderT
         (InlineInfo tyname name uni fun ann)
         (StateT (InlinerState tyname name uni fun ann) Quote)
         b)
-> ReaderT
     (InlineInfo tyname name uni fun ann)
     (StateT (InlinerState tyname name uni fun ann) Quote)
     b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (InlineTerm tyname name uni fun ann
 -> ReaderT
      (InlineInfo tyname name uni fun ann)
      (StateT (InlinerState tyname name uni fun ann) Quote)
      (Term tyname name uni fun ann))
-> Maybe (InlineTerm tyname name uni fun ann)
-> ReaderT
     (InlineInfo tyname name uni fun ann)
     (StateT (InlinerState tyname name uni fun ann) Quote)
     (Maybe (Term tyname name uni fun ann))
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) -> Maybe a -> f (Maybe b)
traverse InlineTerm tyname name uni fun ann
-> ReaderT
     (InlineInfo tyname name uni fun ann)
     (StateT (InlinerState tyname name uni fun ann) Quote)
     (Term tyname name uni fun ann)
forall tyname name (uni :: * -> *) fun ann.
InliningConstraints tyname name uni fun =>
InlineTerm tyname name uni fun ann
-> InlineM tyname name uni fun ann (Term tyname name uni fun ann)
renameTerm

-- See Note [Inlining approach and 'Secrets of the GHC Inliner']
-- Already processed term, just rename and put it in, don't do any further optimization here.
renameTerm :: forall tyname name uni fun ann. InliningConstraints tyname name uni fun
    => InlineTerm tyname name uni fun ann
    -> InlineM tyname name uni fun ann (Term tyname name uni fun ann)
renameTerm :: forall tyname name (uni :: * -> *) fun ann.
InliningConstraints tyname name uni fun =>
InlineTerm tyname name uni fun ann
-> InlineM tyname name uni fun ann (Term tyname name uni fun ann)
renameTerm (Done Dupable (Term tyname name uni fun ann)
t) = Dupable (Term tyname name uni fun ann)
-> ReaderT
     (InlineInfo tyname name uni fun ann)
     (StateT (InlinerState tyname name uni fun ann) Quote)
     (Term tyname name uni fun ann)
forall (m :: * -> *) a.
(MonadQuote m, Rename a) =>
Dupable a -> m a
liftDupable Dupable (Term tyname name uni fun ann)
t

{- Note [Renaming strategy]
Since we assume global uniqueness, we can take a slightly different approach to
renaming:  we rename the term we are substituting in, instead of renaming
every binder that our substitution encounters, which should guarantee that we
avoid any variable capture.

We rename both terms and types as both may have binders in them.
-}

-- Heuristics:

-- | Check if term is pure. See Note [Inlining and purity]
checkPurity
    :: forall tyname name uni fun ann. InliningConstraints tyname name uni fun
    => Term tyname name uni fun ann -> InlineM tyname name uni fun ann Bool
checkPurity :: forall tyname name (uni :: * -> *) fun ann.
InliningConstraints tyname name uni fun =>
Term tyname name uni fun ann
-> InlineM tyname name uni fun ann Bool
checkPurity Term tyname name uni fun ann
t = do
    VarsInfo tyname name uni ann
varInfo <- Getting
  (VarsInfo tyname name uni ann)
  (InlineInfo tyname name uni fun ann)
  (VarsInfo tyname name uni ann)
-> ReaderT
     (InlineInfo tyname name uni fun ann)
     (StateT (InlinerState tyname name uni fun ann) Quote)
     (VarsInfo tyname name uni ann)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (VarsInfo tyname name uni ann)
  (InlineInfo tyname name uni fun ann)
  (VarsInfo tyname name uni ann)
forall tyname name (uni :: * -> *) fun ann tyname (f :: * -> *).
Functor f =>
(VarsInfo tyname name uni ann -> f (VarsInfo tyname name uni ann))
-> InlineInfo tyname name uni fun ann
-> f (InlineInfo tyname name uni fun ann)
iiVarInfo
    BuiltinsInfo uni fun
binfo <- Getting
  (BuiltinsInfo uni fun)
  (InlineInfo tyname name uni fun ann)
  (BuiltinsInfo uni fun)
-> ReaderT
     (InlineInfo tyname name uni fun ann)
     (StateT (InlinerState tyname name uni fun ann) Quote)
     (BuiltinsInfo uni fun)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (BuiltinsInfo uni fun)
  (InlineInfo tyname name uni fun ann)
  (BuiltinsInfo uni fun)
forall tyname name (uni :: * -> *) fun ann fun (f :: * -> *).
Functor f =>
(BuiltinsInfo uni fun -> f (BuiltinsInfo uni fun))
-> InlineInfo tyname name uni fun ann
-> f (InlineInfo tyname name uni fun ann)
iiBuiltinsInfo
    Bool -> InlineM tyname name uni fun ann Bool
forall a.
a
-> ReaderT
     (InlineInfo tyname name uni fun ann)
     (StateT (InlinerState tyname name uni fun ann) Quote)
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> InlineM tyname name uni fun ann Bool)
-> Bool -> InlineM tyname name uni fun ann Bool
forall a b. (a -> b) -> a -> b
$ BuiltinsInfo uni fun
-> VarsInfo tyname name uni ann
-> Term tyname name uni fun ann
-> 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 ann
varInfo Term tyname name uni fun ann
t

isFirstVarBeforeEffects
    :: forall tyname name uni fun ann. InliningConstraints tyname name uni fun
    => name -> Term tyname name uni fun ann -> InlineM tyname name uni fun ann Bool
isFirstVarBeforeEffects :: forall tyname name (uni :: * -> *) fun ann.
InliningConstraints tyname name uni fun =>
name
-> Term tyname name uni fun ann
-> InlineM tyname name uni fun ann Bool
isFirstVarBeforeEffects name
n Term tyname name uni fun ann
t = do
    VarsInfo tyname name uni ann
varInfo <- Getting
  (VarsInfo tyname name uni ann)
  (InlineInfo tyname name uni fun ann)
  (VarsInfo tyname name uni ann)
-> ReaderT
     (InlineInfo tyname name uni fun ann)
     (StateT (InlinerState tyname name uni fun ann) Quote)
     (VarsInfo tyname name uni ann)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (VarsInfo tyname name uni ann)
  (InlineInfo tyname name uni fun ann)
  (VarsInfo tyname name uni ann)
forall tyname name (uni :: * -> *) fun ann tyname (f :: * -> *).
Functor f =>
(VarsInfo tyname name uni ann -> f (VarsInfo tyname name uni ann))
-> InlineInfo tyname name uni fun ann
-> f (InlineInfo tyname name uni fun ann)
iiVarInfo
    BuiltinsInfo uni fun
binfo <- Getting
  (BuiltinsInfo uni fun)
  (InlineInfo tyname name uni fun ann)
  (BuiltinsInfo uni fun)
-> ReaderT
     (InlineInfo tyname name uni fun ann)
     (StateT (InlinerState tyname name uni fun ann) Quote)
     (BuiltinsInfo uni fun)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (BuiltinsInfo uni fun)
  (InlineInfo tyname name uni fun ann)
  (BuiltinsInfo uni fun)
forall tyname name (uni :: * -> *) fun ann fun (f :: * -> *).
Functor f =>
(BuiltinsInfo uni fun -> f (BuiltinsInfo uni fun))
-> InlineInfo tyname name uni fun ann
-> f (InlineInfo tyname name uni fun ann)
iiBuiltinsInfo
    -- This can in the worst case traverse a lot of the term, which could lead to us
    -- doing ~quadratic work as we process the program. However in practice most terms
    -- have a relatively short evaluation order before we hit Unknown, so it's not too bad.
    Bool -> InlineM tyname name uni fun ann Bool
forall a.
a
-> ReaderT
     (InlineInfo tyname name uni fun ann)
     (StateT (InlinerState tyname name uni fun ann) Quote)
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> InlineM tyname name uni fun ann Bool)
-> Bool -> InlineM tyname name uni fun ann Bool
forall a b. (a -> b) -> a -> b
$ [EvalTerm tyname name uni fun ann] -> Bool
go (EvalOrder tyname name uni fun ann
-> [EvalTerm tyname name uni fun ann]
forall tyname name (uni :: * -> *) fun a.
EvalOrder tyname name uni fun a -> [EvalTerm tyname name uni fun a]
unEvalOrder (BuiltinsInfo uni fun
-> VarsInfo tyname name uni ann
-> Term tyname name uni fun ann
-> EvalOrder tyname name uni fun ann
forall tyname name (uni :: * -> *) fun a.
(ToBuiltinMeaning uni fun, HasUnique name TermUnique) =>
BuiltinsInfo uni fun
-> VarsInfo tyname name uni a
-> Term tyname name uni fun a
-> EvalOrder tyname name uni fun a
termEvaluationOrder BuiltinsInfo uni fun
binfo VarsInfo tyname name uni ann
varInfo Term tyname name uni fun ann
t))
    where
      -- Found the variable we're looking for!
      go :: [EvalTerm tyname name uni fun ann] -> Bool
go ((EvalTerm Purity
_ WorkFreedom
_ (Var ann
_ name
n')):[EvalTerm tyname name uni fun ann]
_) | name
n name -> name -> Bool
forall a. Eq a => a -> a -> Bool
== name
n' = Bool
True
      -- Found a pure term, ignore it and continue
      go ((EvalTerm Purity
Pure WorkFreedom
_ Term tyname name uni fun ann
_):[EvalTerm tyname name uni fun ann]
rest) = [EvalTerm tyname name uni fun ann] -> Bool
go [EvalTerm tyname name uni fun ann]
rest
      -- Found a possibly impure term, our variable is definitely not first
      go ((EvalTerm Purity
MaybeImpure WorkFreedom
_ Term tyname name uni fun ann
_):[EvalTerm tyname name uni fun ann]
_) = Bool
False
      -- Don't know, be conservative
      go (EvalTerm tyname name uni fun ann
Unknown:[EvalTerm tyname name uni fun ann]
_) = Bool
False
      go [] = Bool
False


-- | Checks if a binding is pure, i.e. will evaluating it have effects
isTermBindingPure :: forall tyname name uni fun ann. InliningConstraints tyname name uni fun
    => Strictness
    -> Term tyname name uni fun ann
    -> InlineM tyname name uni fun ann Bool
isTermBindingPure :: forall tyname name (uni :: * -> *) fun ann.
InliningConstraints tyname name uni fun =>
Strictness
-> Term tyname name uni fun ann
-> InlineM tyname name uni fun ann Bool
isTermBindingPure Strictness
s Term tyname name uni fun ann
tm =
    case Strictness
s of
        -- For non-strict bindings, the effects would have occurred at the call sites anyway.
        Strictness
NonStrict -> Bool -> InlineM tyname name uni fun ann Bool
forall a.
a
-> ReaderT
     (InlineInfo tyname name uni fun ann)
     (StateT (InlinerState tyname name uni fun ann) Quote)
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
        Strictness
Strict    -> Term tyname name uni fun ann
-> InlineM tyname name uni fun ann Bool
forall tyname name (uni :: * -> *) fun ann.
InliningConstraints tyname name uni fun =>
Term tyname name uni fun ann
-> InlineM tyname name uni fun ann Bool
checkPurity Term tyname name uni fun ann
tm

{- Note [Inlining and purity]
When can we inline something that might have effects? We must remember that we often also
remove a binding that we inline.

For strict bindings, the answer is that we can't: we will delay the effects to the use site,
so they may happen multiple times (or none). So we can only inline bindings whose RHS is pure,
or if we can prove that the effects don't change. We take a conservative view on this,
saying that no effects change if:
- The variable is clearly the first possibly-effectful term evaluated in the body
- The variable is used exactly once (so we won't duplicate or remove effects)

For non-strict bindings, the effects already happened at the use site, so it's fine to inline it
unconditionally.

TODO: if we are not in conservative optimization mode and we're allowed to move/duplicate
effects, then we could relax these criteria (e.g. say that the binding must be evaluted
*somewhere*, but not necessarily before any other effects), but we don't currently.
-}

nameUsedAtMostOnce :: forall tyname name uni fun ann. InliningConstraints tyname name uni fun
    => name
    -> InlineM tyname name uni fun ann Bool
nameUsedAtMostOnce :: forall tyname name (uni :: * -> *) fun ann.
InliningConstraints tyname name uni fun =>
name -> InlineM tyname name uni fun ann Bool
nameUsedAtMostOnce name
n = do
    Usages
usgs <- Getting Usages (InlineInfo tyname name uni fun ann) Usages
-> ReaderT
     (InlineInfo tyname name uni fun ann)
     (StateT (InlinerState tyname name uni fun ann) Quote)
     Usages
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Usages (InlineInfo tyname name uni fun ann) Usages
forall tyname name (uni :: * -> *) fun ann (f :: * -> *).
Functor f =>
(Usages -> f Usages)
-> InlineInfo tyname name uni fun ann
-> f (InlineInfo tyname name uni fun ann)
iiUsages
    -- 'inlining' terms used 0 times is a cheap way to remove dead code while we're here
    Bool -> InlineM tyname name uni fun ann Bool
forall a.
a
-> ReaderT
     (InlineInfo tyname name uni fun ann)
     (StateT (InlinerState tyname name uni fun ann) Quote)
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> InlineM tyname name uni fun ann Bool)
-> Bool -> InlineM tyname name uni fun ann Bool
forall a b. (a -> b) -> a -> b
$ name -> Usages -> Int
forall n unique. HasUnique n unique => n -> Usages -> Int
Usages.getUsageCount name
n Usages
usgs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
1

effectSafe :: forall tyname name uni fun ann. InliningConstraints tyname name uni fun
    => Term tyname name uni fun ann
    -> Strictness
    -> name
    -> Bool -- ^ is it pure?
    -> InlineM tyname name uni fun ann Bool
effectSafe :: forall tyname name (uni :: * -> *) fun ann.
InliningConstraints tyname name uni fun =>
Term tyname name uni fun ann
-> Strictness
-> name
-> Bool
-> InlineM tyname name uni fun ann Bool
effectSafe Term tyname name uni fun ann
body Strictness
Strict name
n Bool
purity = do
  -- See Note [Inlining and purity]
  Bool
immediatelyEvaluated <- name
-> Term tyname name uni fun ann
-> InlineM tyname name uni fun ann Bool
forall tyname name (uni :: * -> *) fun ann.
InliningConstraints tyname name uni fun =>
name
-> Term tyname name uni fun ann
-> InlineM tyname name uni fun ann Bool
isFirstVarBeforeEffects name
n Term tyname name uni fun ann
body
  Bool -> InlineM tyname name uni fun ann Bool
forall a.
a
-> ReaderT
     (InlineInfo tyname name uni fun ann)
     (StateT (InlinerState tyname name uni fun ann) Quote)
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> InlineM tyname name uni fun ann Bool)
-> Bool -> InlineM tyname name uni fun ann Bool
forall a b. (a -> b) -> a -> b
$ Bool
purity Bool -> Bool -> Bool
|| Bool
immediatelyEvaluated
effectSafe Term tyname name uni fun ann
_ Strictness
NonStrict name
_ Bool
_ = Bool -> InlineM tyname name uni fun ann Bool
forall a.
a
-> ReaderT
     (InlineInfo tyname name uni fun ann)
     (StateT (InlinerState tyname name uni fun ann) Quote)
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True

{- Note [Inlining criteria]
What gets inlined? Our goals are simple:
- Make the resulting program faster (or at least no slower)
- Make the resulting program smaller (or at least no bigger)
- Inline as much as we can, since it exposes optimization opportunities

There are two easy cases:
- Inlining approximately variable-sized and variable-costing terms (e.g. builtins, other variables)
- Inlining single-use terms

After that it gets more difficult. As soon as we're inlining things that are not variable-sized
and are used more than once, we are at risk of doing more work or making things bigger.

-}

{- Note [Inlining constants]

Constants can in principle be large, and hence inlining them can make the program bigger.
However, usually they are not large, and inlining them is helpful, in particular it can expose
more opportunities for evaluating builtins.

Hence we inline constants by default, but refrain from doing so if we are trying to be conservative.
-}

-- See Note [Inlining criteria]
-- | Is the cost increase (in terms of evaluation work) of inlining a variable whose RHS is
-- the given term acceptable?
costIsAcceptable :: Term tyname name uni fun ann -> Bool
costIsAcceptable :: forall tyname name (uni :: * -> *) fun ann.
Term tyname name uni fun ann -> Bool
costIsAcceptable = \case
  Builtin{}  -> Bool
True
  Var{}      -> Bool
True
  Constant{} -> Bool
True
  Error{}    -> Bool
True
  -- This will mean that we create closures at each use site instead of
  -- once, but that's a very low cost which we're okay rounding to 0.
  LamAbs{}   -> Bool
True
  TyAbs{}    -> Bool
True

  -- Inlining constructors of size 1 or 0 seems okay, but does result in doing
  -- the work for the elements at each use site.
  Constr ann
_ Type tyname uni ann
_ Word64
_ [Term tyname name uni fun ann]
es  -> case [Term tyname name uni fun ann]
es of
      []  -> Bool
True
      [Term tyname name uni fun ann
e] -> Term tyname name uni fun ann -> Bool
forall tyname name (uni :: * -> *) fun ann.
Term tyname name uni fun ann -> Bool
costIsAcceptable Term tyname name uni fun ann
e
      [Term tyname name uni fun ann]
_   -> Bool
False
  -- Inlining a case means redoing the match at each use site
  Case{} -> Bool
False

  -- Arguably we could allow these two, but they're uncommon anyway
  IWrap{}    -> Bool
False
  Unwrap{}   -> Bool
False

  Apply{}    -> Bool
False
  TyInst{}   -> Bool
False
  Let{}      -> Bool
False

-- See Note [Inlining criteria]
-- | Is the size increase (in the AST) of inlining a variable whose RHS is
-- the given term acceptable?
sizeIsAcceptable :: Bool -> Term tyname name uni fun ann -> Bool
sizeIsAcceptable :: forall tyname name (uni :: * -> *) fun ann.
Bool -> Term tyname name uni fun ann -> Bool
sizeIsAcceptable Bool
inlineConstants = \case
  Builtin{}  -> Bool
True
  Var{}      -> Bool
True
  Error{}    -> Bool
True
  LamAbs {}  -> Bool
False
  TyAbs {}   -> Bool
False

  -- Inlining constructors of size 1 or 0 seems okay
  Constr ann
_ Type tyname uni ann
_ Word64
_ [Term tyname name uni fun ann]
es  -> case [Term tyname name uni fun ann]
es of
      []  -> Bool
True
      [Term tyname name uni fun ann
e] -> Bool -> Term tyname name uni fun ann -> Bool
forall tyname name (uni :: * -> *) fun ann.
Bool -> Term tyname name uni fun ann -> Bool
sizeIsAcceptable Bool
inlineConstants Term tyname name uni fun ann
e
      [Term tyname name uni fun ann]
_   -> Bool
False
  -- Cases are pretty big, due to the case branches
  Case{} -> Bool
False

  -- Arguably we could allow these two, but they're uncommon anyway
  IWrap{}    -> Bool
False
  Unwrap{}   -> Bool
False
  -- Inlining constants is deemed acceptable if the 'inlineConstants'
  -- flag is turned on, see Note [Inlining constants].
  Constant{} -> Bool
inlineConstants
  Apply{}    -> Bool
False
  TyInst{}   -> Bool
False
  Let{}      -> Bool
False

-- | Is this an utterly trivial type which might as well be inlined?
trivialType :: Type tyname uni ann -> Bool
trivialType :: forall tyname (uni :: * -> *) ann. Type tyname uni ann -> Bool
trivialType = \case
    TyBuiltin{} -> Bool
True
    TyVar{}     -> Bool
True
    Type tyname uni ann
_           -> Bool
False

shouldUnconditionallyInline ::
  (InliningConstraints tyname name uni fun) =>
  Strictness ->
  name ->
  Term tyname name uni fun ann ->
  Term tyname name uni fun ann ->
  InlineM tyname name uni fun ann Bool
shouldUnconditionallyInline :: forall tyname name (uni :: * -> *) fun ann.
InliningConstraints tyname name uni fun =>
Strictness
-> name
-> Term tyname name uni fun ann
-> Term tyname name uni fun ann
-> InlineM tyname name uni fun ann Bool
shouldUnconditionallyInline Strictness
s name
n Term tyname name uni fun ann
rhs Term tyname name uni fun ann
body = ReaderT
  (InlineInfo tyname name uni fun ann)
  (StateT (InlinerState tyname name uni fun ann) Quote)
  Bool
preUnconditional ReaderT
  (InlineInfo tyname name uni fun ann)
  (StateT (InlinerState tyname name uni fun ann) Quote)
  Bool
-> ReaderT
     (InlineInfo tyname name uni fun ann)
     (StateT (InlinerState tyname name uni fun ann) Quote)
     Bool
-> ReaderT
     (InlineInfo tyname name uni fun ann)
     (StateT (InlinerState tyname name uni fun ann) Quote)
     Bool
forall (m :: * -> *). Monad m => m Bool -> m Bool -> m Bool
||^ ReaderT
  (InlineInfo tyname name uni fun ann)
  (StateT (InlinerState tyname name uni fun ann) Quote)
  Bool
postUnconditional
  where
    -- similar to the paper, preUnconditional inlining checks that the binder is 'OnceSafe'.
    -- I.e., it's used at most once AND it neither duplicate code or work.
    -- While we don't check for lambda etc like in the paper, `effectSafe` ensures that it
    -- isn't doing any substantial work.
    -- We actually also inline 'Dead' binders (i.e., remove dead code) here.
    preUnconditional :: ReaderT
  (InlineInfo tyname name uni fun ann)
  (StateT (InlinerState tyname name uni fun ann) Quote)
  Bool
preUnconditional = do
      Bool
isTermPure <- Term tyname name uni fun ann
-> ReaderT
     (InlineInfo tyname name uni fun ann)
     (StateT (InlinerState tyname name uni fun ann) Quote)
     Bool
forall tyname name (uni :: * -> *) fun ann.
InliningConstraints tyname name uni fun =>
Term tyname name uni fun ann
-> InlineM tyname name uni fun ann Bool
checkPurity Term tyname name uni fun ann
rhs
      name
-> ReaderT
     (InlineInfo tyname name uni fun ann)
     (StateT (InlinerState tyname name uni fun ann) Quote)
     Bool
forall tyname name (uni :: * -> *) fun ann.
InliningConstraints tyname name uni fun =>
name -> InlineM tyname name uni fun ann Bool
nameUsedAtMostOnce name
n ReaderT
  (InlineInfo tyname name uni fun ann)
  (StateT (InlinerState tyname name uni fun ann) Quote)
  Bool
-> ReaderT
     (InlineInfo tyname name uni fun ann)
     (StateT (InlinerState tyname name uni fun ann) Quote)
     Bool
-> ReaderT
     (InlineInfo tyname name uni fun ann)
     (StateT (InlinerState tyname name uni fun ann) Quote)
     Bool
forall (m :: * -> *). Monad m => m Bool -> m Bool -> m Bool
&&^ Term tyname name uni fun ann
-> Strictness
-> name
-> Bool
-> ReaderT
     (InlineInfo tyname name uni fun ann)
     (StateT (InlinerState tyname name uni fun ann) Quote)
     Bool
forall tyname name (uni :: * -> *) fun ann.
InliningConstraints tyname name uni fun =>
Term tyname name uni fun ann
-> Strictness
-> name
-> Bool
-> InlineM tyname name uni fun ann Bool
effectSafe Term tyname name uni fun ann
body Strictness
s name
n Bool
isTermPure

    -- See Note [Inlining approach and 'Secrets of the GHC Inliner'] and [Inlining and
    -- purity]. This is the case where we don't know that the number of occurrences is
    -- exactly one, so there's no point checking if the term is immediately evaluated.
    postUnconditional :: ReaderT
  (InlineInfo tyname name uni fun ann)
  (StateT (InlinerState tyname name uni fun ann) Quote)
  Bool
postUnconditional = do
      Bool
isBindingPure <- Strictness
-> Term tyname name uni fun ann
-> ReaderT
     (InlineInfo tyname name uni fun ann)
     (StateT (InlinerState tyname name uni fun ann) Quote)
     Bool
forall tyname name (uni :: * -> *) fun ann.
InliningConstraints tyname name uni fun =>
Strictness
-> Term tyname name uni fun ann
-> InlineM tyname name uni fun ann Bool
isTermBindingPure Strictness
s Term tyname name uni fun ann
rhs
      Bool
inlineConstants <- Getting Bool (InlineInfo tyname name uni fun ann) Bool
-> ReaderT
     (InlineInfo tyname name uni fun ann)
     (StateT (InlinerState tyname name uni fun ann) Quote)
     Bool
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Bool (InlineInfo tyname name uni fun ann) Bool
forall tyname name (uni :: * -> *) fun ann (f :: * -> *).
Functor f =>
(Bool -> f Bool)
-> InlineInfo tyname name uni fun ann
-> f (InlineInfo tyname name uni fun ann)
iiInlineConstants
      Bool
-> ReaderT
     (InlineInfo tyname name uni fun ann)
     (StateT (InlinerState tyname name uni fun ann) Quote)
     Bool
forall a.
a
-> ReaderT
     (InlineInfo tyname name uni fun ann)
     (StateT (InlinerState tyname name uni fun ann) Quote)
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool
 -> ReaderT
      (InlineInfo tyname name uni fun ann)
      (StateT (InlinerState tyname name uni fun ann) Quote)
      Bool)
-> Bool
-> ReaderT
     (InlineInfo tyname name uni fun ann)
     (StateT (InlinerState tyname name uni fun ann) Quote)
     Bool
forall a b. (a -> b) -> a -> b
$ Bool
isBindingPure Bool -> Bool -> Bool
&& Bool -> Term tyname name uni fun ann -> Bool
forall tyname name (uni :: * -> *) fun ann.
Bool -> Term tyname name uni fun ann -> Bool
sizeIsAcceptable Bool
inlineConstants Term tyname name uni fun ann
rhs Bool -> Bool -> Bool
&& Term tyname name uni fun ann -> Bool
forall tyname name (uni :: * -> *) fun ann.
Term tyname name uni fun ann -> Bool
costIsAcceptable Term tyname name uni fun ann
rhs