{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts   #-}
{-# LANGUAGE OverloadedStrings  #-}
{-# LANGUAGE RankNTypes         #-}
{-# LANGUAGE RecordWildCards    #-}

module PlutusTx.Eval where

import Prelude

import Data.Either (isRight)
import Data.SatInt (unSatInt)
import Data.Text (Text)
import Formatting (commas, format)
import PlutusCore.DeBruijn.Internal (NamedDeBruijn)
import PlutusCore.Evaluation.Machine.ExBudget (ExBudget (..))
import PlutusCore.Evaluation.Machine.ExBudgetingDefaults (defaultCekParametersForTesting)
import PlutusCore.Evaluation.Machine.ExMemory (ExCPU (..), ExMemory (..))
import PlutusCore.Evaluation.Machine.MachineParameters.Default (DefaultMachineParameters)
import PlutusCore.Pretty
import PlutusTx.Code (CompiledCode, getPlcNoAnn)
import Prettyprinter (dot, indent, plural, vsep, (<+>))
import UntypedPlutusCore (DefaultFun, DefaultUni, Program (..))
import UntypedPlutusCore.Evaluation.Machine.Cek (CekEvaluationException, CountingSt (..), counting,
                                                 logEmitter)
import UntypedPlutusCore.Evaluation.Machine.Cek.Internal (NTerm, runCekDeBruijn)

data EvalResult = EvalResult
  { EvalResult
-> Either
     (CekEvaluationException NamedDeBruijn DefaultUni DefaultFun)
     (NTerm DefaultUni DefaultFun ())
evalResult
      :: Either
           (CekEvaluationException NamedDeBruijn DefaultUni DefaultFun)
           (NTerm DefaultUni DefaultFun ())
  , EvalResult -> ExBudget
evalResultBudget :: ExBudget
  , EvalResult -> [Text]
evalResultTraces :: [Text]
  }
  deriving stock (Int -> EvalResult -> ShowS
[EvalResult] -> ShowS
EvalResult -> String
(Int -> EvalResult -> ShowS)
-> (EvalResult -> String)
-> ([EvalResult] -> ShowS)
-> Show EvalResult
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EvalResult -> ShowS
showsPrec :: Int -> EvalResult -> ShowS
$cshow :: EvalResult -> String
show :: EvalResult -> String
$cshowList :: [EvalResult] -> ShowS
showList :: [EvalResult] -> ShowS
Show)

instance Pretty EvalResult where
  pretty :: forall ann. EvalResult -> Doc ann
pretty EvalResult{[Text]
Either
  (CekEvaluationException NamedDeBruijn DefaultUni DefaultFun)
  (NTerm DefaultUni DefaultFun ())
ExBudget
evalResult :: EvalResult
-> Either
     (CekEvaluationException NamedDeBruijn DefaultUni DefaultFun)
     (NTerm DefaultUni DefaultFun ())
evalResultBudget :: EvalResult -> ExBudget
evalResultTraces :: EvalResult -> [Text]
evalResult :: Either
  (CekEvaluationException NamedDeBruijn DefaultUni DefaultFun)
  (NTerm DefaultUni DefaultFun ())
evalResultBudget :: ExBudget
evalResultTraces :: [Text]
..} =
    [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep
      [ case Either
  (CekEvaluationException NamedDeBruijn DefaultUni DefaultFun)
  (NTerm DefaultUni DefaultFun ())
evalResult of
          Left CekEvaluationException NamedDeBruijn DefaultUni DefaultFun
err ->
            [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep
              [ Doc ann
"Evaluation FAILED:"
              , Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
indent Int
2 (Doc ann -> Doc ann) -> Doc ann -> Doc ann
forall a b. (a -> b) -> a -> b
$ CekEvaluationException NamedDeBruijn DefaultUni DefaultFun
-> Doc ann
forall a ann. PrettyPlc a => a -> Doc ann
prettyPlcClassicSimple CekEvaluationException NamedDeBruijn DefaultUni DefaultFun
err
              ]
          Right NTerm DefaultUni DefaultFun ()
term ->
            [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep
              [ Doc ann
"Evaluation was SUCCESSFUL, result is:"
              , Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
indent Int
2 (Doc ann -> Doc ann) -> Doc ann -> Doc ann
forall a b. (a -> b) -> a -> b
$ NTerm DefaultUni DefaultFun () -> Doc ann
forall a ann. PrettyPlc a => a -> Doc ann
prettyPlcReadableSimple NTerm DefaultUni DefaultFun ()
term
              ]
      , Doc ann
forall a. Monoid a => a
mempty
      , [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep
          [ Doc ann
"Execution budget spent:"
          , Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
indent Int
2 (Doc ann -> Doc ann) -> Doc ann -> Doc ann
forall a b. (a -> b) -> a -> b
$ ExBudget -> Doc ann
forall ann. ExBudget -> Doc ann
prettyExBudget ExBudget
evalResultBudget
          ]
      , Doc ann
forall a. Monoid a => a
mempty
      , if [Text] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
evalResultTraces
          then Doc ann
"No traces were emitted"
          else
            [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep
              [ Doc ann
"Evaluation"
                  Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann -> Doc ann -> Int -> Doc ann
forall amount doc.
(Num amount, Eq amount) =>
doc -> doc -> amount -> doc
plural Doc ann
"trace" Doc ann
"traces" ([Text] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
evalResultTraces)
                  Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
":"
              , Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
indent Int
2 (Doc ann -> Doc ann) -> Doc ann -> Doc ann
forall a b. (a -> b) -> a -> b
$
                  [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall a b. (a -> b) -> a -> b
$
                    (Int -> Text -> Doc ann) -> [Int] -> [Text] -> [Doc ann]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith
                      (\Int
idx Text
trace -> Int -> Doc ann
forall ann. Int -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Int
idx Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
dot Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Text -> Doc ann
forall ann. Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Text
trace)
                      [Int
1 :: Int ..]
                      [Text]
evalResultTraces
              ]
      , Doc ann
forall a. Monoid a => a
mempty
      ]

displayEvalResult :: EvalResult -> Text
displayEvalResult :: EvalResult -> Text
displayEvalResult = EvalResult -> Text
forall str a. (Pretty a, Render str) => a -> str
display

displayExBudget :: ExBudget -> Text
displayExBudget :: ExBudget -> Text
displayExBudget = Doc Any -> Text
forall ann. Doc ann -> Text
forall str ann. Render str => Doc ann -> str
render (Doc Any -> Text) -> (ExBudget -> Doc Any) -> ExBudget -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExBudget -> Doc Any
forall ann. ExBudget -> Doc ann
prettyExBudget

prettyExBudget :: ExBudget -> Doc ann
prettyExBudget :: forall ann. ExBudget -> Doc ann
prettyExBudget
  ExBudget{exBudgetCPU :: ExBudget -> ExCPU
exBudgetCPU = ExCPU CostingInteger
cpu, exBudgetMemory :: ExBudget -> ExMemory
exBudgetMemory = ExMemory CostingInteger
mem} =
    [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep
      [ Doc ann
"CPU" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Text -> Doc ann
forall ann. Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Format Text (Int -> Text) -> Int -> Text
forall a. Format Text a -> a
format Format Text (Int -> Text)
forall n r. (Buildable n, Integral n) => Format r (n -> r)
commas (CostingInteger -> Int
unSatInt CostingInteger
cpu))
      , Doc ann
"MEM" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Text -> Doc ann
forall ann. Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Format Text (Int -> Text) -> Int -> Text
forall a. Format Text a -> a
format Format Text (Int -> Text)
forall n r. (Buildable n, Integral n) => Format r (n -> r)
commas (CostingInteger -> Int
unSatInt CostingInteger
mem))
      ]

{-| Evaluates the given 'CompiledCode' using the CEK machine
with the default machine parameters.
-}
evaluateCompiledCode :: CompiledCode a -> EvalResult
evaluateCompiledCode :: forall a. CompiledCode a -> EvalResult
evaluateCompiledCode = DefaultMachineParameters -> CompiledCode a -> EvalResult
forall a. DefaultMachineParameters -> CompiledCode a -> EvalResult
evaluateCompiledCode' DefaultMachineParameters
forall ann.
Typeable ann =>
MachineParameters
  CekMachineCosts DefaultFun (CekValue DefaultUni DefaultFun ann)
defaultCekParametersForTesting

{-| Evaluates the given 'CompiledCode' using the CEK machine
with the given machine parameters.
-}
evaluateCompiledCode'
  :: DefaultMachineParameters -> CompiledCode a -> EvalResult
evaluateCompiledCode' :: forall a. DefaultMachineParameters -> CompiledCode a -> EvalResult
evaluateCompiledCode' DefaultMachineParameters
params CompiledCode a
code = EvalResult{[Text]
Either
  (CekEvaluationException NamedDeBruijn DefaultUni DefaultFun)
  (NTerm DefaultUni DefaultFun ())
ExBudget
evalResult :: Either
  (CekEvaluationException NamedDeBruijn DefaultUni DefaultFun)
  (NTerm DefaultUni DefaultFun ())
evalResultBudget :: ExBudget
evalResultTraces :: [Text]
evalResult :: Either
  (CekEvaluationException NamedDeBruijn DefaultUni DefaultFun)
  (NTerm DefaultUni DefaultFun ())
evalResultBudget :: ExBudget
evalResultTraces :: [Text]
..}
 where
  Program ()
_ann Version
_version NTerm DefaultUni DefaultFun ()
term = CompiledCode a -> Program NamedDeBruijn DefaultUni DefaultFun ()
forall (uni :: * -> *) fun a.
(Closed uni, Everywhere uni Flat, Flat fun) =>
CompiledCodeIn uni fun a -> Program NamedDeBruijn uni fun ()
getPlcNoAnn CompiledCode a
code
  (Either
  (CekEvaluationException NamedDeBruijn DefaultUni DefaultFun)
  (NTerm DefaultUni DefaultFun ())
evalResult, CountingSt ExBudget
evalResultBudget, [Text]
evalResultTraces) =
    DefaultMachineParameters
-> ExBudgetMode CountingSt DefaultUni DefaultFun
-> EmitterMode DefaultUni DefaultFun
-> NTerm DefaultUni DefaultFun ()
-> (Either
      (CekEvaluationException NamedDeBruijn DefaultUni DefaultFun)
      (NTerm DefaultUni DefaultFun ()),
    CountingSt, [Text])
forall (uni :: * -> *) fun ann cost.
ThrowableBuiltins uni fun =>
MachineParameters CekMachineCosts fun (CekValue uni fun ann)
-> ExBudgetMode cost uni fun
-> EmitterMode uni fun
-> NTerm uni fun ann
-> (Either
      (CekEvaluationException NamedDeBruijn uni fun) (NTerm uni fun ()),
    cost, [Text])
runCekDeBruijn DefaultMachineParameters
params ExBudgetMode CountingSt DefaultUni DefaultFun
forall (uni :: * -> *) fun. ExBudgetMode CountingSt uni fun
counting EmitterMode DefaultUni DefaultFun
forall (uni :: * -> *) fun. EmitterMode uni fun
logEmitter NTerm DefaultUni DefaultFun ()
term

evaluatesToError :: CompiledCode a -> Bool
evaluatesToError :: forall a. CompiledCode a -> Bool
evaluatesToError = Bool -> Bool
not (Bool -> Bool)
-> (CompiledCode a -> Bool) -> CompiledCode a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CompiledCode a -> Bool
forall a. CompiledCode a -> Bool
evaluatesWithoutError

evaluatesWithoutError :: CompiledCode a -> Bool
evaluatesWithoutError :: forall a. CompiledCode a -> Bool
evaluatesWithoutError CompiledCode a
code = Either
  (CekEvaluationException NamedDeBruijn DefaultUni DefaultFun)
  (NTerm DefaultUni DefaultFun ())
-> Bool
forall a b. Either a b -> Bool
isRight (EvalResult
-> Either
     (CekEvaluationException NamedDeBruijn DefaultUni DefaultFun)
     (NTerm DefaultUni DefaultFun ())
evalResult (CompiledCode a -> EvalResult
forall a. CompiledCode a -> EvalResult
evaluateCompiledCode CompiledCode a
code))