module PlutusCore.Compiler
  ( module Opts
  , compileTerm
  , compileProgram
  , runCompile
  , evalCompile
  ) where

import PlutusCore.Compiler.Erase
import PlutusCore.Compiler.Opts as Opts
import PlutusCore.Compiler.Types
import PlutusCore.Core
import PlutusCore.Name.Unique
import PlutusCore.Rename
import UntypedPlutusCore.Core.Type qualified as UPLC
import UntypedPlutusCore.Simplify qualified as UPLC

import Control.Lens (view)
import Control.Monad.Reader (MonadReader, ReaderT (runReaderT))
import Control.Monad.State (MonadState (..), StateT (runStateT))

-- | Compile a PLC term to UPLC, and optimize it.
compileTerm
  :: (Compiling m uni fun name a
  , MonadReader (CompilationOpts name fun a) m
  , MonadState (UPLCSimplifierTrace name uni fun a) m
  )
  => Term tyname name uni fun a
  -> m (UPLC.Term name uni fun a)
compileTerm :: forall (m :: * -> *) (uni :: * -> *) fun name a tyname.
(Compiling m uni fun name a,
 MonadReader (CompilationOpts name fun a) m,
 MonadState (UPLCSimplifierTrace name uni fun a) m) =>
Term tyname name uni fun a -> m (Term name uni fun a)
compileTerm Term tyname name uni fun a
t = do
  SimplifyOpts name a
simplOpts <- Getting
  (SimplifyOpts name a)
  (CompilationOpts name fun a)
  (SimplifyOpts name a)
-> m (SimplifyOpts name a)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (SimplifyOpts name a)
  (CompilationOpts name fun a)
  (SimplifyOpts name a)
forall name1 fun a1 name2 a2 (f :: * -> *).
Functor f =>
(SimplifyOpts name1 a1 -> f (SimplifyOpts name2 a2))
-> CompilationOpts name1 fun a1 -> f (CompilationOpts name2 fun a2)
coSimplifyOpts
  BuiltinSemanticsVariant fun
builtinSemanticsVariant <- Getting
  (BuiltinSemanticsVariant fun)
  (CompilationOpts name fun a)
  (BuiltinSemanticsVariant fun)
-> m (BuiltinSemanticsVariant fun)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (BuiltinSemanticsVariant fun)
  (CompilationOpts name fun a)
  (BuiltinSemanticsVariant fun)
forall name fun1 a fun2 (f :: * -> *).
Functor f =>
(BuiltinSemanticsVariant fun1 -> f (BuiltinSemanticsVariant fun2))
-> CompilationOpts name fun1 a -> f (CompilationOpts name fun2 a)
coBuiltinSemanticsVariant
  let erased :: Term name uni fun a
erased = Term tyname name uni fun a -> Term name uni fun a
forall name tyname (uni :: * -> *) fun ann.
HasUnique name TermUnique =>
Term tyname name uni fun ann -> Term name uni fun ann
eraseTerm Term tyname name uni fun a
t
  Term name uni fun a
renamed <- Term name uni fun a -> m (Term name uni fun a)
forall a (m :: * -> *). (Rename a, MonadQuote m) => a -> m a
forall (m :: * -> *).
MonadQuote m =>
Term name uni fun a -> m (Term name uni fun a)
rename Term name uni fun a
erased
  SimplifyOpts name a
-> BuiltinSemanticsVariant fun
-> Term name uni fun a
-> m (Term name uni fun a)
forall name (uni :: * -> *) fun (m :: * -> *) a.
(Compiling m uni fun name a,
 MonadState (UPLCSimplifierTrace name uni fun a) m) =>
SimplifyOpts name a
-> BuiltinSemanticsVariant fun
-> Term name uni fun a
-> m (Term name uni fun a)
UPLC.simplifyTerm SimplifyOpts name a
simplOpts BuiltinSemanticsVariant fun
builtinSemanticsVariant Term name uni fun a
renamed

-- | Compile a PLC program to UPLC, and optimize it.
compileProgram
  :: (Compiling m uni fun name a
  , MonadReader (CompilationOpts name fun a) m
  , MonadState (UPLCSimplifierTrace name uni fun a) m
  )
  => Program tyname name uni fun a
  -> m (UPLC.Program name uni fun a)
compileProgram :: forall (m :: * -> *) (uni :: * -> *) fun name a tyname.
(Compiling m uni fun name a,
 MonadReader (CompilationOpts name fun a) m,
 MonadState (UPLCSimplifierTrace name uni fun a) m) =>
Program tyname name uni fun a -> m (Program name uni fun a)
compileProgram (Program a
a Version
v Term tyname name uni fun a
t) = a -> Version -> Term name uni fun a -> Program name uni fun a
forall name (uni :: * -> *) fun ann.
ann -> Version -> Term name uni fun ann -> Program name uni fun ann
UPLC.Program a
a Version
v (Term name uni fun a -> Program name uni fun a)
-> m (Term name uni fun a) -> m (Program name uni fun a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Term tyname name uni fun a -> m (Term name uni fun a)
forall (m :: * -> *) (uni :: * -> *) fun name a tyname.
(Compiling m uni fun name a,
 MonadReader (CompilationOpts name fun a) m,
 MonadState (UPLCSimplifierTrace name uni fun a) m) =>
Term tyname name uni fun a -> m (Term name uni fun a)
compileTerm Term tyname name uni fun a
t

type Compile m name uni fun a =
  ReaderT
    (CompilationOpts name fun a)
    (StateT
       (UPLCSimplifierTrace name uni fun a)
       m
    )

runCompile
  :: CompilationOpts name fun a
  -> Compile m name uni fun a b
  -> m (b, UPLCSimplifierTrace name uni fun a)
runCompile :: forall name fun a (m :: * -> *) (uni :: * -> *) b.
CompilationOpts name fun a
-> Compile m name uni fun a b
-> m (b, UPLCSimplifierTrace name uni fun a)
runCompile CompilationOpts name fun a
opts =
  (StateT (UPLCSimplifierTrace name uni fun a) m b
 -> UPLCSimplifierTrace name uni fun a
 -> m (b, UPLCSimplifierTrace name uni fun a))
-> UPLCSimplifierTrace name uni fun a
-> StateT (UPLCSimplifierTrace name uni fun a) m b
-> m (b, UPLCSimplifierTrace name uni fun a)
forall a b c. (a -> b -> c) -> b -> a -> c
flip StateT (UPLCSimplifierTrace name uni fun a) m b
-> UPLCSimplifierTrace name uni fun a
-> m (b, UPLCSimplifierTrace name uni fun a)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT UPLCSimplifierTrace name uni fun a
forall name (uni :: * -> *) fun a.
UPLCSimplifierTrace name uni fun a
initUPLCSimplifierTrace
  (StateT (UPLCSimplifierTrace name uni fun a) m b
 -> m (b, UPLCSimplifierTrace name uni fun a))
-> (Compile m name uni fun a b
    -> StateT (UPLCSimplifierTrace name uni fun a) m b)
-> Compile m name uni fun a b
-> m (b, UPLCSimplifierTrace name uni fun a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Compile m name uni fun a b
 -> CompilationOpts name fun a
 -> StateT (UPLCSimplifierTrace name uni fun a) m b)
-> CompilationOpts name fun a
-> Compile m name uni fun a b
-> StateT (UPLCSimplifierTrace name uni fun a) m b
forall a b c. (a -> b -> c) -> b -> a -> c
flip Compile m name uni fun a b
-> CompilationOpts name fun a
-> StateT (UPLCSimplifierTrace name uni fun a) m b
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT CompilationOpts name fun a
opts

evalCompile
  :: Functor m
  => CompilationOpts name fun a
  -> Compile m name uni fun a b
  -> m b
evalCompile :: forall (m :: * -> *) name fun a (uni :: * -> *) b.
Functor m =>
CompilationOpts name fun a -> Compile m name uni fun a b -> m b
evalCompile CompilationOpts name fun a
opts = ((b, UPLCSimplifierTrace name uni fun a) -> b)
-> m (b, UPLCSimplifierTrace name uni fun a) -> m b
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (b, UPLCSimplifierTrace name uni fun a) -> b
forall a b. (a, b) -> a
fst (m (b, UPLCSimplifierTrace name uni fun a) -> m b)
-> (Compile m name uni fun a b
    -> m (b, UPLCSimplifierTrace name uni fun a))
-> Compile m name uni fun a b
-> m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CompilationOpts name fun a
-> Compile m name uni fun a b
-> m (b, UPLCSimplifierTrace name uni fun a)
forall name fun a (m :: * -> *) (uni :: * -> *) b.
CompilationOpts name fun a
-> Compile m name uni fun a b
-> m (b, UPLCSimplifierTrace name uni fun a)
runCompile CompilationOpts name fun a
opts