module PlutusCore.Compiler
  ( module Opts
  , compileTerm
  , compileProgram
  , compileProgramWithTrace
  ) 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.Optimize qualified as UPLC

import Control.Lens (view)
import Control.Monad.Reader (MonadReader)

-- | Compile a PLC term to UPLC, and optimize it.
compileTerm
  :: ( Compiling m uni fun name a
     , MonadReader (CompilationOpts name 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) =>
Term tyname name uni fun a -> m (Term name uni fun a)
compileTerm Term tyname name uni fun a
t = do
  OptimizeOpts name a
optimizeOpts <- Getting
  (OptimizeOpts name a)
  (CompilationOpts name fun a)
  (OptimizeOpts name a)
-> m (OptimizeOpts name a)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (OptimizeOpts name a)
  (CompilationOpts name fun a)
  (OptimizeOpts name a)
forall name1 fun a1 name2 a2 (f :: * -> *).
Functor f =>
(OptimizeOpts name1 a1 -> f (OptimizeOpts name2 a2))
-> CompilationOpts name1 fun a1 -> f (CompilationOpts name2 fun a2)
coOptimizeOpts
  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
  OptimizeOpts 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 =>
OptimizeOpts name a
-> BuiltinSemanticsVariant fun
-> Term name uni fun a
-> m (Term name uni fun a)
UPLC.optimizeTerm OptimizeOpts name a
optimizeOpts 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
     )
  => 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) =>
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) =>
Term tyname name uni fun a -> m (Term name uni fun a)
compileTerm Term tyname name uni fun a
t

{-| Compile a PLC program to UPLC, and optimize it. This includes
the compilation trace in the result. -}
compileProgramWithTrace
  :: ( Compiling m uni fun name a
     , MonadReader (CompilationOpts name fun a) m
     )
  => Program tyname name uni fun a
  -> m (UPLC.Program name uni fun a, UPLC.OptimizerTrace name uni fun a)
compileProgramWithTrace :: forall (m :: * -> *) (uni :: * -> *) fun name a tyname.
(Compiling m uni fun name a,
 MonadReader (CompilationOpts name fun a) m) =>
Program tyname name uni fun a
-> m (Program name uni fun a, OptimizerTrace name uni fun a)
compileProgramWithTrace (Program a
a Version
v Term tyname name uni fun a
t) = do
  OptimizeOpts name a
optimizeOpts <- Getting
  (OptimizeOpts name a)
  (CompilationOpts name fun a)
  (OptimizeOpts name a)
-> m (OptimizeOpts name a)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (OptimizeOpts name a)
  (CompilationOpts name fun a)
  (OptimizeOpts name a)
forall name1 fun a1 name2 a2 (f :: * -> *).
Functor f =>
(OptimizeOpts name1 a1 -> f (OptimizeOpts name2 a2))
-> CompilationOpts name1 fun a1 -> f (CompilationOpts name2 fun a2)
coOptimizeOpts
  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
  Program name uni fun a
renamedProgram <- 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 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
  OptimizeOpts name a
-> BuiltinSemanticsVariant fun
-> Program name uni fun a
-> m (Program name uni fun a, OptimizerTrace name uni fun a)
forall name (uni :: * -> *) fun (m :: * -> *) a.
Compiling m uni fun name a =>
OptimizeOpts name a
-> BuiltinSemanticsVariant fun
-> Program name uni fun a
-> m (Program name uni fun a, OptimizerTrace name uni fun a)
UPLC.optimizeProgramWithTrace
    OptimizeOpts name a
optimizeOpts
    BuiltinSemanticsVariant fun
builtinSemanticsVariant
    Program name uni fun a
renamedProgram