-- | The internal module of the renamer that defines the actual algorithms,
-- but not the user-facing API.

{-# LANGUAGE ConstraintKinds #-}

module UntypedPlutusCore.Rename.Internal
    ( module Export
    , renameTermM
    , renameProgramM
    ) where

import UntypedPlutusCore.Core

import PlutusCore.Core (HasUniques)
import PlutusCore.Name.Unique
import PlutusCore.Quote
import PlutusCore.Rename.Monad as Export

import Control.Monad.Reader (MonadReader)

type MonadRename m = (MonadQuote m, MonadReader (Renaming TermUnique) m)

-- | Rename a 'Term' in the 'RenameM' monad.
renameTermM
    :: (MonadRename m, HasUniques (Term name uni fun ann))
    => Term name uni fun ann -> m (Term name uni fun ann)
renameTermM :: forall (m :: * -> *) name (uni :: * -> *) fun ann.
(MonadRename m, HasUniques (Term name uni fun ann)) =>
Term name uni fun ann -> m (Term name uni fun ann)
renameTermM (LamAbs ann
ann name
name Term name uni fun ann
body)  =
     name
-> (name -> m (Term name uni fun ann)) -> m (Term name uni fun ann)
forall ren unique name (m :: * -> *) c.
(HasRenaming ren unique, HasUnique name unique, MonadQuote m,
 MonadReader ren m) =>
name -> (name -> m c) -> m c
withFreshenedName name
name ((name -> m (Term name uni fun ann)) -> m (Term name uni fun ann))
-> (name -> m (Term name uni fun ann)) -> m (Term name uni fun ann)
forall a b. (a -> b) -> a -> b
$ \name
nameFr -> ann -> name -> Term name uni fun ann -> Term name uni fun ann
forall name (uni :: * -> *) fun ann.
ann -> name -> Term name uni fun ann -> Term name uni fun ann
LamAbs ann
ann name
nameFr (Term name uni fun ann -> Term name uni fun ann)
-> m (Term name uni fun ann) -> m (Term name uni fun ann)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Term name uni fun ann -> m (Term name uni fun ann)
forall (m :: * -> *) name (uni :: * -> *) fun ann.
(MonadRename m, HasUniques (Term name uni fun ann)) =>
Term name uni fun ann -> m (Term name uni fun ann)
renameTermM Term name uni fun ann
body
renameTermM (Apply ann
ann Term name uni fun ann
fun Term name uni fun ann
arg)        = ann
-> Term name uni fun ann
-> Term name uni fun ann
-> Term name uni fun ann
forall name (uni :: * -> *) fun ann.
ann
-> Term name uni fun ann
-> Term name uni fun ann
-> Term name uni fun ann
Apply ann
ann (Term name uni fun ann
 -> Term name uni fun ann -> Term name uni fun ann)
-> m (Term name uni fun ann)
-> m (Term name uni fun ann -> Term name uni fun ann)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Term name uni fun ann -> m (Term name uni fun ann)
forall (m :: * -> *) name (uni :: * -> *) fun ann.
(MonadRename m, HasUniques (Term name uni fun ann)) =>
Term name uni fun ann -> m (Term name uni fun ann)
renameTermM Term name uni fun ann
fun m (Term name uni fun ann -> Term name uni fun ann)
-> m (Term name uni fun ann) -> m (Term name uni fun ann)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Term name uni fun ann -> m (Term name uni fun ann)
forall (m :: * -> *) name (uni :: * -> *) fun ann.
(MonadRename m, HasUniques (Term name uni fun ann)) =>
Term name uni fun ann -> m (Term name uni fun ann)
renameTermM Term name uni fun ann
arg
renameTermM err :: Term name uni fun ann
err@Error{}                = Term name uni fun ann -> m (Term name uni fun ann)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term name uni fun ann
err
renameTermM (Var ann
ann name
name)             = ann -> name -> Term name uni fun ann
forall name (uni :: * -> *) fun ann.
ann -> name -> Term name uni fun ann
Var ann
ann (name -> Term name uni fun ann)
-> m name -> m (Term name uni fun ann)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> name -> m name
forall ren unique name (m :: * -> *).
(HasRenaming ren unique, HasUnique name unique,
 MonadReader ren m) =>
name -> m name
renameNameM name
name
renameTermM (Delay ann
ann Term name uni fun ann
term)           = ann -> Term name uni fun ann -> Term name uni fun ann
forall name (uni :: * -> *) fun ann.
ann -> Term name uni fun ann -> Term name uni fun ann
Delay ann
ann (Term name uni fun ann -> Term name uni fun ann)
-> m (Term name uni fun ann) -> m (Term name uni fun ann)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Term name uni fun ann -> m (Term name uni fun ann)
forall (m :: * -> *) name (uni :: * -> *) fun ann.
(MonadRename m, HasUniques (Term name uni fun ann)) =>
Term name uni fun ann -> m (Term name uni fun ann)
renameTermM Term name uni fun ann
term
renameTermM (Force ann
ann Term name uni fun ann
term)           = ann -> Term name uni fun ann -> Term name uni fun ann
forall name (uni :: * -> *) fun ann.
ann -> Term name uni fun ann -> Term name uni fun ann
Force ann
ann (Term name uni fun ann -> Term name uni fun ann)
-> m (Term name uni fun ann) -> m (Term name uni fun ann)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Term name uni fun ann -> m (Term name uni fun ann)
forall (m :: * -> *) name (uni :: * -> *) fun ann.
(MonadRename m, HasUniques (Term name uni fun ann)) =>
Term name uni fun ann -> m (Term name uni fun ann)
renameTermM Term name uni fun ann
term
renameTermM (Constr ann
ann Word64
i [Term name uni fun ann]
es)          = ann -> Word64 -> [Term name uni fun ann] -> Term name uni fun ann
forall name (uni :: * -> *) fun ann.
ann -> Word64 -> [Term name uni fun ann] -> Term name uni fun ann
Constr ann
ann Word64
i ([Term name uni fun ann] -> Term name uni fun ann)
-> m [Term name uni fun ann] -> m (Term name uni fun ann)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Term name uni fun ann -> m (Term name uni fun ann))
-> [Term name uni fun ann] -> m [Term 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) -> [a] -> f [b]
traverse Term name uni fun ann -> m (Term name uni fun ann)
forall (m :: * -> *) name (uni :: * -> *) fun ann.
(MonadRename m, HasUniques (Term name uni fun ann)) =>
Term name uni fun ann -> m (Term name uni fun ann)
renameTermM [Term name uni fun ann]
es
renameTermM (Case ann
ann Term name uni fun ann
arg Vector (Term name uni fun ann)
cs)          = ann
-> Term name uni fun ann
-> Vector (Term name uni fun ann)
-> Term name uni fun ann
forall name (uni :: * -> *) fun ann.
ann
-> Term name uni fun ann
-> Vector (Term name uni fun ann)
-> Term name uni fun ann
Case ann
ann (Term name uni fun ann
 -> Vector (Term name uni fun ann) -> Term name uni fun ann)
-> m (Term name uni fun ann)
-> m (Vector (Term name uni fun ann) -> Term name uni fun ann)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Term name uni fun ann -> m (Term name uni fun ann)
forall (m :: * -> *) name (uni :: * -> *) fun ann.
(MonadRename m, HasUniques (Term name uni fun ann)) =>
Term name uni fun ann -> m (Term name uni fun ann)
renameTermM Term name uni fun ann
arg m (Vector (Term name uni fun ann) -> Term name uni fun ann)
-> m (Vector (Term name uni fun ann)) -> m (Term name uni fun ann)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Term name uni fun ann -> m (Term name uni fun ann))
-> Vector (Term name uni fun ann)
-> m (Vector (Term 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) -> Vector a -> f (Vector b)
traverse Term name uni fun ann -> m (Term name uni fun ann)
forall (m :: * -> *) name (uni :: * -> *) fun ann.
(MonadRename m, HasUniques (Term name uni fun ann)) =>
Term name uni fun ann -> m (Term name uni fun ann)
renameTermM Vector (Term name uni fun ann)
cs
renameTermM con :: Term name uni fun ann
con@Constant{}             = Term name uni fun ann -> m (Term name uni fun ann)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term name uni fun ann
con
renameTermM bi :: Term name uni fun ann
bi@Builtin{}               = Term name uni fun ann -> m (Term name uni fun ann)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term name uni fun ann
bi

-- | Rename a 'Program' in the 'RenameM' monad.
renameProgramM
    :: (MonadRename m, HasUniques (Program name uni fun ann))
    => Program name uni fun ann -> m (Program name uni fun ann)
renameProgramM :: forall (m :: * -> *) name (uni :: * -> *) fun ann.
(MonadRename m, HasUniques (Program name uni fun ann)) =>
Program name uni fun ann -> m (Program name uni fun ann)
renameProgramM (Program ann
ann Version
ver Term name uni fun ann
term) = ann -> Version -> Term name uni fun ann -> Program name uni fun ann
forall name (uni :: * -> *) fun ann.
ann -> Version -> Term name uni fun ann -> Program name uni fun ann
Program ann
ann Version
ver (Term name uni fun ann -> Program name uni fun ann)
-> m (Term name uni fun ann) -> m (Program name uni fun ann)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Term name uni fun ann -> m (Term name uni fun ann)
forall (m :: * -> *) name (uni :: * -> *) fun ann.
(MonadRename m, HasUniques (Term name uni fun ann)) =>
Term name uni fun ann -> m (Term name uni fun ann)
renameTermM Term name uni fun ann
term