{-# LANGUAGE LambdaCase #-}
-- | Definition analysis for untyped Plutus Core.
-- This just adapts term-related code from PlutusCore.Analysis.Definitions;
-- we just re-use the typed machinery to do the hard work here.
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