{-# LANGUAGE LambdaCase #-}
module UntypedPlutusCore.Analysis.Definitions
( termDefs
, runTermDefs
) where
import UntypedPlutusCore.Core
import PlutusCore.Analysis.Definitions (ScopeType (TermScope), UniqueInfos, addDef, addUsage)
import PlutusCore.Error (UniqueError)
import PlutusCore.Name.Unique (HasUnique, TermUnique (TermUnique), Unique (Unique))
import Control.Lens (forMOf_)
import Control.Monad.State (MonadState, execStateT)
import Control.Monad.Writer (MonadWriter, WriterT (runWriterT))
termDefs
:: (Ord ann,
HasUnique name TermUnique,
MonadState (UniqueInfos ann) m,
MonadWriter [UniqueError ann] m)
=> Term name uni fun ann
-> m ()
termDefs :: forall ann name (m :: * -> *) (uni :: * -> *) fun.
(Ord ann, HasUnique name TermUnique,
MonadState (UniqueInfos ann) m, MonadWriter [UniqueError ann] m) =>
Term name uni fun ann -> m ()
termDefs Term name uni fun ann
tm = do
Getting
(Sequenced () m) (Term name uni fun ann) (Term name uni fun ann)
-> Term name uni fun ann -> (Term name uni fun ann -> m ()) -> m ()
forall (m :: * -> *) r s a.
Monad m =>
Getting (Sequenced r m) s a -> s -> (a -> m r) -> m ()
forMOf_ Getting
(Sequenced () m) (Term name uni fun ann) (Term name uni fun ann)
forall name (uni :: * -> *) fun ann (f :: * -> *).
(Contravariant f, Applicative f) =>
(Term name uni fun ann -> f (Term name uni fun ann))
-> Term name uni fun ann -> f (Term name uni fun ann)
termSubtermsDeep Term name uni fun ann
tm Term name uni fun ann -> m ()
forall ann name (m :: * -> *) (uni :: * -> *) fun.
(Ord ann, HasUnique name TermUnique,
MonadState (UniqueInfos ann) m, MonadWriter [UniqueError ann] m) =>
Term name uni fun ann -> m ()
handleTerm
handleTerm :: (Ord ann,
HasUnique name TermUnique,
MonadState (UniqueInfos ann) m,
MonadWriter [UniqueError ann] m)
=> Term name uni fun ann
-> m ()
handleTerm :: forall ann name (m :: * -> *) (uni :: * -> *) fun.
(Ord ann, HasUnique name TermUnique,
MonadState (UniqueInfos ann) m, MonadWriter [UniqueError ann] m) =>
Term name uni fun ann -> m ()
handleTerm = \case
Var ann
ann name
n ->
name -> ann -> ScopeType -> m ()
forall ann n unique (m :: * -> *).
(Ord ann, HasUnique n unique, MonadState (UniqueInfos ann) m,
MonadWriter [UniqueError ann] m) =>
n -> ann -> ScopeType -> m ()
addUsage name
n ann
ann ScopeType
TermScope
LamAbs ann
ann name
n Term name uni fun ann
_ ->
name -> ann -> ScopeType -> m ()
forall ann n unique (m :: * -> *).
(Ord ann, HasUnique n unique, MonadState (UniqueInfos ann) m,
MonadWriter [UniqueError ann] m) =>
n -> ann -> ScopeType -> m ()
addDef name
n ann
ann ScopeType
TermScope
Term name uni fun ann
_ -> () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
runTermDefs
:: (Ord ann,
HasUnique name TermUnique,
Monad m)
=> Term name uni fun ann
-> m (UniqueInfos ann, [UniqueError ann])
runTermDefs :: forall ann name (m :: * -> *) (uni :: * -> *) fun.
(Ord ann, HasUnique name TermUnique, Monad m) =>
Term name uni fun ann -> m (UniqueInfos ann, [UniqueError ann])
runTermDefs = WriterT [UniqueError ann] m (UniqueInfos ann)
-> m (UniqueInfos ann, [UniqueError ann])
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT (WriterT [UniqueError ann] m (UniqueInfos ann)
-> m (UniqueInfos ann, [UniqueError ann]))
-> (Term name uni fun ann
-> WriterT [UniqueError ann] m (UniqueInfos ann))
-> Term name uni fun ann
-> m (UniqueInfos ann, [UniqueError ann])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StateT (UniqueInfos ann) (WriterT [UniqueError ann] m) ()
-> UniqueInfos ann
-> WriterT [UniqueError ann] m (UniqueInfos ann))
-> UniqueInfos ann
-> StateT (UniqueInfos ann) (WriterT [UniqueError ann] m) ()
-> WriterT [UniqueError ann] m (UniqueInfos ann)
forall a b c. (a -> b -> c) -> b -> a -> c
flip StateT (UniqueInfos ann) (WriterT [UniqueError ann] m) ()
-> UniqueInfos ann -> WriterT [UniqueError ann] m (UniqueInfos ann)
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m s
execStateT UniqueInfos ann
forall a. Monoid a => a
mempty (StateT (UniqueInfos ann) (WriterT [UniqueError ann] m) ()
-> WriterT [UniqueError ann] m (UniqueInfos ann))
-> (Term name uni fun ann
-> StateT (UniqueInfos ann) (WriterT [UniqueError ann] m) ())
-> Term name uni fun ann
-> WriterT [UniqueError ann] m (UniqueInfos ann)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Term name uni fun ann
-> StateT (UniqueInfos ann) (WriterT [UniqueError ann] m) ()
forall ann name (m :: * -> *) (uni :: * -> *) fun.
(Ord ann, HasUnique name TermUnique,
MonadState (UniqueInfos ann) m, MonadWriter [UniqueError ann] m) =>
Term name uni fun ann -> m ()
termDefs