{-# LANGUAGE LambdaCase #-}
module UntypedPlutusCore.Analysis.Definitions
( termDefs
, runTermDefs
) where
import UntypedPlutusCore.Core
import PlutusCore.Analysis.Definitions (ScopeType (TermScope), UniqueInfos, addDef, addUsage)
import PlutusCore.Error
import PlutusCore.Name
import Data.Functor.Foldable
import Control.Monad.State
import Control.Monad.Writer
termDefs
:: (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 -> m ()
termDefs = (Base (Term name uni fun ann) (m ()) -> m ())
-> Term name uni fun ann -> m ()
forall t a. Recursive t => (Base t a -> a) -> t -> a
cata ((Base (Term name uni fun ann) (m ()) -> m ())
-> Term name uni fun ann -> m ())
-> (Base (Term name uni fun ann) (m ()) -> m ())
-> Term name uni fun ann
-> m ()
forall a b. (a -> b) -> a -> b
$ \case
VarF ann 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
LamAbsF ann n t -> 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 m () -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> m ()
t
Base (Term name uni fun ann) (m ())
x -> TermF name uni fun ann (m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ Base (Term name uni fun ann) (m ())
TermF name uni fun ann (m ())
x
runTermDefs
:: (Ord ann,
HasUnique name TermUnique,
Monad m)
=> Term name uni fun ann
-> m (UniqueInfos ann, [UniqueError ann])
runTermDefs :: 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