{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
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
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
)
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
, forall tyname name (uni :: * -> *) fun ann.
InlineInfo tyname name uni fun ann -> Usages
_iiUsages :: Usages.Usages
, forall tyname name (uni :: * -> *) fun ann.
InlineInfo tyname name uni fun ann -> InlineHints name ann
_iiHints :: InlineHints name ann
, forall tyname name (uni :: * -> *) fun ann.
InlineInfo tyname name uni fun ann -> BuiltinsInfo uni fun
_iiBuiltinsInfo :: BuiltinsInfo uni fun
, forall tyname name (uni :: * -> *) fun ann.
InlineInfo tyname name uni fun ann -> Bool
_iiInlineConstants :: Bool
}
makeLenses ''InlineInfo
type InlineM tyname name uni fun ann =
ReaderT
(InlineInfo tyname name uni fun ann)
(StateT (InlinerState tyname name uni fun ann) Quote)
newtype InlineTerm tyname name uni fun ann =
Done (Dupable (Term tyname name uni fun ann))
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)
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)
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)
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
}
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
lookupTerm
:: (HasUnique name TermUnique)
=> name
-> 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
extendTerm
:: (HasUnique name TermUnique)
=> name
-> InlineTerm tyname name uni fun ann
-> 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
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
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
extendType
:: (HasUnique tyname TypeUnique)
=> tyname
-> Type tyname uni ann
-> 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)
lookupVarInfo
:: (HasUnique name TermUnique)
=> name
-> 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
extendVarInfo
:: (HasUnique name TermUnique)
=> name
-> InlineVarInfo tyname name uni fun ann
-> 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
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
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
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
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
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
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
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
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
go ((EvalTerm Purity
MaybeImpure WorkFreedom
_ Term tyname name uni fun ann
_):[EvalTerm tyname name uni fun ann]
_) = Bool
False
go (EvalTerm tyname name uni fun ann
Unknown:[EvalTerm tyname name uni fun ann]
_) = Bool
False
go [] = Bool
False
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
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
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
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
-> 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
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
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
LamAbs{} -> Bool
True
TyAbs{} -> Bool
True
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
Case{} -> Bool
False
IWrap{} -> Bool
False
Unwrap{} -> Bool
False
Apply{} -> Bool
False
TyInst{} -> Bool
False
Let{} -> Bool
False
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
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
Case{} -> Bool
False
IWrap{} -> Bool
False
Unwrap{} -> Bool
False
Constant{} -> Bool
inlineConstants
Apply{} -> Bool
False
TyInst{} -> Bool
False
Let{} -> Bool
False
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
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
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