{-# LANGUAGE BlockArguments    #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications  #-}

module Transform.CaseOfCase.Spec where

import Data.ByteString.Lazy qualified as BSL
import Data.Text.Encoding (encodeUtf8)
import Data.Vector qualified as V
import PlutusCore qualified as PLC
import PlutusCore.Evaluation.Machine.BuiltinCostModel (BuiltinCostModel)
import PlutusCore.Evaluation.Machine.ExBudgetingDefaults (defaultBuiltinCostModelForTesting,
                                                          defaultCekMachineCostsForTesting)
import PlutusCore.Evaluation.Machine.MachineParameters (CostModel (..), MachineParameters (..),
                                                        mkMachineVariantParameters)
import PlutusCore.Evaluation.Machine.MachineParameters.Default (DefaultMachineParameters)
import PlutusCore.MkPlc (mkConstant, mkIterApp)
import PlutusCore.Pretty
import PlutusCore.Quote (freshName, runQuote)
import PlutusPrelude (Default (def))
import Test.Tasty (TestTree, testGroup)
import Test.Tasty.Golden (goldenVsString)
import Test.Tasty.HUnit (testCase, (@?=))
import UntypedPlutusCore (DefaultFun, DefaultUni, Name, Term (..))
import UntypedPlutusCore.Core qualified as UPLC
import UntypedPlutusCore.Evaluation.Machine.Cek (CekMachineCosts, EvaluationResult (..),
                                                 evaluateCek, noEmitter,
                                                 unsafeSplitStructuralOperational)
import UntypedPlutusCore.Transform.CaseOfCase (caseOfCase)
import UntypedPlutusCore.Transform.Simplifier (evalSimplifier)

test_caseOfCase :: TestTree
test_caseOfCase :: TestTree
test_caseOfCase =
  [Char] -> [TestTree] -> TestTree
testGroup
    [Char]
"CaseOfCase"
    [ [Char] -> Term Name DefaultUni DefaultFun () -> TestTree
goldenVsSimplified [Char]
"1" Term Name DefaultUni DefaultFun ()
caseOfCase1
    , [Char] -> Term Name DefaultUni DefaultFun () -> TestTree
goldenVsSimplified [Char]
"2" Term Name DefaultUni DefaultFun ()
caseOfCase2
    , [Char] -> Term Name DefaultUni DefaultFun () -> TestTree
goldenVsSimplified [Char]
"3" Term Name DefaultUni DefaultFun ()
caseOfCase3
    , [Char] -> Term Name DefaultUni DefaultFun () -> TestTree
goldenVsSimplified [Char]
"withError" Term Name DefaultUni DefaultFun ()
caseOfCaseWithError
    , TestTree
testCaseOfCaseWithError
    ]

caseOfCase1 :: Term Name PLC.DefaultUni PLC.DefaultFun ()
caseOfCase1 :: Term Name DefaultUni DefaultFun ()
caseOfCase1 = Quote (Term Name DefaultUni DefaultFun ())
-> Term Name DefaultUni DefaultFun ()
forall a. Quote a -> a
runQuote do
  Name
b <- Text -> QuoteT Identity Name
forall (m :: * -> *). MonadQuote m => Text -> m Name
freshName Text
"b"
  let ite :: Term name uni DefaultFun ()
ite = () -> Term name uni DefaultFun () -> Term name uni DefaultFun ()
forall name (uni :: * -> *) fun ann.
ann -> Term name uni fun ann -> Term name uni fun ann
Force () (() -> DefaultFun -> Term name uni DefaultFun ()
forall name (uni :: * -> *) fun ann.
ann -> fun -> Term name uni fun ann
Builtin () DefaultFun
PLC.IfThenElse)
      true :: Term name uni fun ()
true = () -> Word64 -> [Term name uni fun ()] -> Term name uni fun ()
forall name (uni :: * -> *) fun ann.
ann -> Word64 -> [Term name uni fun ann] -> Term name uni fun ann
Constr () Word64
0 []
      false :: Term name uni fun ()
false = () -> Word64 -> [Term name uni fun ()] -> Term name uni fun ()
forall name (uni :: * -> *) fun ann.
ann -> Word64 -> [Term name uni fun ann] -> Term name uni fun ann
Constr () Word64
1 []
      alts :: Vector (Term Name DefaultUni DefaultFun ())
alts = [Term Name DefaultUni DefaultFun ()]
-> Vector (Term Name DefaultUni DefaultFun ())
forall a. [a] -> Vector a
V.fromList [forall a (uni :: * -> *) fun (term :: * -> *) tyname name ann.
(TermLike term tyname name uni fun, HasTermLevel uni a) =>
ann -> a -> term ann
mkConstant @Integer () Integer
1, forall a (uni :: * -> *) fun (term :: * -> *) tyname name ann.
(TermLike term tyname name uni fun, HasTermLevel uni a) =>
ann -> a -> term ann
mkConstant @Integer () Integer
2]
  Term Name DefaultUni DefaultFun ()
-> Quote (Term Name DefaultUni DefaultFun ())
forall a. a -> QuoteT Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Term Name DefaultUni DefaultFun ()
 -> Quote (Term Name DefaultUni DefaultFun ()))
-> Term Name DefaultUni DefaultFun ()
-> Quote (Term Name DefaultUni DefaultFun ())
forall a b. (a -> b) -> a -> b
$ ()
-> Term Name DefaultUni DefaultFun ()
-> Vector (Term Name DefaultUni DefaultFun ())
-> Term Name DefaultUni DefaultFun ()
forall name (uni :: * -> *) fun ann.
ann
-> Term name uni fun ann
-> Vector (Term name uni fun ann)
-> Term name uni fun ann
Case () (Term Name DefaultUni DefaultFun ()
-> [((), Term Name DefaultUni DefaultFun ())]
-> Term Name DefaultUni DefaultFun ()
forall (term :: * -> *) tyname name (uni :: * -> *) fun ann.
TermLike term tyname name uni fun =>
term ann -> [(ann, term ann)] -> term ann
mkIterApp Term Name DefaultUni DefaultFun ()
forall {name} {uni :: * -> *}. Term name uni DefaultFun ()
ite [((), () -> Name -> Term Name DefaultUni DefaultFun ()
forall name (uni :: * -> *) fun ann.
ann -> name -> Term name uni fun ann
Var () Name
b), ((), Term Name DefaultUni DefaultFun ()
forall {name} {uni :: * -> *} {fun}. Term name uni fun ()
true), ((), Term Name DefaultUni DefaultFun ()
forall {name} {uni :: * -> *} {fun}. Term name uni fun ()
false)]) Vector (Term Name DefaultUni DefaultFun ())
alts

{- | This should not simplify, because one of the branches of `ifThenElse` is not a `Constr`.
Unless both branches are known constructors, the case-of-case transformation
may increase the program size.
-}
caseOfCase2 :: Term Name PLC.DefaultUni PLC.DefaultFun ()
caseOfCase2 :: Term Name DefaultUni DefaultFun ()
caseOfCase2 = Quote (Term Name DefaultUni DefaultFun ())
-> Term Name DefaultUni DefaultFun ()
forall a. Quote a -> a
runQuote do
  Name
b <- Text -> QuoteT Identity Name
forall (m :: * -> *). MonadQuote m => Text -> m Name
freshName Text
"b"
  Name
t <- Text -> QuoteT Identity Name
forall (m :: * -> *). MonadQuote m => Text -> m Name
freshName Text
"t"
  let ite :: Term name uni DefaultFun ()
ite = () -> Term name uni DefaultFun () -> Term name uni DefaultFun ()
forall name (uni :: * -> *) fun ann.
ann -> Term name uni fun ann -> Term name uni fun ann
Force () (() -> DefaultFun -> Term name uni DefaultFun ()
forall name (uni :: * -> *) fun ann.
ann -> fun -> Term name uni fun ann
Builtin () DefaultFun
PLC.IfThenElse)
      true :: Term Name uni fun ()
true = () -> Name -> Term Name uni fun ()
forall name (uni :: * -> *) fun ann.
ann -> name -> Term name uni fun ann
Var () Name
t
      false :: Term name uni fun ()
false = () -> Word64 -> [Term name uni fun ()] -> Term name uni fun ()
forall name (uni :: * -> *) fun ann.
ann -> Word64 -> [Term name uni fun ann] -> Term name uni fun ann
Constr () Word64
1 []
      alts :: Vector (Term Name DefaultUni DefaultFun ())
alts = [Term Name DefaultUni DefaultFun ()]
-> Vector (Term Name DefaultUni DefaultFun ())
forall a. [a] -> Vector a
V.fromList [forall a (uni :: * -> *) fun (term :: * -> *) tyname name ann.
(TermLike term tyname name uni fun, HasTermLevel uni a) =>
ann -> a -> term ann
mkConstant @Integer () Integer
1, forall a (uni :: * -> *) fun (term :: * -> *) tyname name ann.
(TermLike term tyname name uni fun, HasTermLevel uni a) =>
ann -> a -> term ann
mkConstant @Integer () Integer
2]
  Term Name DefaultUni DefaultFun ()
-> Quote (Term Name DefaultUni DefaultFun ())
forall a. a -> QuoteT Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Term Name DefaultUni DefaultFun ()
 -> Quote (Term Name DefaultUni DefaultFun ()))
-> Term Name DefaultUni DefaultFun ()
-> Quote (Term Name DefaultUni DefaultFun ())
forall a b. (a -> b) -> a -> b
$ ()
-> Term Name DefaultUni DefaultFun ()
-> Vector (Term Name DefaultUni DefaultFun ())
-> Term Name DefaultUni DefaultFun ()
forall name (uni :: * -> *) fun ann.
ann
-> Term name uni fun ann
-> Vector (Term name uni fun ann)
-> Term name uni fun ann
Case () (Term Name DefaultUni DefaultFun ()
-> [((), Term Name DefaultUni DefaultFun ())]
-> Term Name DefaultUni DefaultFun ()
forall (term :: * -> *) tyname name (uni :: * -> *) fun ann.
TermLike term tyname name uni fun =>
term ann -> [(ann, term ann)] -> term ann
mkIterApp Term Name DefaultUni DefaultFun ()
forall {name} {uni :: * -> *}. Term name uni DefaultFun ()
ite [((), () -> Name -> Term Name DefaultUni DefaultFun ()
forall name (uni :: * -> *) fun ann.
ann -> name -> Term name uni fun ann
Var () Name
b), ((), Term Name DefaultUni DefaultFun ()
forall {uni :: * -> *} {fun}. Term Name uni fun ()
true), ((), Term Name DefaultUni DefaultFun ()
forall {name} {uni :: * -> *} {fun}. Term name uni fun ()
false)]) Vector (Term Name DefaultUni DefaultFun ())
alts

{- | Similar to `caseOfCase1`, but the type of the @true@ and @false@ branches is
@[Integer]@ rather than Bool (note that @Constr 0@ has two parameters, @x@ and @xs@).
-}
caseOfCase3 :: Term Name PLC.DefaultUni PLC.DefaultFun ()
caseOfCase3 :: Term Name DefaultUni DefaultFun ()
caseOfCase3 = Quote (Term Name DefaultUni DefaultFun ())
-> Term Name DefaultUni DefaultFun ()
forall a. Quote a -> a
runQuote do
  Name
b <- Text -> QuoteT Identity Name
forall (m :: * -> *). MonadQuote m => Text -> m Name
freshName Text
"b"
  Name
x <- Text -> QuoteT Identity Name
forall (m :: * -> *). MonadQuote m => Text -> m Name
freshName Text
"x"
  Name
xs <- Text -> QuoteT Identity Name
forall (m :: * -> *). MonadQuote m => Text -> m Name
freshName Text
"xs"
  Name
f <- Text -> QuoteT Identity Name
forall (m :: * -> *). MonadQuote m => Text -> m Name
freshName Text
"f"
  let ite :: Term name uni DefaultFun ()
ite = () -> Term name uni DefaultFun () -> Term name uni DefaultFun ()
forall name (uni :: * -> *) fun ann.
ann -> Term name uni fun ann -> Term name uni fun ann
Force () (() -> DefaultFun -> Term name uni DefaultFun ()
forall name (uni :: * -> *) fun ann.
ann -> fun -> Term name uni fun ann
Builtin () DefaultFun
PLC.IfThenElse)
      true :: Term Name uni fun ()
true = () -> Word64 -> [Term Name uni fun ()] -> Term Name uni fun ()
forall name (uni :: * -> *) fun ann.
ann -> Word64 -> [Term name uni fun ann] -> Term name uni fun ann
Constr () Word64
0 [() -> Name -> Term Name uni fun ()
forall name (uni :: * -> *) fun ann.
ann -> name -> Term name uni fun ann
Var () Name
x, () -> Name -> Term Name uni fun ()
forall name (uni :: * -> *) fun ann.
ann -> name -> Term name uni fun ann
Var () Name
xs]
      false :: Term name uni fun ()
false = () -> Word64 -> [Term name uni fun ()] -> Term name uni fun ()
forall name (uni :: * -> *) fun ann.
ann -> Word64 -> [Term name uni fun ann] -> Term name uni fun ann
Constr () Word64
1 []
      altTrue :: Term Name uni fun ()
altTrue = () -> Name -> Term Name uni fun ()
forall name (uni :: * -> *) fun ann.
ann -> name -> Term name uni fun ann
Var () Name
f
      altFalse :: Term Name DefaultUni DefaultFun ()
altFalse = forall a (uni :: * -> *) fun (term :: * -> *) tyname name ann.
(TermLike term tyname name uni fun, HasTermLevel uni a) =>
ann -> a -> term ann
mkConstant @Integer () Integer
2
      alts :: Vector (Term Name DefaultUni DefaultFun ())
alts = [Term Name DefaultUni DefaultFun ()]
-> Vector (Term Name DefaultUni DefaultFun ())
forall a. [a] -> Vector a
V.fromList [Term Name DefaultUni DefaultFun ()
forall {uni :: * -> *} {fun}. Term Name uni fun ()
altTrue, Term Name DefaultUni DefaultFun ()
altFalse]
  Term Name DefaultUni DefaultFun ()
-> Quote (Term Name DefaultUni DefaultFun ())
forall a. a -> QuoteT Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Term Name DefaultUni DefaultFun ()
 -> Quote (Term Name DefaultUni DefaultFun ()))
-> Term Name DefaultUni DefaultFun ()
-> Quote (Term Name DefaultUni DefaultFun ())
forall a b. (a -> b) -> a -> b
$ ()
-> Term Name DefaultUni DefaultFun ()
-> Vector (Term Name DefaultUni DefaultFun ())
-> Term Name DefaultUni DefaultFun ()
forall name (uni :: * -> *) fun ann.
ann
-> Term name uni fun ann
-> Vector (Term name uni fun ann)
-> Term name uni fun ann
Case () (Term Name DefaultUni DefaultFun ()
-> [((), Term Name DefaultUni DefaultFun ())]
-> Term Name DefaultUni DefaultFun ()
forall (term :: * -> *) tyname name (uni :: * -> *) fun ann.
TermLike term tyname name uni fun =>
term ann -> [(ann, term ann)] -> term ann
mkIterApp Term Name DefaultUni DefaultFun ()
forall {name} {uni :: * -> *}. Term name uni DefaultFun ()
ite [((), () -> Name -> Term Name DefaultUni DefaultFun ()
forall name (uni :: * -> *) fun ann.
ann -> name -> Term name uni fun ann
Var () Name
b), ((), Term Name DefaultUni DefaultFun ()
forall {uni :: * -> *} {fun}. Term Name uni fun ()
true), ((), Term Name DefaultUni DefaultFun ()
forall {name} {uni :: * -> *} {fun}. Term name uni fun ()
false)]) Vector (Term Name DefaultUni DefaultFun ())
alts

{- |

@
  case (force ifThenElse) True True False of
    True -> ()
    False -> _|_
@

Evaluates to `()` because the first case alternative is selected.
(The _|_ is not evaluated because case alternatives are evaluated lazily).

After the `CaseOfCase` transformation the program should evaluate to `()` as well.

@
  force ((force ifThenElse) True (delay ()) (delay _|_))
@
-}
caseOfCaseWithError :: Term Name DefaultUni DefaultFun ()
caseOfCaseWithError :: Term Name DefaultUni DefaultFun ()
caseOfCaseWithError =
  ()
-> Term Name DefaultUni DefaultFun ()
-> Vector (Term Name DefaultUni DefaultFun ())
-> Term Name DefaultUni DefaultFun ()
forall name (uni :: * -> *) fun ann.
ann
-> Term name uni fun ann
-> Vector (Term name uni fun ann)
-> Term name uni fun ann
Case
    ()
    ( Term Name DefaultUni DefaultFun ()
-> [((), Term Name DefaultUni DefaultFun ())]
-> Term Name DefaultUni DefaultFun ()
forall (term :: * -> *) tyname name (uni :: * -> *) fun ann.
TermLike term tyname name uni fun =>
term ann -> [(ann, term ann)] -> term ann
mkIterApp
        (()
-> Term Name DefaultUni DefaultFun ()
-> Term Name DefaultUni DefaultFun ()
forall name (uni :: * -> *) fun ann.
ann -> Term name uni fun ann -> Term name uni fun ann
Force () (() -> DefaultFun -> Term Name DefaultUni DefaultFun ()
forall name (uni :: * -> *) fun ann.
ann -> fun -> Term name uni fun ann
Builtin () DefaultFun
PLC.IfThenElse))
        [ ((), forall a (uni :: * -> *) fun (term :: * -> *) tyname name ann.
(TermLike term tyname name uni fun, HasTermLevel uni a) =>
ann -> a -> term ann
mkConstant @Bool () Bool
True)
        , ((), ()
-> Word64
-> [Term Name DefaultUni DefaultFun ()]
-> Term Name DefaultUni DefaultFun ()
forall name (uni :: * -> *) fun ann.
ann -> Word64 -> [Term name uni fun ann] -> Term name uni fun ann
Constr () Word64
0 []) -- True
        , ((), ()
-> Word64
-> [Term Name DefaultUni DefaultFun ()]
-> Term Name DefaultUni DefaultFun ()
forall name (uni :: * -> *) fun ann.
ann -> Word64 -> [Term name uni fun ann] -> Term name uni fun ann
Constr () Word64
1 []) -- False
        ]
    )
    ([Term Name DefaultUni DefaultFun ()]
-> Vector (Term Name DefaultUni DefaultFun ())
forall a. [a] -> Vector a
V.fromList [forall a (uni :: * -> *) fun (term :: * -> *) tyname name ann.
(TermLike term tyname name uni fun, HasTermLevel uni a) =>
ann -> a -> term ann
mkConstant @() () (), () -> Term Name DefaultUni DefaultFun ()
forall name (uni :: * -> *) fun ann. ann -> Term name uni fun ann
Error ()])

testCaseOfCaseWithError :: TestTree
testCaseOfCaseWithError :: TestTree
testCaseOfCaseWithError =
  [Char] -> Assertion -> TestTree
testCase [Char]
"Transformation doesn't evaluate error eagerly" do
    let simplifiedTerm :: Term Name DefaultUni DefaultFun ()
simplifiedTerm = Term Name DefaultUni DefaultFun ()
-> Term Name DefaultUni DefaultFun ()
evalCaseOfCase Term Name DefaultUni DefaultFun ()
caseOfCaseWithError
    Term Name DefaultUni DefaultFun ()
-> EvaluationResult (Term Name DefaultUni DefaultFun ())
evaluateUplc Term Name DefaultUni DefaultFun ()
simplifiedTerm EvaluationResult (Term Name DefaultUni DefaultFun ())
-> EvaluationResult (Term Name DefaultUni DefaultFun ())
-> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Term Name DefaultUni DefaultFun ()
-> EvaluationResult (Term Name DefaultUni DefaultFun ())
evaluateUplc Term Name DefaultUni DefaultFun ()
caseOfCaseWithError

----------------------------------------------------------------------------------------------------
-- Helper functions --------------------------------------------------------------------------------

evalCaseOfCase
  :: Term Name DefaultUni DefaultFun ()
  -> Term Name DefaultUni DefaultFun ()
evalCaseOfCase :: Term Name DefaultUni DefaultFun ()
-> Term Name DefaultUni DefaultFun ()
evalCaseOfCase Term Name DefaultUni DefaultFun ()
term = Simplifier
  Name DefaultUni DefaultFun () (Term Name DefaultUni DefaultFun ())
-> Term Name DefaultUni DefaultFun ()
forall name (uni :: * -> *) fun ann a.
Simplifier name uni fun ann a -> a
evalSimplifier (Simplifier
   Name DefaultUni DefaultFun () (Term Name DefaultUni DefaultFun ())
 -> Term Name DefaultUni DefaultFun ())
-> Simplifier
     Name DefaultUni DefaultFun () (Term Name DefaultUni DefaultFun ())
-> Term Name DefaultUni DefaultFun ()
forall a b. (a -> b) -> a -> b
$ Term Name DefaultUni DefaultFun ()
-> Simplifier
     Name DefaultUni DefaultFun () (Term Name DefaultUni DefaultFun ())
forall fun (m :: * -> *) (uni :: * -> *) name a.
(fun ~ DefaultFun, Monad m, CaseBuiltin uni, GEq uni, Closed uni,
 Everywhere uni Eq) =>
Term name uni fun a
-> SimplifierT name uni fun a m (Term name uni fun a)
caseOfCase Term Name DefaultUni DefaultFun ()
term

evaluateUplc
  :: UPLC.Term Name DefaultUni DefaultFun ()
  -> EvaluationResult (UPLC.Term Name DefaultUni DefaultFun ())
evaluateUplc :: Term Name DefaultUni DefaultFun ()
-> EvaluationResult (Term Name DefaultUni DefaultFun ())
evaluateUplc = Either
  (EvaluationException
     (MachineError DefaultFun)
     CekUserError
     (Term Name DefaultUni DefaultFun ()))
  (Term Name DefaultUni DefaultFun ())
-> EvaluationResult (Term Name DefaultUni DefaultFun ())
forall structural term operational a.
(PrettyPlc structural, PrettyPlc term, Typeable structural,
 Typeable term) =>
Either (EvaluationException structural operational term) a
-> EvaluationResult a
unsafeSplitStructuralOperational (Either
   (EvaluationException
      (MachineError DefaultFun)
      CekUserError
      (Term Name DefaultUni DefaultFun ()))
   (Term Name DefaultUni DefaultFun ())
 -> EvaluationResult (Term Name DefaultUni DefaultFun ()))
-> ((Either
       (EvaluationException
          (MachineError DefaultFun)
          CekUserError
          (Term Name DefaultUni DefaultFun ()))
       (Term Name DefaultUni DefaultFun ()),
     [Text])
    -> Either
         (EvaluationException
            (MachineError DefaultFun)
            CekUserError
            (Term Name DefaultUni DefaultFun ()))
         (Term Name DefaultUni DefaultFun ()))
-> (Either
      (EvaluationException
         (MachineError DefaultFun)
         CekUserError
         (Term Name DefaultUni DefaultFun ()))
      (Term Name DefaultUni DefaultFun ()),
    [Text])
-> EvaluationResult (Term Name DefaultUni DefaultFun ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Either
   (EvaluationException
      (MachineError DefaultFun)
      CekUserError
      (Term Name DefaultUni DefaultFun ()))
   (Term Name DefaultUni DefaultFun ()),
 [Text])
-> Either
     (EvaluationException
        (MachineError DefaultFun)
        CekUserError
        (Term Name DefaultUni DefaultFun ()))
     (Term Name DefaultUni DefaultFun ())
forall a b. (a, b) -> a
fst ((Either
    (EvaluationException
       (MachineError DefaultFun)
       CekUserError
       (Term Name DefaultUni DefaultFun ()))
    (Term Name DefaultUni DefaultFun ()),
  [Text])
 -> EvaluationResult (Term Name DefaultUni DefaultFun ()))
-> (Term Name DefaultUni DefaultFun ()
    -> (Either
          (EvaluationException
             (MachineError DefaultFun)
             CekUserError
             (Term Name DefaultUni DefaultFun ()))
          (Term Name DefaultUni DefaultFun ()),
        [Text]))
-> Term Name DefaultUni DefaultFun ()
-> EvaluationResult (Term Name DefaultUni DefaultFun ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> EmitterMode DefaultUni DefaultFun
-> MachineParameters
     CekMachineCosts DefaultFun (CekValue DefaultUni DefaultFun ())
-> Term Name DefaultUni DefaultFun ()
-> (Either
      (EvaluationException
         (MachineError DefaultFun)
         CekUserError
         (Term Name DefaultUni DefaultFun ()))
      (Term Name DefaultUni DefaultFun ()),
    [Text])
forall (uni :: * -> *) fun ann.
ThrowableBuiltins uni fun =>
EmitterMode uni fun
-> MachineParameters CekMachineCosts fun (CekValue uni fun ann)
-> Term Name uni fun ann
-> (Either
      (CekEvaluationException Name uni fun) (Term Name uni fun ()),
    [Text])
evaluateCek EmitterMode DefaultUni DefaultFun
forall (uni :: * -> *) fun. EmitterMode uni fun
noEmitter MachineParameters
  CekMachineCosts DefaultFun (CekValue DefaultUni DefaultFun ())
machineParameters
 where
  costModel :: CostModel CekMachineCosts BuiltinCostModel
  costModel :: CostModel CekMachineCosts BuiltinCostModel
costModel =
      CekMachineCosts
-> BuiltinCostModel -> CostModel CekMachineCosts BuiltinCostModel
forall machinecosts builtincosts.
machinecosts -> builtincosts -> CostModel machinecosts builtincosts
CostModel CekMachineCosts
defaultCekMachineCostsForTesting BuiltinCostModel
defaultBuiltinCostModelForTesting

  machineParameters :: DefaultMachineParameters
  machineParameters :: MachineParameters
  CekMachineCosts DefaultFun (CekValue DefaultUni DefaultFun ())
machineParameters =
      -- TODO: proper semantic variant. What should def be?
      CaserBuiltin (UniOf (CekValue DefaultUni DefaultFun ()))
-> MachineVariantParameters
     CekMachineCosts DefaultFun (CekValue DefaultUni DefaultFun ())
-> MachineParameters
     CekMachineCosts DefaultFun (CekValue DefaultUni DefaultFun ())
forall machineCosts fun val.
CaserBuiltin (UniOf val)
-> MachineVariantParameters machineCosts fun val
-> MachineParameters machineCosts fun val
MachineParameters CaserBuiltin (UniOf (CekValue DefaultUni DefaultFun ()))
CaserBuiltin DefaultUni
forall a. Default a => a
def (MachineVariantParameters
   CekMachineCosts DefaultFun (CekValue DefaultUni DefaultFun ())
 -> MachineParameters
      CekMachineCosts DefaultFun (CekValue DefaultUni DefaultFun ()))
-> MachineVariantParameters
     CekMachineCosts DefaultFun (CekValue DefaultUni DefaultFun ())
-> MachineParameters
     CekMachineCosts DefaultFun (CekValue DefaultUni DefaultFun ())
forall a b. (a -> b) -> a -> b
$ BuiltinSemanticsVariant DefaultFun
-> CostModel CekMachineCosts BuiltinCostModel
-> MachineVariantParameters
     CekMachineCosts DefaultFun (CekValue DefaultUni DefaultFun ())
forall (uni :: * -> *) fun builtincosts val machineCosts.
(CostingPart uni fun ~ builtincosts, HasMeaningIn uni val,
 ToBuiltinMeaning uni fun) =>
BuiltinSemanticsVariant fun
-> CostModel machineCosts builtincosts
-> MachineVariantParameters machineCosts fun val
mkMachineVariantParameters BuiltinSemanticsVariant DefaultFun
forall a. Default a => a
def CostModel CekMachineCosts BuiltinCostModel
costModel

goldenVsSimplified :: String -> Term Name PLC.DefaultUni PLC.DefaultFun () -> TestTree
goldenVsSimplified :: [Char] -> Term Name DefaultUni DefaultFun () -> TestTree
goldenVsSimplified [Char]
name =
  [Char] -> [Char] -> IO ByteString -> TestTree
goldenVsString [Char]
name ([Char]
"untyped-plutus-core/test/Transform/CaseOfCase/" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
name [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
".uplc.golden")
    (IO ByteString -> TestTree)
-> (Term Name DefaultUni DefaultFun () -> IO ByteString)
-> Term Name DefaultUni DefaultFun ()
-> TestTree
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> IO ByteString
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    (ByteString -> IO ByteString)
-> (Term Name DefaultUni DefaultFun () -> ByteString)
-> Term Name DefaultUni DefaultFun ()
-> IO ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BSL.fromStrict
    (ByteString -> ByteString)
-> (Term Name DefaultUni DefaultFun () -> ByteString)
-> Term Name DefaultUni DefaultFun ()
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
encodeUtf8
    (Text -> ByteString)
-> (Term Name DefaultUni DefaultFun () -> Text)
-> Term Name DefaultUni DefaultFun ()
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc Any -> Text
forall ann. Doc ann -> Text
forall str ann. Render str => Doc ann -> str
render
    (Doc Any -> Text)
-> (Term Name DefaultUni DefaultFun () -> Doc Any)
-> Term Name DefaultUni DefaultFun ()
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Term Name DefaultUni DefaultFun () -> Doc Any
forall a ann. PrettyClassic a => a -> Doc ann
prettyClassicSimple
    (Term Name DefaultUni DefaultFun () -> Doc Any)
-> (Term Name DefaultUni DefaultFun ()
    -> Term Name DefaultUni DefaultFun ())
-> Term Name DefaultUni DefaultFun ()
-> Doc Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Term Name DefaultUni DefaultFun ()
-> Term Name DefaultUni DefaultFun ()
evalCaseOfCase