-- editorconfig-checker-disable-file
-- | Tests for all kinds of built-in functions.

{-# LANGUAGE BlockArguments        #-}
{-# LANGUAGE CPP                   #-}
{-# LANGUAGE LambdaCase            #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE PartialTypeSignatures #-}
{-# LANGUAGE TypeApplications      #-}
{-# LANGUAGE TypeOperators         #-}

-- Sure GHC, I'm enabling the extension just so that you can warn me about its usages.
{-# OPTIONS_GHC -fno-warn-partial-type-signatures #-}

module Evaluation.Builtins.Definition
    ( test_definition
    ) where

import PlutusPrelude

import Evaluation.Builtins.Bitwise.CIP0122 qualified as CIP0122
import Evaluation.Builtins.Bitwise.CIP0123 qualified as CIP0123
import Evaluation.Builtins.BLS12_381 (test_BLS12_381)
import Evaluation.Builtins.Common
import Evaluation.Builtins.Conversion qualified as Conversion
import Evaluation.Builtins.SignatureVerification (ecdsaSecp256k1Prop, ed25519_VariantAProp,
                                                  ed25519_VariantBProp, ed25519_VariantCProp,
                                                  schnorrSecp256k1Prop)

import PlutusCore hiding (Constr)
import PlutusCore qualified as PLC
import PlutusCore.Builtin
import PlutusCore.Compiler.Erase (eraseTerm)
import PlutusCore.Data
import PlutusCore.Default
import PlutusCore.Evaluation.Machine.ExBudgetingDefaults
import PlutusCore.Evaluation.Machine.MachineParameters
import PlutusCore.Examples.Builtins
import PlutusCore.Examples.Data.Data
import PlutusCore.Generators.Hedgehog.Interesting
import PlutusCore.Generators.QuickCheck.Builtin
import PlutusCore.MkPlc hiding (error)
import PlutusCore.Pretty
import PlutusCore.StdLib.Data.Bool
import PlutusCore.StdLib.Data.Data
import PlutusCore.StdLib.Data.Function qualified as Plc
import PlutusCore.StdLib.Data.Integer
import PlutusCore.StdLib.Data.List qualified as Builtin
import PlutusCore.StdLib.Data.MatchOption
import PlutusCore.StdLib.Data.Pair
import PlutusCore.StdLib.Data.ScottList qualified as Scott
import PlutusCore.StdLib.Data.ScottUnit qualified as Scott
import PlutusCore.StdLib.Data.Unit
import PlutusCore.Test
import UntypedPlutusCore.Evaluation.Machine.Cek

import Control.Exception (evaluate, try)
import Data.Bifunctor (bimap)
import Data.ByteString (ByteString, pack)
import Data.ByteString.Base16 qualified as Base16
import Data.DList qualified as DList
import Data.List (find)
import Data.Proxy (Proxy (..))
import Data.String (IsString (fromString))
import Data.Text (Text)
import Data.Text qualified as Text
import Data.Text.Encoding qualified as Text
import Data.Vector.Strict (Vector)
import Data.Vector.Strict qualified as Vector
import Hedgehog (forAll, property, withTests, (===))
import Hedgehog.Gen qualified as Gen
import Hedgehog.Range qualified as Range
import Prettyprinter (vsep)
import Test.Tasty (TestTree, testGroup)
import Test.Tasty.Hedgehog (testPropertyNamed)
import Test.Tasty.HUnit (Assertion, assertBool, assertFailure, testCase, (@=?), (@?=))
import Test.Tasty.QuickCheck qualified as QC

type DefaultFunExt = Either DefaultFun ExtensionFun

runTestNestedHere :: [TestNested] -> TestTree
runTestNestedHere :: [TestNested] -> TestTree
runTestNestedHere = [String] -> [TestNested] -> TestTree
runTestNested
    [String
"untyped-plutus-core", String
"test", String
"Evaluation", String
"Builtins", String
"Golden"]

defaultBuiltinCostModelExt :: CostingPart DefaultUni DefaultFunExt
defaultBuiltinCostModelExt :: CostingPart DefaultUni (Either DefaultFun ExtensionFun)
defaultBuiltinCostModelExt = (BuiltinCostModel
defaultBuiltinCostModelForTesting, ())

{- FIXME: in this module there are many occurrences of things like

     typecheckEvaluateCekNoEmit def defaultBuiltinCostModelForTesting

   Here `def` is the default semantics variant defined in
   PlutusCore.Default.Builtins.  Currently that is equal to
   `DefaultFunSemanticsVariantC`, and `defaultBuiltinCostModelForTesting` is the
   cost model for the same variant.  Can we couple these things together more
   tightly so that it's guaranteed that the two things refer to the same
   semantics variant?
-}

test_IntegerDistribution :: TestTree
test_IntegerDistribution :: TestTree
test_IntegerDistribution =
    String -> Property -> TestTree
forall a. Testable a => String -> a -> TestTree
QC.testProperty String
"distribution of 'Integer' constants" (Property -> TestTree)
-> ((AsArbitraryBuiltin Integer -> Property) -> Property)
-> (AsArbitraryBuiltin Integer -> Property)
-> TestTree
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> (AsArbitraryBuiltin Integer -> Property) -> Property
forall prop. Testable prop => Int -> prop -> Property
QC.withMaxSuccess Int
10000 ((AsArbitraryBuiltin Integer -> Property) -> TestTree)
-> (AsArbitraryBuiltin Integer -> Property) -> TestTree
forall a b. (a -> b) -> a -> b
$
        \(AsArbitraryBuiltin (Integer
i :: Integer)) ->
            let magnitudes :: [(Integer, Integer)]
magnitudes = (Integer -> Integer) -> Integer -> [(Integer, Integer)]
magnitudesPositive Integer -> Integer
nextInterestingBound Integer
highInterestingBound
                (Integer
low, Integer
high) =
                    (Integer, Integer)
-> ((Integer, Integer) -> (Integer, Integer))
-> Maybe (Integer, Integer)
-> (Integer, Integer)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> (Integer, Integer)
forall a. HasCallStack => String -> a
error String
"Panic: unknown integer") ((Integer -> Integer)
-> (Integer -> Integer) -> (Integer, Integer) -> (Integer, Integer)
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer -> Integer
forall a. Num a => a -> a
signum Integer
i) (Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer -> Integer
forall a. Num a => a -> a
signum Integer
i)) (Maybe (Integer, Integer) -> (Integer, Integer))
-> Maybe (Integer, Integer) -> (Integer, Integer)
forall a b. (a -> b) -> a -> b
$
                      ((Integer, Integer) -> Bool)
-> [(Integer, Integer)] -> Maybe (Integer, Integer)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer -> Integer
forall a. Num a => a -> a
abs Integer
i) (Integer -> Bool)
-> ((Integer, Integer) -> Integer) -> (Integer, Integer) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer, Integer) -> Integer
forall a b. (a, b) -> b
snd) [(Integer, Integer)]
magnitudes
                bounds :: [Integer]
bounds = ((Integer, Integer) -> Integer)
-> [(Integer, Integer)] -> [Integer]
forall a b. (a -> b) -> [a] -> [b]
map (Integer, Integer) -> Integer
forall a b. (a, b) -> b
snd [(Integer, Integer)]
magnitudes
                isInteresting :: Bool
isInteresting = Integer
i Integer -> [Integer] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[Integer]] -> [Integer]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
                    [ (Integer -> Integer) -> [Integer] -> [Integer]
forall a b. (a -> b) -> [a] -> [b]
map (Integer -> Integer
forall a. Enum a => a -> a
pred (Integer -> Integer) -> (Integer -> Integer) -> Integer -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Integer
forall a. Num a => a -> a
negate) [Integer]
bounds
                    , (Integer -> Integer) -> [Integer] -> [Integer]
forall a b. (a -> b) -> [a] -> [b]
map Integer -> Integer
forall a. Num a => a -> a
negate [Integer]
bounds
                    , [-Integer
1, Integer
0, Integer
1]
                    , [Integer]
bounds
                    , (Integer -> Integer) -> [Integer] -> [Integer]
forall a b. (a -> b) -> [a] -> [b]
map Integer -> Integer
forall a. Enum a => a -> a
succ [Integer]
bounds
                    ]
            in (if Integer
i Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= Integer
0
                        then String -> Property -> Property
forall prop. Testable prop => String -> prop -> Property
QC.label (String -> Property -> Property) -> String -> Property -> Property
forall a b. (a -> b) -> a -> b
$ String
"(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
low String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
high String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
                        else Property -> Property
forall prop. Testable prop => prop -> Property
QC.property)
                ((if Bool
isInteresting
                        then String -> Bool -> Property
forall prop. Testable prop => String -> prop -> Property
QC.label (String -> Bool -> Property) -> String -> Bool -> Property
forall a b. (a -> b) -> a -> b
$ Integer -> String
forall a. Show a => a -> String
show Integer
i
                        else Bool -> Property
forall prop. Testable prop => prop -> Property
QC.property)
                    Bool
True)

-- | Check that the 'Factorial' builtin computes to the same thing as factorial defined in PLC
-- itself.
test_Factorial :: TestTree
test_Factorial :: TestTree
test_Factorial =
    String -> Assertion -> TestTree
testCase String
"Factorial" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ do
        let ten :: Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
ten = forall a (uni :: * -> *) fun (term :: * -> *) tyname name ann.
(TermLike term tyname name uni fun, HasTermLevel uni a) =>
ann -> a -> term ann
mkConstant @Integer @DefaultUni () Integer
10
            lhs :: Either
  (Error DefaultUni (Either DefaultFun ExtensionFun) ())
  (EvaluationResult
     (Term Name DefaultUni (Either DefaultFun ExtensionFun) ()),
   [Text])
lhs = BuiltinSemanticsVariant (Either DefaultFun ExtensionFun)
-> CostingPart DefaultUni (Either DefaultFun ExtensionFun)
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
-> Either
     (Error DefaultUni (Either DefaultFun ExtensionFun) ())
     (EvaluationResult
        (Term Name DefaultUni (Either DefaultFun ExtensionFun) ()),
      [Text])
forall (uni :: * -> *) fun (m :: * -> *).
(MonadError (Error uni fun ()) m, Typecheckable uni fun, GEq uni,
 Everywhere uni ExMemoryUsage, PrettyUni uni, Pretty fun) =>
BuiltinSemanticsVariant fun
-> CostingPart uni fun
-> Term TyName Name uni fun ()
-> m (EvaluationResult (Term Name uni fun ()), [Text])
typecheckEvaluateCek BuiltinSemanticsVariant (Either DefaultFun ExtensionFun)
forall a. Default a => a
def CostingPart DefaultUni (Either DefaultFun ExtensionFun)
defaultBuiltinCostModelExt (Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
 -> Either
      (Error DefaultUni (Either DefaultFun ExtensionFun) ())
      (EvaluationResult
         (Term Name DefaultUni (Either DefaultFun ExtensionFun) ()),
       [Text]))
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
-> Either
     (Error DefaultUni (Either DefaultFun ExtensionFun) ())
     (EvaluationResult
        (Term Name DefaultUni (Either DefaultFun ExtensionFun) ()),
      [Text])
forall a b. (a -> b) -> a -> b
$
                    ()
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
forall ann.
ann
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ann
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ann
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ann
forall (term :: * -> *) tyname name (uni :: * -> *) fun ann.
TermLike term tyname name uni fun =>
ann -> term ann -> term ann -> term ann
apply () (()
-> Either DefaultFun ExtensionFun
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
forall ann.
ann
-> Either DefaultFun ExtensionFun
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ann
forall (term :: * -> *) tyname name (uni :: * -> *) fun ann.
TermLike term tyname name uni fun =>
ann -> fun -> term ann
builtin () (Either DefaultFun ExtensionFun
 -> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ())
-> Either DefaultFun ExtensionFun
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
forall a b. (a -> b) -> a -> b
$ ExtensionFun -> Either DefaultFun ExtensionFun
forall a b. b -> Either a b
Right ExtensionFun
Factorial) Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
ten
            rhs :: Either
  (Error DefaultUni (Either DefaultFun ExtensionFun) ())
  (EvaluationResult
     (Term Name DefaultUni (Either DefaultFun ExtensionFun) ()),
   [Text])
rhs = BuiltinSemanticsVariant (Either DefaultFun ExtensionFun)
-> CostingPart DefaultUni (Either DefaultFun ExtensionFun)
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
-> Either
     (Error DefaultUni (Either DefaultFun ExtensionFun) ())
     (EvaluationResult
        (Term Name DefaultUni (Either DefaultFun ExtensionFun) ()),
      [Text])
forall (uni :: * -> *) fun (m :: * -> *).
(MonadError (Error uni fun ()) m, Typecheckable uni fun, GEq uni,
 Everywhere uni ExMemoryUsage, PrettyUni uni, Pretty fun) =>
BuiltinSemanticsVariant fun
-> CostingPart uni fun
-> Term TyName Name uni fun ()
-> m (EvaluationResult (Term Name uni fun ()), [Text])
typecheckEvaluateCek BuiltinSemanticsVariant (Either DefaultFun ExtensionFun)
forall a. Default a => a
def CostingPart DefaultUni (Either DefaultFun ExtensionFun)
defaultBuiltinCostModelExt (Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
 -> Either
      (Error DefaultUni (Either DefaultFun ExtensionFun) ())
      (EvaluationResult
         (Term Name DefaultUni (Either DefaultFun ExtensionFun) ()),
       [Text]))
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
-> Either
     (Error DefaultUni (Either DefaultFun ExtensionFun) ())
     (EvaluationResult
        (Term Name DefaultUni (Either DefaultFun ExtensionFun) ()),
      [Text])
forall a b. (a -> b) -> a -> b
$
                    ()
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
forall ann.
ann
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ann
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ann
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ann
forall (term :: * -> *) tyname name (uni :: * -> *) fun ann.
TermLike term tyname name uni fun =>
ann -> term ann -> term ann -> term ann
apply () ((DefaultFun -> Either DefaultFun ExtensionFun)
-> Term TyName Name DefaultUni DefaultFun ()
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
forall fun fun' tyname name (uni :: * -> *) ann.
(fun -> fun')
-> Term tyname name uni fun ann -> Term tyname name uni fun' ann
mapFun DefaultFun -> Either DefaultFun ExtensionFun
forall a b. a -> Either a b
Left Term TyName Name DefaultUni DefaultFun ()
factorial) Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
ten
        HasCallStack => String -> Bool -> Assertion
String -> Bool -> Assertion
assertBool String
"type checks" (Bool -> Assertion) -> Bool -> Assertion
forall a b. (a -> b) -> a -> b
$ Either
  (Error DefaultUni (Either DefaultFun ExtensionFun) ())
  (EvaluationResult
     (Term Name DefaultUni (Either DefaultFun ExtensionFun) ()),
   [Text])
-> Bool
forall a b. Either a b -> Bool
isRight Either
  (Error DefaultUni (Either DefaultFun ExtensionFun) ())
  (EvaluationResult
     (Term Name DefaultUni (Either DefaultFun ExtensionFun) ()),
   [Text])
lhs
        Either
  (Error DefaultUni (Either DefaultFun ExtensionFun) ())
  (EvaluationResult
     (Term Name DefaultUni (Either DefaultFun ExtensionFun) ()),
   [Text])
lhs Either
  (Error DefaultUni (Either DefaultFun ExtensionFun) ())
  (EvaluationResult
     (Term Name DefaultUni (Either DefaultFun ExtensionFun) ()),
   [Text])
-> Either
     (Error DefaultUni (Either DefaultFun ExtensionFun) ())
     (EvaluationResult
        (Term Name DefaultUni (Either DefaultFun ExtensionFun) ()),
      [Text])
-> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Either
  (Error DefaultUni (Either DefaultFun ExtensionFun) ())
  (EvaluationResult
     (Term Name DefaultUni (Either DefaultFun ExtensionFun) ()),
   [Text])
rhs

-- | Check that 'Const' from the above computes to the same thing as
-- a const defined in PLC itself.
test_Const :: TestTree
test_Const :: TestTree
test_Const =
    String -> PropertyName -> Property -> TestTree
testPropertyNamed String
"Const" PropertyName
"Const" (Property -> TestTree)
-> (PropertyT IO () -> Property) -> PropertyT IO () -> TestTree
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TestLimit -> Property -> Property
withTests TestLimit
10 (Property -> Property)
-> (PropertyT IO () -> Property) -> PropertyT IO () -> Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => PropertyT IO () -> Property
PropertyT IO () -> Property
property (PropertyT IO () -> TestTree) -> PropertyT IO () -> TestTree
forall a b. (a -> b) -> a -> b
$ do
        Text
c <- Gen Text -> PropertyT IO Text
forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll (Gen Text -> PropertyT IO Text) -> Gen Text -> PropertyT IO Text
forall a b. (a -> b) -> a -> b
$ Range Int -> GenT Identity Char -> Gen Text
forall (m :: * -> *). MonadGen m => Range Int -> m Char -> m Text
Gen.text (Int -> Int -> Range Int
forall a. Integral a => a -> a -> Range a
Range.linear Int
0 Int
100) GenT Identity Char
forall (m :: * -> *). MonadGen m => m Char
Gen.unicode
        Bool
b <- Gen Bool -> PropertyT IO Bool
forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen Bool
forall (m :: * -> *). MonadGen m => m Bool
Gen.bool
        let tC :: Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
tC = ()
-> Text
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
forall a (uni :: * -> *) fun (term :: * -> *) tyname name ann.
(TermLike term tyname name uni fun, HasTermLevel uni a) =>
ann -> a -> term ann
mkConstant () Text
c
            tB :: Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
tB = ()
-> Bool
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
forall a (uni :: * -> *) fun (term :: * -> *) tyname name ann.
(TermLike term tyname name uni fun, HasTermLevel uni a) =>
ann -> a -> term ann
mkConstant () Bool
b
            text :: Type w DefaultUni ()
text = forall a tyname (uni :: * -> *) (x :: a) (proxy :: a -> *).
KnownTypeAst tyname uni x =>
proxy x -> Type tyname uni ()
toTypeAst @_ @_ @DefaultUni @Text Proxy Text
forall {k} (t :: k). Proxy t
Proxy
            runConst :: Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
runConst Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
con = Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
-> [Term
      TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()]
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
forall (term :: * -> *) tyname name (uni :: * -> *) fun.
TermLike term tyname name uni fun =>
term () -> [term ()] -> term ()
mkIterAppNoAnn (Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
-> [Type TyName DefaultUni ()]
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
forall (term :: * -> *) tyname name (uni :: * -> *) fun.
TermLike term tyname name uni fun =>
term () -> [Type tyname uni ()] -> term ()
mkIterInstNoAnn Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
con [Type TyName DefaultUni ()
forall {w}. Type w DefaultUni ()
text, Type TyName DefaultUni ()
forall (uni :: * -> *) tyname.
HasTypeLevel uni Bool =>
Type tyname uni ()
bool]) [Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
tC, Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
tB]
            lhs :: Either
  (Error DefaultUni (Either DefaultFun ExtensionFun) ())
  (Either
     (CekEvaluationException
        Name DefaultUni (Either DefaultFun ExtensionFun))
     Text)
lhs = BuiltinSemanticsVariant (Either DefaultFun ExtensionFun)
-> CostingPart DefaultUni (Either DefaultFun ExtensionFun)
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
-> Either
     (Error DefaultUni (Either DefaultFun ExtensionFun) ())
     (Either
        (CekEvaluationException
           Name DefaultUni (Either DefaultFun ExtensionFun))
        Text)
forall (uni :: * -> *) fun (m :: * -> *) a.
(MonadError (Error uni fun ()) m, Typecheckable uni fun, GEq uni,
 Everywhere uni ExMemoryUsage, PrettyUni uni, Pretty fun,
 ReadKnown (Term Name uni fun ()) a) =>
BuiltinSemanticsVariant fun
-> CostingPart uni fun
-> Term TyName Name uni fun ()
-> m (Either (CekEvaluationException Name uni fun) a)
typecheckReadKnownCek BuiltinSemanticsVariant (Either DefaultFun ExtensionFun)
forall a. Default a => a
def CostingPart DefaultUni (Either DefaultFun ExtensionFun)
defaultBuiltinCostModelExt (Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
 -> Either
      (Error DefaultUni (Either DefaultFun ExtensionFun) ())
      (Either
         (CekEvaluationException
            Name DefaultUni (Either DefaultFun ExtensionFun))
         Text))
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
-> Either
     (Error DefaultUni (Either DefaultFun ExtensionFun) ())
     (Either
        (CekEvaluationException
           Name DefaultUni (Either DefaultFun ExtensionFun))
        Text)
forall a b. (a -> b) -> a -> b
$
                    Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
runConst (Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
 -> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ())
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
forall a b. (a -> b) -> a -> b
$ ()
-> Either DefaultFun ExtensionFun
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
forall ann.
ann
-> Either DefaultFun ExtensionFun
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ann
forall (term :: * -> *) tyname name (uni :: * -> *) fun ann.
TermLike term tyname name uni fun =>
ann -> fun -> term ann
builtin () (ExtensionFun -> Either DefaultFun ExtensionFun
forall a b. b -> Either a b
Right ExtensionFun
Const)
            rhs :: Either
  (Error DefaultUni (Either DefaultFun ExtensionFun) ())
  (Either
     (CekEvaluationException
        Name DefaultUni (Either DefaultFun ExtensionFun))
     Text)
rhs = BuiltinSemanticsVariant (Either DefaultFun ExtensionFun)
-> CostingPart DefaultUni (Either DefaultFun ExtensionFun)
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
-> Either
     (Error DefaultUni (Either DefaultFun ExtensionFun) ())
     (Either
        (CekEvaluationException
           Name DefaultUni (Either DefaultFun ExtensionFun))
        Text)
forall (uni :: * -> *) fun (m :: * -> *) a.
(MonadError (Error uni fun ()) m, Typecheckable uni fun, GEq uni,
 Everywhere uni ExMemoryUsage, PrettyUni uni, Pretty fun,
 ReadKnown (Term Name uni fun ()) a) =>
BuiltinSemanticsVariant fun
-> CostingPart uni fun
-> Term TyName Name uni fun ()
-> m (Either (CekEvaluationException Name uni fun) a)
typecheckReadKnownCek BuiltinSemanticsVariant (Either DefaultFun ExtensionFun)
forall a. Default a => a
def CostingPart DefaultUni (Either DefaultFun ExtensionFun)
defaultBuiltinCostModelExt (Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
 -> Either
      (Error DefaultUni (Either DefaultFun ExtensionFun) ())
      (Either
         (CekEvaluationException
            Name DefaultUni (Either DefaultFun ExtensionFun))
         Text))
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
-> Either
     (Error DefaultUni (Either DefaultFun ExtensionFun) ())
     (Either
        (CekEvaluationException
           Name DefaultUni (Either DefaultFun ExtensionFun))
        Text)
forall a b. (a -> b) -> a -> b
$
                    Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
runConst (Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
 -> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ())
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
forall a b. (a -> b) -> a -> b
$ forall fun fun' tyname name (uni :: * -> *) ann.
(fun -> fun')
-> Term tyname name uni fun ann -> Term tyname name uni fun' ann
mapFun @DefaultFun DefaultFun -> Either DefaultFun ExtensionFun
forall a b. a -> Either a b
Left Term TyName Name DefaultUni DefaultFun ()
forall (term :: * -> *) (uni :: * -> *) fun.
TermLike term TyName Name uni fun =>
term ()
Plc.const
        Either
  (Error DefaultUni (Either DefaultFun ExtensionFun) ())
  (Either
     (CekEvaluationException
        Name DefaultUni (Either DefaultFun ExtensionFun))
     Text)
lhs Either
  (Error DefaultUni (Either DefaultFun ExtensionFun) ())
  (Either
     (CekEvaluationException
        Name DefaultUni (Either DefaultFun ExtensionFun))
     Text)
-> Either
     (Error DefaultUni (Either DefaultFun ExtensionFun) ())
     (Either
        (CekEvaluationException
           Name DefaultUni (Either DefaultFun ExtensionFun))
        Text)
-> PropertyT IO ()
forall (m :: * -> *) a.
(MonadTest m, Eq a, Show a, HasCallStack) =>
a -> a -> m ()
=== Either
  (CekEvaluationException
     Name DefaultUni (Either DefaultFun ExtensionFun))
  Text
-> Either
     (Error DefaultUni (Either DefaultFun ExtensionFun) ())
     (Either
        (CekEvaluationException
           Name DefaultUni (Either DefaultFun ExtensionFun))
        Text)
forall a b. b -> Either a b
Right (Text
-> Either
     (CekEvaluationException
        Name DefaultUni (Either DefaultFun ExtensionFun))
     Text
forall a b. b -> Either a b
Right Text
c)
        Either
  (Error DefaultUni (Either DefaultFun ExtensionFun) ())
  (Either
     (CekEvaluationException
        Name DefaultUni (Either DefaultFun ExtensionFun))
     Text)
lhs Either
  (Error DefaultUni (Either DefaultFun ExtensionFun) ())
  (Either
     (CekEvaluationException
        Name DefaultUni (Either DefaultFun ExtensionFun))
     Text)
-> Either
     (Error DefaultUni (Either DefaultFun ExtensionFun) ())
     (Either
        (CekEvaluationException
           Name DefaultUni (Either DefaultFun ExtensionFun))
        Text)
-> PropertyT IO ()
forall (m :: * -> *) a.
(MonadTest m, Eq a, Show a, HasCallStack) =>
a -> a -> m ()
=== Either
  (Error DefaultUni (Either DefaultFun ExtensionFun) ())
  (Either
     (CekEvaluationException
        Name DefaultUni (Either DefaultFun ExtensionFun))
     Text)
rhs

-- | Test that forcing a builtin accepting one type argument and no term arguments makes the
-- builtin compute properly.
test_ForallFortyTwo :: TestTree
test_ForallFortyTwo :: TestTree
test_ForallFortyTwo =
    String -> Assertion -> TestTree
testCase String
"ForallFortyTwo" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ do
        let term :: Term TyName Name DefaultUni ExtensionFun ()
term = ()
-> Term TyName Name DefaultUni ExtensionFun ()
-> Type TyName DefaultUni ()
-> Term TyName Name DefaultUni ExtensionFun ()
forall ann.
ann
-> Term TyName Name DefaultUni ExtensionFun ann
-> Type TyName DefaultUni ann
-> Term TyName Name DefaultUni ExtensionFun ann
forall (term :: * -> *) tyname name (uni :: * -> *) fun ann.
TermLike term tyname name uni fun =>
ann -> term ann -> Type tyname uni ann -> term ann
tyInst () (() -> ExtensionFun -> Term TyName Name DefaultUni ExtensionFun ()
forall ann.
ann -> ExtensionFun -> Term TyName Name DefaultUni ExtensionFun ann
forall (term :: * -> *) tyname name (uni :: * -> *) fun ann.
TermLike term tyname name uni fun =>
ann -> fun -> term ann
builtin () ExtensionFun
ForallFortyTwo) (Type TyName DefaultUni ()
 -> Term TyName Name DefaultUni ExtensionFun ())
-> Type TyName DefaultUni ()
-> Term TyName Name DefaultUni ExtensionFun ()
forall a b. (a -> b) -> a -> b
$ forall a (x :: a) (uni :: * -> *) ann tyname.
HasTypeLevel uni x =>
ann -> Type tyname uni ann
mkTyBuiltin @_ @() ()
            lhs :: Either
  (Error DefaultUni ExtensionFun ())
  (EvaluationResult (Term Name DefaultUni ExtensionFun ()))
lhs = BuiltinSemanticsVariant ExtensionFun
-> CostingPart DefaultUni ExtensionFun
-> Term TyName Name DefaultUni ExtensionFun ()
-> Either
     (Error DefaultUni ExtensionFun ())
     (EvaluationResult (Term Name DefaultUni ExtensionFun ()))
forall (uni :: * -> *) fun (m :: * -> *).
(MonadError (Error uni fun ()) m, Typecheckable uni fun, GEq uni,
 Everywhere uni ExMemoryUsage, PrettyUni uni, Pretty fun) =>
BuiltinSemanticsVariant fun
-> CostingPart uni fun
-> Term TyName Name uni fun ()
-> m (EvaluationResult (Term Name uni fun ()))
typecheckEvaluateCekNoEmit BuiltinSemanticsVariant ExtensionFun
forall a. Default a => a
def () Term TyName Name DefaultUni ExtensionFun ()
term
            rhs :: Either a (EvaluationResult (Term Name DefaultUni ExtensionFun ()))
rhs = EvaluationResult (Term Name DefaultUni ExtensionFun ())
-> Either
     a (EvaluationResult (Term Name DefaultUni ExtensionFun ()))
forall a b. b -> Either a b
Right (EvaluationResult (Term Name DefaultUni ExtensionFun ())
 -> Either
      a (EvaluationResult (Term Name DefaultUni ExtensionFun ())))
-> EvaluationResult (Term Name DefaultUni ExtensionFun ())
-> Either
     a (EvaluationResult (Term Name DefaultUni ExtensionFun ()))
forall a b. (a -> b) -> a -> b
$ Term Name DefaultUni ExtensionFun ()
-> EvaluationResult (Term Name DefaultUni ExtensionFun ())
forall a. a -> EvaluationResult a
EvaluationSuccess (Term Name DefaultUni ExtensionFun ()
 -> EvaluationResult (Term Name DefaultUni ExtensionFun ()))
-> Term Name DefaultUni ExtensionFun ()
-> EvaluationResult (Term Name DefaultUni ExtensionFun ())
forall a b. (a -> b) -> a -> b
$ forall a (uni :: * -> *) fun (term :: * -> *) tyname name ann.
(TermLike term tyname name uni fun, HasTermLevel uni a) =>
ann -> a -> term ann
mkConstant @Integer () Integer
42
        Either
  (Error DefaultUni ExtensionFun ())
  (EvaluationResult (Term Name DefaultUni ExtensionFun ()))
lhs Either
  (Error DefaultUni ExtensionFun ())
  (EvaluationResult (Term Name DefaultUni ExtensionFun ()))
-> Either
     (Error DefaultUni ExtensionFun ())
     (EvaluationResult (Term Name DefaultUni ExtensionFun ()))
-> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Either
  (Error DefaultUni ExtensionFun ())
  (EvaluationResult (Term Name DefaultUni ExtensionFun ()))
forall {a}.
Either a (EvaluationResult (Term Name DefaultUni ExtensionFun ()))
rhs

-- | Test that a polymorphic built-in function doesn't subvert the CEK machine.
-- See https://github.com/IntersectMBO/plutus/issues/1882
test_Id :: TestTree
test_Id :: TestTree
test_Id =
    String -> Assertion -> TestTree
testCase String
"Id" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ do
        let zer :: Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
zer = forall a (uni :: * -> *) fun (term :: * -> *) tyname name ann.
(TermLike term tyname name uni fun, HasTermLevel uni a) =>
ann -> a -> term ann
mkConstant @Integer @DefaultUni @DefaultFunExt () Integer
0
            oneT :: Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
oneT = forall a (uni :: * -> *) fun (term :: * -> *) tyname name ann.
(TermLike term tyname name uni fun, HasTermLevel uni a) =>
ann -> a -> term ann
mkConstant @Integer @DefaultUni () Integer
1
            oneU :: Term Name DefaultUni (Either DefaultFun ExtensionFun) ()
oneU = forall a (uni :: * -> *) fun (term :: * -> *) tyname name ann.
(TermLike term tyname name uni fun, HasTermLevel uni a) =>
ann -> a -> term ann
mkConstant @Integer @DefaultUni () Integer
1
            -- > id {integer -> integer} ((\(i : integer) (j : integer) -> i) 1) 0
            term :: Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
term =
                Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
-> [Term
      TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()]
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
forall (term :: * -> *) tyname name (uni :: * -> *) fun.
TermLike term tyname name uni fun =>
term () -> [term ()] -> term ()
mkIterAppNoAnn (()
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
-> Type TyName DefaultUni ()
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
forall ann.
ann
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ann
-> Type TyName DefaultUni ann
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ann
forall (term :: * -> *) tyname name (uni :: * -> *) fun ann.
TermLike term tyname name uni fun =>
ann -> term ann -> Type tyname uni ann -> term ann
tyInst () (()
-> Either DefaultFun ExtensionFun
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
forall ann.
ann
-> Either DefaultFun ExtensionFun
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ann
forall (term :: * -> *) tyname name (uni :: * -> *) fun ann.
TermLike term tyname name uni fun =>
ann -> fun -> term ann
builtin () (Either DefaultFun ExtensionFun
 -> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ())
-> Either DefaultFun ExtensionFun
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
forall a b. (a -> b) -> a -> b
$ ExtensionFun -> Either DefaultFun ExtensionFun
forall a b. b -> Either a b
Right ExtensionFun
Id) (()
-> Type TyName DefaultUni ()
-> Type TyName DefaultUni ()
-> Type TyName DefaultUni ()
forall tyname (uni :: * -> *) ann.
ann
-> Type tyname uni ann
-> Type tyname uni ann
-> Type tyname uni ann
TyFun () Type TyName DefaultUni ()
forall (uni :: * -> *) tyname.
HasTypeLevel uni Integer =>
Type tyname uni ()
integer Type TyName DefaultUni ()
forall (uni :: * -> *) tyname.
HasTypeLevel uni Integer =>
Type tyname uni ()
integer))
                    [ ()
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
forall ann.
ann
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ann
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ann
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ann
forall (term :: * -> *) tyname name (uni :: * -> *) fun ann.
TermLike term tyname name uni fun =>
ann -> term ann -> term ann -> term ann
apply () Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
forall {tyname} {fun}. Term tyname Name DefaultUni fun ()
constIntegerInteger Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
oneT
                    , Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
zer
                    ] where
                          constIntegerInteger :: Term tyname Name DefaultUni fun ()
constIntegerInteger = Quote (Term tyname Name DefaultUni fun ())
-> Term tyname Name DefaultUni fun ()
forall a. Quote a -> a
runQuote (Quote (Term tyname Name DefaultUni fun ())
 -> Term tyname Name DefaultUni fun ())
-> Quote (Term tyname Name DefaultUni fun ())
-> Term tyname Name DefaultUni fun ()
forall a b. (a -> b) -> a -> b
$ do
                              Name
i <- Text -> QuoteT Identity Name
forall (m :: * -> *). MonadQuote m => Text -> m Name
freshName Text
"i"
                              Name
j <- Text -> QuoteT Identity Name
forall (m :: * -> *). MonadQuote m => Text -> m Name
freshName Text
"j"
                              Term tyname Name DefaultUni fun ()
-> Quote (Term tyname Name DefaultUni fun ())
forall a. a -> QuoteT Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return
                                  (Term tyname Name DefaultUni fun ()
 -> Quote (Term tyname Name DefaultUni fun ()))
-> (Term tyname Name DefaultUni fun ()
    -> Term tyname Name DefaultUni fun ())
-> Term tyname Name DefaultUni fun ()
-> Quote (Term tyname Name DefaultUni fun ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ()
-> Name
-> Type tyname DefaultUni ()
-> Term tyname Name DefaultUni fun ()
-> Term tyname Name DefaultUni fun ()
forall tyname name (uni :: * -> *) fun ann.
ann
-> name
-> Type tyname uni ann
-> Term tyname name uni fun ann
-> Term tyname name uni fun ann
LamAbs () Name
i Type tyname DefaultUni ()
forall (uni :: * -> *) tyname.
HasTypeLevel uni Integer =>
Type tyname uni ()
integer
                                  (Term tyname Name DefaultUni fun ()
 -> Term tyname Name DefaultUni fun ())
-> (Term tyname Name DefaultUni fun ()
    -> Term tyname Name DefaultUni fun ())
-> Term tyname Name DefaultUni fun ()
-> Term tyname Name DefaultUni fun ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ()
-> Name
-> Type tyname DefaultUni ()
-> Term tyname Name DefaultUni fun ()
-> Term tyname Name DefaultUni fun ()
forall tyname name (uni :: * -> *) fun ann.
ann
-> name
-> Type tyname uni ann
-> Term tyname name uni fun ann
-> Term tyname name uni fun ann
LamAbs () Name
j Type tyname DefaultUni ()
forall (uni :: * -> *) tyname.
HasTypeLevel uni Integer =>
Type tyname uni ()
integer
                                  (Term tyname Name DefaultUni fun ()
 -> Quote (Term tyname Name DefaultUni fun ()))
-> Term tyname Name DefaultUni fun ()
-> Quote (Term tyname Name DefaultUni fun ())
forall a b. (a -> b) -> a -> b
$ () -> Name -> Term tyname Name DefaultUni fun ()
forall tyname name (uni :: * -> *) fun ann.
ann -> name -> Term tyname name uni fun ann
Var () Name
i
        BuiltinSemanticsVariant (Either DefaultFun ExtensionFun)
-> CostingPart DefaultUni (Either DefaultFun ExtensionFun)
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
-> Either
     (Error DefaultUni (Either DefaultFun ExtensionFun) ())
     (EvaluationResult
        (Term Name DefaultUni (Either DefaultFun ExtensionFun) ()))
forall (uni :: * -> *) fun (m :: * -> *).
(MonadError (Error uni fun ()) m, Typecheckable uni fun, GEq uni,
 Everywhere uni ExMemoryUsage, PrettyUni uni, Pretty fun) =>
BuiltinSemanticsVariant fun
-> CostingPart uni fun
-> Term TyName Name uni fun ()
-> m (EvaluationResult (Term Name uni fun ()))
typecheckEvaluateCekNoEmit BuiltinSemanticsVariant (Either DefaultFun ExtensionFun)
forall a. Default a => a
def CostingPart DefaultUni (Either DefaultFun ExtensionFun)
defaultBuiltinCostModelExt Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
term Either
  (Error DefaultUni (Either DefaultFun ExtensionFun) ())
  (EvaluationResult
     (Term Name DefaultUni (Either DefaultFun ExtensionFun) ()))
-> Either
     (Error DefaultUni (Either DefaultFun ExtensionFun) ())
     (EvaluationResult
        (Term Name DefaultUni (Either DefaultFun ExtensionFun) ()))
-> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?=
            EvaluationResult
  (Term Name DefaultUni (Either DefaultFun ExtensionFun) ())
-> Either
     (Error DefaultUni (Either DefaultFun ExtensionFun) ())
     (EvaluationResult
        (Term Name DefaultUni (Either DefaultFun ExtensionFun) ()))
forall a b. b -> Either a b
Right (Term Name DefaultUni (Either DefaultFun ExtensionFun) ()
-> EvaluationResult
     (Term Name DefaultUni (Either DefaultFun ExtensionFun) ())
forall a. a -> EvaluationResult a
EvaluationSuccess Term Name DefaultUni (Either DefaultFun ExtensionFun) ()
oneU)

-- | Test that a polymorphic built-in function can have a higher-kinded type variable in its
-- signature.
test_IdFInteger :: TestTree
test_IdFInteger :: TestTree
test_IdFInteger =
    String -> Assertion -> TestTree
testCase String
"IdFInteger" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ do
        let one :: Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
one = forall a (uni :: * -> *) fun (term :: * -> *) tyname name ann.
(TermLike term tyname name uni fun, HasTermLevel uni a) =>
ann -> a -> term ann
mkConstant @Integer @DefaultUni () Integer
1
            ten :: Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
ten = forall a (uni :: * -> *) fun (term :: * -> *) tyname name ann.
(TermLike term tyname name uni fun, HasTermLevel uni a) =>
ann -> a -> term ann
mkConstant @Integer @DefaultUni () Integer
10
            res :: Term Name DefaultUni (Either DefaultFun ExtensionFun) ()
res = forall a (uni :: * -> *) fun (term :: * -> *) tyname name ann.
(TermLike term tyname name uni fun, HasTermLevel uni a) =>
ann -> a -> term ann
mkConstant @Integer @DefaultUni () Integer
55
            -- > sum (idFInteger {list} (enumFromTo 1 10))
            term :: Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
term
                = ()
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
forall ann.
ann
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ann
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ann
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ann
forall (term :: * -> *) tyname name (uni :: * -> *) fun ann.
TermLike term tyname name uni fun =>
ann -> term ann -> term ann -> term ann
apply () ((DefaultFun -> Either DefaultFun ExtensionFun)
-> Term TyName Name DefaultUni DefaultFun ()
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
forall fun fun' tyname name (uni :: * -> *) ann.
(fun -> fun')
-> Term tyname name uni fun ann -> Term tyname name uni fun' ann
mapFun DefaultFun -> Either DefaultFun ExtensionFun
forall a b. a -> Either a b
Left Term TyName Name DefaultUni DefaultFun ()
forall (term :: * -> *) (uni :: * -> *).
(TermLike term TyName Name uni DefaultFun,
 HasTypeAndTermLevel uni Integer) =>
term ()
Scott.sum)
                (Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
 -> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ())
-> (Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
    -> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ())
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ()
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
forall ann.
ann
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ann
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ann
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ann
forall (term :: * -> *) tyname name (uni :: * -> *) fun ann.
TermLike term tyname name uni fun =>
ann -> term ann -> term ann -> term ann
apply () (()
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
-> Type TyName DefaultUni ()
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
forall ann.
ann
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ann
-> Type TyName DefaultUni ann
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ann
forall (term :: * -> *) tyname name (uni :: * -> *) fun ann.
TermLike term tyname name uni fun =>
ann -> term ann -> Type tyname uni ann -> term ann
tyInst () (()
-> Either DefaultFun ExtensionFun
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
forall ann.
ann
-> Either DefaultFun ExtensionFun
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ann
forall (term :: * -> *) tyname name (uni :: * -> *) fun ann.
TermLike term tyname name uni fun =>
ann -> fun -> term ann
builtin () (Either DefaultFun ExtensionFun
 -> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ())
-> Either DefaultFun ExtensionFun
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
forall a b. (a -> b) -> a -> b
$ ExtensionFun -> Either DefaultFun ExtensionFun
forall a b. b -> Either a b
Right ExtensionFun
IdFInteger) Type TyName DefaultUni ()
forall (uni :: * -> *). Type TyName uni ()
Scott.listTy)
                (Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
 -> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ())
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
forall a b. (a -> b) -> a -> b
$ Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
-> [Term
      TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()]
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
forall (term :: * -> *) tyname name (uni :: * -> *) fun.
TermLike term tyname name uni fun =>
term () -> [term ()] -> term ()
mkIterAppNoAnn ((DefaultFun -> Either DefaultFun ExtensionFun)
-> Term TyName Name DefaultUni DefaultFun ()
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
forall fun fun' tyname name (uni :: * -> *) ann.
(fun -> fun')
-> Term tyname name uni fun ann -> Term tyname name uni fun' ann
mapFun DefaultFun -> Either DefaultFun ExtensionFun
forall a b. a -> Either a b
Left Term TyName Name DefaultUni DefaultFun ()
forall (term :: * -> *) (uni :: * -> *).
(TermLike term TyName Name uni DefaultFun,
 HasTypeAndTermLevel uni Integer, HasTypeAndTermLevel uni (),
 HasTypeAndTermLevel uni Bool) =>
term ()
Scott.enumFromTo) [Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
one, Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
ten]
        BuiltinSemanticsVariant (Either DefaultFun ExtensionFun)
-> CostingPart DefaultUni (Either DefaultFun ExtensionFun)
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
-> Either
     (Error DefaultUni (Either DefaultFun ExtensionFun) ())
     (EvaluationResult
        (Term Name DefaultUni (Either DefaultFun ExtensionFun) ()))
forall (uni :: * -> *) fun (m :: * -> *).
(MonadError (Error uni fun ()) m, Typecheckable uni fun, GEq uni,
 Everywhere uni ExMemoryUsage, PrettyUni uni, Pretty fun) =>
BuiltinSemanticsVariant fun
-> CostingPart uni fun
-> Term TyName Name uni fun ()
-> m (EvaluationResult (Term Name uni fun ()))
typecheckEvaluateCekNoEmit BuiltinSemanticsVariant (Either DefaultFun ExtensionFun)
forall a. Default a => a
def CostingPart DefaultUni (Either DefaultFun ExtensionFun)
defaultBuiltinCostModelExt Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
term Either
  (Error DefaultUni (Either DefaultFun ExtensionFun) ())
  (EvaluationResult
     (Term Name DefaultUni (Either DefaultFun ExtensionFun) ()))
-> Either
     (Error DefaultUni (Either DefaultFun ExtensionFun) ())
     (EvaluationResult
        (Term Name DefaultUni (Either DefaultFun ExtensionFun) ()))
-> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?=
            EvaluationResult
  (Term Name DefaultUni (Either DefaultFun ExtensionFun) ())
-> Either
     (Error DefaultUni (Either DefaultFun ExtensionFun) ())
     (EvaluationResult
        (Term Name DefaultUni (Either DefaultFun ExtensionFun) ()))
forall a b. b -> Either a b
Right (Term Name DefaultUni (Either DefaultFun ExtensionFun) ()
-> EvaluationResult
     (Term Name DefaultUni (Either DefaultFun ExtensionFun) ())
forall a. a -> EvaluationResult a
EvaluationSuccess Term Name DefaultUni (Either DefaultFun ExtensionFun) ()
res)

test_IdList :: TestTree
test_IdList :: TestTree
test_IdList =
    String -> Assertion -> TestTree
testCase String
"IdList" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ do
        let tyAct :: Type TyName DefaultUni ()
tyAct = forall (uni :: * -> *) fun.
ToBuiltinMeaning uni fun =>
BuiltinSemanticsVariant fun -> fun -> Type TyName uni ()
typeOfBuiltinFunction @DefaultUni BuiltinSemanticsVariant ExtensionFun
forall a. Default a => a
def ExtensionFun
IdList
            tyExp :: Type TyName uni ()
tyExp = let a :: TyName
a = Name -> TyName
TyName (Name -> TyName) -> (Unique -> Name) -> Unique -> TyName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Unique -> Name
Name Text
"a" (Unique -> TyName) -> Unique -> TyName
forall a b. (a -> b) -> a -> b
$ Int -> Unique
Unique Int
0
                        listA :: Type TyName uni ()
listA = ()
-> Type TyName uni () -> Type TyName uni () -> Type TyName uni ()
forall tyname (uni :: * -> *) ann.
ann
-> Type tyname uni ann
-> Type tyname uni ann
-> Type tyname uni ann
TyApp () Type TyName uni ()
forall (uni :: * -> *). Type TyName uni ()
Scott.listTy (() -> TyName -> Type TyName uni ()
forall tyname (uni :: * -> *) ann.
ann -> tyname -> Type tyname uni ann
TyVar () TyName
a)
                    in () -> TyName -> Kind () -> Type TyName uni () -> Type TyName uni ()
forall tyname (uni :: * -> *) ann.
ann
-> tyname -> Kind ann -> Type tyname uni ann -> Type tyname uni ann
TyForall () TyName
a (() -> Kind ()
forall ann. ann -> Kind ann
Type ()) (Type TyName uni () -> Type TyName uni ())
-> Type TyName uni () -> Type TyName uni ()
forall a b. (a -> b) -> a -> b
$ ()
-> Type TyName uni () -> Type TyName uni () -> Type TyName uni ()
forall tyname (uni :: * -> *) ann.
ann
-> Type tyname uni ann
-> Type tyname uni ann
-> Type tyname uni ann
TyFun () Type TyName uni ()
forall (uni :: * -> *). Type TyName uni ()
listA Type TyName uni ()
forall (uni :: * -> *). Type TyName uni ()
listA
            one :: Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
one = forall a (uni :: * -> *) fun (term :: * -> *) tyname name ann.
(TermLike term tyname name uni fun, HasTermLevel uni a) =>
ann -> a -> term ann
mkConstant @Integer @DefaultUni () Integer
1
            ten :: Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
ten = forall a (uni :: * -> *) fun (term :: * -> *) tyname name ann.
(TermLike term tyname name uni fun, HasTermLevel uni a) =>
ann -> a -> term ann
mkConstant @Integer @DefaultUni () Integer
10
            res :: Term Name DefaultUni (Either DefaultFun ExtensionFun) ()
res = forall a (uni :: * -> *) fun (term :: * -> *) tyname name ann.
(TermLike term tyname name uni fun, HasTermLevel uni a) =>
ann -> a -> term ann
mkConstant @Integer @DefaultUni () Integer
55
            -- > sum (idList {integer} (enumFromTo 1 10))
            term :: Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
term
                = ()
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
forall ann.
ann
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ann
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ann
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ann
forall (term :: * -> *) tyname name (uni :: * -> *) fun ann.
TermLike term tyname name uni fun =>
ann -> term ann -> term ann -> term ann
apply () ((DefaultFun -> Either DefaultFun ExtensionFun)
-> Term TyName Name DefaultUni DefaultFun ()
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
forall fun fun' tyname name (uni :: * -> *) ann.
(fun -> fun')
-> Term tyname name uni fun ann -> Term tyname name uni fun' ann
mapFun DefaultFun -> Either DefaultFun ExtensionFun
forall a b. a -> Either a b
Left Term TyName Name DefaultUni DefaultFun ()
forall (term :: * -> *) (uni :: * -> *).
(TermLike term TyName Name uni DefaultFun,
 HasTypeAndTermLevel uni Integer) =>
term ()
Scott.sum)
                (Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
 -> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ())
-> (Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
    -> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ())
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ()
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
forall ann.
ann
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ann
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ann
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ann
forall (term :: * -> *) tyname name (uni :: * -> *) fun ann.
TermLike term tyname name uni fun =>
ann -> term ann -> term ann -> term ann
apply () (()
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
-> Type TyName DefaultUni ()
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
forall ann.
ann
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ann
-> Type TyName DefaultUni ann
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ann
forall (term :: * -> *) tyname name (uni :: * -> *) fun ann.
TermLike term tyname name uni fun =>
ann -> term ann -> Type tyname uni ann -> term ann
tyInst () (()
-> Either DefaultFun ExtensionFun
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
forall ann.
ann
-> Either DefaultFun ExtensionFun
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ann
forall (term :: * -> *) tyname name (uni :: * -> *) fun ann.
TermLike term tyname name uni fun =>
ann -> fun -> term ann
builtin () (Either DefaultFun ExtensionFun
 -> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ())
-> Either DefaultFun ExtensionFun
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
forall a b. (a -> b) -> a -> b
$ ExtensionFun -> Either DefaultFun ExtensionFun
forall a b. b -> Either a b
Right ExtensionFun
IdList) Type TyName DefaultUni ()
forall (uni :: * -> *) tyname.
HasTypeLevel uni Integer =>
Type tyname uni ()
integer)
                (Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
 -> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ())
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
forall a b. (a -> b) -> a -> b
$ Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
-> [Term
      TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()]
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
forall (term :: * -> *) tyname name (uni :: * -> *) fun.
TermLike term tyname name uni fun =>
term () -> [term ()] -> term ()
mkIterAppNoAnn ((DefaultFun -> Either DefaultFun ExtensionFun)
-> Term TyName Name DefaultUni DefaultFun ()
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
forall fun fun' tyname name (uni :: * -> *) ann.
(fun -> fun')
-> Term tyname name uni fun ann -> Term tyname name uni fun' ann
mapFun DefaultFun -> Either DefaultFun ExtensionFun
forall a b. a -> Either a b
Left Term TyName Name DefaultUni DefaultFun ()
forall (term :: * -> *) (uni :: * -> *).
(TermLike term TyName Name uni DefaultFun,
 HasTypeAndTermLevel uni Integer, HasTypeAndTermLevel uni (),
 HasTypeAndTermLevel uni Bool) =>
term ()
Scott.enumFromTo) [Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
one, Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
ten]
        Type TyName DefaultUni ()
tyAct Type TyName DefaultUni () -> Type TyName DefaultUni () -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Type TyName DefaultUni ()
forall (uni :: * -> *). Type TyName uni ()
tyExp
        BuiltinSemanticsVariant (Either DefaultFun ExtensionFun)
-> CostingPart DefaultUni (Either DefaultFun ExtensionFun)
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
-> Either
     (Error DefaultUni (Either DefaultFun ExtensionFun) ())
     (EvaluationResult
        (Term Name DefaultUni (Either DefaultFun ExtensionFun) ()))
forall (uni :: * -> *) fun (m :: * -> *).
(MonadError (Error uni fun ()) m, Typecheckable uni fun, GEq uni,
 Everywhere uni ExMemoryUsage, PrettyUni uni, Pretty fun) =>
BuiltinSemanticsVariant fun
-> CostingPart uni fun
-> Term TyName Name uni fun ()
-> m (EvaluationResult (Term Name uni fun ()))
typecheckEvaluateCekNoEmit BuiltinSemanticsVariant (Either DefaultFun ExtensionFun)
forall a. Default a => a
def CostingPart DefaultUni (Either DefaultFun ExtensionFun)
defaultBuiltinCostModelExt Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
term Either
  (Error DefaultUni (Either DefaultFun ExtensionFun) ())
  (EvaluationResult
     (Term Name DefaultUni (Either DefaultFun ExtensionFun) ()))
-> Either
     (Error DefaultUni (Either DefaultFun ExtensionFun) ())
     (EvaluationResult
        (Term Name DefaultUni (Either DefaultFun ExtensionFun) ()))
-> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?=
            EvaluationResult
  (Term Name DefaultUni (Either DefaultFun ExtensionFun) ())
-> Either
     (Error DefaultUni (Either DefaultFun ExtensionFun) ())
     (EvaluationResult
        (Term Name DefaultUni (Either DefaultFun ExtensionFun) ()))
forall a b. b -> Either a b
Right (Term Name DefaultUni (Either DefaultFun ExtensionFun) ()
-> EvaluationResult
     (Term Name DefaultUni (Either DefaultFun ExtensionFun) ())
forall a. a -> EvaluationResult a
EvaluationSuccess Term Name DefaultUni (Either DefaultFun ExtensionFun) ()
res)

{- Note [Higher-rank built-in functions]
We can't unlift a monomorphic function passed to a built-in function, let alone unlift a polymorphic
one, however we can define a built-in function that accepts an 'Opaque' term of a polymorphic type.
However, as is always the case with an 'Opaque' term, we can't inspect it or use it in any
non-opaque way, so a function of type

    all (f :: * -> *). (all (a :: *). f a) -> all (a :: *). f a

can be assigned the following meaning on the Haskell side:

    \x -> x

but we have no way of providing a meaning for a built-in function with the following signature:

    all (f :: * -> *). all (a :: *). (all (a :: *). f a) -> f a

That's because the meaning function would have to instantiate the @all (a :: *). f a@ argument
somehow to get an @f a@, but that is exactly "using a term in a non-opaque way".

Basically, since we are either generic over @term@ or, like in the example below, use 'CekValue',
there's is no sensible way of instantiating a passed polymorphic argument (or applying a passed
argument when it's a function, for another example).
-}

-- | Test that opaque terms with higher-rank types are allowed.
test_IdRank2 :: TestTree
test_IdRank2 :: TestTree
test_IdRank2 =
    String -> Assertion -> TestTree
testCase String
"IdRank2" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ do
        let res :: Term Name DefaultUni (Either DefaultFun ExtensionFun) ()
res = forall a (uni :: * -> *) fun (term :: * -> *) tyname name ann.
(TermLike term tyname name uni fun, HasTermLevel uni a) =>
ann -> a -> term ann
mkConstant @Integer @DefaultUni () Integer
0
            -- > sum (idRank2 {list} nil {integer})
            term :: Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
term
                = ()
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
forall ann.
ann
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ann
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ann
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ann
forall (term :: * -> *) tyname name (uni :: * -> *) fun ann.
TermLike term tyname name uni fun =>
ann -> term ann -> term ann -> term ann
apply () ((DefaultFun -> Either DefaultFun ExtensionFun)
-> Term TyName Name DefaultUni DefaultFun ()
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
forall fun fun' tyname name (uni :: * -> *) ann.
(fun -> fun')
-> Term tyname name uni fun ann -> Term tyname name uni fun' ann
mapFun DefaultFun -> Either DefaultFun ExtensionFun
forall a b. a -> Either a b
Left Term TyName Name DefaultUni DefaultFun ()
forall (term :: * -> *) (uni :: * -> *).
(TermLike term TyName Name uni DefaultFun,
 HasTypeAndTermLevel uni Integer) =>
term ()
Scott.sum)
                (Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
 -> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ())
-> (Type TyName DefaultUni ()
    -> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ())
-> Type TyName DefaultUni ()
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ()
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
-> Type TyName DefaultUni ()
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
forall ann.
ann
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ann
-> Type TyName DefaultUni ann
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ann
forall (term :: * -> *) tyname name (uni :: * -> *) fun ann.
TermLike term tyname name uni fun =>
ann -> term ann -> Type tyname uni ann -> term ann
tyInst () (()
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
forall ann.
ann
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ann
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ann
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ann
forall (term :: * -> *) tyname name (uni :: * -> *) fun ann.
TermLike term tyname name uni fun =>
ann -> term ann -> term ann -> term ann
apply () (()
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
-> Type TyName DefaultUni ()
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
forall ann.
ann
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ann
-> Type TyName DefaultUni ann
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ann
forall (term :: * -> *) tyname name (uni :: * -> *) fun ann.
TermLike term tyname name uni fun =>
ann -> term ann -> Type tyname uni ann -> term ann
tyInst () (()
-> Either DefaultFun ExtensionFun
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
forall ann.
ann
-> Either DefaultFun ExtensionFun
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ann
forall (term :: * -> *) tyname name (uni :: * -> *) fun ann.
TermLike term tyname name uni fun =>
ann -> fun -> term ann
builtin () (Either DefaultFun ExtensionFun
 -> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ())
-> Either DefaultFun ExtensionFun
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
forall a b. (a -> b) -> a -> b
$ ExtensionFun -> Either DefaultFun ExtensionFun
forall a b. b -> Either a b
Right ExtensionFun
IdRank2) Type TyName DefaultUni ()
forall (uni :: * -> *). Type TyName uni ()
Scott.listTy) Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
forall (term :: * -> *) (uni :: * -> *) fun.
TermLike term TyName Name uni fun =>
term ()
Scott.nil)
                (Type TyName DefaultUni ()
 -> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ())
-> Type TyName DefaultUni ()
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
forall a b. (a -> b) -> a -> b
$ Type TyName DefaultUni ()
forall (uni :: * -> *) tyname.
HasTypeLevel uni Integer =>
Type tyname uni ()
integer
        BuiltinSemanticsVariant (Either DefaultFun ExtensionFun)
-> CostingPart DefaultUni (Either DefaultFun ExtensionFun)
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
-> Either
     (Error DefaultUni (Either DefaultFun ExtensionFun) ())
     (EvaluationResult
        (Term Name DefaultUni (Either DefaultFun ExtensionFun) ()))
forall (uni :: * -> *) fun (m :: * -> *).
(MonadError (Error uni fun ()) m, Typecheckable uni fun, GEq uni,
 Everywhere uni ExMemoryUsage, PrettyUni uni, Pretty fun) =>
BuiltinSemanticsVariant fun
-> CostingPart uni fun
-> Term TyName Name uni fun ()
-> m (EvaluationResult (Term Name uni fun ()))
typecheckEvaluateCekNoEmit BuiltinSemanticsVariant (Either DefaultFun ExtensionFun)
forall a. Default a => a
def CostingPart DefaultUni (Either DefaultFun ExtensionFun)
defaultBuiltinCostModelExt Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
term Either
  (Error DefaultUni (Either DefaultFun ExtensionFun) ())
  (EvaluationResult
     (Term Name DefaultUni (Either DefaultFun ExtensionFun) ()))
-> Either
     (Error DefaultUni (Either DefaultFun ExtensionFun) ())
     (EvaluationResult
        (Term Name DefaultUni (Either DefaultFun ExtensionFun) ()))
-> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?=
            EvaluationResult
  (Term Name DefaultUni (Either DefaultFun ExtensionFun) ())
-> Either
     (Error DefaultUni (Either DefaultFun ExtensionFun) ())
     (EvaluationResult
        (Term Name DefaultUni (Either DefaultFun ExtensionFun) ()))
forall a b. b -> Either a b
Right (Term Name DefaultUni (Either DefaultFun ExtensionFun) ()
-> EvaluationResult
     (Term Name DefaultUni (Either DefaultFun ExtensionFun) ())
forall a. a -> EvaluationResult a
EvaluationSuccess Term Name DefaultUni (Either DefaultFun ExtensionFun) ()
res)

-- | Test that a builtin can be applied to a non-constant term.
test_ScottToMetaUnit :: TestTree
test_ScottToMetaUnit :: TestTree
test_ScottToMetaUnit =
    String -> Assertion -> TestTree
testCase String
"ScottToMetaUnit" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ do
        let res :: EvaluationResult (Term Name DefaultUni ExtensionFun ())
res = Term Name DefaultUni ExtensionFun ()
-> EvaluationResult (Term Name DefaultUni ExtensionFun ())
forall a. a -> EvaluationResult a
EvaluationSuccess (Term Name DefaultUni ExtensionFun ()
 -> EvaluationResult (Term Name DefaultUni ExtensionFun ()))
-> Term Name DefaultUni ExtensionFun ()
-> EvaluationResult (Term Name DefaultUni ExtensionFun ())
forall a b. (a -> b) -> a -> b
$ forall a (uni :: * -> *) fun (term :: * -> *) tyname name ann.
(TermLike term tyname name uni fun, HasTermLevel uni a) =>
ann -> a -> term ann
mkConstant @() @DefaultUni () ()
            applyTerm :: Term TyName Name DefaultUni ExtensionFun ()
-> Term TyName Name DefaultUni ExtensionFun ()
applyTerm = ()
-> Term TyName Name DefaultUni ExtensionFun ()
-> Term TyName Name DefaultUni ExtensionFun ()
-> Term TyName Name DefaultUni ExtensionFun ()
forall ann.
ann
-> Term TyName Name DefaultUni ExtensionFun ann
-> Term TyName Name DefaultUni ExtensionFun ann
-> Term TyName Name DefaultUni ExtensionFun ann
forall (term :: * -> *) tyname name (uni :: * -> *) fun ann.
TermLike term tyname name uni fun =>
ann -> term ann -> term ann -> term ann
apply () (() -> ExtensionFun -> Term TyName Name DefaultUni ExtensionFun ()
forall ann.
ann -> ExtensionFun -> Term TyName Name DefaultUni ExtensionFun ann
forall (term :: * -> *) tyname name (uni :: * -> *) fun ann.
TermLike term tyname name uni fun =>
ann -> fun -> term ann
builtin () ExtensionFun
ScottToMetaUnit)
        -- @scottToMetaUnit Scott.unitval@ is well-typed and runs successfully.
        BuiltinSemanticsVariant ExtensionFun
-> CostingPart DefaultUni ExtensionFun
-> Term TyName Name DefaultUni ExtensionFun ()
-> Either
     (Error DefaultUni ExtensionFun ())
     (EvaluationResult (Term Name DefaultUni ExtensionFun ()))
forall (uni :: * -> *) fun (m :: * -> *).
(MonadError (Error uni fun ()) m, Typecheckable uni fun, GEq uni,
 Everywhere uni ExMemoryUsage, PrettyUni uni, Pretty fun) =>
BuiltinSemanticsVariant fun
-> CostingPart uni fun
-> Term TyName Name uni fun ()
-> m (EvaluationResult (Term Name uni fun ()))
typecheckEvaluateCekNoEmit BuiltinSemanticsVariant ExtensionFun
forall a. Default a => a
def () (Term TyName Name DefaultUni ExtensionFun ()
-> Term TyName Name DefaultUni ExtensionFun ()
applyTerm Term TyName Name DefaultUni ExtensionFun ()
forall (term :: * -> *) (uni :: * -> *) fun.
TermLike term TyName Name uni fun =>
term ()
Scott.unitval) Either
  (Error DefaultUni ExtensionFun ())
  (EvaluationResult (Term Name DefaultUni ExtensionFun ()))
-> Either
     (Error DefaultUni ExtensionFun ())
     (EvaluationResult (Term Name DefaultUni ExtensionFun ()))
-> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= EvaluationResult (Term Name DefaultUni ExtensionFun ())
-> Either
     (Error DefaultUni ExtensionFun ())
     (EvaluationResult (Term Name DefaultUni ExtensionFun ()))
forall a b. b -> Either a b
Right EvaluationResult (Term Name DefaultUni ExtensionFun ())
res
        let runtime :: MachineParameters
  CekMachineCosts ExtensionFun (CekValue DefaultUni ExtensionFun ())
runtime = BuiltinSemanticsVariant ExtensionFun
-> CostModel CekMachineCosts ()
-> MachineParameters
     CekMachineCosts ExtensionFun (CekValue DefaultUni ExtensionFun ())
forall (uni :: * -> *) fun builtincosts val machinecosts.
(CostingPart uni fun ~ builtincosts, HasMeaningIn uni val,
 ToBuiltinMeaning uni fun) =>
BuiltinSemanticsVariant fun
-> CostModel machinecosts builtincosts
-> MachineParameters machinecosts fun val
mkMachineParameters BuiltinSemanticsVariant ExtensionFun
forall a. Default a => a
def (CostModel CekMachineCosts ()
 -> MachineParameters
      CekMachineCosts ExtensionFun (CekValue DefaultUni ExtensionFun ()))
-> CostModel CekMachineCosts ()
-> MachineParameters
     CekMachineCosts ExtensionFun (CekValue DefaultUni ExtensionFun ())
forall a b. (a -> b) -> a -> b
$ CekMachineCosts -> () -> CostModel CekMachineCosts ()
forall machinecosts builtincosts.
machinecosts -> builtincosts -> CostModel machinecosts builtincosts
CostModel CekMachineCosts
defaultCekMachineCostsForTesting ()
        -- @scottToMetaUnit Scott.map@ is ill-typed, but still runs successfully, since the builtin
        -- doesn't look at the argument.
        Either
  (CekEvaluationException Name DefaultUni ExtensionFun)
  (Term Name DefaultUni ExtensionFun ())
-> EvaluationResult (Term Name DefaultUni ExtensionFun ())
forall structural term operational a.
(PrettyPlc structural, PrettyPlc term, Typeable structural,
 Typeable term) =>
Either (EvaluationException structural operational term) a
-> EvaluationResult a
unsafeSplitStructuralOperational (MachineParameters
  CekMachineCosts ExtensionFun (CekValue DefaultUni ExtensionFun ())
-> Term Name DefaultUni ExtensionFun ()
-> Either
     (CekEvaluationException Name DefaultUni ExtensionFun)
     (Term Name DefaultUni ExtensionFun ())
forall (uni :: * -> *) fun ann.
ThrowableBuiltins uni fun =>
MachineParameters CekMachineCosts fun (CekValue uni fun ann)
-> Term Name uni fun ann
-> Either
     (CekEvaluationException Name uni fun) (Term Name uni fun ())
evaluateCekNoEmit MachineParameters
  CekMachineCosts ExtensionFun (CekValue DefaultUni ExtensionFun ())
runtime (Term TyName Name DefaultUni ExtensionFun ()
-> Term Name DefaultUni ExtensionFun ()
forall name tyname (uni :: * -> *) fun ann.
HasUnique name TermUnique =>
Term tyname name uni fun ann -> Term name uni fun ann
eraseTerm (Term TyName Name DefaultUni ExtensionFun ()
 -> Term Name DefaultUni ExtensionFun ())
-> Term TyName Name DefaultUni ExtensionFun ()
-> Term Name DefaultUni ExtensionFun ()
forall a b. (a -> b) -> a -> b
$ Term TyName Name DefaultUni ExtensionFun ()
-> Term TyName Name DefaultUni ExtensionFun ()
applyTerm Term TyName Name DefaultUni ExtensionFun ()
forall (term :: * -> *) (uni :: * -> *) fun.
TermLike term TyName Name uni fun =>
term ()
Scott.map)) EvaluationResult (Term Name DefaultUni ExtensionFun ())
-> EvaluationResult (Term Name DefaultUni ExtensionFun ())
-> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?=
            EvaluationResult (Term Name DefaultUni ExtensionFun ())
res

-- | Test that an exception thrown in the builtin application code does not get caught in the CEK
-- machine and blows in the caller face instead. Uses a one-argument built-in function.
test_FailingSucc :: TestTree
test_FailingSucc :: TestTree
test_FailingSucc =
    String -> Assertion -> TestTree
testCase String
"FailingSucc" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ do
        let term :: Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
term =
                ()
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
forall ann.
ann
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ann
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ann
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ann
forall (term :: * -> *) tyname name (uni :: * -> *) fun ann.
TermLike term tyname name uni fun =>
ann -> term ann -> term ann -> term ann
apply () (()
-> Either DefaultFun ExtensionFun
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
forall ann.
ann
-> Either DefaultFun ExtensionFun
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ann
forall (term :: * -> *) tyname name (uni :: * -> *) fun ann.
TermLike term tyname name uni fun =>
ann -> fun -> term ann
builtin () (Either DefaultFun ExtensionFun
 -> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ())
-> Either DefaultFun ExtensionFun
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
forall a b. (a -> b) -> a -> b
$ ExtensionFun -> Either DefaultFun ExtensionFun
forall a b. b -> Either a b
Right ExtensionFun
FailingSucc) (Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
 -> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ())
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
forall a b. (a -> b) -> a -> b
$
                    forall a (uni :: * -> *) fun (term :: * -> *) tyname name ann.
(TermLike term tyname name uni fun, HasTermLevel uni a) =>
ann -> a -> term ann
mkConstant @Integer @DefaultUni @DefaultFunExt () Integer
0
        Either
  (Error DefaultUni (Either DefaultFun ExtensionFun) ())
  (Either
     BuiltinErrorCall
     (EvaluationResult
        (Term Name DefaultUni (Either DefaultFun ExtensionFun) ())))
typeErrOrEvalExcOrRes :: Either _ (Either BuiltinErrorCall _) <-
            -- Here we rely on 'typecheckAnd' lazily running the action after type checking the
            -- term.
            (EvaluationResult
   (Term Name DefaultUni (Either DefaultFun ExtensionFun) ())
 -> IO
      (Either
         BuiltinErrorCall
         (EvaluationResult
            (Term Name DefaultUni (Either DefaultFun ExtensionFun) ()))))
-> Either
     (Error DefaultUni (Either DefaultFun ExtensionFun) ())
     (EvaluationResult
        (Term Name DefaultUni (Either DefaultFun ExtensionFun) ()))
-> IO
     (Either
        (Error DefaultUni (Either DefaultFun ExtensionFun) ())
        (Either
           BuiltinErrorCall
           (EvaluationResult
              (Term Name DefaultUni (Either DefaultFun ExtensionFun) ()))))
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)
-> Either (Error DefaultUni (Either DefaultFun ExtensionFun) ()) a
-> f (Either
        (Error DefaultUni (Either DefaultFun ExtensionFun) ()) b)
traverse (IO
  (EvaluationResult
     (Term Name DefaultUni (Either DefaultFun ExtensionFun) ()))
-> IO
     (Either
        BuiltinErrorCall
        (EvaluationResult
           (Term Name DefaultUni (Either DefaultFun ExtensionFun) ())))
forall e a. Exception e => IO a -> IO (Either e a)
try (IO
   (EvaluationResult
      (Term Name DefaultUni (Either DefaultFun ExtensionFun) ()))
 -> IO
      (Either
         BuiltinErrorCall
         (EvaluationResult
            (Term Name DefaultUni (Either DefaultFun ExtensionFun) ()))))
-> (EvaluationResult
      (Term Name DefaultUni (Either DefaultFun ExtensionFun) ())
    -> IO
         (EvaluationResult
            (Term Name DefaultUni (Either DefaultFun ExtensionFun) ())))
-> EvaluationResult
     (Term Name DefaultUni (Either DefaultFun ExtensionFun) ())
-> IO
     (Either
        BuiltinErrorCall
        (EvaluationResult
           (Term Name DefaultUni (Either DefaultFun ExtensionFun) ())))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EvaluationResult
  (Term Name DefaultUni (Either DefaultFun ExtensionFun) ())
-> IO
     (EvaluationResult
        (Term Name DefaultUni (Either DefaultFun ExtensionFun) ()))
forall a. a -> IO a
evaluate) (Either
   (Error DefaultUni (Either DefaultFun ExtensionFun) ())
   (EvaluationResult
      (Term Name DefaultUni (Either DefaultFun ExtensionFun) ()))
 -> IO
      (Either
         (Error DefaultUni (Either DefaultFun ExtensionFun) ())
         (Either
            BuiltinErrorCall
            (EvaluationResult
               (Term Name DefaultUni (Either DefaultFun ExtensionFun) ())))))
-> Either
     (Error DefaultUni (Either DefaultFun ExtensionFun) ())
     (EvaluationResult
        (Term Name DefaultUni (Either DefaultFun ExtensionFun) ()))
-> IO
     (Either
        (Error DefaultUni (Either DefaultFun ExtensionFun) ())
        (Either
           BuiltinErrorCall
           (EvaluationResult
              (Term Name DefaultUni (Either DefaultFun ExtensionFun) ()))))
forall a b. (a -> b) -> a -> b
$
                BuiltinSemanticsVariant (Either DefaultFun ExtensionFun)
-> CostingPart DefaultUni (Either DefaultFun ExtensionFun)
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
-> Either
     (Error DefaultUni (Either DefaultFun ExtensionFun) ())
     (EvaluationResult
        (Term Name DefaultUni (Either DefaultFun ExtensionFun) ()))
forall (uni :: * -> *) fun (m :: * -> *).
(MonadError (Error uni fun ()) m, Typecheckable uni fun, GEq uni,
 Everywhere uni ExMemoryUsage, PrettyUni uni, Pretty fun) =>
BuiltinSemanticsVariant fun
-> CostingPart uni fun
-> Term TyName Name uni fun ()
-> m (EvaluationResult (Term Name uni fun ()))
typecheckEvaluateCekNoEmit BuiltinSemanticsVariant (Either DefaultFun ExtensionFun)
forall a. Default a => a
def CostingPart DefaultUni (Either DefaultFun ExtensionFun)
defaultBuiltinCostModelExt Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
term
        Either
  (Error DefaultUni (Either DefaultFun ExtensionFun) ())
  (Either
     BuiltinErrorCall
     (EvaluationResult
        (Term Name DefaultUni (Either DefaultFun ExtensionFun) ())))
typeErrOrEvalExcOrRes Either
  (Error DefaultUni (Either DefaultFun ExtensionFun) ())
  (Either
     BuiltinErrorCall
     (EvaluationResult
        (Term Name DefaultUni (Either DefaultFun ExtensionFun) ())))
-> Either
     (Error DefaultUni (Either DefaultFun ExtensionFun) ())
     (Either
        BuiltinErrorCall
        (EvaluationResult
           (Term Name DefaultUni (Either DefaultFun ExtensionFun) ())))
-> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Either
  BuiltinErrorCall
  (EvaluationResult
     (Term Name DefaultUni (Either DefaultFun ExtensionFun) ()))
-> Either
     (Error DefaultUni (Either DefaultFun ExtensionFun) ())
     (Either
        BuiltinErrorCall
        (EvaluationResult
           (Term Name DefaultUni (Either DefaultFun ExtensionFun) ())))
forall a b. b -> Either a b
Right (BuiltinErrorCall
-> Either
     BuiltinErrorCall
     (EvaluationResult
        (Term Name DefaultUni (Either DefaultFun ExtensionFun) ()))
forall a b. a -> Either a b
Left BuiltinErrorCall
BuiltinErrorCall)

-- | Test that evaluating a PLC builtin application that is expensive enough to exceed the budget
-- does not result in actual evaluation of the application on the Haskell side and instead we get an
-- 'EvaluationFailure'. Uses a one-argument built-in function.
test_ExpensiveSucc :: TestTree
test_ExpensiveSucc :: TestTree
test_ExpensiveSucc =
    String -> Assertion -> TestTree
testCase String
"ExpensiveSucc" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ do
        let term :: Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
term =
                ()
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
forall ann.
ann
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ann
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ann
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ann
forall (term :: * -> *) tyname name (uni :: * -> *) fun ann.
TermLike term tyname name uni fun =>
ann -> term ann -> term ann -> term ann
apply () (()
-> Either DefaultFun ExtensionFun
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
forall ann.
ann
-> Either DefaultFun ExtensionFun
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ann
forall (term :: * -> *) tyname name (uni :: * -> *) fun ann.
TermLike term tyname name uni fun =>
ann -> fun -> term ann
builtin () (Either DefaultFun ExtensionFun
 -> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ())
-> Either DefaultFun ExtensionFun
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
forall a b. (a -> b) -> a -> b
$ ExtensionFun -> Either DefaultFun ExtensionFun
forall a b. b -> Either a b
Right ExtensionFun
ExpensiveSucc) (Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
 -> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ())
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
forall a b. (a -> b) -> a -> b
$
                    forall a (uni :: * -> *) fun (term :: * -> *) tyname name ann.
(TermLike term tyname name uni fun, HasTermLevel uni a) =>
ann -> a -> term ann
mkConstant @Integer @DefaultUni @DefaultFunExt () Integer
0
        Either
  (Error DefaultUni (Either DefaultFun ExtensionFun) ())
  (Either
     BuiltinErrorCall
     (EvaluationResult
        (Term Name DefaultUni (Either DefaultFun ExtensionFun) ())))
typeErrOrEvalExcOrRes :: Either _ (Either BuiltinErrorCall _) <-
            (EvaluationResult
   (Term Name DefaultUni (Either DefaultFun ExtensionFun) ())
 -> IO
      (Either
         BuiltinErrorCall
         (EvaluationResult
            (Term Name DefaultUni (Either DefaultFun ExtensionFun) ()))))
-> Either
     (Error DefaultUni (Either DefaultFun ExtensionFun) ())
     (EvaluationResult
        (Term Name DefaultUni (Either DefaultFun ExtensionFun) ()))
-> IO
     (Either
        (Error DefaultUni (Either DefaultFun ExtensionFun) ())
        (Either
           BuiltinErrorCall
           (EvaluationResult
              (Term Name DefaultUni (Either DefaultFun ExtensionFun) ()))))
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)
-> Either (Error DefaultUni (Either DefaultFun ExtensionFun) ()) a
-> f (Either
        (Error DefaultUni (Either DefaultFun ExtensionFun) ()) b)
traverse (IO
  (EvaluationResult
     (Term Name DefaultUni (Either DefaultFun ExtensionFun) ()))
-> IO
     (Either
        BuiltinErrorCall
        (EvaluationResult
           (Term Name DefaultUni (Either DefaultFun ExtensionFun) ())))
forall e a. Exception e => IO a -> IO (Either e a)
try (IO
   (EvaluationResult
      (Term Name DefaultUni (Either DefaultFun ExtensionFun) ()))
 -> IO
      (Either
         BuiltinErrorCall
         (EvaluationResult
            (Term Name DefaultUni (Either DefaultFun ExtensionFun) ()))))
-> (EvaluationResult
      (Term Name DefaultUni (Either DefaultFun ExtensionFun) ())
    -> IO
         (EvaluationResult
            (Term Name DefaultUni (Either DefaultFun ExtensionFun) ())))
-> EvaluationResult
     (Term Name DefaultUni (Either DefaultFun ExtensionFun) ())
-> IO
     (Either
        BuiltinErrorCall
        (EvaluationResult
           (Term Name DefaultUni (Either DefaultFun ExtensionFun) ())))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EvaluationResult
  (Term Name DefaultUni (Either DefaultFun ExtensionFun) ())
-> IO
     (EvaluationResult
        (Term Name DefaultUni (Either DefaultFun ExtensionFun) ()))
forall a. a -> IO a
evaluate) (Either
   (Error DefaultUni (Either DefaultFun ExtensionFun) ())
   (EvaluationResult
      (Term Name DefaultUni (Either DefaultFun ExtensionFun) ()))
 -> IO
      (Either
         (Error DefaultUni (Either DefaultFun ExtensionFun) ())
         (Either
            BuiltinErrorCall
            (EvaluationResult
               (Term Name DefaultUni (Either DefaultFun ExtensionFun) ())))))
-> Either
     (Error DefaultUni (Either DefaultFun ExtensionFun) ())
     (EvaluationResult
        (Term Name DefaultUni (Either DefaultFun ExtensionFun) ()))
-> IO
     (Either
        (Error DefaultUni (Either DefaultFun ExtensionFun) ())
        (Either
           BuiltinErrorCall
           (EvaluationResult
              (Term Name DefaultUni (Either DefaultFun ExtensionFun) ()))))
forall a b. (a -> b) -> a -> b
$
                BuiltinSemanticsVariant (Either DefaultFun ExtensionFun)
-> CostingPart DefaultUni (Either DefaultFun ExtensionFun)
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
-> Either
     (Error DefaultUni (Either DefaultFun ExtensionFun) ())
     (EvaluationResult
        (Term Name DefaultUni (Either DefaultFun ExtensionFun) ()))
forall (uni :: * -> *) fun (m :: * -> *).
(MonadError (Error uni fun ()) m, Typecheckable uni fun, GEq uni,
 Everywhere uni ExMemoryUsage, PrettyUni uni, Pretty fun) =>
BuiltinSemanticsVariant fun
-> CostingPart uni fun
-> Term TyName Name uni fun ()
-> m (EvaluationResult (Term Name uni fun ()))
typecheckEvaluateCekNoEmit BuiltinSemanticsVariant (Either DefaultFun ExtensionFun)
forall a. Default a => a
def CostingPart DefaultUni (Either DefaultFun ExtensionFun)
defaultBuiltinCostModelExt Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
term
        Either
  (Error DefaultUni (Either DefaultFun ExtensionFun) ())
  (Either
     BuiltinErrorCall
     (EvaluationResult
        (Term Name DefaultUni (Either DefaultFun ExtensionFun) ())))
typeErrOrEvalExcOrRes Either
  (Error DefaultUni (Either DefaultFun ExtensionFun) ())
  (Either
     BuiltinErrorCall
     (EvaluationResult
        (Term Name DefaultUni (Either DefaultFun ExtensionFun) ())))
-> Either
     (Error DefaultUni (Either DefaultFun ExtensionFun) ())
     (Either
        BuiltinErrorCall
        (EvaluationResult
           (Term Name DefaultUni (Either DefaultFun ExtensionFun) ())))
-> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Either
  BuiltinErrorCall
  (EvaluationResult
     (Term Name DefaultUni (Either DefaultFun ExtensionFun) ()))
-> Either
     (Error DefaultUni (Either DefaultFun ExtensionFun) ())
     (Either
        BuiltinErrorCall
        (EvaluationResult
           (Term Name DefaultUni (Either DefaultFun ExtensionFun) ())))
forall a b. b -> Either a b
Right (EvaluationResult
  (Term Name DefaultUni (Either DefaultFun ExtensionFun) ())
-> Either
     BuiltinErrorCall
     (EvaluationResult
        (Term Name DefaultUni (Either DefaultFun ExtensionFun) ()))
forall a b. b -> Either a b
Right EvaluationResult
  (Term Name DefaultUni (Either DefaultFun ExtensionFun) ())
forall a. EvaluationResult a
EvaluationFailure)

-- | Test that an exception thrown in the builtin application code does not get caught in the CEK
-- machine and blows in the caller face instead. Uses a two-arguments built-in function.
test_FailingPlus :: TestTree
test_FailingPlus :: TestTree
test_FailingPlus =
    String -> Assertion -> TestTree
testCase String
"FailingPlus" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ do
        let term :: Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
term =
                Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
-> [Term
      TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()]
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
forall (term :: * -> *) tyname name (uni :: * -> *) fun.
TermLike term tyname name uni fun =>
term () -> [term ()] -> term ()
mkIterAppNoAnn (()
-> Either DefaultFun ExtensionFun
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
forall ann.
ann
-> Either DefaultFun ExtensionFun
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ann
forall (term :: * -> *) tyname name (uni :: * -> *) fun ann.
TermLike term tyname name uni fun =>
ann -> fun -> term ann
builtin () (Either DefaultFun ExtensionFun
 -> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ())
-> Either DefaultFun ExtensionFun
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
forall a b. (a -> b) -> a -> b
$ ExtensionFun -> Either DefaultFun ExtensionFun
forall a b. b -> Either a b
Right ExtensionFun
FailingPlus)
                    [ forall a (uni :: * -> *) fun (term :: * -> *) tyname name ann.
(TermLike term tyname name uni fun, HasTermLevel uni a) =>
ann -> a -> term ann
mkConstant @Integer @DefaultUni @DefaultFunExt () Integer
0
                    , forall a (uni :: * -> *) fun (term :: * -> *) tyname name ann.
(TermLike term tyname name uni fun, HasTermLevel uni a) =>
ann -> a -> term ann
mkConstant @Integer @DefaultUni () Integer
1
                    ]
        Either
  (Error DefaultUni (Either DefaultFun ExtensionFun) ())
  (Either
     BuiltinErrorCall
     (EvaluationResult
        (Term Name DefaultUni (Either DefaultFun ExtensionFun) ())))
typeErrOrEvalExcOrRes :: Either _ (Either BuiltinErrorCall _) <-
            -- Here we rely on 'typecheckAnd' lazily running the action after type checking the
            -- term.
            (EvaluationResult
   (Term Name DefaultUni (Either DefaultFun ExtensionFun) ())
 -> IO
      (Either
         BuiltinErrorCall
         (EvaluationResult
            (Term Name DefaultUni (Either DefaultFun ExtensionFun) ()))))
-> Either
     (Error DefaultUni (Either DefaultFun ExtensionFun) ())
     (EvaluationResult
        (Term Name DefaultUni (Either DefaultFun ExtensionFun) ()))
-> IO
     (Either
        (Error DefaultUni (Either DefaultFun ExtensionFun) ())
        (Either
           BuiltinErrorCall
           (EvaluationResult
              (Term Name DefaultUni (Either DefaultFun ExtensionFun) ()))))
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)
-> Either (Error DefaultUni (Either DefaultFun ExtensionFun) ()) a
-> f (Either
        (Error DefaultUni (Either DefaultFun ExtensionFun) ()) b)
traverse (IO
  (EvaluationResult
     (Term Name DefaultUni (Either DefaultFun ExtensionFun) ()))
-> IO
     (Either
        BuiltinErrorCall
        (EvaluationResult
           (Term Name DefaultUni (Either DefaultFun ExtensionFun) ())))
forall e a. Exception e => IO a -> IO (Either e a)
try (IO
   (EvaluationResult
      (Term Name DefaultUni (Either DefaultFun ExtensionFun) ()))
 -> IO
      (Either
         BuiltinErrorCall
         (EvaluationResult
            (Term Name DefaultUni (Either DefaultFun ExtensionFun) ()))))
-> (EvaluationResult
      (Term Name DefaultUni (Either DefaultFun ExtensionFun) ())
    -> IO
         (EvaluationResult
            (Term Name DefaultUni (Either DefaultFun ExtensionFun) ())))
-> EvaluationResult
     (Term Name DefaultUni (Either DefaultFun ExtensionFun) ())
-> IO
     (Either
        BuiltinErrorCall
        (EvaluationResult
           (Term Name DefaultUni (Either DefaultFun ExtensionFun) ())))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EvaluationResult
  (Term Name DefaultUni (Either DefaultFun ExtensionFun) ())
-> IO
     (EvaluationResult
        (Term Name DefaultUni (Either DefaultFun ExtensionFun) ()))
forall a. a -> IO a
evaluate) (Either
   (Error DefaultUni (Either DefaultFun ExtensionFun) ())
   (EvaluationResult
      (Term Name DefaultUni (Either DefaultFun ExtensionFun) ()))
 -> IO
      (Either
         (Error DefaultUni (Either DefaultFun ExtensionFun) ())
         (Either
            BuiltinErrorCall
            (EvaluationResult
               (Term Name DefaultUni (Either DefaultFun ExtensionFun) ())))))
-> Either
     (Error DefaultUni (Either DefaultFun ExtensionFun) ())
     (EvaluationResult
        (Term Name DefaultUni (Either DefaultFun ExtensionFun) ()))
-> IO
     (Either
        (Error DefaultUni (Either DefaultFun ExtensionFun) ())
        (Either
           BuiltinErrorCall
           (EvaluationResult
              (Term Name DefaultUni (Either DefaultFun ExtensionFun) ()))))
forall a b. (a -> b) -> a -> b
$
                BuiltinSemanticsVariant (Either DefaultFun ExtensionFun)
-> CostingPart DefaultUni (Either DefaultFun ExtensionFun)
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
-> Either
     (Error DefaultUni (Either DefaultFun ExtensionFun) ())
     (EvaluationResult
        (Term Name DefaultUni (Either DefaultFun ExtensionFun) ()))
forall (uni :: * -> *) fun (m :: * -> *).
(MonadError (Error uni fun ()) m, Typecheckable uni fun, GEq uni,
 Everywhere uni ExMemoryUsage, PrettyUni uni, Pretty fun) =>
BuiltinSemanticsVariant fun
-> CostingPart uni fun
-> Term TyName Name uni fun ()
-> m (EvaluationResult (Term Name uni fun ()))
typecheckEvaluateCekNoEmit BuiltinSemanticsVariant (Either DefaultFun ExtensionFun)
forall a. Default a => a
def CostingPart DefaultUni (Either DefaultFun ExtensionFun)
defaultBuiltinCostModelExt Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
term
        Either
  (Error DefaultUni (Either DefaultFun ExtensionFun) ())
  (Either
     BuiltinErrorCall
     (EvaluationResult
        (Term Name DefaultUni (Either DefaultFun ExtensionFun) ())))
typeErrOrEvalExcOrRes Either
  (Error DefaultUni (Either DefaultFun ExtensionFun) ())
  (Either
     BuiltinErrorCall
     (EvaluationResult
        (Term Name DefaultUni (Either DefaultFun ExtensionFun) ())))
-> Either
     (Error DefaultUni (Either DefaultFun ExtensionFun) ())
     (Either
        BuiltinErrorCall
        (EvaluationResult
           (Term Name DefaultUni (Either DefaultFun ExtensionFun) ())))
-> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Either
  BuiltinErrorCall
  (EvaluationResult
     (Term Name DefaultUni (Either DefaultFun ExtensionFun) ()))
-> Either
     (Error DefaultUni (Either DefaultFun ExtensionFun) ())
     (Either
        BuiltinErrorCall
        (EvaluationResult
           (Term Name DefaultUni (Either DefaultFun ExtensionFun) ())))
forall a b. b -> Either a b
Right (BuiltinErrorCall
-> Either
     BuiltinErrorCall
     (EvaluationResult
        (Term Name DefaultUni (Either DefaultFun ExtensionFun) ()))
forall a b. a -> Either a b
Left BuiltinErrorCall
BuiltinErrorCall)

-- | Test that evaluating a PLC builtin application that is expensive enough to exceed the budget
-- does not result in actual evaluation of the application on the Haskell side and instead we get an
-- 'EvaluationFailure'. Uses a two-arguments built-in function.
test_ExpensivePlus :: TestTree
test_ExpensivePlus :: TestTree
test_ExpensivePlus =
    String -> Assertion -> TestTree
testCase String
"ExpensivePlus" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ do
        let term :: Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
term =
                Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
-> [Term
      TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()]
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
forall (term :: * -> *) tyname name (uni :: * -> *) fun.
TermLike term tyname name uni fun =>
term () -> [term ()] -> term ()
mkIterAppNoAnn (()
-> Either DefaultFun ExtensionFun
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
forall ann.
ann
-> Either DefaultFun ExtensionFun
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ann
forall (term :: * -> *) tyname name (uni :: * -> *) fun ann.
TermLike term tyname name uni fun =>
ann -> fun -> term ann
builtin () (Either DefaultFun ExtensionFun
 -> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ())
-> Either DefaultFun ExtensionFun
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
forall a b. (a -> b) -> a -> b
$ ExtensionFun -> Either DefaultFun ExtensionFun
forall a b. b -> Either a b
Right ExtensionFun
ExpensivePlus)
                    [ forall a (uni :: * -> *) fun (term :: * -> *) tyname name ann.
(TermLike term tyname name uni fun, HasTermLevel uni a) =>
ann -> a -> term ann
mkConstant @Integer @DefaultUni @DefaultFunExt () Integer
0
                    , forall a (uni :: * -> *) fun (term :: * -> *) tyname name ann.
(TermLike term tyname name uni fun, HasTermLevel uni a) =>
ann -> a -> term ann
mkConstant @Integer @DefaultUni () Integer
1
                    ]
        Either
  (Error DefaultUni (Either DefaultFun ExtensionFun) ())
  (Either
     BuiltinErrorCall
     (EvaluationResult
        (Term Name DefaultUni (Either DefaultFun ExtensionFun) ())))
typeErrOrEvalExcOrRes :: Either _ (Either BuiltinErrorCall _) <-
            (EvaluationResult
   (Term Name DefaultUni (Either DefaultFun ExtensionFun) ())
 -> IO
      (Either
         BuiltinErrorCall
         (EvaluationResult
            (Term Name DefaultUni (Either DefaultFun ExtensionFun) ()))))
-> Either
     (Error DefaultUni (Either DefaultFun ExtensionFun) ())
     (EvaluationResult
        (Term Name DefaultUni (Either DefaultFun ExtensionFun) ()))
-> IO
     (Either
        (Error DefaultUni (Either DefaultFun ExtensionFun) ())
        (Either
           BuiltinErrorCall
           (EvaluationResult
              (Term Name DefaultUni (Either DefaultFun ExtensionFun) ()))))
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)
-> Either (Error DefaultUni (Either DefaultFun ExtensionFun) ()) a
-> f (Either
        (Error DefaultUni (Either DefaultFun ExtensionFun) ()) b)
traverse (IO
  (EvaluationResult
     (Term Name DefaultUni (Either DefaultFun ExtensionFun) ()))
-> IO
     (Either
        BuiltinErrorCall
        (EvaluationResult
           (Term Name DefaultUni (Either DefaultFun ExtensionFun) ())))
forall e a. Exception e => IO a -> IO (Either e a)
try (IO
   (EvaluationResult
      (Term Name DefaultUni (Either DefaultFun ExtensionFun) ()))
 -> IO
      (Either
         BuiltinErrorCall
         (EvaluationResult
            (Term Name DefaultUni (Either DefaultFun ExtensionFun) ()))))
-> (EvaluationResult
      (Term Name DefaultUni (Either DefaultFun ExtensionFun) ())
    -> IO
         (EvaluationResult
            (Term Name DefaultUni (Either DefaultFun ExtensionFun) ())))
-> EvaluationResult
     (Term Name DefaultUni (Either DefaultFun ExtensionFun) ())
-> IO
     (Either
        BuiltinErrorCall
        (EvaluationResult
           (Term Name DefaultUni (Either DefaultFun ExtensionFun) ())))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EvaluationResult
  (Term Name DefaultUni (Either DefaultFun ExtensionFun) ())
-> IO
     (EvaluationResult
        (Term Name DefaultUni (Either DefaultFun ExtensionFun) ()))
forall a. a -> IO a
evaluate) (Either
   (Error DefaultUni (Either DefaultFun ExtensionFun) ())
   (EvaluationResult
      (Term Name DefaultUni (Either DefaultFun ExtensionFun) ()))
 -> IO
      (Either
         (Error DefaultUni (Either DefaultFun ExtensionFun) ())
         (Either
            BuiltinErrorCall
            (EvaluationResult
               (Term Name DefaultUni (Either DefaultFun ExtensionFun) ())))))
-> Either
     (Error DefaultUni (Either DefaultFun ExtensionFun) ())
     (EvaluationResult
        (Term Name DefaultUni (Either DefaultFun ExtensionFun) ()))
-> IO
     (Either
        (Error DefaultUni (Either DefaultFun ExtensionFun) ())
        (Either
           BuiltinErrorCall
           (EvaluationResult
              (Term Name DefaultUni (Either DefaultFun ExtensionFun) ()))))
forall a b. (a -> b) -> a -> b
$
                BuiltinSemanticsVariant (Either DefaultFun ExtensionFun)
-> CostingPart DefaultUni (Either DefaultFun ExtensionFun)
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
-> Either
     (Error DefaultUni (Either DefaultFun ExtensionFun) ())
     (EvaluationResult
        (Term Name DefaultUni (Either DefaultFun ExtensionFun) ()))
forall (uni :: * -> *) fun (m :: * -> *).
(MonadError (Error uni fun ()) m, Typecheckable uni fun, GEq uni,
 Everywhere uni ExMemoryUsage, PrettyUni uni, Pretty fun) =>
BuiltinSemanticsVariant fun
-> CostingPart uni fun
-> Term TyName Name uni fun ()
-> m (EvaluationResult (Term Name uni fun ()))
typecheckEvaluateCekNoEmit BuiltinSemanticsVariant (Either DefaultFun ExtensionFun)
forall a. Default a => a
def CostingPart DefaultUni (Either DefaultFun ExtensionFun)
defaultBuiltinCostModelExt Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
term
        Either
  (Error DefaultUni (Either DefaultFun ExtensionFun) ())
  (Either
     BuiltinErrorCall
     (EvaluationResult
        (Term Name DefaultUni (Either DefaultFun ExtensionFun) ())))
typeErrOrEvalExcOrRes Either
  (Error DefaultUni (Either DefaultFun ExtensionFun) ())
  (Either
     BuiltinErrorCall
     (EvaluationResult
        (Term Name DefaultUni (Either DefaultFun ExtensionFun) ())))
-> Either
     (Error DefaultUni (Either DefaultFun ExtensionFun) ())
     (Either
        BuiltinErrorCall
        (EvaluationResult
           (Term Name DefaultUni (Either DefaultFun ExtensionFun) ())))
-> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Either
  BuiltinErrorCall
  (EvaluationResult
     (Term Name DefaultUni (Either DefaultFun ExtensionFun) ()))
-> Either
     (Error DefaultUni (Either DefaultFun ExtensionFun) ())
     (Either
        BuiltinErrorCall
        (EvaluationResult
           (Term Name DefaultUni (Either DefaultFun ExtensionFun) ())))
forall a b. b -> Either a b
Right (EvaluationResult
  (Term Name DefaultUni (Either DefaultFun ExtensionFun) ())
-> Either
     BuiltinErrorCall
     (EvaluationResult
        (Term Name DefaultUni (Either DefaultFun ExtensionFun) ()))
forall a b. b -> Either a b
Right EvaluationResult
  (Term Name DefaultUni (Either DefaultFun ExtensionFun) ())
forall a. EvaluationResult a
EvaluationFailure)

-- | Test that @Null@, @Head@ and @Tail@ are enough to get pattern matching on built-in lists.
test_BuiltinList :: TestTree
test_BuiltinList :: TestTree
test_BuiltinList =
    String -> [TestTree] -> TestTree
testGroup String
"BuiltinList" ([TestTree] -> TestTree) -> [TestTree] -> TestTree
forall a b. (a -> b) -> a -> b
$ [MatchOption]
forall a. (Enum a, Bounded a) => [a]
enumerate [MatchOption] -> (MatchOption -> TestTree) -> [TestTree]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \MatchOption
optMatch ->
        String -> Assertion -> TestTree
testCase (MatchOption -> String
forall a. Show a => a -> String
show MatchOption
optMatch) (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ do
            let xs :: [Integer]
xs  = [Integer
1..Integer
10]
                res :: Term Name DefaultUni DefaultFun ()
res = forall a (uni :: * -> *) fun (term :: * -> *) tyname name ann.
(TermLike term tyname name uni fun, HasTermLevel uni a) =>
ann -> a -> term ann
mkConstant @Integer @DefaultUni () (Integer -> Term Name DefaultUni DefaultFun ())
-> Integer -> Term Name DefaultUni DefaultFun ()
forall a b. (a -> b) -> a -> b
$ (Integer -> Integer -> Integer) -> Integer -> [Integer] -> Integer
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (-) Integer
0 [Integer]
xs
                term :: Term TyName Name DefaultUni DefaultFun ()
term
                    = Term TyName Name DefaultUni DefaultFun ()
-> [Term TyName Name DefaultUni DefaultFun ()]
-> Term TyName Name DefaultUni DefaultFun ()
forall (term :: * -> *) tyname name (uni :: * -> *) fun.
TermLike term tyname name uni fun =>
term () -> [term ()] -> term ()
mkIterAppNoAnn
                        (Term TyName Name DefaultUni DefaultFun ()
-> [Type TyName DefaultUni ()]
-> Term TyName Name DefaultUni DefaultFun ()
forall (term :: * -> *) tyname name (uni :: * -> *) fun.
TermLike term tyname name uni fun =>
term () -> [Type tyname uni ()] -> term ()
mkIterInstNoAnn (MatchOption -> Term TyName Name DefaultUni DefaultFun ()
forall (term :: * -> *).
TermLike term TyName Name DefaultUni DefaultFun =>
MatchOption -> term ()
Builtin.foldrList MatchOption
optMatch) [Type TyName DefaultUni ()
forall (uni :: * -> *) tyname.
HasTypeLevel uni Integer =>
Type tyname uni ()
integer, Type TyName DefaultUni ()
forall (uni :: * -> *) tyname.
HasTypeLevel uni Integer =>
Type tyname uni ()
integer])
                        [ () -> DefaultFun -> Term TyName Name DefaultUni DefaultFun ()
forall tyname name (uni :: * -> *) fun ann.
ann -> fun -> Term tyname name uni fun ann
Builtin () DefaultFun
SubtractInteger
                        , forall a (uni :: * -> *) fun (term :: * -> *) tyname name ann.
(TermLike term tyname name uni fun, HasTermLevel uni a) =>
ann -> a -> term ann
mkConstant @Integer () Integer
0
                        , forall a (uni :: * -> *) fun (term :: * -> *) tyname name ann.
(TermLike term tyname name uni fun, HasTermLevel uni a) =>
ann -> a -> term ann
mkConstant @[Integer] () [Integer]
xs
                        ]
            BuiltinSemanticsVariant DefaultFun
-> CostingPart DefaultUni DefaultFun
-> Term TyName Name DefaultUni DefaultFun ()
-> Either
     (Error DefaultUni DefaultFun ())
     (EvaluationResult (Term Name DefaultUni DefaultFun ()))
forall (uni :: * -> *) fun (m :: * -> *).
(MonadError (Error uni fun ()) m, Typecheckable uni fun, GEq uni,
 Everywhere uni ExMemoryUsage, PrettyUni uni, Pretty fun) =>
BuiltinSemanticsVariant fun
-> CostingPart uni fun
-> Term TyName Name uni fun ()
-> m (EvaluationResult (Term Name uni fun ()))
typecheckEvaluateCekNoEmit BuiltinSemanticsVariant DefaultFun
forall a. Default a => a
def BuiltinCostModel
CostingPart DefaultUni DefaultFun
defaultBuiltinCostModelForTesting Term TyName Name DefaultUni DefaultFun ()
term Either
  (Error DefaultUni DefaultFun ())
  (EvaluationResult (Term Name DefaultUni DefaultFun ()))
-> Either
     (Error DefaultUni DefaultFun ())
     (EvaluationResult (Term Name DefaultUni DefaultFun ()))
-> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?=
                EvaluationResult (Term Name DefaultUni DefaultFun ())
-> Either
     (Error DefaultUni DefaultFun ())
     (EvaluationResult (Term Name DefaultUni DefaultFun ()))
forall a b. b -> Either a b
Right (Term Name DefaultUni DefaultFun ()
-> EvaluationResult (Term Name DefaultUni DefaultFun ())
forall a. a -> EvaluationResult a
EvaluationSuccess Term Name DefaultUni DefaultFun ()
res)

-- | Test that right-folding a built-in list with built-in 'Cons' recreates that list.
test_IdBuiltinList :: TestTree
test_IdBuiltinList :: TestTree
test_IdBuiltinList =
    String -> [TestTree] -> TestTree
testGroup String
"IdBuiltinList" ([TestTree] -> TestTree) -> [TestTree] -> TestTree
forall a b. (a -> b) -> a -> b
$ [MatchOption]
forall a. (Enum a, Bounded a) => [a]
enumerate [MatchOption] -> (MatchOption -> TestTree) -> [TestTree]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \MatchOption
optMatch ->
        String -> Assertion -> TestTree
testCase (MatchOption -> String
forall a. Show a => a -> String
show MatchOption
optMatch) (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ do
            let xsTerm :: TermLike term tyname name DefaultUni DefaultFunExt => term ()
                xsTerm :: forall (term :: * -> *) tyname name.
TermLike
  term tyname name DefaultUni (Either DefaultFun ExtensionFun) =>
term ()
xsTerm = 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..Integer
10]
                listOfInteger :: Type tyname DefaultUni ()
listOfInteger = forall a (x :: a) (uni :: * -> *) ann tyname.
HasTypeLevel uni x =>
ann -> Type tyname uni ann
mkTyBuiltin @_ @[Integer] ()
                term :: Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
term
                    = Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
-> [Term
      TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()]
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
forall (term :: * -> *) tyname name (uni :: * -> *) fun.
TermLike term tyname name uni fun =>
term () -> [term ()] -> term ()
mkIterAppNoAnn
                        (Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
-> [Type TyName DefaultUni ()]
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
forall (term :: * -> *) tyname name (uni :: * -> *) fun.
TermLike term tyname name uni fun =>
term () -> [Type tyname uni ()] -> term ()
mkIterInstNoAnn ((DefaultFun -> Either DefaultFun ExtensionFun)
-> Term TyName Name DefaultUni DefaultFun ()
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
forall fun fun' tyname name (uni :: * -> *) ann.
(fun -> fun')
-> Term tyname name uni fun ann -> Term tyname name uni fun' ann
mapFun DefaultFun -> Either DefaultFun ExtensionFun
forall a b. a -> Either a b
Left (Term TyName Name DefaultUni DefaultFun ()
 -> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ())
-> Term TyName Name DefaultUni DefaultFun ()
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
forall a b. (a -> b) -> a -> b
$ MatchOption -> Term TyName Name DefaultUni DefaultFun ()
forall (term :: * -> *).
TermLike term TyName Name DefaultUni DefaultFun =>
MatchOption -> term ()
Builtin.foldrList MatchOption
optMatch)
                            [Type TyName DefaultUni ()
forall (uni :: * -> *) tyname.
HasTypeLevel uni Integer =>
Type tyname uni ()
integer, Type TyName DefaultUni ()
forall {w}. Type w DefaultUni ()
listOfInteger])
                        [ ()
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
-> Type TyName DefaultUni ()
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
forall ann.
ann
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ann
-> Type TyName DefaultUni ann
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ann
forall (term :: * -> *) tyname name (uni :: * -> *) fun ann.
TermLike term tyname name uni fun =>
ann -> term ann -> Type tyname uni ann -> term ann
tyInst () (()
-> Either DefaultFun ExtensionFun
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
forall ann.
ann
-> Either DefaultFun ExtensionFun
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ann
forall (term :: * -> *) tyname name (uni :: * -> *) fun ann.
TermLike term tyname name uni fun =>
ann -> fun -> term ann
builtin () (Either DefaultFun ExtensionFun
 -> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ())
-> Either DefaultFun ExtensionFun
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
forall a b. (a -> b) -> a -> b
$ DefaultFun -> Either DefaultFun ExtensionFun
forall a b. a -> Either a b
Left DefaultFun
MkCons) Type TyName DefaultUni ()
forall (uni :: * -> *) tyname.
HasTypeLevel uni Integer =>
Type tyname uni ()
integer
                        , forall a (uni :: * -> *) fun (term :: * -> *) tyname name ann.
(TermLike term tyname name uni fun, HasTermLevel uni a) =>
ann -> a -> term ann
mkConstant @[Integer] () []
                        , Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
forall (term :: * -> *) tyname name.
TermLike
  term tyname name DefaultUni (Either DefaultFun ExtensionFun) =>
term ()
xsTerm
                        ]
            BuiltinSemanticsVariant (Either DefaultFun ExtensionFun)
-> CostingPart DefaultUni (Either DefaultFun ExtensionFun)
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
-> Either
     (Error DefaultUni (Either DefaultFun ExtensionFun) ())
     (EvaluationResult
        (Term Name DefaultUni (Either DefaultFun ExtensionFun) ()))
forall (uni :: * -> *) fun (m :: * -> *).
(MonadError (Error uni fun ()) m, Typecheckable uni fun, GEq uni,
 Everywhere uni ExMemoryUsage, PrettyUni uni, Pretty fun) =>
BuiltinSemanticsVariant fun
-> CostingPart uni fun
-> Term TyName Name uni fun ()
-> m (EvaluationResult (Term Name uni fun ()))
typecheckEvaluateCekNoEmit BuiltinSemanticsVariant (Either DefaultFun ExtensionFun)
forall a. Default a => a
def CostingPart DefaultUni (Either DefaultFun ExtensionFun)
defaultBuiltinCostModelExt Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
term Either
  (Error DefaultUni (Either DefaultFun ExtensionFun) ())
  (EvaluationResult
     (Term Name DefaultUni (Either DefaultFun ExtensionFun) ()))
-> Either
     (Error DefaultUni (Either DefaultFun ExtensionFun) ())
     (EvaluationResult
        (Term Name DefaultUni (Either DefaultFun ExtensionFun) ()))
-> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?=
                EvaluationResult
  (Term Name DefaultUni (Either DefaultFun ExtensionFun) ())
-> Either
     (Error DefaultUni (Either DefaultFun ExtensionFun) ())
     (EvaluationResult
        (Term Name DefaultUni (Either DefaultFun ExtensionFun) ()))
forall a b. b -> Either a b
Right (Term Name DefaultUni (Either DefaultFun ExtensionFun) ()
-> EvaluationResult
     (Term Name DefaultUni (Either DefaultFun ExtensionFun) ())
forall a. a -> EvaluationResult a
EvaluationSuccess Term Name DefaultUni (Either DefaultFun ExtensionFun) ()
forall (term :: * -> *) tyname name.
TermLike
  term tyname name DefaultUni (Either DefaultFun ExtensionFun) =>
term ()
xsTerm)

test_BuiltinArray :: TestTree
test_BuiltinArray :: TestTree
test_BuiltinArray =
  String -> [TestTree] -> TestTree
testGroup String
"BuiltinArray" [
    String -> Assertion -> TestTree
testCase String
"listToArray" do
      let listOfInts :: Term TyName Name DefaultUni DefaultFun ()
listOfInts = forall a (uni :: * -> *) fun (term :: * -> *) tyname name ann.
(TermLike term tyname name uni fun, HasTermLevel uni a) =>
ann -> a -> term ann
mkConstant @[Integer] @DefaultUni () [Integer
1..Integer
10]
      let arrayOfInts :: Term Name DefaultUni DefaultFun ()
arrayOfInts = forall a (uni :: * -> *) fun (term :: * -> *) tyname name ann.
(TermLike term tyname name uni fun, HasTermLevel uni a) =>
ann -> a -> term ann
mkConstant @(Vector Integer) @DefaultUni () ([Integer] -> Vector Integer
forall a. [a] -> Vector a
Vector.fromList [Integer
1..Integer
10])
      let term :: Term TyName Name DefaultUni DefaultFun ()
term = ()
-> Term TyName Name DefaultUni DefaultFun ()
-> Term TyName Name DefaultUni DefaultFun ()
-> Term TyName Name DefaultUni DefaultFun ()
forall ann.
ann
-> Term TyName Name DefaultUni DefaultFun ann
-> Term TyName Name DefaultUni DefaultFun ann
-> Term TyName Name DefaultUni DefaultFun ann
forall (term :: * -> *) tyname name (uni :: * -> *) fun ann.
TermLike term tyname name uni fun =>
ann -> term ann -> term ann -> term ann
apply () (()
-> Term TyName Name DefaultUni DefaultFun ()
-> Type TyName DefaultUni ()
-> Term TyName Name DefaultUni DefaultFun ()
forall ann.
ann
-> Term TyName Name DefaultUni DefaultFun ann
-> Type TyName DefaultUni ann
-> Term TyName Name DefaultUni DefaultFun ann
forall (term :: * -> *) tyname name (uni :: * -> *) fun ann.
TermLike term tyname name uni fun =>
ann -> term ann -> Type tyname uni ann -> term ann
tyInst () (() -> DefaultFun -> Term TyName Name DefaultUni DefaultFun ()
forall ann.
ann -> DefaultFun -> Term TyName Name DefaultUni DefaultFun ann
forall (term :: * -> *) tyname name (uni :: * -> *) fun ann.
TermLike term tyname name uni fun =>
ann -> fun -> term ann
builtin () DefaultFun
ListToArray) Type TyName DefaultUni ()
forall (uni :: * -> *) tyname.
HasTypeLevel uni Integer =>
Type tyname uni ()
integer) Term TyName Name DefaultUni DefaultFun ()
listOfInts
      BuiltinSemanticsVariant DefaultFun
-> CostingPart DefaultUni DefaultFun
-> Term TyName Name DefaultUni DefaultFun ()
-> Either
     (Error DefaultUni DefaultFun ())
     (EvaluationResult (Term Name DefaultUni DefaultFun ()))
forall (uni :: * -> *) fun (m :: * -> *).
(MonadError (Error uni fun ()) m, Typecheckable uni fun, GEq uni,
 Everywhere uni ExMemoryUsage, PrettyUni uni, Pretty fun) =>
BuiltinSemanticsVariant fun
-> CostingPart uni fun
-> Term TyName Name uni fun ()
-> m (EvaluationResult (Term Name uni fun ()))
typecheckEvaluateCekNoEmit BuiltinSemanticsVariant DefaultFun
forall a. Default a => a
def BuiltinCostModel
CostingPart DefaultUni DefaultFun
defaultBuiltinCostModelForTesting Term TyName Name DefaultUni DefaultFun ()
term Either
  (Error DefaultUni DefaultFun ())
  (EvaluationResult (Term Name DefaultUni DefaultFun ()))
-> Either
     (Error DefaultUni DefaultFun ())
     (EvaluationResult (Term Name DefaultUni DefaultFun ()))
-> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?=
          EvaluationResult (Term Name DefaultUni DefaultFun ())
-> Either
     (Error DefaultUni DefaultFun ())
     (EvaluationResult (Term Name DefaultUni DefaultFun ()))
forall a b. b -> Either a b
Right (Term Name DefaultUni DefaultFun ()
-> EvaluationResult (Term Name DefaultUni DefaultFun ())
forall a. a -> EvaluationResult a
EvaluationSuccess Term Name DefaultUni DefaultFun ()
arrayOfInts)
    , String -> Assertion -> TestTree
testCase String
"lengthOfArray" do
      let arrayOfInts :: Term TyName Name DefaultUni DefaultFun ()
arrayOfInts = forall a (uni :: * -> *) fun (term :: * -> *) tyname name ann.
(TermLike term tyname name uni fun, HasTermLevel uni a) =>
ann -> a -> term ann
mkConstant @(Vector Integer) @DefaultUni () ([Integer] -> Vector Integer
forall a. [a] -> Vector a
Vector.fromList [Integer
1..Integer
10])
      let expectedLength :: Term Name DefaultUni DefaultFun ()
expectedLength = forall a (uni :: * -> *) fun (term :: * -> *) tyname name ann.
(TermLike term tyname name uni fun, HasTermLevel uni a) =>
ann -> a -> term ann
mkConstant @Integer @DefaultUni () Integer
10
          term :: Term TyName Name DefaultUni DefaultFun ()
term = ()
-> Term TyName Name DefaultUni DefaultFun ()
-> Term TyName Name DefaultUni DefaultFun ()
-> Term TyName Name DefaultUni DefaultFun ()
forall ann.
ann
-> Term TyName Name DefaultUni DefaultFun ann
-> Term TyName Name DefaultUni DefaultFun ann
-> Term TyName Name DefaultUni DefaultFun ann
forall (term :: * -> *) tyname name (uni :: * -> *) fun ann.
TermLike term tyname name uni fun =>
ann -> term ann -> term ann -> term ann
apply () (()
-> Term TyName Name DefaultUni DefaultFun ()
-> Type TyName DefaultUni ()
-> Term TyName Name DefaultUni DefaultFun ()
forall ann.
ann
-> Term TyName Name DefaultUni DefaultFun ann
-> Type TyName DefaultUni ann
-> Term TyName Name DefaultUni DefaultFun ann
forall (term :: * -> *) tyname name (uni :: * -> *) fun ann.
TermLike term tyname name uni fun =>
ann -> term ann -> Type tyname uni ann -> term ann
tyInst () (() -> DefaultFun -> Term TyName Name DefaultUni DefaultFun ()
forall ann.
ann -> DefaultFun -> Term TyName Name DefaultUni DefaultFun ann
forall (term :: * -> *) tyname name (uni :: * -> *) fun ann.
TermLike term tyname name uni fun =>
ann -> fun -> term ann
builtin () DefaultFun
LengthOfArray) Type TyName DefaultUni ()
forall (uni :: * -> *) tyname.
HasTypeLevel uni Integer =>
Type tyname uni ()
integer) Term TyName Name DefaultUni DefaultFun ()
arrayOfInts
      BuiltinSemanticsVariant DefaultFun
-> CostingPart DefaultUni DefaultFun
-> Term TyName Name DefaultUni DefaultFun ()
-> Either
     (Error DefaultUni DefaultFun ())
     (EvaluationResult (Term Name DefaultUni DefaultFun ()))
forall (uni :: * -> *) fun (m :: * -> *).
(MonadError (Error uni fun ()) m, Typecheckable uni fun, GEq uni,
 Everywhere uni ExMemoryUsage, PrettyUni uni, Pretty fun) =>
BuiltinSemanticsVariant fun
-> CostingPart uni fun
-> Term TyName Name uni fun ()
-> m (EvaluationResult (Term Name uni fun ()))
typecheckEvaluateCekNoEmit BuiltinSemanticsVariant DefaultFun
forall a. Default a => a
def BuiltinCostModel
CostingPart DefaultUni DefaultFun
defaultBuiltinCostModelForTesting Term TyName Name DefaultUni DefaultFun ()
term Either
  (Error DefaultUni DefaultFun ())
  (EvaluationResult (Term Name DefaultUni DefaultFun ()))
-> Either
     (Error DefaultUni DefaultFun ())
     (EvaluationResult (Term Name DefaultUni DefaultFun ()))
-> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?=
          EvaluationResult (Term Name DefaultUni DefaultFun ())
-> Either
     (Error DefaultUni DefaultFun ())
     (EvaluationResult (Term Name DefaultUni DefaultFun ()))
forall a b. b -> Either a b
Right (Term Name DefaultUni DefaultFun ()
-> EvaluationResult (Term Name DefaultUni DefaultFun ())
forall a. a -> EvaluationResult a
EvaluationSuccess Term Name DefaultUni DefaultFun ()
expectedLength)
    , String -> Assertion -> TestTree
testCase String
"indexArray" do
      let arrayOfInts :: Term TyName Name DefaultUni DefaultFun ()
arrayOfInts = forall a (uni :: * -> *) fun (term :: * -> *) tyname name ann.
(TermLike term tyname name uni fun, HasTermLevel uni a) =>
ann -> a -> term ann
mkConstant @(Vector Integer) @DefaultUni () ([Integer] -> Vector Integer
forall a. [a] -> Vector a
Vector.fromList [Integer
1..Integer
10])
      let index :: Term TyName Name DefaultUni DefaultFun ()
index = forall a (uni :: * -> *) fun (term :: * -> *) tyname name ann.
(TermLike term tyname name uni fun, HasTermLevel uni a) =>
ann -> a -> term ann
mkConstant @Integer @DefaultUni () Integer
5
          expectedValue :: Term Name DefaultUni DefaultFun ()
expectedValue = forall a (uni :: * -> *) fun (term :: * -> *) tyname name ann.
(TermLike term tyname name uni fun, HasTermLevel uni a) =>
ann -> a -> term ann
mkConstant @Integer @DefaultUni () Integer
6
          term :: Term TyName Name DefaultUni DefaultFun ()
term = Term TyName Name DefaultUni DefaultFun ()
-> [Term TyName Name DefaultUni DefaultFun ()]
-> Term TyName Name DefaultUni DefaultFun ()
forall (term :: * -> *) tyname name (uni :: * -> *) fun.
TermLike term tyname name uni fun =>
term () -> [term ()] -> term ()
mkIterAppNoAnn (()
-> Term TyName Name DefaultUni DefaultFun ()
-> Type TyName DefaultUni ()
-> Term TyName Name DefaultUni DefaultFun ()
forall ann.
ann
-> Term TyName Name DefaultUni DefaultFun ann
-> Type TyName DefaultUni ann
-> Term TyName Name DefaultUni DefaultFun ann
forall (term :: * -> *) tyname name (uni :: * -> *) fun ann.
TermLike term tyname name uni fun =>
ann -> term ann -> Type tyname uni ann -> term ann
tyInst () (() -> DefaultFun -> Term TyName Name DefaultUni DefaultFun ()
forall ann.
ann -> DefaultFun -> Term TyName Name DefaultUni DefaultFun ann
forall (term :: * -> *) tyname name (uni :: * -> *) fun ann.
TermLike term tyname name uni fun =>
ann -> fun -> term ann
builtin () DefaultFun
IndexArray) Type TyName DefaultUni ()
forall (uni :: * -> *) tyname.
HasTypeLevel uni Integer =>
Type tyname uni ()
integer) [Term TyName Name DefaultUni DefaultFun ()
arrayOfInts, Term TyName Name DefaultUni DefaultFun ()
index]
      BuiltinSemanticsVariant DefaultFun
-> CostingPart DefaultUni DefaultFun
-> Term TyName Name DefaultUni DefaultFun ()
-> Either
     (Error DefaultUni DefaultFun ())
     (EvaluationResult (Term Name DefaultUni DefaultFun ()))
forall (uni :: * -> *) fun (m :: * -> *).
(MonadError (Error uni fun ()) m, Typecheckable uni fun, GEq uni,
 Everywhere uni ExMemoryUsage, PrettyUni uni, Pretty fun) =>
BuiltinSemanticsVariant fun
-> CostingPart uni fun
-> Term TyName Name uni fun ()
-> m (EvaluationResult (Term Name uni fun ()))
typecheckEvaluateCekNoEmit BuiltinSemanticsVariant DefaultFun
forall a. Default a => a
def BuiltinCostModel
CostingPart DefaultUni DefaultFun
defaultBuiltinCostModelForTesting Term TyName Name DefaultUni DefaultFun ()
term Either
  (Error DefaultUni DefaultFun ())
  (EvaluationResult (Term Name DefaultUni DefaultFun ()))
-> Either
     (Error DefaultUni DefaultFun ())
     (EvaluationResult (Term Name DefaultUni DefaultFun ()))
-> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?=
          EvaluationResult (Term Name DefaultUni DefaultFun ())
-> Either
     (Error DefaultUni DefaultFun ())
     (EvaluationResult (Term Name DefaultUni DefaultFun ()))
forall a b. b -> Either a b
Right (Term Name DefaultUni DefaultFun ()
-> EvaluationResult (Term Name DefaultUni DefaultFun ())
forall a. a -> EvaluationResult a
EvaluationSuccess Term Name DefaultUni DefaultFun ()
expectedValue)
  ]

test_BuiltinPair :: TestTree
test_BuiltinPair :: TestTree
test_BuiltinPair =
    String -> Assertion -> TestTree
testCase String
"BuiltinPair" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ do
        let arg :: Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
arg = forall a (uni :: * -> *) fun (term :: * -> *) tyname name ann.
(TermLike term tyname name uni fun, HasTermLevel uni a) =>
ann -> a -> term ann
mkConstant @(Integer, Bool) @DefaultUni () (Integer
1, Bool
False)
            inst :: fun -> term ()
inst fun
efun = term () -> [Type tyname uni ()] -> term ()
forall (term :: * -> *) tyname name (uni :: * -> *) fun.
TermLike term tyname name uni fun =>
term () -> [Type tyname uni ()] -> term ()
mkIterInstNoAnn (() -> fun -> term ()
forall ann. ann -> fun -> term ann
forall (term :: * -> *) tyname name (uni :: * -> *) fun ann.
TermLike term tyname name uni fun =>
ann -> fun -> term ann
builtin () fun
efun) [Type tyname uni ()
forall (uni :: * -> *) tyname.
HasTypeLevel uni Integer =>
Type tyname uni ()
integer, Type tyname uni ()
forall (uni :: * -> *) tyname.
HasTypeLevel uni Bool =>
Type tyname uni ()
bool]
            swapped :: Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
swapped = ()
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
forall ann.
ann
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ann
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ann
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ann
forall (term :: * -> *) tyname name (uni :: * -> *) fun ann.
TermLike term tyname name uni fun =>
ann -> term ann -> term ann -> term ann
apply () (Either DefaultFun ExtensionFun
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
forall {term :: * -> *} {tyname} {name} {uni :: * -> *} {fun}.
(TermLike term tyname name uni fun,
 KnownTypeAst Void uni (ElaborateBuiltin uni Integer),
 KnownTypeAst Void uni (ElaborateBuiltin uni Bool)) =>
fun -> term ()
inst (Either DefaultFun ExtensionFun
 -> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ())
-> Either DefaultFun ExtensionFun
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
forall a b. (a -> b) -> a -> b
$ ExtensionFun -> Either DefaultFun ExtensionFun
forall a b. b -> Either a b
Right ExtensionFun
Swap) Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
arg
            fsted :: Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
fsted   = ()
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
forall ann.
ann
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ann
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ann
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ann
forall (term :: * -> *) tyname name (uni :: * -> *) fun ann.
TermLike term tyname name uni fun =>
ann -> term ann -> term ann -> term ann
apply () (Either DefaultFun ExtensionFun
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
forall {term :: * -> *} {tyname} {name} {uni :: * -> *} {fun}.
(TermLike term tyname name uni fun,
 KnownTypeAst Void uni (ElaborateBuiltin uni Integer),
 KnownTypeAst Void uni (ElaborateBuiltin uni Bool)) =>
fun -> term ()
inst (Either DefaultFun ExtensionFun
 -> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ())
-> Either DefaultFun ExtensionFun
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
forall a b. (a -> b) -> a -> b
$ DefaultFun -> Either DefaultFun ExtensionFun
forall a b. a -> Either a b
Left DefaultFun
FstPair) Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
arg
            snded :: Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
snded   = ()
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
forall ann.
ann
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ann
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ann
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ann
forall (term :: * -> *) tyname name (uni :: * -> *) fun ann.
TermLike term tyname name uni fun =>
ann -> term ann -> term ann -> term ann
apply () (Either DefaultFun ExtensionFun
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
forall {term :: * -> *} {tyname} {name} {uni :: * -> *} {fun}.
(TermLike term tyname name uni fun,
 KnownTypeAst Void uni (ElaborateBuiltin uni Integer),
 KnownTypeAst Void uni (ElaborateBuiltin uni Bool)) =>
fun -> term ()
inst (Either DefaultFun ExtensionFun
 -> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ())
-> Either DefaultFun ExtensionFun
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
forall a b. (a -> b) -> a -> b
$ DefaultFun -> Either DefaultFun ExtensionFun
forall a b. a -> Either a b
Left DefaultFun
SndPair) Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
arg
        -- > swap {integer} {bool} (1, False) ~> (False, 1)
        BuiltinSemanticsVariant (Either DefaultFun ExtensionFun)
-> CostingPart DefaultUni (Either DefaultFun ExtensionFun)
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
-> Either
     (Error DefaultUni (Either DefaultFun ExtensionFun) ())
     (EvaluationResult
        (Term Name DefaultUni (Either DefaultFun ExtensionFun) ()))
forall (uni :: * -> *) fun (m :: * -> *).
(MonadError (Error uni fun ()) m, Typecheckable uni fun, GEq uni,
 Everywhere uni ExMemoryUsage, PrettyUni uni, Pretty fun) =>
BuiltinSemanticsVariant fun
-> CostingPart uni fun
-> Term TyName Name uni fun ()
-> m (EvaluationResult (Term Name uni fun ()))
typecheckEvaluateCekNoEmit BuiltinSemanticsVariant (Either DefaultFun ExtensionFun)
forall a. Default a => a
def CostingPart DefaultUni (Either DefaultFun ExtensionFun)
defaultBuiltinCostModelExt Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
swapped Either
  (Error DefaultUni (Either DefaultFun ExtensionFun) ())
  (EvaluationResult
     (Term Name DefaultUni (Either DefaultFun ExtensionFun) ()))
-> Either
     (Error DefaultUni (Either DefaultFun ExtensionFun) ())
     (EvaluationResult
        (Term Name DefaultUni (Either DefaultFun ExtensionFun) ()))
-> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?=
            EvaluationResult
  (Term Name DefaultUni (Either DefaultFun ExtensionFun) ())
-> Either
     (Error DefaultUni (Either DefaultFun ExtensionFun) ())
     (EvaluationResult
        (Term Name DefaultUni (Either DefaultFun ExtensionFun) ()))
forall a b. b -> Either a b
Right (Term Name DefaultUni (Either DefaultFun ExtensionFun) ()
-> EvaluationResult
     (Term Name DefaultUni (Either DefaultFun ExtensionFun) ())
forall a. a -> EvaluationResult a
EvaluationSuccess (Term Name DefaultUni (Either DefaultFun ExtensionFun) ()
 -> EvaluationResult
      (Term Name DefaultUni (Either DefaultFun ExtensionFun) ()))
-> Term Name DefaultUni (Either DefaultFun ExtensionFun) ()
-> EvaluationResult
     (Term Name DefaultUni (Either DefaultFun ExtensionFun) ())
forall a b. (a -> b) -> a -> b
$ forall a (uni :: * -> *) fun (term :: * -> *) tyname name ann.
(TermLike term tyname name uni fun, HasTermLevel uni a) =>
ann -> a -> term ann
mkConstant @(Bool, Integer) () (Bool
False, Integer
1))
        -- > fst {integer} {bool} (1, False) ~> 1
        BuiltinSemanticsVariant (Either DefaultFun ExtensionFun)
-> CostingPart DefaultUni (Either DefaultFun ExtensionFun)
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
-> Either
     (Error DefaultUni (Either DefaultFun ExtensionFun) ())
     (EvaluationResult
        (Term Name DefaultUni (Either DefaultFun ExtensionFun) ()))
forall (uni :: * -> *) fun (m :: * -> *).
(MonadError (Error uni fun ()) m, Typecheckable uni fun, GEq uni,
 Everywhere uni ExMemoryUsage, PrettyUni uni, Pretty fun) =>
BuiltinSemanticsVariant fun
-> CostingPart uni fun
-> Term TyName Name uni fun ()
-> m (EvaluationResult (Term Name uni fun ()))
typecheckEvaluateCekNoEmit BuiltinSemanticsVariant (Either DefaultFun ExtensionFun)
forall a. Default a => a
def CostingPart DefaultUni (Either DefaultFun ExtensionFun)
defaultBuiltinCostModelExt Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
fsted Either
  (Error DefaultUni (Either DefaultFun ExtensionFun) ())
  (EvaluationResult
     (Term Name DefaultUni (Either DefaultFun ExtensionFun) ()))
-> Either
     (Error DefaultUni (Either DefaultFun ExtensionFun) ())
     (EvaluationResult
        (Term Name DefaultUni (Either DefaultFun ExtensionFun) ()))
-> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?=
            EvaluationResult
  (Term Name DefaultUni (Either DefaultFun ExtensionFun) ())
-> Either
     (Error DefaultUni (Either DefaultFun ExtensionFun) ())
     (EvaluationResult
        (Term Name DefaultUni (Either DefaultFun ExtensionFun) ()))
forall a b. b -> Either a b
Right (Term Name DefaultUni (Either DefaultFun ExtensionFun) ()
-> EvaluationResult
     (Term Name DefaultUni (Either DefaultFun ExtensionFun) ())
forall a. a -> EvaluationResult a
EvaluationSuccess (Term Name DefaultUni (Either DefaultFun ExtensionFun) ()
 -> EvaluationResult
      (Term Name DefaultUni (Either DefaultFun ExtensionFun) ()))
-> Term Name DefaultUni (Either DefaultFun ExtensionFun) ()
-> EvaluationResult
     (Term Name DefaultUni (Either DefaultFun ExtensionFun) ())
forall a b. (a -> b) -> a -> b
$ 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)
        -- > snd {integer} {bool} (1, False) ~> False
        BuiltinSemanticsVariant (Either DefaultFun ExtensionFun)
-> CostingPart DefaultUni (Either DefaultFun ExtensionFun)
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
-> Either
     (Error DefaultUni (Either DefaultFun ExtensionFun) ())
     (EvaluationResult
        (Term Name DefaultUni (Either DefaultFun ExtensionFun) ()))
forall (uni :: * -> *) fun (m :: * -> *).
(MonadError (Error uni fun ()) m, Typecheckable uni fun, GEq uni,
 Everywhere uni ExMemoryUsage, PrettyUni uni, Pretty fun) =>
BuiltinSemanticsVariant fun
-> CostingPart uni fun
-> Term TyName Name uni fun ()
-> m (EvaluationResult (Term Name uni fun ()))
typecheckEvaluateCekNoEmit BuiltinSemanticsVariant (Either DefaultFun ExtensionFun)
forall a. Default a => a
def CostingPart DefaultUni (Either DefaultFun ExtensionFun)
defaultBuiltinCostModelExt Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
snded Either
  (Error DefaultUni (Either DefaultFun ExtensionFun) ())
  (EvaluationResult
     (Term Name DefaultUni (Either DefaultFun ExtensionFun) ()))
-> Either
     (Error DefaultUni (Either DefaultFun ExtensionFun) ())
     (EvaluationResult
        (Term Name DefaultUni (Either DefaultFun ExtensionFun) ()))
-> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?=
            EvaluationResult
  (Term Name DefaultUni (Either DefaultFun ExtensionFun) ())
-> Either
     (Error DefaultUni (Either DefaultFun ExtensionFun) ())
     (EvaluationResult
        (Term Name DefaultUni (Either DefaultFun ExtensionFun) ()))
forall a b. b -> Either a b
Right (Term Name DefaultUni (Either DefaultFun ExtensionFun) ()
-> EvaluationResult
     (Term Name DefaultUni (Either DefaultFun ExtensionFun) ())
forall a. a -> EvaluationResult a
EvaluationSuccess (Term Name DefaultUni (Either DefaultFun ExtensionFun) ()
 -> EvaluationResult
      (Term Name DefaultUni (Either DefaultFun ExtensionFun) ()))
-> Term Name DefaultUni (Either DefaultFun ExtensionFun) ()
-> EvaluationResult
     (Term Name DefaultUni (Either DefaultFun ExtensionFun) ())
forall a b. (a -> b) -> a -> b
$ forall a (uni :: * -> *) fun (term :: * -> *) tyname name ann.
(TermLike term tyname name uni fun, HasTermLevel uni a) =>
ann -> a -> term ann
mkConstant @Bool () Bool
False)

test_SwapEls :: TestTree
test_SwapEls :: TestTree
test_SwapEls =
    String -> [TestTree] -> TestTree
testGroup String
"SwapEls" ([TestTree] -> TestTree) -> [TestTree] -> TestTree
forall a b. (a -> b) -> a -> b
$ [MatchOption]
forall a. (Enum a, Bounded a) => [a]
enumerate [MatchOption] -> (MatchOption -> TestTree) -> [TestTree]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \MatchOption
optMatch ->
        String -> Assertion -> TestTree
testCase (MatchOption -> String
forall a. Show a => a -> String
show MatchOption
optMatch) (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ do
            let xs :: [(Integer, Bool)]
xs = [Integer] -> [Bool] -> [(Integer, Bool)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Integer
1..Integer
10] ([Bool] -> [(Integer, Bool)]) -> [Bool] -> [(Integer, Bool)]
forall a b. (a -> b) -> a -> b
$ [Bool] -> [Bool]
forall a. HasCallStack => [a] -> [a]
cycle [Bool
False, Bool
True]
                res :: Term Name DefaultUni DefaultFun ()
res = forall a (uni :: * -> *) fun (term :: * -> *) tyname name ann.
(TermLike term tyname name uni fun, HasTermLevel uni a) =>
ann -> a -> term ann
mkConstant @Integer @DefaultUni () (Integer -> Term Name DefaultUni DefaultFun ())
-> Integer -> Term Name DefaultUni DefaultFun ()
forall a b. (a -> b) -> a -> b
$
                        ((Integer, Bool) -> Integer -> Integer)
-> Integer -> [(Integer, Bool)] -> Integer
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\(Integer, Bool)
p Integer
r -> Integer
r Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ (if (Integer, Bool) -> Bool
forall a b. (a, b) -> b
snd (Integer, Bool)
p then -Integer
1 else Integer
1) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* (Integer, Bool) -> Integer
forall a b. (a, b) -> a
fst (Integer, Bool)
p) Integer
0 [(Integer, Bool)]
xs
                el :: Type tyname DefaultUni ()
el = forall a (x :: a) (uni :: * -> *) ann tyname.
HasTypeLevel uni x =>
ann -> Type tyname uni ann
mkTyBuiltin @_ @(Integer, Bool) ()
                instProj :: fun -> term ()
instProj fun
p = term () -> [Type tyname uni ()] -> term ()
forall (term :: * -> *) tyname name (uni :: * -> *) fun.
TermLike term tyname name uni fun =>
term () -> [Type tyname uni ()] -> term ()
mkIterInstNoAnn (() -> fun -> term ()
forall ann. ann -> fun -> term ann
forall (term :: * -> *) tyname name (uni :: * -> *) fun ann.
TermLike term tyname name uni fun =>
ann -> fun -> term ann
builtin () fun
p) [Type tyname uni ()
forall (uni :: * -> *) tyname.
HasTypeLevel uni Integer =>
Type tyname uni ()
integer, Type tyname uni ()
forall (uni :: * -> *) tyname.
HasTypeLevel uni Bool =>
Type tyname uni ()
bool]
                fun :: Term tyname Name DefaultUni DefaultFun ()
fun = Quote (Term tyname Name DefaultUni DefaultFun ())
-> Term tyname Name DefaultUni DefaultFun ()
forall a. Quote a -> a
runQuote (Quote (Term tyname Name DefaultUni DefaultFun ())
 -> Term tyname Name DefaultUni DefaultFun ())
-> Quote (Term tyname Name DefaultUni DefaultFun ())
-> Term tyname Name DefaultUni DefaultFun ()
forall a b. (a -> b) -> a -> b
$ do
                        Name
p <- Text -> QuoteT Identity Name
forall (m :: * -> *). MonadQuote m => Text -> m Name
freshName Text
"p"
                        Name
r <- Text -> QuoteT Identity Name
forall (m :: * -> *). MonadQuote m => Text -> m Name
freshName Text
"r"
                        Term tyname Name DefaultUni DefaultFun ()
-> Quote (Term tyname Name DefaultUni DefaultFun ())
forall a. a -> QuoteT Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return
                            (Term tyname Name DefaultUni DefaultFun ()
 -> Quote (Term tyname Name DefaultUni DefaultFun ()))
-> (Term tyname Name DefaultUni DefaultFun ()
    -> Term tyname Name DefaultUni DefaultFun ())
-> Term tyname Name DefaultUni DefaultFun ()
-> Quote (Term tyname Name DefaultUni DefaultFun ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ()
-> Name
-> Type tyname DefaultUni ()
-> Term tyname Name DefaultUni DefaultFun ()
-> Term tyname Name DefaultUni DefaultFun ()
forall ann.
ann
-> Name
-> Type tyname DefaultUni ann
-> Term tyname Name DefaultUni DefaultFun ann
-> Term tyname Name DefaultUni DefaultFun ann
forall (term :: * -> *) tyname name (uni :: * -> *) fun ann.
TermLike term tyname name uni fun =>
ann -> name -> Type tyname uni ann -> term ann -> term ann
lamAbs () Name
p Type tyname DefaultUni ()
forall {w}. Type w DefaultUni ()
el
                            (Term tyname Name DefaultUni DefaultFun ()
 -> Term tyname Name DefaultUni DefaultFun ())
-> (Term tyname Name DefaultUni DefaultFun ()
    -> Term tyname Name DefaultUni DefaultFun ())
-> Term tyname Name DefaultUni DefaultFun ()
-> Term tyname Name DefaultUni DefaultFun ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ()
-> Name
-> Type tyname DefaultUni ()
-> Term tyname Name DefaultUni DefaultFun ()
-> Term tyname Name DefaultUni DefaultFun ()
forall ann.
ann
-> Name
-> Type tyname DefaultUni ann
-> Term tyname Name DefaultUni DefaultFun ann
-> Term tyname Name DefaultUni DefaultFun ann
forall (term :: * -> *) tyname name (uni :: * -> *) fun ann.
TermLike term tyname name uni fun =>
ann -> name -> Type tyname uni ann -> term ann -> term ann
lamAbs () Name
r Type tyname DefaultUni ()
forall (uni :: * -> *) tyname.
HasTypeLevel uni Integer =>
Type tyname uni ()
integer
                            (Term tyname Name DefaultUni DefaultFun ()
 -> Quote (Term tyname Name DefaultUni DefaultFun ()))
-> Term tyname Name DefaultUni DefaultFun ()
-> Quote (Term tyname Name DefaultUni DefaultFun ())
forall a b. (a -> b) -> a -> b
$ Term tyname Name DefaultUni DefaultFun ()
-> [Term tyname Name DefaultUni DefaultFun ()]
-> Term tyname Name DefaultUni DefaultFun ()
forall (term :: * -> *) tyname name (uni :: * -> *) fun.
TermLike term tyname name uni fun =>
term () -> [term ()] -> term ()
mkIterAppNoAnn (() -> DefaultFun -> Term tyname Name DefaultUni DefaultFun ()
forall ann.
ann -> DefaultFun -> Term tyname Name DefaultUni DefaultFun ann
forall (term :: * -> *) tyname name (uni :: * -> *) fun ann.
TermLike term tyname name uni fun =>
ann -> fun -> term ann
builtin () DefaultFun
AddInteger)
                                [ () -> Name -> Term tyname Name DefaultUni DefaultFun ()
forall tyname name (uni :: * -> *) fun ann.
ann -> name -> Term tyname name uni fun ann
Var () Name
r
                                , Term tyname Name DefaultUni DefaultFun ()
-> [Term tyname Name DefaultUni DefaultFun ()]
-> Term tyname Name DefaultUni DefaultFun ()
forall (term :: * -> *) tyname name (uni :: * -> *) fun.
TermLike term tyname name uni fun =>
term () -> [term ()] -> term ()
mkIterAppNoAnn (() -> DefaultFun -> Term tyname Name DefaultUni DefaultFun ()
forall ann.
ann -> DefaultFun -> Term tyname Name DefaultUni DefaultFun ann
forall (term :: * -> *) tyname name (uni :: * -> *) fun ann.
TermLike term tyname name uni fun =>
ann -> fun -> term ann
builtin () DefaultFun
MultiplyInteger)
                                    [ Term tyname Name DefaultUni DefaultFun ()
-> [Term tyname Name DefaultUni DefaultFun ()]
-> Term tyname Name DefaultUni DefaultFun ()
forall (term :: * -> *) tyname name (uni :: * -> *) fun.
TermLike term tyname name uni fun =>
term () -> [term ()] -> term ()
mkIterAppNoAnn (()
-> Term tyname Name DefaultUni DefaultFun ()
-> Type tyname DefaultUni ()
-> Term tyname Name DefaultUni DefaultFun ()
forall ann.
ann
-> Term tyname Name DefaultUni DefaultFun ann
-> Type tyname DefaultUni ann
-> Term tyname Name DefaultUni DefaultFun ann
forall (term :: * -> *) tyname name (uni :: * -> *) fun ann.
TermLike term tyname name uni fun =>
ann -> term ann -> Type tyname uni ann -> term ann
tyInst () (() -> DefaultFun -> Term tyname Name DefaultUni DefaultFun ()
forall ann.
ann -> DefaultFun -> Term tyname Name DefaultUni DefaultFun ann
forall (term :: * -> *) tyname name (uni :: * -> *) fun ann.
TermLike term tyname name uni fun =>
ann -> fun -> term ann
builtin () DefaultFun
IfThenElse) Type tyname DefaultUni ()
forall (uni :: * -> *) tyname.
HasTypeLevel uni Integer =>
Type tyname uni ()
integer)
                                        [ ()
-> Term tyname Name DefaultUni DefaultFun ()
-> Term tyname Name DefaultUni DefaultFun ()
-> Term tyname Name DefaultUni DefaultFun ()
forall ann.
ann
-> Term tyname Name DefaultUni DefaultFun ann
-> Term tyname Name DefaultUni DefaultFun ann
-> Term tyname Name DefaultUni DefaultFun ann
forall (term :: * -> *) tyname name (uni :: * -> *) fun ann.
TermLike term tyname name uni fun =>
ann -> term ann -> term ann -> term ann
apply () (DefaultFun -> Term tyname Name DefaultUni DefaultFun ()
forall {term :: * -> *} {tyname} {name} {uni :: * -> *} {fun}.
(TermLike term tyname name uni fun,
 KnownTypeAst Void uni (ElaborateBuiltin uni Integer),
 KnownTypeAst Void uni (ElaborateBuiltin uni Bool)) =>
fun -> term ()
instProj DefaultFun
SndPair) (Term tyname Name DefaultUni DefaultFun ()
 -> Term tyname Name DefaultUni DefaultFun ())
-> Term tyname Name DefaultUni DefaultFun ()
-> Term tyname Name DefaultUni DefaultFun ()
forall a b. (a -> b) -> a -> b
$ () -> Name -> Term tyname Name DefaultUni DefaultFun ()
forall tyname name (uni :: * -> *) fun ann.
ann -> name -> Term tyname name uni fun ann
Var () Name
p
                                        , 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
1
                                        ]
                                    , ()
-> Term tyname Name DefaultUni DefaultFun ()
-> Term tyname Name DefaultUni DefaultFun ()
-> Term tyname Name DefaultUni DefaultFun ()
forall ann.
ann
-> Term tyname Name DefaultUni DefaultFun ann
-> Term tyname Name DefaultUni DefaultFun ann
-> Term tyname Name DefaultUni DefaultFun ann
forall (term :: * -> *) tyname name (uni :: * -> *) fun ann.
TermLike term tyname name uni fun =>
ann -> term ann -> term ann -> term ann
apply () (DefaultFun -> Term tyname Name DefaultUni DefaultFun ()
forall {term :: * -> *} {tyname} {name} {uni :: * -> *} {fun}.
(TermLike term tyname name uni fun,
 KnownTypeAst Void uni (ElaborateBuiltin uni Integer),
 KnownTypeAst Void uni (ElaborateBuiltin uni Bool)) =>
fun -> term ()
instProj DefaultFun
FstPair) (Term tyname Name DefaultUni DefaultFun ()
 -> Term tyname Name DefaultUni DefaultFun ())
-> Term tyname Name DefaultUni DefaultFun ()
-> Term tyname Name DefaultUni DefaultFun ()
forall a b. (a -> b) -> a -> b
$ () -> Name -> Term tyname Name DefaultUni DefaultFun ()
forall tyname name (uni :: * -> *) fun ann.
ann -> name -> Term tyname name uni fun ann
Var () Name
p
                                    ]
                                ]
                term :: Term TyName Name DefaultUni DefaultFun ()
term
                    = Term TyName Name DefaultUni DefaultFun ()
-> [Term TyName Name DefaultUni DefaultFun ()]
-> Term TyName Name DefaultUni DefaultFun ()
forall (term :: * -> *) tyname name (uni :: * -> *) fun.
TermLike term tyname name uni fun =>
term () -> [term ()] -> term ()
mkIterAppNoAnn (Term TyName Name DefaultUni DefaultFun ()
-> [Type TyName DefaultUni ()]
-> Term TyName Name DefaultUni DefaultFun ()
forall (term :: * -> *) tyname name (uni :: * -> *) fun.
TermLike term tyname name uni fun =>
term () -> [Type tyname uni ()] -> term ()
mkIterInstNoAnn (MatchOption -> Term TyName Name DefaultUni DefaultFun ()
forall (term :: * -> *).
TermLike term TyName Name DefaultUni DefaultFun =>
MatchOption -> term ()
Builtin.foldrList MatchOption
optMatch) [Type TyName DefaultUni ()
forall {w}. Type w DefaultUni ()
el, Type TyName DefaultUni ()
forall (uni :: * -> *) tyname.
HasTypeLevel uni Integer =>
Type tyname uni ()
integer])
                        [ Term TyName Name DefaultUni DefaultFun ()
forall {tyname}. Term tyname Name DefaultUni DefaultFun ()
fun
                        , forall a (uni :: * -> *) fun (term :: * -> *) tyname name ann.
(TermLike term tyname name uni fun, HasTermLevel uni a) =>
ann -> a -> term ann
mkConstant @Integer () Integer
0
                        , ()
-> [(Integer, Bool)] -> Term TyName Name DefaultUni DefaultFun ()
forall a (uni :: * -> *) fun (term :: * -> *) tyname name ann.
(TermLike term tyname name uni fun, HasTermLevel uni a) =>
ann -> a -> term ann
mkConstant () [(Integer, Bool)]
xs
                        ]
            BuiltinSemanticsVariant DefaultFun
-> CostingPart DefaultUni DefaultFun
-> Term TyName Name DefaultUni DefaultFun ()
-> Either
     (Error DefaultUni DefaultFun ())
     (EvaluationResult (Term Name DefaultUni DefaultFun ()))
forall (uni :: * -> *) fun (m :: * -> *).
(MonadError (Error uni fun ()) m, Typecheckable uni fun, GEq uni,
 Everywhere uni ExMemoryUsage, PrettyUni uni, Pretty fun) =>
BuiltinSemanticsVariant fun
-> CostingPart uni fun
-> Term TyName Name uni fun ()
-> m (EvaluationResult (Term Name uni fun ()))
typecheckEvaluateCekNoEmit BuiltinSemanticsVariant DefaultFun
forall a. Default a => a
def BuiltinCostModel
CostingPart DefaultUni DefaultFun
defaultBuiltinCostModelForTesting Term TyName Name DefaultUni DefaultFun ()
term Either
  (Error DefaultUni DefaultFun ())
  (EvaluationResult (Term Name DefaultUni DefaultFun ()))
-> Either
     (Error DefaultUni DefaultFun ())
     (EvaluationResult (Term Name DefaultUni DefaultFun ()))
-> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?=
              EvaluationResult (Term Name DefaultUni DefaultFun ())
-> Either
     (Error DefaultUni DefaultFun ())
     (EvaluationResult (Term Name DefaultUni DefaultFun ()))
forall a b. b -> Either a b
Right (Term Name DefaultUni DefaultFun ()
-> EvaluationResult (Term Name DefaultUni DefaultFun ())
forall a. a -> EvaluationResult a
EvaluationSuccess Term Name DefaultUni DefaultFun ()
res)

-- | Test that right-folding a built-in 'Data' with the constructors of 'Data' recreates the
-- original value.
test_IdBuiltinData :: TestTree
test_IdBuiltinData :: TestTree
test_IdBuiltinData =
    String -> [TestTree] -> TestTree
testGroup String
"IdBuiltinData" ([TestTree] -> TestTree) -> [TestTree] -> TestTree
forall a b. (a -> b) -> a -> b
$ [MatchOption]
forall a. (Enum a, Bounded a) => [a]
enumerate [MatchOption] -> (MatchOption -> TestTree) -> [TestTree]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \MatchOption
optMatch ->
        String -> Assertion -> TestTree
testCase (MatchOption -> String
forall a. Show a => a -> String
show MatchOption
optMatch) (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ do
            let dTerm :: TermLike term tyname name DefaultUni fun => term ()
                dTerm :: forall (term :: * -> *) tyname name fun.
TermLike term tyname name DefaultUni fun =>
term ()
dTerm = forall a (uni :: * -> *) fun (term :: * -> *) tyname name ann.
(TermLike term tyname name uni fun, HasTermLevel uni a) =>
ann -> a -> term ann
mkConstant @Data () (Data -> term ()) -> Data -> term ()
forall a b. (a -> b) -> a -> b
$
                    [(Data, Data)] -> Data
Map [(Integer -> Data
I Integer
42, Integer -> [Data] -> Data
Constr Integer
4 [[Data] -> Data
List [ByteString -> Data
B ByteString
"abc", Integer -> [Data] -> Data
Constr Integer
2 []], Integer -> Data
I Integer
0])]
                emb :: DefaultFun
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
emb = ()
-> Either DefaultFun ExtensionFun
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
forall ann.
ann
-> Either DefaultFun ExtensionFun
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ann
forall (term :: * -> *) tyname name (uni :: * -> *) fun ann.
TermLike term tyname name uni fun =>
ann -> fun -> term ann
builtin () (Either DefaultFun ExtensionFun
 -> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ())
-> (DefaultFun -> Either DefaultFun ExtensionFun)
-> DefaultFun
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DefaultFun -> Either DefaultFun ExtensionFun
forall a b. a -> Either a b
Left
                term :: Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
term = Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
-> [Term
      TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()]
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
forall (term :: * -> *) tyname name (uni :: * -> *) fun.
TermLike term tyname name uni fun =>
term () -> [term ()] -> term ()
mkIterAppNoAnn (MatchOption
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
ofoldrData MatchOption
optMatch)
                    [ DefaultFun
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
emb DefaultFun
ConstrData
                    , DefaultFun
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
emb DefaultFun
MapData
                    , DefaultFun
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
emb DefaultFun
ListData
                    , DefaultFun
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
emb DefaultFun
IData
                    , DefaultFun
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
emb DefaultFun
BData
                    , Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
forall (term :: * -> *) tyname name fun.
TermLike term tyname name DefaultUni fun =>
term ()
dTerm
                    ]
            BuiltinSemanticsVariant (Either DefaultFun ExtensionFun)
-> CostingPart DefaultUni (Either DefaultFun ExtensionFun)
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
-> Either
     (Error DefaultUni (Either DefaultFun ExtensionFun) ())
     (EvaluationResult
        (Term Name DefaultUni (Either DefaultFun ExtensionFun) ()))
forall (uni :: * -> *) fun (m :: * -> *).
(MonadError (Error uni fun ()) m, Typecheckable uni fun, GEq uni,
 Everywhere uni ExMemoryUsage, PrettyUni uni, Pretty fun) =>
BuiltinSemanticsVariant fun
-> CostingPart uni fun
-> Term TyName Name uni fun ()
-> m (EvaluationResult (Term Name uni fun ()))
typecheckEvaluateCekNoEmit BuiltinSemanticsVariant (Either DefaultFun ExtensionFun)
forall a. Default a => a
def CostingPart DefaultUni (Either DefaultFun ExtensionFun)
defaultBuiltinCostModelExt Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
term Either
  (Error DefaultUni (Either DefaultFun ExtensionFun) ())
  (EvaluationResult
     (Term Name DefaultUni (Either DefaultFun ExtensionFun) ()))
-> Either
     (Error DefaultUni (Either DefaultFun ExtensionFun) ())
     (EvaluationResult
        (Term Name DefaultUni (Either DefaultFun ExtensionFun) ()))
-> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?=
                EvaluationResult
  (Term Name DefaultUni (Either DefaultFun ExtensionFun) ())
-> Either
     (Error DefaultUni (Either DefaultFun ExtensionFun) ())
     (EvaluationResult
        (Term Name DefaultUni (Either DefaultFun ExtensionFun) ()))
forall a b. b -> Either a b
Right (Term Name DefaultUni (Either DefaultFun ExtensionFun) ()
-> EvaluationResult
     (Term Name DefaultUni (Either DefaultFun ExtensionFun) ())
forall a. a -> EvaluationResult a
EvaluationSuccess Term Name DefaultUni (Either DefaultFun ExtensionFun) ()
forall (term :: * -> *) tyname name fun.
TermLike term tyname name DefaultUni fun =>
term ()
dTerm)

-- | For testing how an evaluator instantiated at a particular 'ExBudgetMode' handles the
-- 'TrackCosts' builtin.
test_TrackCostsWith
    :: String -> Int -> (Term TyName Name DefaultUni ExtensionFun () -> IO ()) -> TestTree
test_TrackCostsWith :: String
-> Int
-> (Term TyName Name DefaultUni ExtensionFun () -> Assertion)
-> TestTree
test_TrackCostsWith String
cat Int
len Term TyName Name DefaultUni ExtensionFun () -> Assertion
checkTerm =
    String -> Assertion -> TestTree
testCase (String
"TrackCosts: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
cat) (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ do
        let term :: Term TyName Name DefaultUni ExtensionFun ()
term
                = ()
-> Term TyName Name DefaultUni ExtensionFun ()
-> Term TyName Name DefaultUni ExtensionFun ()
-> Term TyName Name DefaultUni ExtensionFun ()
forall ann.
ann
-> Term TyName Name DefaultUni ExtensionFun ann
-> Term TyName Name DefaultUni ExtensionFun ann
-> Term TyName Name DefaultUni ExtensionFun ann
forall (term :: * -> *) tyname name (uni :: * -> *) fun ann.
TermLike term tyname name uni fun =>
ann -> term ann -> term ann -> term ann
apply () (() -> ExtensionFun -> Term TyName Name DefaultUni ExtensionFun ()
forall ann.
ann -> ExtensionFun -> Term TyName Name DefaultUni ExtensionFun ann
forall (term :: * -> *) tyname name (uni :: * -> *) fun ann.
TermLike term tyname name uni fun =>
ann -> fun -> term ann
builtin () ExtensionFun
TrackCosts)
                (Term TyName Name DefaultUni ExtensionFun ()
 -> Term TyName Name DefaultUni ExtensionFun ())
-> Term TyName Name DefaultUni ExtensionFun ()
-> Term TyName Name DefaultUni ExtensionFun ()
forall a b. (a -> b) -> a -> b
$ forall a (uni :: * -> *) fun (term :: * -> *) tyname name ann.
(TermLike term tyname name uni fun, HasTermLevel uni a) =>
ann -> a -> term ann
mkConstant @Data () ([Data] -> Data
List ([Data] -> Data) -> (Data -> [Data]) -> Data -> Data
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Data -> [Data]
forall a. Int -> a -> [a]
replicate Int
len (Data -> Data) -> Data -> Data
forall a b. (a -> b) -> a -> b
$ Integer -> Data
I Integer
42)
        Term TyName Name DefaultUni ExtensionFun () -> Assertion
checkTerm Term TyName Name DefaultUni ExtensionFun ()
term

-- | Test that individual budgets are picked up by GC while spending is still ongoing.
test_TrackCostsRestricting :: TestTree
test_TrackCostsRestricting :: TestTree
test_TrackCostsRestricting =
    let n :: Int
n = Int
10000
    in String
-> Int
-> (Term TyName Name DefaultUni ExtensionFun () -> Assertion)
-> TestTree
test_TrackCostsWith String
"restricting" Int
n ((Term TyName Name DefaultUni ExtensionFun () -> Assertion)
 -> TestTree)
-> (Term TyName Name DefaultUni ExtensionFun () -> Assertion)
-> TestTree
forall a b. (a -> b) -> a -> b
$ \Term TyName Name DefaultUni ExtensionFun ()
term ->
        case BuiltinSemanticsVariant ExtensionFun
-> CostingPart DefaultUni ExtensionFun
-> Term TyName Name DefaultUni ExtensionFun ()
-> Either
     (Error DefaultUni ExtensionFun ())
     (Either
        (CekEvaluationException Name DefaultUni ExtensionFun) [Integer])
forall (uni :: * -> *) fun (m :: * -> *) a.
(MonadError (Error uni fun ()) m, Typecheckable uni fun, GEq uni,
 Everywhere uni ExMemoryUsage, PrettyUni uni, Pretty fun,
 ReadKnown (Term Name uni fun ()) a) =>
BuiltinSemanticsVariant fun
-> CostingPart uni fun
-> Term TyName Name uni fun ()
-> m (Either (CekEvaluationException Name uni fun) a)
typecheckReadKnownCek BuiltinSemanticsVariant ExtensionFun
forall a. Default a => a
def () Term TyName Name DefaultUni ExtensionFun ()
term of
            Left Error DefaultUni ExtensionFun ()
err                         -> String -> Assertion
forall a. String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Assertion) -> String -> Assertion
forall a b. (a -> b) -> a -> b
$ Error DefaultUni ExtensionFun () -> String
forall a str. (PrettyPlc a, Render str) => a -> str
displayPlc Error DefaultUni ExtensionFun ()
err
            Right (Left CekEvaluationException Name DefaultUni ExtensionFun
err)                 -> String -> Assertion
forall a. String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Assertion) -> String -> Assertion
forall a b. (a -> b) -> a -> b
$ CekEvaluationException Name DefaultUni ExtensionFun -> String
forall a str. (PrettyPlc a, Render str) => a -> str
displayPlc CekEvaluationException Name DefaultUni ExtensionFun
err
            Right (Right ([Integer]
res :: [Integer])) -> do
                let expected :: Int
expected = Int
n Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
10
                    actual :: Int
actual = [Integer] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Integer]
res
                    err :: String
err = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
                        [ String
"Too few elements picked up by GC\n"
                        , String
"Expected at least: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
expected String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n"
                        , String
"But got: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
actual
                        ]
                HasCallStack => String -> Bool -> Assertion
String -> Bool -> Assertion
assertBool String
err (Bool -> Assertion) -> Bool -> Assertion
forall a b. (a -> b) -> a -> b
$ Int
expected Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
actual

test_TrackCostsRetaining :: TestTree
test_TrackCostsRetaining :: TestTree
test_TrackCostsRetaining =
#if MIN_VERSION_base(4,15,0)
    String
-> Int
-> (Term TyName Name DefaultUni ExtensionFun () -> Assertion)
-> TestTree
test_TrackCostsWith String
"retaining" Int
10000 ((Term TyName Name DefaultUni ExtensionFun () -> Assertion)
 -> TestTree)
-> (Term TyName Name DefaultUni ExtensionFun () -> Assertion)
-> TestTree
forall a b. (a -> b) -> a -> b
$ \Term TyName Name DefaultUni ExtensionFun ()
term -> do
        let -- An 'ExBudgetMode' that retains all the individual budgets by sticking them into a
            -- 'DList'.
            retaining :: ExBudgetMode (DList ExBudget) uni fun
retaining = (ExBudgetCategory fun -> ExBudget -> DList ExBudget)
-> ExBudgetMode (DList ExBudget) uni fun
forall cost fun (uni :: * -> *).
Monoid cost =>
(ExBudgetCategory fun -> ExBudget -> cost)
-> ExBudgetMode cost uni fun
monoidalBudgeting ((ExBudgetCategory fun -> ExBudget -> DList ExBudget)
 -> ExBudgetMode (DList ExBudget) uni fun)
-> (ExBudgetCategory fun -> ExBudget -> DList ExBudget)
-> ExBudgetMode (DList ExBudget) uni fun
forall a b. (a -> b) -> a -> b
$ (ExBudget -> DList ExBudget)
-> ExBudgetCategory fun -> ExBudget -> DList ExBudget
forall a b. a -> b -> a
const ExBudget -> DList ExBudget
forall a. a -> DList a
DList.singleton
            typecheckAndRunRetainer :: CostingPart DefaultUni ExtensionFun
-> Term TyName Name DefaultUni ExtensionFun ()
-> Either
     (Error DefaultUni ExtensionFun ())
     (Either
        (CekEvaluationException Name DefaultUni ExtensionFun) [Integer],
      DList ExBudget)
typecheckAndRunRetainer = BuiltinSemanticsVariant ExtensionFun
-> (MachineParameters
      CekMachineCosts ExtensionFun (CekValue DefaultUni ExtensionFun ())
    -> Term Name DefaultUni ExtensionFun ()
    -> (Either
          (CekEvaluationException Name DefaultUni ExtensionFun) [Integer],
        DList ExBudget))
-> CostingPart DefaultUni ExtensionFun
-> Term TyName Name DefaultUni ExtensionFun ()
-> Either
     (Error DefaultUni ExtensionFun ())
     (Either
        (CekEvaluationException Name DefaultUni ExtensionFun) [Integer],
      DList ExBudget)
forall (uni :: * -> *) fun (m :: * -> *) a.
(MonadError (Error uni fun ()) m, Typecheckable uni fun, GEq uni,
 Closed uni, Everywhere uni ExMemoryUsage) =>
BuiltinSemanticsVariant fun
-> (MachineParameters CekMachineCosts fun (CekValue uni fun ())
    -> Term Name uni fun () -> a)
-> CostingPart uni fun
-> Term TyName Name uni fun ()
-> m a
typecheckAnd BuiltinSemanticsVariant ExtensionFun
forall a. Default a => a
def ((MachineParameters
    CekMachineCosts ExtensionFun (CekValue DefaultUni ExtensionFun ())
  -> Term Name DefaultUni ExtensionFun ()
  -> (Either
        (CekEvaluationException Name DefaultUni ExtensionFun) [Integer],
      DList ExBudget))
 -> CostingPart DefaultUni ExtensionFun
 -> Term TyName Name DefaultUni ExtensionFun ()
 -> Either
      (Error DefaultUni ExtensionFun ())
      (Either
         (CekEvaluationException Name DefaultUni ExtensionFun) [Integer],
       DList ExBudget))
-> (MachineParameters
      CekMachineCosts ExtensionFun (CekValue DefaultUni ExtensionFun ())
    -> Term Name DefaultUni ExtensionFun ()
    -> (Either
          (CekEvaluationException Name DefaultUni ExtensionFun) [Integer],
        DList ExBudget))
-> CostingPart DefaultUni ExtensionFun
-> Term TyName Name DefaultUni ExtensionFun ()
-> Either
     (Error DefaultUni ExtensionFun ())
     (Either
        (CekEvaluationException Name DefaultUni ExtensionFun) [Integer],
      DList ExBudget)
forall a b. (a -> b) -> a -> b
$ \MachineParameters
  CekMachineCosts ExtensionFun (CekValue DefaultUni ExtensionFun ())
params Term Name DefaultUni ExtensionFun ()
term' ->
                let (Either
  (CekEvaluationException Name DefaultUni ExtensionFun)
  (Term Name DefaultUni ExtensionFun ())
getRes, DList ExBudget
budgets) = MachineParameters
  CekMachineCosts ExtensionFun (CekValue DefaultUni ExtensionFun ())
-> ExBudgetMode (DList ExBudget) DefaultUni ExtensionFun
-> Term Name DefaultUni ExtensionFun ()
-> (Either
      (CekEvaluationException Name DefaultUni ExtensionFun)
      (Term Name DefaultUni ExtensionFun ()),
    DList ExBudget)
forall (uni :: * -> *) fun ann cost.
ThrowableBuiltins uni fun =>
MachineParameters CekMachineCosts fun (CekValue uni fun ann)
-> ExBudgetMode cost uni fun
-> Term Name uni fun ann
-> (Either
      (CekEvaluationException Name uni fun) (Term Name uni fun ()),
    cost)
runCekNoEmit MachineParameters
  CekMachineCosts ExtensionFun (CekValue DefaultUni ExtensionFun ())
params ExBudgetMode (DList ExBudget) DefaultUni ExtensionFun
forall {uni :: * -> *} {fun}. ExBudgetMode (DList ExBudget) uni fun
retaining Term Name DefaultUni ExtensionFun ()
term'
                in (Either
  (CekEvaluationException Name DefaultUni ExtensionFun)
  (Term Name DefaultUni ExtensionFun ())
getRes Either
  (CekEvaluationException Name DefaultUni ExtensionFun)
  (Term Name DefaultUni ExtensionFun ())
-> (Term Name DefaultUni ExtensionFun ()
    -> Either
         (CekEvaluationException Name DefaultUni ExtensionFun) [Integer])
-> Either
     (CekEvaluationException Name DefaultUni ExtensionFun) [Integer]
forall a b.
Either (CekEvaluationException Name DefaultUni ExtensionFun) a
-> (a
    -> Either (CekEvaluationException Name DefaultUni ExtensionFun) b)
-> Either (CekEvaluationException Name DefaultUni ExtensionFun) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Term Name DefaultUni ExtensionFun ()
-> Either
     (CekEvaluationException Name DefaultUni ExtensionFun) [Integer]
forall val a err.
(ReadKnown val a, AsUnliftingEvaluationError err,
 AsEvaluationFailure err) =>
val -> Either (ErrorWithCause err val) a
readKnownSelf, DList ExBudget
budgets)
        case CostingPart DefaultUni ExtensionFun
-> Term TyName Name DefaultUni ExtensionFun ()
-> Either
     (Error DefaultUni ExtensionFun ())
     (Either
        (CekEvaluationException Name DefaultUni ExtensionFun) [Integer],
      DList ExBudget)
typecheckAndRunRetainer () Term TyName Name DefaultUni ExtensionFun ()
term of
            Left Error DefaultUni ExtensionFun ()
err                                  -> String -> Assertion
forall a. String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Assertion) -> String -> Assertion
forall a b. (a -> b) -> a -> b
$ Error DefaultUni ExtensionFun () -> String
forall a str. (PrettyPlc a, Render str) => a -> str
displayPlc Error DefaultUni ExtensionFun ()
err
            Right (Left CekEvaluationException Name DefaultUni ExtensionFun
err, DList ExBudget
_)                       -> String -> Assertion
forall a. String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Assertion) -> String -> Assertion
forall a b. (a -> b) -> a -> b
$ CekEvaluationException Name DefaultUni ExtensionFun -> String
forall a str. (PrettyPlc a, Render str) => a -> str
displayPlc CekEvaluationException Name DefaultUni ExtensionFun
err
            Right (Right ([Integer]
res :: [Integer]), DList ExBudget
budgets) -> do
                -- @length budgets@ is for retaining @budgets@ for as long as possible just in case.
                -- @3@ is just for giving us room to handle erratic GC behavior. It really should be
                -- @1@.
                let expected :: Int
expected = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
5 (DList ExBudget -> Int
forall a. DList a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length DList ExBudget
budgets)
                    actual :: Int
actual = [Integer] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Integer]
res
                    err :: String
err = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
                        [ String
"Too many elements picked up by GC\n"
                        , String
"Expected at most: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
expected String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n"
                        , String
"But got: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
actual String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n"
                        , String
"The result was: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Integer] -> String
forall a. Show a => a -> String
show [Integer]
res
                        ]
                HasCallStack => String -> Bool -> Assertion
String -> Bool -> Assertion
assertBool String
err (Bool -> Assertion) -> Bool -> Assertion
forall a b. (a -> b) -> a -> b
$ Int
expected Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
actual
#else
    -- FIXME: @effectfully
    -- broken only for darwin :x86_64-darwin.ghc810 <https://ci.iog.io/build/5076829/nixlog/1>
    -- TrackCosts: retaining:                                                             FAIL (0.51s)
    -- untyped-plutus-core/test/Evaluation/Builtins/Definition.hs:482:
    -- Too many elements picked up by GC
    -- Expected at most: 5
    -- But got: 6
    -- The result was: [6829,0,0,0,0,3173]
    -- Use -p '/TrackCosts: retaining/' to rerun this test only.
    testCase "TrackCosts: retaining" $ do
        assertBool "dummy" $ not . null $ DList.singleton 'x' -- Avoid 'redundant-imports' warning
#endif

typecheckAndEvalToOutOfEx :: Term TyName Name DefaultUni DefaultFun () -> Assertion
typecheckAndEvalToOutOfEx :: Term TyName Name DefaultUni DefaultFun () -> Assertion
typecheckAndEvalToOutOfEx Term TyName Name DefaultUni DefaultFun ()
term =
    let evalRestricting :: MachineParameters CekMachineCosts fun (CekValue uni fun ann)
-> Term Name uni fun ann
-> Either
     (CekEvaluationException Name uni fun) (Term Name uni fun ())
evalRestricting MachineParameters CekMachineCosts fun (CekValue uni fun ann)
params = (Either
   (CekEvaluationException Name uni fun) (Term Name uni fun ()),
 RestrictingSt)
-> Either
     (CekEvaluationException Name uni fun) (Term Name uni fun ())
forall a b. (a, b) -> a
fst ((Either
    (CekEvaluationException Name uni fun) (Term Name uni fun ()),
  RestrictingSt)
 -> Either
      (CekEvaluationException Name uni fun) (Term Name uni fun ()))
-> (Term Name uni fun ann
    -> (Either
          (CekEvaluationException Name uni fun) (Term Name uni fun ()),
        RestrictingSt))
-> Term Name uni fun ann
-> Either
     (CekEvaluationException Name uni fun) (Term Name uni fun ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MachineParameters CekMachineCosts fun (CekValue uni fun ann)
-> ExBudgetMode RestrictingSt uni fun
-> Term Name uni fun ann
-> (Either
      (CekEvaluationException Name uni fun) (Term Name uni fun ()),
    RestrictingSt)
forall (uni :: * -> *) fun ann cost.
ThrowableBuiltins uni fun =>
MachineParameters CekMachineCosts fun (CekValue uni fun ann)
-> ExBudgetMode cost uni fun
-> Term Name uni fun ann
-> (Either
      (CekEvaluationException Name uni fun) (Term Name uni fun ()),
    cost)
runCekNoEmit MachineParameters CekMachineCosts fun (CekValue uni fun ann)
params ExBudgetMode RestrictingSt uni fun
forall (uni :: * -> *) fun.
ThrowableBuiltins uni fun =>
ExBudgetMode RestrictingSt uni fun
restrictingLarge
    in case BuiltinSemanticsVariant DefaultFun
-> (MachineParameters
      CekMachineCosts DefaultFun (CekValue DefaultUni DefaultFun ())
    -> Term Name DefaultUni DefaultFun ()
    -> Either
         (CekEvaluationException Name DefaultUni DefaultFun)
         (Term Name DefaultUni DefaultFun ()))
-> CostingPart DefaultUni DefaultFun
-> Term TyName Name DefaultUni DefaultFun ()
-> Either
     (Error DefaultUni DefaultFun ())
     (Either
        (CekEvaluationException Name DefaultUni DefaultFun)
        (Term Name DefaultUni DefaultFun ()))
forall (uni :: * -> *) fun (m :: * -> *) a.
(MonadError (Error uni fun ()) m, Typecheckable uni fun, GEq uni,
 Closed uni, Everywhere uni ExMemoryUsage) =>
BuiltinSemanticsVariant fun
-> (MachineParameters CekMachineCosts fun (CekValue uni fun ())
    -> Term Name uni fun () -> a)
-> CostingPart uni fun
-> Term TyName Name uni fun ()
-> m a
typecheckAnd BuiltinSemanticsVariant DefaultFun
forall a. Default a => a
def MachineParameters
  CekMachineCosts DefaultFun (CekValue DefaultUni DefaultFun ())
-> Term Name DefaultUni DefaultFun ()
-> Either
     (CekEvaluationException Name DefaultUni DefaultFun)
     (Term Name DefaultUni DefaultFun ())
forall {uni :: * -> *} {fun} {ann}.
(Everywhere uni PrettyConst, PrettyParens (SomeTypeIn uni),
 Closed uni, Pretty fun, Typeable uni, Typeable fun) =>
MachineParameters CekMachineCosts fun (CekValue uni fun ann)
-> Term Name uni fun ann
-> Either
     (CekEvaluationException Name uni fun) (Term Name uni fun ())
evalRestricting BuiltinCostModel
CostingPart DefaultUni DefaultFun
defaultBuiltinCostModelForTesting Term TyName Name DefaultUni DefaultFun ()
term of
        Right (Left (ErrorWithCause (OperationalEvaluationError (CekOutOfExError ExRestrictingBudget
_)) Maybe (Term Name DefaultUni DefaultFun ())
_)) ->
            () -> Assertion
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        Either
  (Error DefaultUni DefaultFun ())
  (Either
     (CekEvaluationException Name DefaultUni DefaultFun)
     (Term Name DefaultUni DefaultFun ()))
err -> String -> Assertion
forall a. HasCallStack => String -> IO a
assertFailure (String -> Assertion) -> String -> Assertion
forall a b. (a -> b) -> a -> b
$ String
"Expected a 'CekOutOfExError' but got: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Either
  (Error DefaultUni DefaultFun ())
  (Either
     (CekEvaluationException Name DefaultUni DefaultFun)
     (Term Name DefaultUni DefaultFun ()))
-> String
forall a str. (PrettyPlc a, Render str) => a -> str
displayPlc Either
  (Error DefaultUni DefaultFun ())
  (Either
     (CekEvaluationException Name DefaultUni DefaultFun)
     (Term Name DefaultUni DefaultFun ()))
err

test_SerialiseDataImpossible :: TestTree
test_SerialiseDataImpossible :: TestTree
test_SerialiseDataImpossible =
    String -> Assertion -> TestTree
testCase String
"Serialising an impossible 'Data' object runs out of budget and finishes" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ do
        let dataLoop :: Term TyName Name DefaultUni DefaultFun ()
            dataLoop :: Term TyName Name DefaultUni DefaultFun ()
dataLoop =
                let loop :: Data
loop = [Data] -> Data
List [Data
loop]
                in ()
-> Term TyName Name DefaultUni DefaultFun ()
-> Term TyName Name DefaultUni DefaultFun ()
-> Term TyName Name DefaultUni DefaultFun ()
forall tyname name (uni :: * -> *) fun ann.
ann
-> Term tyname name uni fun ann
-> Term tyname name uni fun ann
-> Term tyname name uni fun ann
Apply () (() -> DefaultFun -> Term TyName Name DefaultUni DefaultFun ()
forall tyname name (uni :: * -> *) fun ann.
ann -> fun -> Term tyname name uni fun ann
Builtin () DefaultFun
SerialiseData) (Term TyName Name DefaultUni DefaultFun ()
 -> Term TyName Name DefaultUni DefaultFun ())
-> Term TyName Name DefaultUni DefaultFun ()
-> Term TyName Name DefaultUni DefaultFun ()
forall a b. (a -> b) -> a -> b
$ () -> Data -> Term TyName Name DefaultUni DefaultFun ()
forall a (uni :: * -> *) fun (term :: * -> *) tyname name ann.
(TermLike term tyname name uni fun, HasTermLevel uni a) =>
ann -> a -> term ann
mkConstant () Data
loop
        Term TyName Name DefaultUni DefaultFun () -> Assertion
typecheckAndEvalToOutOfEx Term TyName Name DefaultUni DefaultFun ()
dataLoop

test_fixId :: TestTree
test_fixId :: TestTree
test_fixId =
    String -> Assertion -> TestTree
testCase String
"'fix id' runs out of budget and finishes" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ do
        let fixId :: Term TyName Name DefaultUni DefaultFun ()
            fixId :: Term TyName Name DefaultUni DefaultFun ()
fixId =
                Term TyName Name DefaultUni DefaultFun ()
-> [Term TyName Name DefaultUni DefaultFun ()]
-> Term TyName Name DefaultUni DefaultFun ()
forall (term :: * -> *) tyname name (uni :: * -> *) fun.
TermLike term tyname name uni fun =>
term () -> [term ()] -> term ()
mkIterAppNoAnn (Term TyName Name DefaultUni DefaultFun ()
-> [Type TyName DefaultUni ()]
-> Term TyName Name DefaultUni DefaultFun ()
forall (term :: * -> *) tyname name (uni :: * -> *) fun.
TermLike term tyname name uni fun =>
term () -> [Type tyname uni ()] -> term ()
mkIterInstNoAnn Term TyName Name DefaultUni DefaultFun ()
forall (term :: * -> *) (uni :: * -> *) fun.
TermLike term TyName Name uni fun =>
term ()
Plc.fix [Type TyName DefaultUni ()
forall (uni :: * -> *) tyname.
HasTypeLevel uni Integer =>
Type tyname uni ()
integer, Type TyName DefaultUni ()
forall (uni :: * -> *) tyname.
HasTypeLevel uni Integer =>
Type tyname uni ()
integer])
                    [ ()
-> Term TyName Name DefaultUni DefaultFun ()
-> Type TyName DefaultUni ()
-> Term TyName Name DefaultUni DefaultFun ()
forall ann.
ann
-> Term TyName Name DefaultUni DefaultFun ann
-> Type TyName DefaultUni ann
-> Term TyName Name DefaultUni DefaultFun ann
forall (term :: * -> *) tyname name (uni :: * -> *) fun ann.
TermLike term tyname name uni fun =>
ann -> term ann -> Type tyname uni ann -> term ann
tyInst () Term TyName Name DefaultUni DefaultFun ()
forall (term :: * -> *) (uni :: * -> *) fun.
TermLike term TyName Name uni fun =>
term ()
Plc.idFun (()
-> Type TyName DefaultUni ()
-> Type TyName DefaultUni ()
-> Type TyName DefaultUni ()
forall tyname (uni :: * -> *) ann.
ann
-> Type tyname uni ann
-> Type tyname uni ann
-> Type tyname uni ann
TyFun () Type TyName DefaultUni ()
forall (uni :: * -> *) tyname.
HasTypeLevel uni Integer =>
Type tyname uni ()
integer Type TyName DefaultUni ()
forall (uni :: * -> *) tyname.
HasTypeLevel uni Integer =>
Type tyname uni ()
integer)
                    , forall a (uni :: * -> *) fun (term :: * -> *) tyname name ann.
(TermLike term tyname name uni fun, HasTermLevel uni a) =>
ann -> a -> term ann
mkConstant @Integer () Integer
42
                    ]
        Term TyName Name DefaultUni DefaultFun () -> Assertion
typecheckAndEvalToOutOfEx Term TyName Name DefaultUni DefaultFun ()
fixId

-- | If the first char is an opening paren and the last chat is a closing paren, then remove them.
-- This is useful for rendering a term-as-a-test-name in CLI, since currently we wrap readably
-- pretty-printed terms in parens (which is to be fixed).
stripParensIfAny :: String -> String
stripParensIfAny :: String -> String
stripParensIfAny str :: String
str@(Char
'(' : String
str1) | String -> Char
forall a. HasCallStack => [a] -> a
last String
str Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
')' = String -> String
forall a. HasCallStack => [a] -> [a]
init String
str1
stripParensIfAny String
str                                = String
str

-- | Apply a built-in function to type then term arguments, evaluate that expression and expect
-- evaluation to succeed and return the given @a@ value.
evals
    :: DefaultUni `HasTermLevel` a
    => a
    -> DefaultFun
    -> [Type TyName DefaultUni ()]
    -> [Term TyName Name DefaultUni DefaultFun ()]
    -> TestNested
evals :: forall a.
HasTermLevel DefaultUni a =>
a
-> DefaultFun
-> [Type TyName DefaultUni ()]
-> [Term TyName Name DefaultUni DefaultFun ()]
-> TestNested
evals a
expectedVal DefaultFun
fun [Type TyName DefaultUni ()]
typeArgs [Term TyName Name DefaultUni DefaultFun ()]
termArgs =
    let actualExpNoTermArgs :: Term TyName Name DefaultUni DefaultFun ()
actualExpNoTermArgs = Term TyName Name DefaultUni DefaultFun ()
-> [Type TyName DefaultUni ()]
-> Term TyName Name DefaultUni DefaultFun ()
forall (term :: * -> *) tyname name (uni :: * -> *) fun.
TermLike term tyname name uni fun =>
term () -> [Type tyname uni ()] -> term ()
mkIterInstNoAnn (() -> DefaultFun -> Term TyName Name DefaultUni DefaultFun ()
forall ann.
ann -> DefaultFun -> Term TyName Name DefaultUni DefaultFun ann
forall (term :: * -> *) tyname name (uni :: * -> *) fun ann.
TermLike term tyname name uni fun =>
ann -> fun -> term ann
builtin () DefaultFun
fun) [Type TyName DefaultUni ()]
typeArgs
        actualExp :: Term TyName Name DefaultUni DefaultFun ()
actualExp = Term TyName Name DefaultUni DefaultFun ()
-> [Term TyName Name DefaultUni DefaultFun ()]
-> Term TyName Name DefaultUni DefaultFun ()
forall (term :: * -> *) tyname name (uni :: * -> *) fun.
TermLike term tyname name uni fun =>
term () -> [term ()] -> term ()
mkIterAppNoAnn Term TyName Name DefaultUni DefaultFun ()
actualExpNoTermArgs [Term TyName Name DefaultUni DefaultFun ()]
termArgs
        prename :: String
prename = String -> String
stripParensIfAny (String -> String) -> (Doc Any -> String) -> Doc Any -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc Any -> String
forall ann. Doc ann -> String
forall str ann. Render str => Doc ann -> str
render (Doc Any -> String) -> Doc Any -> String
forall a b. (a -> b) -> a -> b
$ Term TyName Name DefaultUni DefaultFun () -> Doc Any
forall a ann. PrettyPlc a => a -> Doc ann
prettyPlcReadable Term TyName Name DefaultUni DefaultFun ()
actualExp
        -- Shorten the name of the test in case it's too long to be displayed in CLI.
        name :: String
name = if String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
prename Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
70 then String
prename else
            String -> String
stripParensIfAny (Doc Any -> String
forall ann. Doc ann -> String
forall str ann. Render str => Doc ann -> str
render (Doc Any -> String) -> Doc Any -> String
forall a b. (a -> b) -> a -> b
$ Term TyName Name DefaultUni DefaultFun () -> Doc Any
forall a ann. PrettyPlc a => a -> Doc ann
prettyPlcReadable Term TyName Name DefaultUni DefaultFun ()
actualExpNoTermArgs) String -> String -> String
forall a. [a] -> [a] -> [a]
++
                (Term TyName Name DefaultUni DefaultFun () -> String)
-> [Term TyName Name DefaultUni DefaultFun ()] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\Term TyName Name DefaultUni DefaultFun ()
_ -> String
" <...>") [Term TyName Name DefaultUni DefaultFun ()]
termArgs
        expectedRes :: Either a (EvaluationResult (Term Name DefaultUni DefaultFun ()))
expectedRes = EvaluationResult (Term Name DefaultUni DefaultFun ())
-> Either a (EvaluationResult (Term Name DefaultUni DefaultFun ()))
forall a b. b -> Either a b
Right (EvaluationResult (Term Name DefaultUni DefaultFun ())
 -> Either
      a (EvaluationResult (Term Name DefaultUni DefaultFun ())))
-> (Term Name DefaultUni DefaultFun ()
    -> EvaluationResult (Term Name DefaultUni DefaultFun ()))
-> Term Name DefaultUni DefaultFun ()
-> Either a (EvaluationResult (Term Name DefaultUni DefaultFun ()))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Term Name DefaultUni DefaultFun ()
-> EvaluationResult (Term Name DefaultUni DefaultFun ())
forall a. a -> EvaluationResult a
EvaluationSuccess (Term Name DefaultUni DefaultFun ()
 -> Either
      a (EvaluationResult (Term Name DefaultUni DefaultFun ())))
-> Term Name DefaultUni DefaultFun ()
-> Either a (EvaluationResult (Term Name DefaultUni DefaultFun ()))
forall a b. (a -> b) -> a -> b
$ a -> Term Name DefaultUni DefaultFun ()
forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons a
expectedVal
        actualRes :: Either
  (Error DefaultUni DefaultFun ())
  (EvaluationResult (Term Name DefaultUni DefaultFun ()))
actualRes = BuiltinSemanticsVariant DefaultFun
-> CostingPart DefaultUni DefaultFun
-> Term TyName Name DefaultUni DefaultFun ()
-> Either
     (Error DefaultUni DefaultFun ())
     (EvaluationResult (Term Name DefaultUni DefaultFun ()))
forall (uni :: * -> *) fun (m :: * -> *).
(MonadError (Error uni fun ()) m, Typecheckable uni fun, GEq uni,
 Everywhere uni ExMemoryUsage, PrettyUni uni, Pretty fun) =>
BuiltinSemanticsVariant fun
-> CostingPart uni fun
-> Term TyName Name uni fun ()
-> m (EvaluationResult (Term Name uni fun ()))
typecheckEvaluateCekNoEmit BuiltinSemanticsVariant DefaultFun
forall a. Default a => a
def BuiltinCostModel
CostingPart DefaultUni DefaultFun
defaultBuiltinCostModelForTesting Term TyName Name DefaultUni DefaultFun ()
actualExp
    in String -> TestNested -> TestNested
testNestedM String
name (TestNested -> TestNested)
-> (Assertion -> TestNested) -> Assertion -> TestNested
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TestTree -> TestNested
forall a (m :: * -> *). MonadFree ((,) a) m => a -> m ()
embed (TestTree -> TestNested)
-> (Assertion -> TestTree) -> Assertion -> TestNested
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Assertion -> TestTree
testCase String
"type checks and evaluates as expected" (Assertion -> TestNested) -> Assertion -> TestNested
forall a b. (a -> b) -> a -> b
$
        Either
  (Error DefaultUni DefaultFun ())
  (EvaluationResult (Term Name DefaultUni DefaultFun ()))
forall {a}.
Either a (EvaluationResult (Term Name DefaultUni DefaultFun ()))
expectedRes Either
  (Error DefaultUni DefaultFun ())
  (EvaluationResult (Term Name DefaultUni DefaultFun ()))
-> Either
     (Error DefaultUni DefaultFun ())
     (EvaluationResult (Term Name DefaultUni DefaultFun ()))
-> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@=? Either
  (Error DefaultUni DefaultFun ())
  (EvaluationResult (Term Name DefaultUni DefaultFun ()))
actualRes

-- | Apply a built-in function to type then term arguments, evaluate that expression and expect
-- evaluation to fail. The logs along with the error are printed to a golden file.
fails
    :: String  -- ^ Name of the golden file.
    -> DefaultFun
    -> [Type TyName DefaultUni ()]
    -> [Term TyName Name DefaultUni DefaultFun ()]
    -> TestNested
fails :: String
-> DefaultFun
-> [Type TyName DefaultUni ()]
-> [Term TyName Name DefaultUni DefaultFun ()]
-> TestNested
fails String
fileName DefaultFun
fun [Type TyName DefaultUni ()]
typeArgs [Term TyName Name DefaultUni DefaultFun ()]
termArgs = do
    let actualExpNoTermArgs :: Term TyName Name DefaultUni DefaultFun ()
actualExpNoTermArgs = Term TyName Name DefaultUni DefaultFun ()
-> [Type TyName DefaultUni ()]
-> Term TyName Name DefaultUni DefaultFun ()
forall (term :: * -> *) tyname name (uni :: * -> *) fun.
TermLike term tyname name uni fun =>
term () -> [Type tyname uni ()] -> term ()
mkIterInstNoAnn (() -> DefaultFun -> Term TyName Name DefaultUni DefaultFun ()
forall ann.
ann -> DefaultFun -> Term TyName Name DefaultUni DefaultFun ann
forall (term :: * -> *) tyname name (uni :: * -> *) fun ann.
TermLike term tyname name uni fun =>
ann -> fun -> term ann
builtin () DefaultFun
fun) [Type TyName DefaultUni ()]
typeArgs
        actualExp :: Term TyName Name DefaultUni DefaultFun ()
actualExp = Term TyName Name DefaultUni DefaultFun ()
-> [Term TyName Name DefaultUni DefaultFun ()]
-> Term TyName Name DefaultUni DefaultFun ()
forall (term :: * -> *) tyname name (uni :: * -> *) fun.
TermLike term tyname name uni fun =>
term () -> [term ()] -> term ()
mkIterAppNoAnn Term TyName Name DefaultUni DefaultFun ()
actualExpNoTermArgs [Term TyName Name DefaultUni DefaultFun ()]
termArgs
        expectedToDisplay :: String
expectedToDisplay = String
"type checks and fails evaluation as expected"
    case BuiltinSemanticsVariant DefaultFun
-> (MachineParameters
      CekMachineCosts DefaultFun (CekValue DefaultUni DefaultFun ())
    -> Term Name DefaultUni DefaultFun ()
    -> (Either
          (CekEvaluationException Name DefaultUni DefaultFun)
          (Term Name DefaultUni DefaultFun ()),
        [Text]))
-> CostingPart DefaultUni DefaultFun
-> Term TyName Name DefaultUni DefaultFun ()
-> Either
     (Error DefaultUni DefaultFun ())
     (Either
        (CekEvaluationException Name DefaultUni DefaultFun)
        (Term Name DefaultUni DefaultFun ()),
      [Text])
forall (uni :: * -> *) fun (m :: * -> *) a.
(MonadError (Error uni fun ()) m, Typecheckable uni fun, GEq uni,
 Closed uni, Everywhere uni ExMemoryUsage) =>
BuiltinSemanticsVariant fun
-> (MachineParameters CekMachineCosts fun (CekValue uni fun ())
    -> Term Name uni fun () -> a)
-> CostingPart uni fun
-> Term TyName Name uni fun ()
-> m a
typecheckAnd BuiltinSemanticsVariant DefaultFun
forall a. Default a => a
def (EmitterMode DefaultUni DefaultFun
-> MachineParameters
     CekMachineCosts DefaultFun (CekValue DefaultUni DefaultFun ())
-> Term Name DefaultUni DefaultFun ()
-> (Either
      (CekEvaluationException 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
logEmitter) BuiltinCostModel
CostingPart DefaultUni DefaultFun
defaultBuiltinCostModelForTesting Term TyName Name DefaultUni DefaultFun ()
actualExp of
        Left Error DefaultUni DefaultFun ()
err ->
            TestTree -> TestNested
forall a (m :: * -> *). MonadFree ((,) a) m => a -> m ()
embed (TestTree -> TestNested)
-> (Assertion -> TestTree) -> Assertion -> TestNested
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Assertion -> TestTree
testCase String
"type checks as expected" (Assertion -> TestNested) -> Assertion -> TestNested
forall a b. (a -> b) -> a -> b
$
                String -> Assertion
forall a. HasCallStack => String -> IO a
assertFailure (String -> Assertion) -> String -> Assertion
forall a b. (a -> b) -> a -> b
$ Error DefaultUni DefaultFun () -> String
forall a str. (PrettyPlc a, Render str) => a -> str
displayPlcCondensedErrorClassic Error DefaultUni DefaultFun ()
err
        Right (Either
  (CekEvaluationException Name DefaultUni DefaultFun)
  (Term Name DefaultUni DefaultFun ())
actualRes, [Text]
logs) -> case Either
  (CekEvaluationException Name DefaultUni DefaultFun)
  (Term Name DefaultUni DefaultFun ())
actualRes of
            Right Term Name DefaultUni DefaultFun ()
_ ->
                TestTree -> TestNested
forall a (m :: * -> *). MonadFree ((,) a) m => a -> m ()
embed (TestTree -> TestNested)
-> (Assertion -> TestTree) -> Assertion -> TestNested
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Assertion -> TestTree
testCase String
expectedToDisplay (Assertion -> TestNested) -> Assertion -> TestNested
forall a b. (a -> b) -> a -> b
$
                    String -> Assertion
forall a. HasCallStack => String -> IO a
assertFailure String
"expected an evaluation failure, but got a success"
            Left CekEvaluationException Name DefaultUni DefaultFun
err ->
                let prename :: String
prename = String -> String
stripParensIfAny (String -> String) -> (Doc Any -> String) -> Doc Any -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc Any -> String
forall ann. Doc ann -> String
forall str ann. Render str => Doc ann -> str
render (Doc Any -> String) -> Doc Any -> String
forall a b. (a -> b) -> a -> b
$ Term TyName Name DefaultUni DefaultFun () -> Doc Any
forall a ann. PrettyPlc a => a -> Doc ann
prettyPlcReadable Term TyName Name DefaultUni DefaultFun ()
actualExp
                    -- Shorten the name of the test in case it's too long to be displayed in CLI.
                    name :: String
name = if String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
prename Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
70 then String
prename else
                        String -> String
stripParensIfAny (Doc Any -> String
forall ann. Doc ann -> String
forall str ann. Render str => Doc ann -> str
render (Doc Any -> String) -> Doc Any -> String
forall a b. (a -> b) -> a -> b
$ Term TyName Name DefaultUni DefaultFun () -> Doc Any
forall a ann. PrettyPlc a => a -> Doc ann
prettyPlcReadable Term TyName Name DefaultUni DefaultFun ()
actualExpNoTermArgs) String -> String -> String
forall a. [a] -> [a] -> [a]
++
                            (Term TyName Name DefaultUni DefaultFun () -> String)
-> [Term TyName Name DefaultUni DefaultFun ()] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\Term TyName Name DefaultUni DefaultFun ()
_ -> String
" <...>") [Term TyName Name DefaultUni DefaultFun ()]
termArgs
                in String -> String -> TestNested -> TestNested
testNestedNamedM String
forall a. Monoid a => a
mempty String
name (TestNested -> TestNested) -> TestNested -> TestNested
forall a b. (a -> b) -> a -> b
$
                    String -> String -> TestNested -> TestNested
testNestedNamedM String
forall a. Monoid a => a
mempty String
expectedToDisplay (TestNested -> TestNested) -> TestNested -> TestNested
forall a b. (a -> b) -> a -> b
$
                        String -> String -> Doc Any -> TestNested
forall ann. String -> String -> Doc ann -> TestNested
nestedGoldenVsDoc String
fileName String
".err" (Doc Any -> TestNested)
-> ([Doc Any] -> Doc Any) -> [Doc Any] -> TestNested
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc Any] -> Doc Any
forall ann. [Doc ann] -> Doc ann
vsep ([Doc Any] -> TestNested) -> [Doc Any] -> TestNested
forall a b. (a -> b) -> a -> b
$ [[Doc Any]] -> [Doc Any]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
                            [ [CekEvaluationException Name DefaultUni DefaultFun -> Doc Any
forall a ann. PrettyPlc a => a -> Doc ann
prettyPlcReadable CekEvaluationException Name DefaultUni DefaultFun
err]
                            , [Doc Any
"Logs were:" | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [Text] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
logs]
                            , (Text -> Doc Any) -> [Text] -> [Doc Any]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Doc Any
forall ann. Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Text]
logs
                            ]

-- | Test all integer related builtins
test_Integer :: TestNested
test_Integer :: TestNested
test_Integer = String -> TestNested -> TestNested
testNestedM String
"Integer" (TestNested -> TestNested) -> TestNested -> TestNested
forall a b. (a -> b) -> a -> b
$ do
    forall a.
HasTermLevel DefaultUni a =>
a
-> DefaultFun
-> [Type TyName DefaultUni ()]
-> [Term TyName Name DefaultUni DefaultFun ()]
-> TestNested
evals @Integer Integer
3 DefaultFun
AddInteger [] [forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons @Integer Integer
2, forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons @Integer Integer
1]
    forall a.
HasTermLevel DefaultUni a =>
a
-> DefaultFun
-> [Type TyName DefaultUni ()]
-> [Term TyName Name DefaultUni DefaultFun ()]
-> TestNested
evals @Integer Integer
2 DefaultFun
SubtractInteger [] [forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons @Integer Integer
100, forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons @Integer Integer
98]
    forall a.
HasTermLevel DefaultUni a =>
a
-> DefaultFun
-> [Type TyName DefaultUni ()]
-> [Term TyName Name DefaultUni DefaultFun ()]
-> TestNested
evals @Integer (-Integer
2) DefaultFun
SubtractInteger [] [forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons @Integer Integer
98, forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons @Integer Integer
100]
    forall a.
HasTermLevel DefaultUni a =>
a
-> DefaultFun
-> [Type TyName DefaultUni ()]
-> [Term TyName Name DefaultUni DefaultFun ()]
-> TestNested
evals @Integer Integer
9702 DefaultFun
MultiplyInteger [] [forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons @Integer Integer
99, forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons @Integer Integer
98]
    forall a.
HasTermLevel DefaultUni a =>
a
-> DefaultFun
-> [Type TyName DefaultUni ()]
-> [Term TyName Name DefaultUni DefaultFun ()]
-> TestNested
evals @Integer (-Integer
3) DefaultFun
DivideInteger [] [forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons @Integer Integer
99, forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons @Integer (-Integer
34)]
    forall a.
HasTermLevel DefaultUni a =>
a
-> DefaultFun
-> [Type TyName DefaultUni ()]
-> [Term TyName Name DefaultUni DefaultFun ()]
-> TestNested
evals @Integer (-Integer
2) DefaultFun
QuotientInteger [] [forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons @Integer Integer
99, forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons @Integer (-Integer
34)]
    forall a.
HasTermLevel DefaultUni a =>
a
-> DefaultFun
-> [Type TyName DefaultUni ()]
-> [Term TyName Name DefaultUni DefaultFun ()]
-> TestNested
evals @Integer Integer
31 DefaultFun
RemainderInteger [] [forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons @Integer Integer
99, forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons @Integer (-Integer
34)]
    forall a.
HasTermLevel DefaultUni a =>
a
-> DefaultFun
-> [Type TyName DefaultUni ()]
-> [Term TyName Name DefaultUni DefaultFun ()]
-> TestNested
evals @Integer (-Integer
3) DefaultFun
ModInteger [] [forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons @Integer Integer
99, forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons @Integer (-Integer
34)]
    Bool
-> DefaultFun
-> [Type TyName DefaultUni ()]
-> [Term TyName Name DefaultUni DefaultFun ()]
-> TestNested
forall a.
HasTermLevel DefaultUni a =>
a
-> DefaultFun
-> [Type TyName DefaultUni ()]
-> [Term TyName Name DefaultUni DefaultFun ()]
-> TestNested
evals Bool
True DefaultFun
LessThanInteger [] [forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons @Integer Integer
30, forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons @Integer Integer
4000]
    Bool
-> DefaultFun
-> [Type TyName DefaultUni ()]
-> [Term TyName Name DefaultUni DefaultFun ()]
-> TestNested
forall a.
HasTermLevel DefaultUni a =>
a
-> DefaultFun
-> [Type TyName DefaultUni ()]
-> [Term TyName Name DefaultUni DefaultFun ()]
-> TestNested
evals Bool
False DefaultFun
LessThanInteger [] [forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons @Integer Integer
40, forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons @Integer Integer
40]
    Bool
-> DefaultFun
-> [Type TyName DefaultUni ()]
-> [Term TyName Name DefaultUni DefaultFun ()]
-> TestNested
forall a.
HasTermLevel DefaultUni a =>
a
-> DefaultFun
-> [Type TyName DefaultUni ()]
-> [Term TyName Name DefaultUni DefaultFun ()]
-> TestNested
evals Bool
True DefaultFun
LessThanEqualsInteger [] [forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons @Integer Integer
30, forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons @Integer Integer
4000]
    Bool
-> DefaultFun
-> [Type TyName DefaultUni ()]
-> [Term TyName Name DefaultUni DefaultFun ()]
-> TestNested
forall a.
HasTermLevel DefaultUni a =>
a
-> DefaultFun
-> [Type TyName DefaultUni ()]
-> [Term TyName Name DefaultUni DefaultFun ()]
-> TestNested
evals Bool
True DefaultFun
LessThanEqualsInteger [] [forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons @Integer Integer
4000, forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons @Integer Integer
4000]
    Bool
-> DefaultFun
-> [Type TyName DefaultUni ()]
-> [Term TyName Name DefaultUni DefaultFun ()]
-> TestNested
forall a.
HasTermLevel DefaultUni a =>
a
-> DefaultFun
-> [Type TyName DefaultUni ()]
-> [Term TyName Name DefaultUni DefaultFun ()]
-> TestNested
evals Bool
False DefaultFun
LessThanEqualsInteger [] [forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons @Integer Integer
4001, forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons @Integer Integer
4000]
    Bool
-> DefaultFun
-> [Type TyName DefaultUni ()]
-> [Term TyName Name DefaultUni DefaultFun ()]
-> TestNested
forall a.
HasTermLevel DefaultUni a =>
a
-> DefaultFun
-> [Type TyName DefaultUni ()]
-> [Term TyName Name DefaultUni DefaultFun ()]
-> TestNested
evals Bool
True DefaultFun
EqualsInteger [] [forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons @Integer (-Integer
101), forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons @Integer (-Integer
101)]
    Bool
-> DefaultFun
-> [Type TyName DefaultUni ()]
-> [Term TyName Name DefaultUni DefaultFun ()]
-> TestNested
forall a.
HasTermLevel DefaultUni a =>
a
-> DefaultFun
-> [Type TyName DefaultUni ()]
-> [Term TyName Name DefaultUni DefaultFun ()]
-> TestNested
evals Bool
False DefaultFun
EqualsInteger [] [forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons @Integer Integer
0, forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons @Integer Integer
1]
    [DefaultFun] -> (DefaultFun -> TestNested) -> TestNested
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [DefaultFun
DivideInteger, DefaultFun
QuotientInteger, DefaultFun
ModInteger, DefaultFun
RemainderInteger] ((DefaultFun -> TestNested) -> TestNested)
-> (DefaultFun -> TestNested) -> TestNested
forall a b. (a -> b) -> a -> b
$ \ DefaultFun
b ->
        String
-> DefaultFun
-> [Type TyName DefaultUni ()]
-> [Term TyName Name DefaultUni DefaultFun ()]
-> TestNested
fails (String -> String
lowerInitialChar (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ DefaultFun -> String
forall a. Show a => a -> String
show DefaultFun
b String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"-div-by-zero") DefaultFun
b [] [forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons @Integer Integer
1, forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons @Integer Integer
0]
    TestNested
test_ExpModInteger

test_ExpModInteger :: TestNested
test_ExpModInteger :: TestNested
test_ExpModInteger = String -> TestNested -> TestNested
testNestedM String
"ExpMod" (TestNested -> TestNested) -> TestNested -> TestNested
forall a b. (a -> b) -> a -> b
$ do
    forall a.
HasTermLevel DefaultUni a =>
a
-> DefaultFun
-> [Type TyName DefaultUni ()]
-> [Term TyName Name DefaultUni DefaultFun ()]
-> TestNested
evals @Integer Integer
1 DefaultFun
b [] [Integer -> Term TyName Name DefaultUni DefaultFun ()
int Integer
500, Term TyName Name DefaultUni DefaultFun ()
zero, Integer -> Term TyName Name DefaultUni DefaultFun ()
int Integer
500] -- base:X, exp: zero, mod: X(strictpos)
    forall a.
HasTermLevel DefaultUni a =>
a
-> DefaultFun
-> [Type TyName DefaultUni ()]
-> [Term TyName Name DefaultUni DefaultFun ()]
-> TestNested
evals @Integer Integer
0 DefaultFun
b [] [Integer -> Term TyName Name DefaultUni DefaultFun ()
int Integer
500, Integer -> Term TyName Name DefaultUni DefaultFun ()
int Integer
5, Integer -> Term TyName Name DefaultUni DefaultFun ()
int Integer
500] -- base:X, exp: strictpos, mod: X(strictpos)
    forall a.
HasTermLevel DefaultUni a =>
a
-> DefaultFun
-> [Type TyName DefaultUni ()]
-> [Term TyName Name DefaultUni DefaultFun ()]
-> TestNested
evals @Integer Integer
1 DefaultFun
b [] [Term TyName Name DefaultUni DefaultFun ()
one , Integer -> Term TyName Name DefaultUni DefaultFun ()
int (-Integer
3), Integer -> Term TyName Name DefaultUni DefaultFun ()
int Integer
4] -- base:1, exp: * , mod: strictpos
    forall a.
HasTermLevel DefaultUni a =>
a
-> DefaultFun
-> [Type TyName DefaultUni ()]
-> [Term TyName Name DefaultUni DefaultFun ()]
-> TestNested
evals @Integer Integer
2 DefaultFun
b [] [Integer -> Term TyName Name DefaultUni DefaultFun ()
int Integer
2, Integer -> Term TyName Name DefaultUni DefaultFun ()
int (-Integer
3), Integer -> Term TyName Name DefaultUni DefaultFun ()
int Integer
3] -- base:*, exp: neg, mod: prime
    -- base is co-prime with mod and exponent is negative
    forall a.
HasTermLevel DefaultUni a =>
a
-> DefaultFun
-> [Type TyName DefaultUni ()]
-> [Term TyName Name DefaultUni DefaultFun ()]
-> TestNested
evals @Integer Integer
4 DefaultFun
b [] [Integer -> Term TyName Name DefaultUni DefaultFun ()
int Integer
4, Integer -> Term TyName Name DefaultUni DefaultFun ()
int (-Integer
5), Integer -> Term TyName Name DefaultUni DefaultFun ()
int Integer
9]
    -- Always return 0 when modulus is 1.
    forall a.
HasTermLevel DefaultUni a =>
a
-> DefaultFun
-> [Type TyName DefaultUni ()]
-> [Term TyName Name DefaultUni DefaultFun ()]
-> TestNested
evals @Integer Integer
0 DefaultFun
b [] [Term TyName Name DefaultUni DefaultFun ()
zero, Term TyName Name DefaultUni DefaultFun ()
zero, Term TyName Name DefaultUni DefaultFun ()
one] -- base:0, exp: zero, mod:1
    forall a.
HasTermLevel DefaultUni a =>
a
-> DefaultFun
-> [Type TyName DefaultUni ()]
-> [Term TyName Name DefaultUni DefaultFun ()]
-> TestNested
evals @Integer Integer
0 DefaultFun
b [] [Term TyName Name DefaultUni DefaultFun ()
zero, Term TyName Name DefaultUni DefaultFun ()
one, Term TyName Name DefaultUni DefaultFun ()
one] -- base:0, exp: 1, mod:1
    forall a.
HasTermLevel DefaultUni a =>
a
-> DefaultFun
-> [Type TyName DefaultUni ()]
-> [Term TyName Name DefaultUni DefaultFun ()]
-> TestNested
evals @Integer Integer
0 DefaultFun
b [] [Term TyName Name DefaultUni DefaultFun ()
zero, Integer -> Term TyName Name DefaultUni DefaultFun ()
int (-Integer
1), Term TyName Name DefaultUni DefaultFun ()
one] -- base:0, exp: neg, mod:1
    forall a.
HasTermLevel DefaultUni a =>
a
-> DefaultFun
-> [Type TyName DefaultUni ()]
-> [Term TyName Name DefaultUni DefaultFun ()]
-> TestNested
evals @Integer Integer
0 DefaultFun
b [] [Integer -> Term TyName Name DefaultUni DefaultFun ()
int Integer
500, Integer -> Term TyName Name DefaultUni DefaultFun ()
int Integer
222, Term TyName Name DefaultUni DefaultFun ()
one] -- base:*, exp: strictpos, mod:1
    forall a.
HasTermLevel DefaultUni a =>
a
-> DefaultFun
-> [Type TyName DefaultUni ()]
-> [Term TyName Name DefaultUni DefaultFun ()]
-> TestNested
evals @Integer Integer
0 DefaultFun
b [] [Integer -> Term TyName Name DefaultUni DefaultFun ()
int Integer
500, Integer -> Term TyName Name DefaultUni DefaultFun ()
int (-Integer
1777), Term TyName Name DefaultUni DefaultFun ()
one] -- base:*, exp: neg, mod:1
    String
-> DefaultFun
-> [Type TyName DefaultUni ()]
-> [Term TyName Name DefaultUni DefaultFun ()]
-> TestNested
fails String
"mod-zero" DefaultFun
b [] [Term TyName Name DefaultUni DefaultFun ()
one, Term TyName Name DefaultUni DefaultFun ()
one, Term TyName Name DefaultUni DefaultFun ()
zero] -- base:*, exp:*, mod: 0
    String
-> DefaultFun
-> [Type TyName DefaultUni ()]
-> [Term TyName Name DefaultUni DefaultFun ()]
-> TestNested
fails String
"mod-neg" DefaultFun
b [] [Term TyName Name DefaultUni DefaultFun ()
one, Term TyName Name DefaultUni DefaultFun ()
one, Integer -> Term TyName Name DefaultUni DefaultFun ()
int (-Integer
3)] -- base:*, exp:*, mod: neg
    -- base and mod are not co-prime, negative exponent
    String
-> DefaultFun
-> [Type TyName DefaultUni ()]
-> [Term TyName Name DefaultUni DefaultFun ()]
-> TestNested
fails String
"exp-neg-non-inverse1" DefaultFun
b [] [Integer -> Term TyName Name DefaultUni DefaultFun ()
int Integer
2, Integer -> Term TyName Name DefaultUni DefaultFun ()
int (-Integer
3), Integer -> Term TyName Name DefaultUni DefaultFun ()
int Integer
4]
    -- mod is prime, but base&mod are not co-prime, negative exponent
    String
-> DefaultFun
-> [Type TyName DefaultUni ()]
-> [Term TyName Name DefaultUni DefaultFun ()]
-> TestNested
fails String
"exp-neg-non-inverse2" DefaultFun
b [] [Integer -> Term TyName Name DefaultUni DefaultFun ()
int Integer
500, Integer -> Term TyName Name DefaultUni DefaultFun ()
int (-Integer
5), Integer -> Term TyName Name DefaultUni DefaultFun ()
int Integer
5]
  where
    int :: Integer -> Term TyName Name DefaultUni DefaultFun ()
int = forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons @Integer
    zero :: Term TyName Name DefaultUni DefaultFun ()
zero = Integer -> Term TyName Name DefaultUni DefaultFun ()
int Integer
0
    one :: Term TyName Name DefaultUni DefaultFun ()
one = Integer -> Term TyName Name DefaultUni DefaultFun ()
int Integer
1
    b :: DefaultFun
b = DefaultFun
ExpModInteger

-- | Test all string-like builtins
test_String :: TestNested
test_String :: TestNested
test_String = String -> TestNested -> TestNested
testNestedM String
"String" (TestNested -> TestNested) -> TestNested -> TestNested
forall a b. (a -> b) -> a -> b
$ do
    -- bytestrings
    forall a.
HasTermLevel DefaultUni a =>
a
-> DefaultFun
-> [Type TyName DefaultUni ()]
-> [Term TyName Name DefaultUni DefaultFun ()]
-> TestNested
evals @ByteString ByteString
"hello world" DefaultFun
AppendByteString [] [forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons @ByteString ByteString
"hello", forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons @ByteString ByteString
" world"]
    forall a.
HasTermLevel DefaultUni a =>
a
-> DefaultFun
-> [Type TyName DefaultUni ()]
-> [Term TyName Name DefaultUni DefaultFun ()]
-> TestNested
evals @ByteString ByteString
"mpla" DefaultFun
AppendByteString [] [forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons @ByteString ByteString
"", forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons @ByteString ByteString
"mpla"]
    Bool
-> DefaultFun
-> [Type TyName DefaultUni ()]
-> [Term TyName Name DefaultUni DefaultFun ()]
-> TestNested
forall a.
HasTermLevel DefaultUni a =>
a
-> DefaultFun
-> [Type TyName DefaultUni ()]
-> [Term TyName Name DefaultUni DefaultFun ()]
-> TestNested
evals Bool
False DefaultFun
EqualsByteString [] [forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons @ByteString ByteString
"" , forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons @ByteString ByteString
"mpla"]
    Bool
-> DefaultFun
-> [Type TyName DefaultUni ()]
-> [Term TyName Name DefaultUni DefaultFun ()]
-> TestNested
forall a.
HasTermLevel DefaultUni a =>
a
-> DefaultFun
-> [Type TyName DefaultUni ()]
-> [Term TyName Name DefaultUni DefaultFun ()]
-> TestNested
evals Bool
True DefaultFun
EqualsByteString [] [forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons @ByteString ByteString
"mpla" , forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons @ByteString ByteString
"mpla"]
    Bool
-> DefaultFun
-> [Type TyName DefaultUni ()]
-> [Term TyName Name DefaultUni DefaultFun ()]
-> TestNested
forall a.
HasTermLevel DefaultUni a =>
a
-> DefaultFun
-> [Type TyName DefaultUni ()]
-> [Term TyName Name DefaultUni DefaultFun ()]
-> TestNested
evals Bool
True DefaultFun
LessThanByteString  [] [forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons @ByteString ByteString
"" , forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons @ByteString ByteString
"mpla"]

    -- strings
    forall a.
HasTermLevel DefaultUni a =>
a
-> DefaultFun
-> [Type TyName DefaultUni ()]
-> [Term TyName Name DefaultUni DefaultFun ()]
-> TestNested
evals @Text Text
"mpla" DefaultFun
AppendString [] [forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons @Text Text
"", forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons @Text Text
"mpla"]
    Bool
-> DefaultFun
-> [Type TyName DefaultUni ()]
-> [Term TyName Name DefaultUni DefaultFun ()]
-> TestNested
forall a.
HasTermLevel DefaultUni a =>
a
-> DefaultFun
-> [Type TyName DefaultUni ()]
-> [Term TyName Name DefaultUni DefaultFun ()]
-> TestNested
evals Bool
False DefaultFun
EqualsString [] [forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons @Text Text
"" , forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons @Text Text
"mpla"]
    Bool
-> DefaultFun
-> [Type TyName DefaultUni ()]
-> [Term TyName Name DefaultUni DefaultFun ()]
-> TestNested
forall a.
HasTermLevel DefaultUni a =>
a
-> DefaultFun
-> [Type TyName DefaultUni ()]
-> [Term TyName Name DefaultUni DefaultFun ()]
-> TestNested
evals Bool
True DefaultFun
EqualsString [] [forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons @Text Text
"mpla" , forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons @Text Text
"mpla"]
    forall a.
HasTermLevel DefaultUni a =>
a
-> DefaultFun
-> [Type TyName DefaultUni ()]
-> [Term TyName Name DefaultUni DefaultFun ()]
-> TestNested
evals @Text Text
"hello world" DefaultFun
AppendString [] [forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons @Text Text
"hello", forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons @Text Text
" world"]

    -- id for subset char8 of utf8
    forall a.
HasTermLevel DefaultUni a =>
a
-> DefaultFun
-> [Type TyName DefaultUni ()]
-> [Term TyName Name DefaultUni DefaultFun ()]
-> TestNested
evals @ByteString ByteString
"hello world" DefaultFun
EncodeUtf8 [] [forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons @Text Text
"hello world"]
    forall a.
HasTermLevel DefaultUni a =>
a
-> DefaultFun
-> [Type TyName DefaultUni ()]
-> [Term TyName Name DefaultUni DefaultFun ()]
-> TestNested
evals @Text Text
"hello world" DefaultFun
DecodeUtf8 [] [forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons @ByteString ByteString
"hello world"]

    -- the 'o's replaced with greek o's, so they are kind of "invisible"
    forall a.
HasTermLevel DefaultUni a =>
a
-> DefaultFun
-> [Type TyName DefaultUni ()]
-> [Term TyName Name DefaultUni DefaultFun ()]
-> TestNested
evals @ByteString ByteString
"hell\206\191 w\206\191rld" DefaultFun
EncodeUtf8 [] [forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons @Text Text
"hellο wοrld"]
    -- cannot decode back, because bytestring only works on Char8 subset of utf8
    forall a.
HasTermLevel DefaultUni a =>
a
-> DefaultFun
-> [Type TyName DefaultUni ()]
-> [Term TyName Name DefaultUni DefaultFun ()]
-> TestNested
evals @Text Text
"hellο wοrld" DefaultFun
DecodeUtf8 [] [forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons @ByteString ByteString
"hell\206\191 w\206\191rld"]

    forall a.
HasTermLevel DefaultUni a =>
a
-> DefaultFun
-> [Type TyName DefaultUni ()]
-> [Term TyName Name DefaultUni DefaultFun ()]
-> TestNested
evals @ByteString ByteString
"\NULhello world" DefaultFun
ConsByteString [] [forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons @Integer Integer
0, forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons @ByteString ByteString
"hello world"]
    -- cannot overflow back to 0
    String
-> DefaultFun
-> [Type TyName DefaultUni ()]
-> [Term TyName Name DefaultUni DefaultFun ()]
-> TestNested
fails String
"consByteString-out-of-range" DefaultFun
ConsByteString []
        [forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons @Integer Integer
256, forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons @ByteString ByteString
"hello world"]
    forall a.
HasTermLevel DefaultUni a =>
a
-> DefaultFun
-> [Type TyName DefaultUni ()]
-> [Term TyName Name DefaultUni DefaultFun ()]
-> TestNested
evals @ByteString ByteString
"\240hello world" DefaultFun
ConsByteString [] [forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons @Integer Integer
240, forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons @ByteString ByteString
"hello world"]
    -- 65 is ASCII A
    forall a.
HasTermLevel DefaultUni a =>
a
-> DefaultFun
-> [Type TyName DefaultUni ()]
-> [Term TyName Name DefaultUni DefaultFun ()]
-> TestNested
evals @ByteString ByteString
"Ahello world" DefaultFun
ConsByteString [] [forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons @Integer Integer
65, forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons @ByteString ByteString
"hello world"]

    forall a.
HasTermLevel DefaultUni a =>
a
-> DefaultFun
-> [Type TyName DefaultUni ()]
-> [Term TyName Name DefaultUni DefaultFun ()]
-> TestNested
evals @ByteString ByteString
"h" DefaultFun
SliceByteString [] [forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons @Integer Integer
0, forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons @Integer Integer
1, forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons @ByteString ByteString
"hello world"]
    forall a.
HasTermLevel DefaultUni a =>
a
-> DefaultFun
-> [Type TyName DefaultUni ()]
-> [Term TyName Name DefaultUni DefaultFun ()]
-> TestNested
evals @ByteString ByteString
"he" DefaultFun
SliceByteString [] [forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons @Integer Integer
0, forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons @Integer Integer
2, forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons @ByteString ByteString
"hello world"]
    forall a.
HasTermLevel DefaultUni a =>
a
-> DefaultFun
-> [Type TyName DefaultUni ()]
-> [Term TyName Name DefaultUni DefaultFun ()]
-> TestNested
evals @ByteString ByteString
"el" DefaultFun
SliceByteString [] [forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons @Integer Integer
1, forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons @Integer Integer
2, forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons @ByteString ByteString
"hello world"]
    forall a.
HasTermLevel DefaultUni a =>
a
-> DefaultFun
-> [Type TyName DefaultUni ()]
-> [Term TyName Name DefaultUni DefaultFun ()]
-> TestNested
evals @ByteString ByteString
"world" DefaultFun
SliceByteString [] [forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons @Integer Integer
6, forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons @Integer Integer
5, forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons @ByteString ByteString
"hello world"]

    forall a.
HasTermLevel DefaultUni a =>
a
-> DefaultFun
-> [Type TyName DefaultUni ()]
-> [Term TyName Name DefaultUni DefaultFun ()]
-> TestNested
evals @Integer Integer
11 DefaultFun
LengthOfByteString [] [forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons @ByteString ByteString
"hello world"]
    forall a.
HasTermLevel DefaultUni a =>
a
-> DefaultFun
-> [Type TyName DefaultUni ()]
-> [Term TyName Name DefaultUni DefaultFun ()]
-> TestNested
evals @Integer Integer
0 DefaultFun
LengthOfByteString [] [forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons @ByteString ByteString
""]
    forall a.
HasTermLevel DefaultUni a =>
a
-> DefaultFun
-> [Type TyName DefaultUni ()]
-> [Term TyName Name DefaultUni DefaultFun ()]
-> TestNested
evals @Integer Integer
1 DefaultFun
LengthOfByteString [] [forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons @ByteString ByteString
"\NUL"]

    -- 65 is ASCII A
    forall a.
HasTermLevel DefaultUni a =>
a
-> DefaultFun
-> [Type TyName DefaultUni ()]
-> [Term TyName Name DefaultUni DefaultFun ()]
-> TestNested
evals @Integer Integer
65 DefaultFun
IndexByteString [] [forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons @ByteString ByteString
"Ahello world", forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons @Integer Integer
0]
    String
-> DefaultFun
-> [Type TyName DefaultUni ()]
-> [Term TyName Name DefaultUni DefaultFun ()]
-> TestNested
fails String
"indexByteString-out-of-bounds-non-empty" DefaultFun
IndexByteString []
        [forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons @ByteString ByteString
"hello world", forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons @Integer Integer
12]
    String
-> DefaultFun
-> [Type TyName DefaultUni ()]
-> [Term TyName Name DefaultUni DefaultFun ()]
-> TestNested
fails String
"indexByteString-out-of-bounds-empty" DefaultFun
IndexByteString []
        [forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons @ByteString ByteString
"", forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons @Integer Integer
0]

test_MatchList :: MatchOption -> TestNested
test_MatchList :: MatchOption -> TestNested
test_MatchList MatchOption
optMatch = String -> TestNested -> TestNested
testNestedM String
"MatchList" (TestNested -> TestNested) -> TestNested -> TestNested
forall a b. (a -> b) -> a -> b
$ do
    let -- the null function that utilizes the ChooseList builtin (through the matchList helper
        -- function)
        nullViaMatch :: [Integer] -> Term TyName Name DefaultUni DefaultFun ()
        nullViaMatch :: [Integer] -> Term TyName Name DefaultUni DefaultFun ()
nullViaMatch [Integer]
l =
            Term TyName Name DefaultUni DefaultFun ()
-> [Term TyName Name DefaultUni DefaultFun ()]
-> Term TyName Name DefaultUni DefaultFun ()
forall (term :: * -> *) tyname name (uni :: * -> *) fun.
TermLike term tyname name uni fun =>
term () -> [term ()] -> term ()
mkIterAppNoAnn
                (()
-> Term TyName Name DefaultUni DefaultFun ()
-> Type TyName DefaultUni ()
-> Term TyName Name DefaultUni DefaultFun ()
forall ann.
ann
-> Term TyName Name DefaultUni DefaultFun ann
-> Type TyName DefaultUni ann
-> Term TyName Name DefaultUni DefaultFun ann
forall (term :: * -> *) tyname name (uni :: * -> *) fun ann.
TermLike term tyname name uni fun =>
ann -> term ann -> Type tyname uni ann -> term ann
tyInst ()
                    (()
-> Term TyName Name DefaultUni DefaultFun ()
-> Term TyName Name DefaultUni DefaultFun ()
-> Term TyName Name DefaultUni DefaultFun ()
forall ann.
ann
-> Term TyName Name DefaultUni DefaultFun ann
-> Term TyName Name DefaultUni DefaultFun ann
-> Term TyName Name DefaultUni DefaultFun ann
forall (term :: * -> *) tyname name (uni :: * -> *) fun ann.
TermLike term tyname name uni fun =>
ann -> term ann -> term ann -> term ann
apply () (()
-> Term TyName Name DefaultUni DefaultFun ()
-> Type TyName DefaultUni ()
-> Term TyName Name DefaultUni DefaultFun ()
forall ann.
ann
-> Term TyName Name DefaultUni DefaultFun ann
-> Type TyName DefaultUni ann
-> Term TyName Name DefaultUni DefaultFun ann
forall (term :: * -> *) tyname name (uni :: * -> *) fun ann.
TermLike term tyname name uni fun =>
ann -> term ann -> Type tyname uni ann -> term ann
tyInst () (MatchOption -> Term TyName Name DefaultUni DefaultFun ()
forall (term :: * -> *).
TermLike term TyName Name DefaultUni DefaultFun =>
MatchOption -> term ()
Builtin.matchList MatchOption
optMatch) Type TyName DefaultUni ()
forall (uni :: * -> *) tyname.
HasTypeLevel uni Integer =>
Type tyname uni ()
integer) (Term TyName Name DefaultUni DefaultFun ()
 -> Term TyName Name DefaultUni DefaultFun ())
-> Term TyName Name DefaultUni DefaultFun ()
-> Term TyName Name DefaultUni DefaultFun ()
forall a b. (a -> b) -> a -> b
$ [Integer] -> Term TyName Name DefaultUni DefaultFun ()
forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons [Integer]
l)
                    Type TyName DefaultUni ()
forall (uni :: * -> *) tyname.
HasTypeLevel uni Bool =>
Type tyname uni ()
bool)
                [ -- zero
                  Term TyName Name DefaultUni DefaultFun ()
forall (term :: * -> *) tyname name (uni :: * -> *) fun.
(TermLike term tyname name uni fun, HasTermLevel uni Bool) =>
term ()
true
                  -- cons
                , Quote (Term TyName Name DefaultUni DefaultFun ())
-> Term TyName Name DefaultUni DefaultFun ()
forall a. Quote a -> a
runQuote (Quote (Term TyName Name DefaultUni DefaultFun ())
 -> Term TyName Name DefaultUni DefaultFun ())
-> Quote (Term TyName Name DefaultUni DefaultFun ())
-> Term TyName Name DefaultUni DefaultFun ()
forall a b. (a -> b) -> a -> b
$ do
                        Name
a1 <- Text -> QuoteT Identity Name
forall (m :: * -> *). MonadQuote m => Text -> m Name
freshName Text
"a1"
                        Name
a2 <- Text -> QuoteT Identity Name
forall (m :: * -> *). MonadQuote m => Text -> m Name
freshName Text
"a2"
                        Term TyName Name DefaultUni DefaultFun ()
-> Quote (Term TyName Name DefaultUni DefaultFun ())
forall a. a -> QuoteT Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
                            (Term TyName Name DefaultUni DefaultFun ()
 -> Quote (Term TyName Name DefaultUni DefaultFun ()))
-> (Term TyName Name DefaultUni DefaultFun ()
    -> Term TyName Name DefaultUni DefaultFun ())
-> Term TyName Name DefaultUni DefaultFun ()
-> Quote (Term TyName Name DefaultUni DefaultFun ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ()
-> Name
-> Type TyName DefaultUni ()
-> Term TyName Name DefaultUni DefaultFun ()
-> Term TyName Name DefaultUni DefaultFun ()
forall ann.
ann
-> Name
-> Type TyName DefaultUni ann
-> Term TyName Name DefaultUni DefaultFun ann
-> Term TyName Name DefaultUni DefaultFun ann
forall (term :: * -> *) tyname name (uni :: * -> *) fun ann.
TermLike term tyname name uni fun =>
ann -> name -> Type tyname uni ann -> term ann -> term ann
lamAbs () Name
a1 Type TyName DefaultUni ()
forall (uni :: * -> *) tyname.
HasTypeLevel uni Integer =>
Type tyname uni ()
integer
                            (Term TyName Name DefaultUni DefaultFun ()
 -> Term TyName Name DefaultUni DefaultFun ())
-> (Term TyName Name DefaultUni DefaultFun ()
    -> Term TyName Name DefaultUni DefaultFun ())
-> Term TyName Name DefaultUni DefaultFun ()
-> Term TyName Name DefaultUni DefaultFun ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ()
-> Name
-> Type TyName DefaultUni ()
-> Term TyName Name DefaultUni DefaultFun ()
-> Term TyName Name DefaultUni DefaultFun ()
forall ann.
ann
-> Name
-> Type TyName DefaultUni ann
-> Term TyName Name DefaultUni DefaultFun ann
-> Term TyName Name DefaultUni DefaultFun ann
forall (term :: * -> *) tyname name (uni :: * -> *) fun ann.
TermLike term tyname name uni fun =>
ann -> name -> Type tyname uni ann -> term ann -> term ann
lamAbs () Name
a2 (()
-> Type TyName DefaultUni ()
-> Type TyName DefaultUni ()
-> Type TyName DefaultUni ()
forall tyname (uni :: * -> *) ann.
ann
-> Type tyname uni ann
-> Type tyname uni ann
-> Type tyname uni ann
TyApp () Type TyName DefaultUni ()
forall (uni :: * -> *) tyname.
HasTypeLevel uni [] =>
Type tyname uni ()
Builtin.list Type TyName DefaultUni ()
forall (uni :: * -> *) tyname.
HasTypeLevel uni Integer =>
Type tyname uni ()
integer)
                            (Term TyName Name DefaultUni DefaultFun ()
 -> Quote (Term TyName Name DefaultUni DefaultFun ()))
-> Term TyName Name DefaultUni DefaultFun ()
-> Quote (Term TyName Name DefaultUni DefaultFun ())
forall a b. (a -> b) -> a -> b
$ Term TyName Name DefaultUni DefaultFun ()
forall (term :: * -> *) tyname name (uni :: * -> *) fun.
(TermLike term tyname name uni fun, HasTermLevel uni Bool) =>
term ()
false
                ]

    TestTree -> TestNested
forall a (m :: * -> *). MonadFree ((,) a) m => a -> m ()
embed (TestTree -> TestNested)
-> (Assertion -> TestTree) -> Assertion -> TestNested
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Assertion -> TestTree
testCase String
"nullViaMatch []" (Assertion -> TestNested) -> Assertion -> TestNested
forall a b. (a -> b) -> a -> b
$
        EvaluationResult (Term Name DefaultUni DefaultFun ())
-> Either
     (Error DefaultUni DefaultFun ())
     (EvaluationResult (Term Name DefaultUni DefaultFun ()))
forall a b. b -> Either a b
Right (Term Name DefaultUni DefaultFun ()
-> EvaluationResult (Term Name DefaultUni DefaultFun ())
forall a. a -> EvaluationResult a
EvaluationSuccess Term Name DefaultUni DefaultFun ()
forall (term :: * -> *) tyname name (uni :: * -> *) fun.
(TermLike term tyname name uni fun, HasTermLevel uni Bool) =>
term ()
true) Either
  (Error DefaultUni DefaultFun ())
  (EvaluationResult (Term Name DefaultUni DefaultFun ()))
-> Either
     (Error DefaultUni DefaultFun ())
     (EvaluationResult (Term Name DefaultUni DefaultFun ()))
-> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@=?
            BuiltinSemanticsVariant DefaultFun
-> CostingPart DefaultUni DefaultFun
-> Term TyName Name DefaultUni DefaultFun ()
-> Either
     (Error DefaultUni DefaultFun ())
     (EvaluationResult (Term Name DefaultUni DefaultFun ()))
forall (uni :: * -> *) fun (m :: * -> *).
(MonadError (Error uni fun ()) m, Typecheckable uni fun, GEq uni,
 Everywhere uni ExMemoryUsage, PrettyUni uni, Pretty fun) =>
BuiltinSemanticsVariant fun
-> CostingPart uni fun
-> Term TyName Name uni fun ()
-> m (EvaluationResult (Term Name uni fun ()))
typecheckEvaluateCekNoEmit BuiltinSemanticsVariant DefaultFun
forall a. Default a => a
def BuiltinCostModel
CostingPart DefaultUni DefaultFun
defaultBuiltinCostModelForTesting
                ([Integer] -> Term TyName Name DefaultUni DefaultFun ()
nullViaMatch [])
    TestTree -> TestNested
forall a (m :: * -> *). MonadFree ((,) a) m => a -> m ()
embed (TestTree -> TestNested)
-> (Assertion -> TestTree) -> Assertion -> TestNested
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Assertion -> TestTree
testCase String
"nullViaMatch [1]" (Assertion -> TestNested) -> Assertion -> TestNested
forall a b. (a -> b) -> a -> b
$
        EvaluationResult (Term Name DefaultUni DefaultFun ())
-> Either
     (Error DefaultUni DefaultFun ())
     (EvaluationResult (Term Name DefaultUni DefaultFun ()))
forall a b. b -> Either a b
Right (Term Name DefaultUni DefaultFun ()
-> EvaluationResult (Term Name DefaultUni DefaultFun ())
forall a. a -> EvaluationResult a
EvaluationSuccess Term Name DefaultUni DefaultFun ()
forall (term :: * -> *) tyname name (uni :: * -> *) fun.
(TermLike term tyname name uni fun, HasTermLevel uni Bool) =>
term ()
false) Either
  (Error DefaultUni DefaultFun ())
  (EvaluationResult (Term Name DefaultUni DefaultFun ()))
-> Either
     (Error DefaultUni DefaultFun ())
     (EvaluationResult (Term Name DefaultUni DefaultFun ()))
-> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@=?
            BuiltinSemanticsVariant DefaultFun
-> CostingPart DefaultUni DefaultFun
-> Term TyName Name DefaultUni DefaultFun ()
-> Either
     (Error DefaultUni DefaultFun ())
     (EvaluationResult (Term Name DefaultUni DefaultFun ()))
forall (uni :: * -> *) fun (m :: * -> *).
(MonadError (Error uni fun ()) m, Typecheckable uni fun, GEq uni,
 Everywhere uni ExMemoryUsage, PrettyUni uni, Pretty fun) =>
BuiltinSemanticsVariant fun
-> CostingPart uni fun
-> Term TyName Name uni fun ()
-> m (EvaluationResult (Term Name uni fun ()))
typecheckEvaluateCekNoEmit BuiltinSemanticsVariant DefaultFun
forall a. Default a => a
def BuiltinCostModel
CostingPart DefaultUni DefaultFun
defaultBuiltinCostModelForTesting
                ([Integer] -> Term TyName Name DefaultUni DefaultFun ()
nullViaMatch [Integer
1])
    TestTree -> TestNested
forall a (m :: * -> *). MonadFree ((,) a) m => a -> m ()
embed (TestTree -> TestNested)
-> (Assertion -> TestTree) -> Assertion -> TestNested
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Assertion -> TestTree
testCase String
"nullViaMatch [1..10]" (Assertion -> TestNested) -> Assertion -> TestNested
forall a b. (a -> b) -> a -> b
$
        EvaluationResult (Term Name DefaultUni DefaultFun ())
-> Either
     (Error DefaultUni DefaultFun ())
     (EvaluationResult (Term Name DefaultUni DefaultFun ()))
forall a b. b -> Either a b
Right (Term Name DefaultUni DefaultFun ()
-> EvaluationResult (Term Name DefaultUni DefaultFun ())
forall a. a -> EvaluationResult a
EvaluationSuccess Term Name DefaultUni DefaultFun ()
forall (term :: * -> *) tyname name (uni :: * -> *) fun.
(TermLike term tyname name uni fun, HasTermLevel uni Bool) =>
term ()
false) Either
  (Error DefaultUni DefaultFun ())
  (EvaluationResult (Term Name DefaultUni DefaultFun ()))
-> Either
     (Error DefaultUni DefaultFun ())
     (EvaluationResult (Term Name DefaultUni DefaultFun ()))
-> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@=?
            BuiltinSemanticsVariant DefaultFun
-> CostingPart DefaultUni DefaultFun
-> Term TyName Name DefaultUni DefaultFun ()
-> Either
     (Error DefaultUni DefaultFun ())
     (EvaluationResult (Term Name DefaultUni DefaultFun ()))
forall (uni :: * -> *) fun (m :: * -> *).
(MonadError (Error uni fun ()) m, Typecheckable uni fun, GEq uni,
 Everywhere uni ExMemoryUsage, PrettyUni uni, Pretty fun) =>
BuiltinSemanticsVariant fun
-> CostingPart uni fun
-> Term TyName Name uni fun ()
-> m (EvaluationResult (Term Name uni fun ()))
typecheckEvaluateCekNoEmit BuiltinSemanticsVariant DefaultFun
forall a. Default a => a
def BuiltinCostModel
CostingPart DefaultUni DefaultFun
defaultBuiltinCostModelForTesting
                ([Integer] -> Term TyName Name DefaultUni DefaultFun ()
nullViaMatch [Integer
1..Integer
10])

-- | Test all list-related builtins
test_List :: TestNested
test_List :: TestNested
test_List = String -> TestNested -> TestNested
testNestedM String
"List" (TestNested -> TestNested) -> TestNested -> TestNested
forall a b. (a -> b) -> a -> b
$ do
    Bool
-> DefaultFun
-> [Type TyName DefaultUni ()]
-> [Term TyName Name DefaultUni DefaultFun ()]
-> TestNested
forall a.
HasTermLevel DefaultUni a =>
a
-> DefaultFun
-> [Type TyName DefaultUni ()]
-> [Term TyName Name DefaultUni DefaultFun ()]
-> TestNested
evals Bool
False DefaultFun
NullList [Type TyName DefaultUni ()
forall (uni :: * -> *) tyname.
HasTypeLevel uni Integer =>
Type tyname uni ()
integer] [forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons @[Integer] [Integer
1,Integer
2]]
    Bool
-> DefaultFun
-> [Type TyName DefaultUni ()]
-> [Term TyName Name DefaultUni DefaultFun ()]
-> TestNested
forall a.
HasTermLevel DefaultUni a =>
a
-> DefaultFun
-> [Type TyName DefaultUni ()]
-> [Term TyName Name DefaultUni DefaultFun ()]
-> TestNested
evals Bool
False DefaultFun
NullList [Type TyName DefaultUni ()
forall (uni :: * -> *) tyname.
HasTypeLevel uni Integer =>
Type tyname uni ()
integer] [forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons @[Integer] [Integer
1]]
    Bool
-> DefaultFun
-> [Type TyName DefaultUni ()]
-> [Term TyName Name DefaultUni DefaultFun ()]
-> TestNested
forall a.
HasTermLevel DefaultUni a =>
a
-> DefaultFun
-> [Type TyName DefaultUni ()]
-> [Term TyName Name DefaultUni DefaultFun ()]
-> TestNested
evals Bool
True DefaultFun
NullList [Type TyName DefaultUni ()
forall (uni :: * -> *) tyname.
HasTypeLevel uni Integer =>
Type tyname uni ()
integer] [forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons @[Integer] []]

    forall a.
HasTermLevel DefaultUni a =>
a
-> DefaultFun
-> [Type TyName DefaultUni ()]
-> [Term TyName Name DefaultUni DefaultFun ()]
-> TestNested
evals @Integer Integer
1 DefaultFun
HeadList [Type TyName DefaultUni ()
forall (uni :: * -> *) tyname.
HasTypeLevel uni Integer =>
Type tyname uni ()
integer] [forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons @[Integer] [Integer
1,Integer
3]]
    forall a.
HasTermLevel DefaultUni a =>
a
-> DefaultFun
-> [Type TyName DefaultUni ()]
-> [Term TyName Name DefaultUni DefaultFun ()]
-> TestNested
evals @[Integer] [Integer
3,Integer
4,Integer
5] DefaultFun
TailList [Type TyName DefaultUni ()
forall (uni :: * -> *) tyname.
HasTypeLevel uni Integer =>
Type tyname uni ()
integer] [forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons @[Integer] [Integer
1,Integer
3,Integer
4,Integer
5]]

    String
-> DefaultFun
-> [Type TyName DefaultUni ()]
-> [Term TyName Name DefaultUni DefaultFun ()]
-> TestNested
fails String
"headList-empty" DefaultFun
HeadList [Type TyName DefaultUni ()
forall (uni :: * -> *) tyname.
HasTypeLevel uni Integer =>
Type tyname uni ()
integer] [forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons @[Integer] []]
    String
-> DefaultFun
-> [Type TyName DefaultUni ()]
-> [Term TyName Name DefaultUni DefaultFun ()]
-> TestNested
fails String
"tailList-empty" DefaultFun
TailList [Type TyName DefaultUni ()
forall (uni :: * -> *) tyname.
HasTypeLevel uni Integer =>
Type tyname uni ()
integer] [forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons @[Integer] []]

    forall a.
HasTermLevel DefaultUni a =>
a
-> DefaultFun
-> [Type TyName DefaultUni ()]
-> [Term TyName Name DefaultUni DefaultFun ()]
-> TestNested
evals @[Integer] [Integer
1] DefaultFun
MkCons [Type TyName DefaultUni ()
forall (uni :: * -> *) tyname.
HasTypeLevel uni Integer =>
Type tyname uni ()
integer] [forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons @Integer Integer
1, forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons @[Integer] []]
    forall a.
HasTermLevel DefaultUni a =>
a
-> DefaultFun
-> [Type TyName DefaultUni ()]
-> [Term TyName Name DefaultUni DefaultFun ()]
-> TestNested
evals @[Integer] [Integer
1,Integer
2] DefaultFun
MkCons [Type TyName DefaultUni ()
forall (uni :: * -> *) tyname.
HasTypeLevel uni Integer =>
Type tyname uni ()
integer] [forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons @Integer Integer
1, forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons @[Integer] [Integer
2]]

    MatchOption -> TestNested
test_MatchList MatchOption
UseChoose
    MatchOption -> TestNested
test_MatchList MatchOption
UseCase

test_MatchData :: MatchOption -> TestNested
test_MatchData :: MatchOption -> TestNested
test_MatchData MatchOption
optMatch = String -> TestNested -> TestNested
testNestedM (MatchOption -> String
forall a. Show a => a -> String
show MatchOption
optMatch) (TestNested -> TestNested) -> TestNested -> TestNested
forall a b. (a -> b) -> a -> b
$ do
    let actualExp :: Term TyName Name DefaultUni DefaultFun ()
actualExp =
            Term TyName Name DefaultUni DefaultFun ()
-> [Term TyName Name DefaultUni DefaultFun ()]
-> Term TyName Name DefaultUni DefaultFun ()
forall (term :: * -> *) tyname name (uni :: * -> *) fun.
TermLike term tyname name uni fun =>
term () -> [term ()] -> term ()
mkIterAppNoAnn
                (()
-> Term TyName Name DefaultUni DefaultFun ()
-> Type TyName DefaultUni ()
-> Term TyName Name DefaultUni DefaultFun ()
forall ann.
ann
-> Term TyName Name DefaultUni DefaultFun ann
-> Type TyName DefaultUni ann
-> Term TyName Name DefaultUni DefaultFun ann
forall (term :: * -> *) tyname name (uni :: * -> *) fun ann.
TermLike term tyname name uni fun =>
ann -> term ann -> Type tyname uni ann -> term ann
tyInst () (()
-> Term TyName Name DefaultUni DefaultFun ()
-> Term TyName Name DefaultUni DefaultFun ()
-> Term TyName Name DefaultUni DefaultFun ()
forall ann.
ann
-> Term TyName Name DefaultUni DefaultFun ann
-> Term TyName Name DefaultUni DefaultFun ann
-> Term TyName Name DefaultUni DefaultFun ann
forall (term :: * -> *) tyname name (uni :: * -> *) fun ann.
TermLike term tyname name uni fun =>
ann -> term ann -> term ann -> term ann
apply () (MatchOption -> Term TyName Name DefaultUni DefaultFun ()
forall (term :: * -> *).
TermLike term TyName Name DefaultUni DefaultFun =>
MatchOption -> term ()
matchData MatchOption
optMatch) (Term TyName Name DefaultUni DefaultFun ()
 -> Term TyName Name DefaultUni DefaultFun ())
-> Term TyName Name DefaultUni DefaultFun ()
-> Term TyName Name DefaultUni DefaultFun ()
forall a b. (a -> b) -> a -> b
$ Data -> Term TyName Name DefaultUni DefaultFun ()
forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons (Data -> Term TyName Name DefaultUni DefaultFun ())
-> Data -> Term TyName Name DefaultUni DefaultFun ()
forall a b. (a -> b) -> a -> b
$ Integer -> Data
I Integer
3) Type TyName DefaultUni ()
forall (uni :: * -> *) tyname.
HasTypeLevel uni Bool =>
Type tyname uni ()
bool)
                [ -- constr
                  Quote (Term TyName Name DefaultUni DefaultFun ())
-> Term TyName Name DefaultUni DefaultFun ()
forall a. Quote a -> a
runQuote (Quote (Term TyName Name DefaultUni DefaultFun ())
 -> Term TyName Name DefaultUni DefaultFun ())
-> Quote (Term TyName Name DefaultUni DefaultFun ())
-> Term TyName Name DefaultUni DefaultFun ()
forall a b. (a -> b) -> a -> b
$ do
                    Name
a1 <- Text -> QuoteT Identity Name
forall (m :: * -> *). MonadQuote m => Text -> m Name
freshName Text
"a1"
                    Name
a2 <- Text -> QuoteT Identity Name
forall (m :: * -> *). MonadQuote m => Text -> m Name
freshName Text
"a2"
                    Term TyName Name DefaultUni DefaultFun ()
-> Quote (Term TyName Name DefaultUni DefaultFun ())
forall a. a -> QuoteT Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Term TyName Name DefaultUni DefaultFun ()
 -> Quote (Term TyName Name DefaultUni DefaultFun ()))
-> Term TyName Name DefaultUni DefaultFun ()
-> Quote (Term TyName Name DefaultUni DefaultFun ())
forall a b. (a -> b) -> a -> b
$ ()
-> Name
-> Type TyName DefaultUni ()
-> Term TyName Name DefaultUni DefaultFun ()
-> Term TyName Name DefaultUni DefaultFun ()
forall ann.
ann
-> Name
-> Type TyName DefaultUni ann
-> Term TyName Name DefaultUni DefaultFun ann
-> Term TyName Name DefaultUni DefaultFun ann
forall (term :: * -> *) tyname name (uni :: * -> *) fun ann.
TermLike term tyname name uni fun =>
ann -> name -> Type tyname uni ann -> term ann -> term ann
lamAbs () Name
a1 Type TyName DefaultUni ()
forall (uni :: * -> *) tyname.
HasTypeLevel uni Integer =>
Type tyname uni ()
integer (Term TyName Name DefaultUni DefaultFun ()
 -> Term TyName Name DefaultUni DefaultFun ())
-> Term TyName Name DefaultUni DefaultFun ()
-> Term TyName Name DefaultUni DefaultFun ()
forall a b. (a -> b) -> a -> b
$ ()
-> Name
-> Type TyName DefaultUni ()
-> Term TyName Name DefaultUni DefaultFun ()
-> Term TyName Name DefaultUni DefaultFun ()
forall ann.
ann
-> Name
-> Type TyName DefaultUni ann
-> Term TyName Name DefaultUni DefaultFun ann
-> Term TyName Name DefaultUni DefaultFun ann
forall (term :: * -> *) tyname name (uni :: * -> *) fun ann.
TermLike term tyname name uni fun =>
ann -> name -> Type tyname uni ann -> term ann -> term ann
lamAbs () Name
a2 (()
-> Type TyName DefaultUni ()
-> Type TyName DefaultUni ()
-> Type TyName DefaultUni ()
forall tyname (uni :: * -> *) ann.
ann
-> Type tyname uni ann
-> Type tyname uni ann
-> Type tyname uni ann
TyApp () Type TyName DefaultUni ()
forall (uni :: * -> *) tyname.
HasTypeLevel uni [] =>
Type tyname uni ()
Builtin.list Type TyName DefaultUni ()
forall (uni :: * -> *) tyname.
HasTypeLevel uni Data =>
Type tyname uni ()
dataTy) Term TyName Name DefaultUni DefaultFun ()
forall (term :: * -> *) tyname name (uni :: * -> *) fun.
(TermLike term tyname name uni fun, HasTermLevel uni Bool) =>
term ()
false
                , -- map
                  Quote (Term TyName Name DefaultUni DefaultFun ())
-> Term TyName Name DefaultUni DefaultFun ()
forall a. Quote a -> a
runQuote (Quote (Term TyName Name DefaultUni DefaultFun ())
 -> Term TyName Name DefaultUni DefaultFun ())
-> Quote (Term TyName Name DefaultUni DefaultFun ())
-> Term TyName Name DefaultUni DefaultFun ()
forall a b. (a -> b) -> a -> b
$ do
                    Name
a1 <- Text -> QuoteT Identity Name
forall (m :: * -> *). MonadQuote m => Text -> m Name
freshName Text
"a1"
                    let listDataData :: Type tyname DefaultUni ()
listDataData = ()
-> Type tyname DefaultUni ()
-> Type tyname DefaultUni ()
-> Type tyname DefaultUni ()
forall tyname (uni :: * -> *) ann.
ann
-> Type tyname uni ann
-> Type tyname uni ann
-> Type tyname uni ann
TyApp () Type tyname DefaultUni ()
forall (uni :: * -> *) tyname.
HasTypeLevel uni [] =>
Type tyname uni ()
Builtin.list (Type tyname DefaultUni () -> Type tyname DefaultUni ())
-> Type tyname DefaultUni () -> Type tyname DefaultUni ()
forall a b. (a -> b) -> a -> b
$ Type tyname DefaultUni ()
-> [Type tyname DefaultUni ()] -> Type tyname DefaultUni ()
forall tyname (uni :: * -> *).
Type tyname uni () -> [Type tyname uni ()] -> Type tyname uni ()
mkIterTyAppNoAnn Type tyname DefaultUni ()
forall (uni :: * -> *) tyname.
HasTypeLevel uni (,) =>
Type tyname uni ()
pair [Type tyname DefaultUni ()
forall (uni :: * -> *) tyname.
HasTypeLevel uni Data =>
Type tyname uni ()
dataTy,Type tyname DefaultUni ()
forall (uni :: * -> *) tyname.
HasTypeLevel uni Data =>
Type tyname uni ()
dataTy]
                    Term TyName Name DefaultUni DefaultFun ()
-> Quote (Term TyName Name DefaultUni DefaultFun ())
forall a. a -> QuoteT Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Term TyName Name DefaultUni DefaultFun ()
 -> Quote (Term TyName Name DefaultUni DefaultFun ()))
-> Term TyName Name DefaultUni DefaultFun ()
-> Quote (Term TyName Name DefaultUni DefaultFun ())
forall a b. (a -> b) -> a -> b
$ ()
-> Name
-> Type TyName DefaultUni ()
-> Term TyName Name DefaultUni DefaultFun ()
-> Term TyName Name DefaultUni DefaultFun ()
forall ann.
ann
-> Name
-> Type TyName DefaultUni ann
-> Term TyName Name DefaultUni DefaultFun ann
-> Term TyName Name DefaultUni DefaultFun ann
forall (term :: * -> *) tyname name (uni :: * -> *) fun ann.
TermLike term tyname name uni fun =>
ann -> name -> Type tyname uni ann -> term ann -> term ann
lamAbs () Name
a1 Type TyName DefaultUni ()
forall {w}. Type w DefaultUni ()
listDataData Term TyName Name DefaultUni DefaultFun ()
forall (term :: * -> *) tyname name (uni :: * -> *) fun.
(TermLike term tyname name uni fun, HasTermLevel uni Bool) =>
term ()
false
                , -- list
                  Quote (Term TyName Name DefaultUni DefaultFun ())
-> Term TyName Name DefaultUni DefaultFun ()
forall a. Quote a -> a
runQuote (Quote (Term TyName Name DefaultUni DefaultFun ())
 -> Term TyName Name DefaultUni DefaultFun ())
-> Quote (Term TyName Name DefaultUni DefaultFun ())
-> Term TyName Name DefaultUni DefaultFun ()
forall a b. (a -> b) -> a -> b
$ do
                    Name
a1 <- Text -> QuoteT Identity Name
forall (m :: * -> *). MonadQuote m => Text -> m Name
freshName Text
"a1"
                    Term TyName Name DefaultUni DefaultFun ()
-> Quote (Term TyName Name DefaultUni DefaultFun ())
forall a. a -> QuoteT Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Term TyName Name DefaultUni DefaultFun ()
 -> Quote (Term TyName Name DefaultUni DefaultFun ()))
-> Term TyName Name DefaultUni DefaultFun ()
-> Quote (Term TyName Name DefaultUni DefaultFun ())
forall a b. (a -> b) -> a -> b
$ ()
-> Name
-> Type TyName DefaultUni ()
-> Term TyName Name DefaultUni DefaultFun ()
-> Term TyName Name DefaultUni DefaultFun ()
forall ann.
ann
-> Name
-> Type TyName DefaultUni ann
-> Term TyName Name DefaultUni DefaultFun ann
-> Term TyName Name DefaultUni DefaultFun ann
forall (term :: * -> *) tyname name (uni :: * -> *) fun ann.
TermLike term tyname name uni fun =>
ann -> name -> Type tyname uni ann -> term ann -> term ann
lamAbs () Name
a1 (()
-> Type TyName DefaultUni ()
-> Type TyName DefaultUni ()
-> Type TyName DefaultUni ()
forall tyname (uni :: * -> *) ann.
ann
-> Type tyname uni ann
-> Type tyname uni ann
-> Type tyname uni ann
TyApp () Type TyName DefaultUni ()
forall (uni :: * -> *) tyname.
HasTypeLevel uni [] =>
Type tyname uni ()
Builtin.list Type TyName DefaultUni ()
forall (uni :: * -> *) tyname.
HasTypeLevel uni Data =>
Type tyname uni ()
dataTy) Term TyName Name DefaultUni DefaultFun ()
forall (term :: * -> *) tyname name (uni :: * -> *) fun.
(TermLike term tyname name uni fun, HasTermLevel uni Bool) =>
term ()
false

                , -- I
                  Quote (Term TyName Name DefaultUni DefaultFun ())
-> Term TyName Name DefaultUni DefaultFun ()
forall a. Quote a -> a
runQuote (Quote (Term TyName Name DefaultUni DefaultFun ())
 -> Term TyName Name DefaultUni DefaultFun ())
-> Quote (Term TyName Name DefaultUni DefaultFun ())
-> Term TyName Name DefaultUni DefaultFun ()
forall a b. (a -> b) -> a -> b
$ do
                    Name
a1 <- Text -> QuoteT Identity Name
forall (m :: * -> *). MonadQuote m => Text -> m Name
freshName Text
"a1"
                    Term TyName Name DefaultUni DefaultFun ()
-> Quote (Term TyName Name DefaultUni DefaultFun ())
forall a. a -> QuoteT Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Term TyName Name DefaultUni DefaultFun ()
 -> Quote (Term TyName Name DefaultUni DefaultFun ()))
-> Term TyName Name DefaultUni DefaultFun ()
-> Quote (Term TyName Name DefaultUni DefaultFun ())
forall a b. (a -> b) -> a -> b
$ ()
-> Name
-> Type TyName DefaultUni ()
-> Term TyName Name DefaultUni DefaultFun ()
-> Term TyName Name DefaultUni DefaultFun ()
forall ann.
ann
-> Name
-> Type TyName DefaultUni ann
-> Term TyName Name DefaultUni DefaultFun ann
-> Term TyName Name DefaultUni DefaultFun ann
forall (term :: * -> *) tyname name (uni :: * -> *) fun ann.
TermLike term tyname name uni fun =>
ann -> name -> Type tyname uni ann -> term ann -> term ann
lamAbs () Name
a1 Type TyName DefaultUni ()
forall (uni :: * -> *) tyname.
HasTypeLevel uni Integer =>
Type tyname uni ()
integer Term TyName Name DefaultUni DefaultFun ()
forall (term :: * -> *) tyname name (uni :: * -> *) fun.
(TermLike term tyname name uni fun, HasTermLevel uni Bool) =>
term ()
true

                , -- B
                  Quote (Term TyName Name DefaultUni DefaultFun ())
-> Term TyName Name DefaultUni DefaultFun ()
forall a. Quote a -> a
runQuote (Quote (Term TyName Name DefaultUni DefaultFun ())
 -> Term TyName Name DefaultUni DefaultFun ())
-> Quote (Term TyName Name DefaultUni DefaultFun ())
-> Term TyName Name DefaultUni DefaultFun ()
forall a b. (a -> b) -> a -> b
$ do
                    Name
a1 <- Text -> QuoteT Identity Name
forall (m :: * -> *). MonadQuote m => Text -> m Name
freshName Text
"a1"
                    Term TyName Name DefaultUni DefaultFun ()
-> Quote (Term TyName Name DefaultUni DefaultFun ())
forall a. a -> QuoteT Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Term TyName Name DefaultUni DefaultFun ()
 -> Quote (Term TyName Name DefaultUni DefaultFun ()))
-> Term TyName Name DefaultUni DefaultFun ()
-> Quote (Term TyName Name DefaultUni DefaultFun ())
forall a b. (a -> b) -> a -> b
$ ()
-> Name
-> Type TyName DefaultUni ()
-> Term TyName Name DefaultUni DefaultFun ()
-> Term TyName Name DefaultUni DefaultFun ()
forall ann.
ann
-> Name
-> Type TyName DefaultUni ann
-> Term TyName Name DefaultUni DefaultFun ann
-> Term TyName Name DefaultUni DefaultFun ann
forall (term :: * -> *) tyname name (uni :: * -> *) fun ann.
TermLike term tyname name uni fun =>
ann -> name -> Type tyname uni ann -> term ann -> term ann
lamAbs () Name
a1 (forall a (x :: a) (uni :: * -> *) ann tyname.
HasTypeLevel uni x =>
ann -> Type tyname uni ann
mkTyBuiltin @_ @ByteString ()) Term TyName Name DefaultUni DefaultFun ()
forall (term :: * -> *) tyname name (uni :: * -> *) fun.
(TermLike term tyname name uni fun, HasTermLevel uni Bool) =>
term ()
false
                ]

    TestTree -> TestNested
forall a (m :: * -> *). MonadFree ((,) a) m => a -> m ()
embed (TestTree -> TestNested)
-> (Assertion -> TestTree) -> Assertion -> TestNested
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Assertion -> TestTree
testCase String
"chooseData" (Assertion -> TestNested) -> Assertion -> TestNested
forall a b. (a -> b) -> a -> b
$
        EvaluationResult (Term Name DefaultUni DefaultFun ())
-> Either
     (Error DefaultUni DefaultFun ())
     (EvaluationResult (Term Name DefaultUni DefaultFun ()))
forall a b. b -> Either a b
Right (Term Name DefaultUni DefaultFun ()
-> EvaluationResult (Term Name DefaultUni DefaultFun ())
forall a. a -> EvaluationResult a
EvaluationSuccess Term Name DefaultUni DefaultFun ()
forall (term :: * -> *) tyname name (uni :: * -> *) fun.
(TermLike term tyname name uni fun, HasTermLevel uni Bool) =>
term ()
true) Either
  (Error DefaultUni DefaultFun ())
  (EvaluationResult (Term Name DefaultUni DefaultFun ()))
-> Either
     (Error DefaultUni DefaultFun ())
     (EvaluationResult (Term Name DefaultUni DefaultFun ()))
-> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@=?
            BuiltinSemanticsVariant DefaultFun
-> CostingPart DefaultUni DefaultFun
-> Term TyName Name DefaultUni DefaultFun ()
-> Either
     (Error DefaultUni DefaultFun ())
     (EvaluationResult (Term Name DefaultUni DefaultFun ()))
forall (uni :: * -> *) fun (m :: * -> *).
(MonadError (Error uni fun ()) m, Typecheckable uni fun, GEq uni,
 Everywhere uni ExMemoryUsage, PrettyUni uni, Pretty fun) =>
BuiltinSemanticsVariant fun
-> CostingPart uni fun
-> Term TyName Name uni fun ()
-> m (EvaluationResult (Term Name uni fun ()))
typecheckEvaluateCekNoEmit BuiltinSemanticsVariant DefaultFun
forall a. Default a => a
def BuiltinCostModel
CostingPart DefaultUni DefaultFun
defaultBuiltinCostModelForTesting
                Term TyName Name DefaultUni DefaultFun ()
actualExp

-- | Test all PlutusData builtins
test_Data :: TestNested
test_Data :: TestNested
test_Data = String -> TestNested -> TestNested
testNestedM String
"Data" (TestNested -> TestNested) -> TestNested -> TestNested
forall a b. (a -> b) -> a -> b
$ do
    -- construction
    Data
-> DefaultFun
-> [Type TyName DefaultUni ()]
-> [Term TyName Name DefaultUni DefaultFun ()]
-> TestNested
forall a.
HasTermLevel DefaultUni a =>
a
-> DefaultFun
-> [Type TyName DefaultUni ()]
-> [Term TyName Name DefaultUni DefaultFun ()]
-> TestNested
evals (Integer -> [Data] -> Data
Constr Integer
2 [Integer -> Data
I Integer
3]) DefaultFun
ConstrData [] [forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons @Integer Integer
2, forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons @[Data] [Integer -> Data
I Integer
3]]
    Data
-> DefaultFun
-> [Type TyName DefaultUni ()]
-> [Term TyName Name DefaultUni DefaultFun ()]
-> TestNested
forall a.
HasTermLevel DefaultUni a =>
a
-> DefaultFun
-> [Type TyName DefaultUni ()]
-> [Term TyName Name DefaultUni DefaultFun ()]
-> TestNested
evals (Integer -> [Data] -> Data
Constr Integer
2 [Integer -> Data
I Integer
3, ByteString -> Data
B ByteString
""]) DefaultFun
ConstrData [] [forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons @Integer Integer
2, forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons @[Data] [Integer -> Data
I Integer
3, ByteString -> Data
B ByteString
""]]
    Data
-> DefaultFun
-> [Type TyName DefaultUni ()]
-> [Term TyName Name DefaultUni DefaultFun ()]
-> TestNested
forall a.
HasTermLevel DefaultUni a =>
a
-> DefaultFun
-> [Type TyName DefaultUni ()]
-> [Term TyName Name DefaultUni DefaultFun ()]
-> TestNested
evals ([Data] -> Data
List []) DefaultFun
ListData [] [forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons @[Data] []]
    Data
-> DefaultFun
-> [Type TyName DefaultUni ()]
-> [Term TyName Name DefaultUni DefaultFun ()]
-> TestNested
forall a.
HasTermLevel DefaultUni a =>
a
-> DefaultFun
-> [Type TyName DefaultUni ()]
-> [Term TyName Name DefaultUni DefaultFun ()]
-> TestNested
evals ([Data] -> Data
List [Integer -> Data
I Integer
3, ByteString -> Data
B ByteString
""]) DefaultFun
ListData [] [forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons @[Data] [Integer -> Data
I Integer
3, ByteString -> Data
B ByteString
""]]
    Data
-> DefaultFun
-> [Type TyName DefaultUni ()]
-> [Term TyName Name DefaultUni DefaultFun ()]
-> TestNested
forall a.
HasTermLevel DefaultUni a =>
a
-> DefaultFun
-> [Type TyName DefaultUni ()]
-> [Term TyName Name DefaultUni DefaultFun ()]
-> TestNested
evals ([(Data, Data)] -> Data
Map []) DefaultFun
MapData [] [forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons @[(Data,Data)] []]
    Data
-> DefaultFun
-> [Type TyName DefaultUni ()]
-> [Term TyName Name DefaultUni DefaultFun ()]
-> TestNested
forall a.
HasTermLevel DefaultUni a =>
a
-> DefaultFun
-> [Type TyName DefaultUni ()]
-> [Term TyName Name DefaultUni DefaultFun ()]
-> TestNested
evals ([(Data, Data)] -> Data
Map [(Integer -> Data
I Integer
3, ByteString -> Data
B ByteString
"")]) DefaultFun
MapData [] [forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons @[(Data,Data)] [(Integer -> Data
I Integer
3, ByteString -> Data
B ByteString
"")]]
    Data
-> DefaultFun
-> [Type TyName DefaultUni ()]
-> [Term TyName Name DefaultUni DefaultFun ()]
-> TestNested
forall a.
HasTermLevel DefaultUni a =>
a
-> DefaultFun
-> [Type TyName DefaultUni ()]
-> [Term TyName Name DefaultUni DefaultFun ()]
-> TestNested
evals (ByteString -> Data
B ByteString
"hello world") DefaultFun
BData [] [forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons @ByteString ByteString
"hello world"]
    Data
-> DefaultFun
-> [Type TyName DefaultUni ()]
-> [Term TyName Name DefaultUni DefaultFun ()]
-> TestNested
forall a.
HasTermLevel DefaultUni a =>
a
-> DefaultFun
-> [Type TyName DefaultUni ()]
-> [Term TyName Name DefaultUni DefaultFun ()]
-> TestNested
evals (Integer -> Data
I Integer
3) DefaultFun
IData [] [forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons @Integer Integer
3]
    Data
-> DefaultFun
-> [Type TyName DefaultUni ()]
-> [Term TyName Name DefaultUni DefaultFun ()]
-> TestNested
forall a.
HasTermLevel DefaultUni a =>
a
-> DefaultFun
-> [Type TyName DefaultUni ()]
-> [Term TyName Name DefaultUni DefaultFun ()]
-> TestNested
evals (ByteString -> Data
B ByteString
"hello world") DefaultFun
BData [] [forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons @ByteString ByteString
"hello world"]
    forall a.
HasTermLevel DefaultUni a =>
a
-> DefaultFun
-> [Type TyName DefaultUni ()]
-> [Term TyName Name DefaultUni DefaultFun ()]
-> TestNested
evals @[Data] [] DefaultFun
MkNilData [] [() -> Term TyName Name DefaultUni DefaultFun ()
forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons ()]
    forall a.
HasTermLevel DefaultUni a =>
a
-> DefaultFun
-> [Type TyName DefaultUni ()]
-> [Term TyName Name DefaultUni DefaultFun ()]
-> TestNested
evals @[(Data,Data)] [] DefaultFun
MkNilPairData [] [() -> Term TyName Name DefaultUni DefaultFun ()
forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons ()]

    -- equality
    Bool
-> DefaultFun
-> [Type TyName DefaultUni ()]
-> [Term TyName Name DefaultUni DefaultFun ()]
-> TestNested
forall a.
HasTermLevel DefaultUni a =>
a
-> DefaultFun
-> [Type TyName DefaultUni ()]
-> [Term TyName Name DefaultUni DefaultFun ()]
-> TestNested
evals Bool
True DefaultFun
EqualsData [] [Data -> Term TyName Name DefaultUni DefaultFun ()
forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons (Data -> Term TyName Name DefaultUni DefaultFun ())
-> Data -> Term TyName Name DefaultUni DefaultFun ()
forall a b. (a -> b) -> a -> b
$ ByteString -> Data
B ByteString
"hello world", Data -> Term TyName Name DefaultUni DefaultFun ()
forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons (Data -> Term TyName Name DefaultUni DefaultFun ())
-> Data -> Term TyName Name DefaultUni DefaultFun ()
forall a b. (a -> b) -> a -> b
$ ByteString -> Data
B ByteString
"hello world"]
    Bool
-> DefaultFun
-> [Type TyName DefaultUni ()]
-> [Term TyName Name DefaultUni DefaultFun ()]
-> TestNested
forall a.
HasTermLevel DefaultUni a =>
a
-> DefaultFun
-> [Type TyName DefaultUni ()]
-> [Term TyName Name DefaultUni DefaultFun ()]
-> TestNested
evals Bool
True DefaultFun
EqualsData [] [Data -> Term TyName Name DefaultUni DefaultFun ()
forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons (Data -> Term TyName Name DefaultUni DefaultFun ())
-> Data -> Term TyName Name DefaultUni DefaultFun ()
forall a b. (a -> b) -> a -> b
$ Integer -> Data
I Integer
4, Data -> Term TyName Name DefaultUni DefaultFun ()
forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons (Data -> Term TyName Name DefaultUni DefaultFun ())
-> Data -> Term TyName Name DefaultUni DefaultFun ()
forall a b. (a -> b) -> a -> b
$ Integer -> Data
I Integer
4]
    Bool
-> DefaultFun
-> [Type TyName DefaultUni ()]
-> [Term TyName Name DefaultUni DefaultFun ()]
-> TestNested
forall a.
HasTermLevel DefaultUni a =>
a
-> DefaultFun
-> [Type TyName DefaultUni ()]
-> [Term TyName Name DefaultUni DefaultFun ()]
-> TestNested
evals Bool
False DefaultFun
EqualsData [] [Data -> Term TyName Name DefaultUni DefaultFun ()
forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons (Data -> Term TyName Name DefaultUni DefaultFun ())
-> Data -> Term TyName Name DefaultUni DefaultFun ()
forall a b. (a -> b) -> a -> b
$ ByteString -> Data
B ByteString
"hello world", Data -> Term TyName Name DefaultUni DefaultFun ()
forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons (Data -> Term TyName Name DefaultUni DefaultFun ())
-> Data -> Term TyName Name DefaultUni DefaultFun ()
forall a b. (a -> b) -> a -> b
$ Integer -> Data
I Integer
4]
    Bool
-> DefaultFun
-> [Type TyName DefaultUni ()]
-> [Term TyName Name DefaultUni DefaultFun ()]
-> TestNested
forall a.
HasTermLevel DefaultUni a =>
a
-> DefaultFun
-> [Type TyName DefaultUni ()]
-> [Term TyName Name DefaultUni DefaultFun ()]
-> TestNested
evals Bool
True DefaultFun
EqualsData [] [Data -> Term TyName Name DefaultUni DefaultFun ()
forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons (Data -> Term TyName Name DefaultUni DefaultFun ())
-> Data -> Term TyName Name DefaultUni DefaultFun ()
forall a b. (a -> b) -> a -> b
$ Integer -> [Data] -> Data
Constr Integer
3 [Integer -> Data
I Integer
4], Data -> Term TyName Name DefaultUni DefaultFun ()
forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons (Data -> Term TyName Name DefaultUni DefaultFun ())
-> Data -> Term TyName Name DefaultUni DefaultFun ()
forall a b. (a -> b) -> a -> b
$ Integer -> [Data] -> Data
Constr Integer
3 [Integer -> Data
I Integer
4]]
    Bool
-> DefaultFun
-> [Type TyName DefaultUni ()]
-> [Term TyName Name DefaultUni DefaultFun ()]
-> TestNested
forall a.
HasTermLevel DefaultUni a =>
a
-> DefaultFun
-> [Type TyName DefaultUni ()]
-> [Term TyName Name DefaultUni DefaultFun ()]
-> TestNested
evals Bool
False DefaultFun
EqualsData [] [Data -> Term TyName Name DefaultUni DefaultFun ()
forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons (Data -> Term TyName Name DefaultUni DefaultFun ())
-> Data -> Term TyName Name DefaultUni DefaultFun ()
forall a b. (a -> b) -> a -> b
$ Integer -> [Data] -> Data
Constr Integer
3 [Integer -> Data
I Integer
3, ByteString -> Data
B ByteString
""], Data -> Term TyName Name DefaultUni DefaultFun ()
forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons (Data -> Term TyName Name DefaultUni DefaultFun ())
-> Data -> Term TyName Name DefaultUni DefaultFun ()
forall a b. (a -> b) -> a -> b
$ Integer -> [Data] -> Data
Constr Integer
3 [Integer -> Data
I Integer
3]]
    Bool
-> DefaultFun
-> [Type TyName DefaultUni ()]
-> [Term TyName Name DefaultUni DefaultFun ()]
-> TestNested
forall a.
HasTermLevel DefaultUni a =>
a
-> DefaultFun
-> [Type TyName DefaultUni ()]
-> [Term TyName Name DefaultUni DefaultFun ()]
-> TestNested
evals Bool
False DefaultFun
EqualsData [] [Data -> Term TyName Name DefaultUni DefaultFun ()
forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons (Data -> Term TyName Name DefaultUni DefaultFun ())
-> Data -> Term TyName Name DefaultUni DefaultFun ()
forall a b. (a -> b) -> a -> b
$ Integer -> [Data] -> Data
Constr Integer
2 [Integer -> Data
I Integer
4], Data -> Term TyName Name DefaultUni DefaultFun ()
forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons (Data -> Term TyName Name DefaultUni DefaultFun ())
-> Data -> Term TyName Name DefaultUni DefaultFun ()
forall a b. (a -> b) -> a -> b
$ Integer -> [Data] -> Data
Constr Integer
3 [Integer -> Data
I Integer
4]]
    Bool
-> DefaultFun
-> [Type TyName DefaultUni ()]
-> [Term TyName Name DefaultUni DefaultFun ()]
-> TestNested
forall a.
HasTermLevel DefaultUni a =>
a
-> DefaultFun
-> [Type TyName DefaultUni ()]
-> [Term TyName Name DefaultUni DefaultFun ()]
-> TestNested
evals Bool
True DefaultFun
EqualsData [] [Data -> Term TyName Name DefaultUni DefaultFun ()
forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons (Data -> Term TyName Name DefaultUni DefaultFun ())
-> Data -> Term TyName Name DefaultUni DefaultFun ()
forall a b. (a -> b) -> a -> b
$ [(Data, Data)] -> Data
Map [(Integer -> Data
I Integer
3, ByteString -> Data
B ByteString
"")], Data -> Term TyName Name DefaultUni DefaultFun ()
forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons (Data -> Term TyName Name DefaultUni DefaultFun ())
-> Data -> Term TyName Name DefaultUni DefaultFun ()
forall a b. (a -> b) -> a -> b
$ [(Data, Data)] -> Data
Map [(Integer -> Data
I Integer
3, ByteString -> Data
B ByteString
"")]]
    Bool
-> DefaultFun
-> [Type TyName DefaultUni ()]
-> [Term TyName Name DefaultUni DefaultFun ()]
-> TestNested
forall a.
HasTermLevel DefaultUni a =>
a
-> DefaultFun
-> [Type TyName DefaultUni ()]
-> [Term TyName Name DefaultUni DefaultFun ()]
-> TestNested
evals Bool
False DefaultFun
EqualsData [] [Data -> Term TyName Name DefaultUni DefaultFun ()
forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons (Data -> Term TyName Name DefaultUni DefaultFun ())
-> Data -> Term TyName Name DefaultUni DefaultFun ()
forall a b. (a -> b) -> a -> b
$ [(Data, Data)] -> Data
Map [(Integer -> Data
I Integer
3, ByteString -> Data
B ByteString
"")], Data -> Term TyName Name DefaultUni DefaultFun ()
forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons (Data -> Term TyName Name DefaultUni DefaultFun ())
-> Data -> Term TyName Name DefaultUni DefaultFun ()
forall a b. (a -> b) -> a -> b
$ [(Data, Data)] -> Data
Map []]
    Bool
-> DefaultFun
-> [Type TyName DefaultUni ()]
-> [Term TyName Name DefaultUni DefaultFun ()]
-> TestNested
forall a.
HasTermLevel DefaultUni a =>
a
-> DefaultFun
-> [Type TyName DefaultUni ()]
-> [Term TyName Name DefaultUni DefaultFun ()]
-> TestNested
evals Bool
False DefaultFun
EqualsData [] [Data -> Term TyName Name DefaultUni DefaultFun ()
forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons (Data -> Term TyName Name DefaultUni DefaultFun ())
-> Data -> Term TyName Name DefaultUni DefaultFun ()
forall a b. (a -> b) -> a -> b
$ [(Data, Data)] -> Data
Map [(Integer -> Data
I Integer
3, ByteString -> Data
B ByteString
"")], Data -> Term TyName Name DefaultUni DefaultFun ()
forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons (Data -> Term TyName Name DefaultUni DefaultFun ())
-> Data -> Term TyName Name DefaultUni DefaultFun ()
forall a b. (a -> b) -> a -> b
$ [(Data, Data)] -> Data
Map [(Integer -> Data
I Integer
3, ByteString -> Data
B ByteString
""), (Integer -> Data
I Integer
4, Integer -> Data
I Integer
4)]]

    -- destruction
    forall a.
HasTermLevel DefaultUni a =>
a
-> DefaultFun
-> [Type TyName DefaultUni ()]
-> [Term TyName Name DefaultUni DefaultFun ()]
-> TestNested
evals @Integer Integer
3 DefaultFun
UnIData [] [Data -> Term TyName Name DefaultUni DefaultFun ()
forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons (Data -> Term TyName Name DefaultUni DefaultFun ())
-> Data -> Term TyName Name DefaultUni DefaultFun ()
forall a b. (a -> b) -> a -> b
$ Integer -> Data
I Integer
3]
    forall a.
HasTermLevel DefaultUni a =>
a
-> DefaultFun
-> [Type TyName DefaultUni ()]
-> [Term TyName Name DefaultUni DefaultFun ()]
-> TestNested
evals @ByteString ByteString
"hello world" DefaultFun
UnBData [] [Data -> Term TyName Name DefaultUni DefaultFun ()
forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons (Data -> Term TyName Name DefaultUni DefaultFun ())
-> Data -> Term TyName Name DefaultUni DefaultFun ()
forall a b. (a -> b) -> a -> b
$ ByteString -> Data
B ByteString
"hello world"]
    forall a.
HasTermLevel DefaultUni a =>
a
-> DefaultFun
-> [Type TyName DefaultUni ()]
-> [Term TyName Name DefaultUni DefaultFun ()]
-> TestNested
evals @Integer Integer
3 DefaultFun
UnIData [] [Data -> Term TyName Name DefaultUni DefaultFun ()
forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons (Data -> Term TyName Name DefaultUni DefaultFun ())
-> Data -> Term TyName Name DefaultUni DefaultFun ()
forall a b. (a -> b) -> a -> b
$ Integer -> Data
I Integer
3]
    forall a.
HasTermLevel DefaultUni a =>
a
-> DefaultFun
-> [Type TyName DefaultUni ()]
-> [Term TyName Name DefaultUni DefaultFun ()]
-> TestNested
evals @(Integer, [Data]) (Integer
1, []) DefaultFun
UnConstrData [] [Data -> Term TyName Name DefaultUni DefaultFun ()
forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons (Data -> Term TyName Name DefaultUni DefaultFun ())
-> Data -> Term TyName Name DefaultUni DefaultFun ()
forall a b. (a -> b) -> a -> b
$ Integer -> [Data] -> Data
Constr Integer
1 []]
    forall a.
HasTermLevel DefaultUni a =>
a
-> DefaultFun
-> [Type TyName DefaultUni ()]
-> [Term TyName Name DefaultUni DefaultFun ()]
-> TestNested
evals @(Integer, [Data]) (Integer
1, [Integer -> Data
I Integer
3]) DefaultFun
UnConstrData [] [Data -> Term TyName Name DefaultUni DefaultFun ()
forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons (Data -> Term TyName Name DefaultUni DefaultFun ())
-> Data -> Term TyName Name DefaultUni DefaultFun ()
forall a b. (a -> b) -> a -> b
$ Integer -> [Data] -> Data
Constr Integer
1 [Integer -> Data
I Integer
3]]
    forall a.
HasTermLevel DefaultUni a =>
a
-> DefaultFun
-> [Type TyName DefaultUni ()]
-> [Term TyName Name DefaultUni DefaultFun ()]
-> TestNested
evals @[(Data, Data)] [] DefaultFun
UnMapData [] [Data -> Term TyName Name DefaultUni DefaultFun ()
forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons (Data -> Term TyName Name DefaultUni DefaultFun ())
-> Data -> Term TyName Name DefaultUni DefaultFun ()
forall a b. (a -> b) -> a -> b
$ [(Data, Data)] -> Data
Map []]
    forall a.
HasTermLevel DefaultUni a =>
a
-> DefaultFun
-> [Type TyName DefaultUni ()]
-> [Term TyName Name DefaultUni DefaultFun ()]
-> TestNested
evals @[(Data, Data)] [(ByteString -> Data
B ByteString
"", Integer -> Data
I Integer
3)] DefaultFun
UnMapData [] [Data -> Term TyName Name DefaultUni DefaultFun ()
forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons (Data -> Term TyName Name DefaultUni DefaultFun ())
-> Data -> Term TyName Name DefaultUni DefaultFun ()
forall a b. (a -> b) -> a -> b
$ [(Data, Data)] -> Data
Map [(ByteString -> Data
B ByteString
"", Integer -> Data
I Integer
3)]]
    forall a.
HasTermLevel DefaultUni a =>
a
-> DefaultFun
-> [Type TyName DefaultUni ()]
-> [Term TyName Name DefaultUni DefaultFun ()]
-> TestNested
evals @[Data] [] DefaultFun
UnListData [] [Data -> Term TyName Name DefaultUni DefaultFun ()
forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons (Data -> Term TyName Name DefaultUni DefaultFun ())
-> Data -> Term TyName Name DefaultUni DefaultFun ()
forall a b. (a -> b) -> a -> b
$ [Data] -> Data
List []]
    forall a.
HasTermLevel DefaultUni a =>
a
-> DefaultFun
-> [Type TyName DefaultUni ()]
-> [Term TyName Name DefaultUni DefaultFun ()]
-> TestNested
evals @[Data] [Integer -> Data
I Integer
3, Integer -> Data
I Integer
4, ByteString -> Data
B ByteString
""] DefaultFun
UnListData [] [Data -> Term TyName Name DefaultUni DefaultFun ()
forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons (Data -> Term TyName Name DefaultUni DefaultFun ())
-> Data -> Term TyName Name DefaultUni DefaultFun ()
forall a b. (a -> b) -> a -> b
$ [Data] -> Data
List [Integer -> Data
I Integer
3, Integer -> Data
I Integer
4, ByteString -> Data
B ByteString
""]]
    forall a.
HasTermLevel DefaultUni a =>
a
-> DefaultFun
-> [Type TyName DefaultUni ()]
-> [Term TyName Name DefaultUni DefaultFun ()]
-> TestNested
evals @ByteString ByteString
"\162\ETX@Ehello8c" DefaultFun
SerialiseData [] [Data -> Term TyName Name DefaultUni DefaultFun ()
forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons (Data -> Term TyName Name DefaultUni DefaultFun ())
-> Data -> Term TyName Name DefaultUni DefaultFun ()
forall a b. (a -> b) -> a -> b
$ [(Data, Data)] -> Data
Map [(Integer -> Data
I Integer
3, ByteString -> Data
B ByteString
""), (ByteString -> Data
B ByteString
"hello", Integer -> Data
I (Integer -> Data) -> Integer -> Data
forall a b. (a -> b) -> a -> b
$ -Integer
100)]]

    String -> TestNested -> TestNested
testNestedM String
"MatchData" (TestNested -> TestNested) -> TestNested -> TestNested
forall a b. (a -> b) -> a -> b
$ do
        MatchOption -> TestNested
test_MatchData MatchOption
UseChoose
        MatchOption -> TestNested
test_MatchData MatchOption
UseCase

-- | Test all cryptography-related builtins
test_Crypto :: TestNested
test_Crypto :: TestNested
test_Crypto = String -> TestNested -> TestNested
testNestedM String
"Crypto" (TestNested -> TestNested) -> TestNested -> TestNested
forall a b. (a -> b) -> a -> b
$ do
    Bool
-> DefaultFun
-> [Type TyName DefaultUni ()]
-> [Term TyName Name DefaultUni DefaultFun ()]
-> TestNested
forall a.
HasTermLevel DefaultUni a =>
a
-> DefaultFun
-> [Type TyName DefaultUni ()]
-> [Term TyName Name DefaultUni DefaultFun ()]
-> TestNested
evals Bool
True DefaultFun
VerifyEd25519Signature []
        [ -- pubkey
          forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons @ByteString ByteString
"Y\218\215\204>\STX\233\152\251\243\158'm\130\&0\197\DEL\STXd\214`\147\243y(\234\167=kTj\164"
          -- message
        , forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons @ByteString ByteString
"hello world"
          -- signature
        , forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons @ByteString ByteString
"\a'\198\r\226\SYN;\bX\254\228\129n\131\177\193\DC3-k\249RriY\221wIL\240\144\r\145\195\191\196]\227\169U(\ETX\171\SI\199\163\138\160\128R\DC4\246n\142[g\SI\169\SUB\178\245\166\&0\243\b"
        ]

    Bool
-> DefaultFun
-> [Type TyName DefaultUni ()]
-> [Term TyName Name DefaultUni DefaultFun ()]
-> TestNested
forall a.
HasTermLevel DefaultUni a =>
a
-> DefaultFun
-> [Type TyName DefaultUni ()]
-> [Term TyName Name DefaultUni DefaultFun ()]
-> TestNested
evals Bool
False DefaultFun
VerifyEd25519Signature []
        [ -- pubkey
          forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons @ByteString ByteString
"Y\218\215\204>\STX\233\152\251\243\158'm\130\&0\197\DEL\STXd\214`\147\243y(\234\167=kTj\164"
          -- message
        , forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons @ByteString ByteString
"HELLO WORLD"
          -- signature
        , forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons @ByteString ByteString
"\a'\198\r\226\SYN;\bX\254\228\129n\131\177\193\DC3-k\249RriY\221wIL\240\144\r\145\195\191\196]\227\169U(\ETX\171\SI\199\163\138\160\128R\DC4\246n\142[g\SI\169\SUB\178\245\166\&0\243\b"
        ]
    -- independently verified by `/usr/bin/sha256sum` with the hex output converted to ascii text
    -- sha256sum hex output: b94d27b9934d3e08a52e52d7da7dabfac484efe37a5380ee9088f7ace2efcde9
    forall a.
HasTermLevel DefaultUni a =>
a
-> DefaultFun
-> [Type TyName DefaultUni ()]
-> [Term TyName Name DefaultUni DefaultFun ()]
-> TestNested
evals @ByteString ByteString
"\185M'\185\147M>\b\165.R\215\218}\171\250\196\132\239\227zS\128\238\144\136\247\172\226\239\205\233"
        DefaultFun
Sha2_256 [] [forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons @ByteString ByteString
"hello world"]
    -- independently verified by `/usr/bin/sha3-256sum` with the hex output converted to ascii text
    -- sha3-256sum hex output: 644bcc7e564373040999aac89e7622f3ca71fba1d972fd94a31c3bfbf24e3938
    forall a.
HasTermLevel DefaultUni a =>
a
-> DefaultFun
-> [Type TyName DefaultUni ()]
-> [Term TyName Name DefaultUni DefaultFun ()]
-> TestNested
evals @ByteString ByteString
"dK\204~VCs\EOT\t\153\170\200\158v\"\243\202q\251\161\217r\253\148\163\FS;\251\242N98"
        DefaultFun
Sha3_256 [] [forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons @ByteString ByteString
"hello world"]
    -- independently verified by `/usr/bin/b2sum -l 256` with the hex output converted to ascii text
    -- b2sum -l 256 hex output: 256c83b297114d201b30179f3f0ef0cace9783622da5974326b436178aeef610
    forall a.
HasTermLevel DefaultUni a =>
a
-> DefaultFun
-> [Type TyName DefaultUni ()]
-> [Term TyName Name DefaultUni DefaultFun ()]
-> TestNested
evals @ByteString ByteString
"%l\131\178\151\DC1M \ESC0\ETB\159?\SO\240\202\206\151\131b-\165\151C&\180\&6\ETB\138\238\246\DLE"
        DefaultFun
Blake2b_256 [] [forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons @ByteString ByteString
"hello world"]
    -- independently verified by `/usr/bin/b2sum -l 224` with the hex output converted to ascii text
    -- b2sum -l 224 hex output: 42d1854b7d69e3b57c64fcc7b4f64171b47dff43fba6ac0499ff437f
    forall a.
HasTermLevel DefaultUni a =>
a
-> DefaultFun
-> [Type TyName DefaultUni ()]
-> [Term TyName Name DefaultUni DefaultFun ()]
-> TestNested
evals @ByteString ByteString
"B\209\133K}i\227\181|d\252\199\180\246Aq\180}\255C\251\166\172\EOT\153\255C\DEL"
        DefaultFun
Blake2b_224 [] [forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons @ByteString ByteString
"hello world"]
    -- independently verified by the calculator at `https://emn178.github.io/online-tools/keccak_256.html`
    -- with the hex output converted to ascii text
    -- hex output: 47173285a8d7341e5e972fc677286384f802f8ef42a5ec5f03bbfa254cb01fad
    forall a.
HasTermLevel DefaultUni a =>
a
-> DefaultFun
-> [Type TyName DefaultUni ()]
-> [Term TyName Name DefaultUni DefaultFun ()]
-> TestNested
evals @ByteString ByteString
"G\ETB2\133\168\215\&4\RS^\151/\198w(c\132\248\STX\248\239B\165\236_\ETX\187\250%L\176\US\173"
        DefaultFun
Keccak_256 [] [forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons @ByteString ByteString
"hello world"]
    -- independently verified by the calculator at https://emn178.github.io/online-tools/ripemd_160.html
    let
      hashHex :: Text
hashHex = Text
"98c615784ccb5fe5936fbc0cbe9dfdb408d92f0f"
      ripemd_160Hash :: ByteString
ripemd_160Hash = case ByteString -> Either String ByteString
Base16.decode (ByteString -> Either String ByteString)
-> ByteString -> Either String ByteString
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
Text.encodeUtf8 Text
hashHex of
        Right ByteString
res -> ByteString
res
        Left String
_    -> String -> ByteString
forall a. HasCallStack => String -> a
error (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ String
"Unexpected error during hex decoding: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
Text.unpack Text
hashHex
    forall a.
HasTermLevel DefaultUni a =>
a
-> DefaultFun
-> [Type TyName DefaultUni ()]
-> [Term TyName Name DefaultUni DefaultFun ()]
-> TestNested
evals @ByteString ByteString
ripemd_160Hash
        DefaultFun
Ripemd_160 [] [forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons @ByteString ByteString
"hello world"]
    -- Tests for blake2b_224: output obtained using the b2sum program from https://github.com/BLAKE2/BLAKE2
    ByteString
-> DefaultFun
-> [Type TyName DefaultUni ()]
-> [Term TyName Name DefaultUni DefaultFun ()]
-> TestNested
forall a.
HasTermLevel DefaultUni a =>
a
-> DefaultFun
-> [Type TyName DefaultUni ()]
-> [Term TyName Name DefaultUni DefaultFun ()]
-> TestNested
evals ([Word8] -> ByteString
pack [ Word8
0x83, Word8
0x6c, Word8
0xc6, Word8
0x89, Word8
0x31, Word8
0xc2, Word8
0xe4, Word8
0xe3, Word8
0xe8, Word8
0x38, Word8
0x60, Word8
0x2e, Word8
0xca, Word8
0x19
                , Word8
0x02, Word8
0x59, Word8
0x1d, Word8
0x21, Word8
0x68, Word8
0x37, Word8
0xba, Word8
0xfd, Word8
0xdf, Word8
0xe6, Word8
0xf0, Word8
0xc8, Word8
0xcb, Word8
0x07 ])
        DefaultFun
Blake2b_224 [] [ByteString -> Term TyName Name DefaultUni DefaultFun ()
forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons (ByteString -> Term TyName Name DefaultUni DefaultFun ())
-> ByteString -> Term TyName Name DefaultUni DefaultFun ()
forall a b. (a -> b) -> a -> b
$ [Word8] -> ByteString
pack []]
    ByteString
-> DefaultFun
-> [Type TyName DefaultUni ()]
-> [Term TyName Name DefaultUni DefaultFun ()]
-> TestNested
forall a.
HasTermLevel DefaultUni a =>
a
-> DefaultFun
-> [Type TyName DefaultUni ()]
-> [Term TyName Name DefaultUni DefaultFun ()]
-> TestNested
evals ([Word8] -> ByteString
pack [ Word8
0xfe, Word8
0x57, Word8
0xe0, Word8
0x22, Word8
0x87, Word8
0x66, Word8
0x2c, Word8
0xe6, Word8
0xe2, Word8
0x9c, Word8
0xba, Word8
0x02, Word8
0xca, Word8
0x2f
                , Word8
0x23, Word8
0xc4, Word8
0x1f, Word8
0x20, Word8
0x84, Word8
0xc7, Word8
0x95, Word8
0x9f, Word8
0x1c, Word8
0xa3, Word8
0xa5, Word8
0x7e, Word8
0xaf, Word8
0x9e ])
        DefaultFun
Blake2b_224 [] [ByteString -> Term TyName Name DefaultUni DefaultFun ()
forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons (ByteString -> Term TyName Name DefaultUni DefaultFun ())
-> ByteString -> Term TyName Name DefaultUni DefaultFun ()
forall a b. (a -> b) -> a -> b
$ [Word8] -> ByteString
pack [ Word8
0xfc, Word8
0x56, Word8
0xca, Word8
0x9a, Word8
0x93, Word8
0x98, Word8
0x2a, Word8
0x46, Word8
0x69, Word8
0xcc
                                 , Word8
0xab, Word8
0xa6, Word8
0xe3, Word8
0xd1, Word8
0x84, Word8
0xa1, Word8
0x9d, Word8
0xe4, Word8
0xce, Word8
0x80
                                 , Word8
0x0b, Word8
0xb6, Word8
0x43, Word8
0xa3, Word8
0x60, Word8
0xc1, Word8
0x45, Word8
0x72, Word8
0xae, Word8
0xdb
                                 , Word8
0x22, Word8
0x97, Word8
0x4f, Word8
0x0c, Word8
0x96, Word8
0x6b, Word8
0x85, Word8
0x9d, Word8
0x91, Word8
0xad
                                 , Word8
0x5d, Word8
0x71, Word8
0x3b, Word8
0x7a, Word8
0xd9, Word8
0x99, Word8
0x35, Word8
0x79, Word8
0x4d, Word8
0x22 ]] -- 400 bits
    -- Tests for blake2b_256: output obtained using the b2sum program from https://github.com/BLAKE2/BLAKE2
    ByteString
-> DefaultFun
-> [Type TyName DefaultUni ()]
-> [Term TyName Name DefaultUni DefaultFun ()]
-> TestNested
forall a.
HasTermLevel DefaultUni a =>
a
-> DefaultFun
-> [Type TyName DefaultUni ()]
-> [Term TyName Name DefaultUni DefaultFun ()]
-> TestNested
evals ([Word8] -> ByteString
pack [ Word8
0x0e, Word8
0x57, Word8
0x51, Word8
0xc0, Word8
0x26, Word8
0xe5, Word8
0x43, Word8
0xb2, Word8
0xe8, Word8
0xab, Word8
0x2e, Word8
0xb0, Word8
0x60, Word8
0x99, Word8
0xda, Word8
0xa1
                , Word8
0xd1, Word8
0xe5, Word8
0xdf, Word8
0x47, Word8
0x77, Word8
0x8f, Word8
0x77, Word8
0x87, Word8
0xfa, Word8
0xab, Word8
0x45, Word8
0xcd, Word8
0xf1, Word8
0x2f, Word8
0xe3, Word8
0xa8 ])
        DefaultFun
Blake2b_256 [] [ByteString -> Term TyName Name DefaultUni DefaultFun ()
forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons (ByteString -> Term TyName Name DefaultUni DefaultFun ())
-> ByteString -> Term TyName Name DefaultUni DefaultFun ()
forall a b. (a -> b) -> a -> b
$ [Word8] -> ByteString
pack []]
    ByteString
-> DefaultFun
-> [Type TyName DefaultUni ()]
-> [Term TyName Name DefaultUni DefaultFun ()]
-> TestNested
forall a.
HasTermLevel DefaultUni a =>
a
-> DefaultFun
-> [Type TyName DefaultUni ()]
-> [Term TyName Name DefaultUni DefaultFun ()]
-> TestNested
evals ([Word8] -> ByteString
pack [ Word8
0xfc, Word8
0x63, Word8
0xa3, Word8
0xcd, Word8
0xf1, Word8
0xc9, Word8
0xbe, Word8
0xb0, Word8
0x9e, Word8
0x18, Word8
0x98, Word8
0x8a, Word8
0x95, Word8
0x7c, Word8
0x58, Word8
0x31
                , Word8
0x98, Word8
0xc7, Word8
0xe3, Word8
0x0f, Word8
0xe4, Word8
0x8b, Word8
0x9e, Word8
0x80, Word8
0x41, Word8
0xbb, Word8
0x90, Word8
0x4a, Word8
0xf8, Word8
0x78, Word8
0x3b, Word8
0x5c ])
        DefaultFun
Blake2b_256 [] [ByteString -> Term TyName Name DefaultUni DefaultFun ()
forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons (ByteString -> Term TyName Name DefaultUni DefaultFun ())
-> ByteString -> Term TyName Name DefaultUni DefaultFun ()
forall a b. (a -> b) -> a -> b
$ [Word8] -> ByteString
pack [ Word8
0xfc, Word8
0x56, Word8
0xca, Word8
0x9a, Word8
0x93, Word8
0x98, Word8
0x2a, Word8
0x46, Word8
0x69, Word8
0xcc
                                 , Word8
0xab, Word8
0xa6, Word8
0xe3, Word8
0xd1, Word8
0x84, Word8
0xa1, Word8
0x9d, Word8
0xe4, Word8
0xce, Word8
0x80
                                 , Word8
0x0b, Word8
0xb6, Word8
0x43, Word8
0xa3, Word8
0x60, Word8
0xc1, Word8
0x45, Word8
0x72, Word8
0xae, Word8
0xdb
                                 , Word8
0x22, Word8
0x97, Word8
0x4f, Word8
0x0c, Word8
0x96, Word8
0x6b, Word8
0x85, Word8
0x9d, Word8
0x91, Word8
0xad
                                 , Word8
0x5d, Word8
0x71, Word8
0x3b, Word8
0x7a, Word8
0xd9, Word8
0x99, Word8
0x35, Word8
0x79, Word8
0x4d, Word8
0x22 ]] -- 400 bits
    -- Test vectors from ShortMsgKAT_256.txt in https://keccak.team/obsolete/KeccakKAT-3.zip.
    ByteString
-> DefaultFun
-> [Type TyName DefaultUni ()]
-> [Term TyName Name DefaultUni DefaultFun ()]
-> TestNested
forall a.
HasTermLevel DefaultUni a =>
a
-> DefaultFun
-> [Type TyName DefaultUni ()]
-> [Term TyName Name DefaultUni DefaultFun ()]
-> TestNested
evals ([Word8] -> ByteString
pack [ Word8
0xC5, Word8
0xD2, Word8
0x46, Word8
0x01, Word8
0x86, Word8
0xF7, Word8
0x23, Word8
0x3C, Word8
0x92, Word8
0x7E, Word8
0x7D, Word8
0xB2, Word8
0xDC, Word8
0xC7, Word8
0x03, Word8
0xC0
                , Word8
0xE5, Word8
0x00, Word8
0xB6, Word8
0x53, Word8
0xCA, Word8
0x82, Word8
0x27, Word8
0x3B, Word8
0x7B, Word8
0xFA, Word8
0xD8, Word8
0x04, Word8
0x5D, Word8
0x85, Word8
0xA4, Word8
0x70 ])
        DefaultFun
Keccak_256 [] [ByteString -> Term TyName Name DefaultUni DefaultFun ()
forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons (ByteString -> Term TyName Name DefaultUni DefaultFun ())
-> ByteString -> Term TyName Name DefaultUni DefaultFun ()
forall a b. (a -> b) -> a -> b
$ [Word8] -> ByteString
pack []]
    ByteString
-> DefaultFun
-> [Type TyName DefaultUni ()]
-> [Term TyName Name DefaultUni DefaultFun ()]
-> TestNested
forall a.
HasTermLevel DefaultUni a =>
a
-> DefaultFun
-> [Type TyName DefaultUni ()]
-> [Term TyName Name DefaultUni DefaultFun ()]
-> TestNested
evals ([Word8] -> ByteString
pack [ Word8
0xFA, Word8
0x46, Word8
0x0C, Word8
0xD5, Word8
0x1B, Word8
0xC6, Word8
0x11, Word8
0x78, Word8
0x6D, Word8
0x36, Word8
0x4F, Word8
0xCA, Word8
0xBE, Word8
0x39, Word8
0x05, Word8
0x2B
                , Word8
0xCD, Word8
0x5F, Word8
0x00, Word8
0x9E, Word8
0xDF, Word8
0xA8, Word8
0x1F, Word8
0x47, Word8
0x01, Word8
0xC5, Word8
0xB2, Word8
0x2B, Word8
0x72, Word8
0x9B, Word8
0x00, Word8
0x16 ])
        DefaultFun
Keccak_256 [] [ByteString -> Term TyName Name DefaultUni DefaultFun ()
forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons (ByteString -> Term TyName Name DefaultUni DefaultFun ())
-> ByteString -> Term TyName Name DefaultUni DefaultFun ()
forall a b. (a -> b) -> a -> b
$ [Word8] -> ByteString
pack [ Word8
0x7E, Word8
0x15, Word8
0xD2, Word8
0xB9, Word8
0xEA, Word8
0x74, Word8
0xCA, Word8
0x60, Word8
0xF6, Word8
0x6C
                                , Word8
0x8D, Word8
0xFA, Word8
0xB3, Word8
0x77, Word8
0xD9, Word8
0x19, Word8
0x8B, Word8
0x7B, Word8
0x16, Word8
0xDE
                                , Word8
0xB6, Word8
0xA1, Word8
0xBA, Word8
0x0E, Word8
0xA3, Word8
0xC7, Word8
0xEE, Word8
0x20, Word8
0x42, Word8
0xF8
                                , Word8
0x9D, Word8
0x37, Word8
0x86, Word8
0xE7, Word8
0x79, Word8
0xCF, Word8
0x05, Word8
0x3C, Word8
0x77, Word8
0x78
                                , Word8
0x5A, Word8
0xA9, Word8
0xE6, Word8
0x92, Word8
0xF8, Word8
0x21, Word8
0xF1, Word8
0x4A, Word8
0x7F, Word8
0x51 ]]  -- 400 bits
    -- Test vectors for sha2_256 from SHA256ShortMessage.rsp in
    -- https://csrc.nist.gov/CSRC/media/Projects/Cryptographic-Algorithm-Validation-Program/documents/shs/shabytetestvectors.zip
    ByteString
-> DefaultFun
-> [Type TyName DefaultUni ()]
-> [Term TyName Name DefaultUni DefaultFun ()]
-> TestNested
forall a.
HasTermLevel DefaultUni a =>
a
-> DefaultFun
-> [Type TyName DefaultUni ()]
-> [Term TyName Name DefaultUni DefaultFun ()]
-> TestNested
evals ([Word8] -> ByteString
pack [ Word8
0xe3, Word8
0xb0, Word8
0xc4, Word8
0x42, Word8
0x98, Word8
0xfc, Word8
0x1c, Word8
0x14, Word8
0x9a, Word8
0xfb, Word8
0xf4, Word8
0xc8, Word8
0x99, Word8
0x6f, Word8
0xb9, Word8
0x24
                , Word8
0x27, Word8
0xae, Word8
0x41, Word8
0xe4, Word8
0x64, Word8
0x9b, Word8
0x93, Word8
0x4c, Word8
0xa4, Word8
0x95, Word8
0x99, Word8
0x1b, Word8
0x78, Word8
0x52, Word8
0xb8, Word8
0x55 ])
        DefaultFun
Sha2_256 [] [ByteString -> Term TyName Name DefaultUni DefaultFun ()
forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons (ByteString -> Term TyName Name DefaultUni DefaultFun ())
-> ByteString -> Term TyName Name DefaultUni DefaultFun ()
forall a b. (a -> b) -> a -> b
$ [Word8] -> ByteString
pack []]
    ByteString
-> DefaultFun
-> [Type TyName DefaultUni ()]
-> [Term TyName Name DefaultUni DefaultFun ()]
-> TestNested
forall a.
HasTermLevel DefaultUni a =>
a
-> DefaultFun
-> [Type TyName DefaultUni ()]
-> [Term TyName Name DefaultUni DefaultFun ()]
-> TestNested
evals ([Word8] -> ByteString
pack [ Word8
0x99, Word8
0xdc, Word8
0x77, Word8
0x2e, Word8
0x91, Word8
0xea, Word8
0x02, Word8
0xd9, Word8
0xe4, Word8
0x21, Word8
0xd5, Word8
0x52, Word8
0xd6, Word8
0x19, Word8
0x01, Word8
0x01
                , Word8
0x6b, Word8
0x9f, Word8
0xd4, Word8
0xad, Word8
0x2d, Word8
0xf4, Word8
0xa8, Word8
0x21, Word8
0x2c, Word8
0x1e, Word8
0xc5, Word8
0xba, Word8
0x13, Word8
0x89, Word8
0x3a, Word8
0xb2 ])
        DefaultFun
Sha2_256 [] [ByteString -> Term TyName Name DefaultUni DefaultFun ()
forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons (ByteString -> Term TyName Name DefaultUni DefaultFun ())
-> ByteString -> Term TyName Name DefaultUni DefaultFun ()
forall a b. (a -> b) -> a -> b
$ [Word8] -> ByteString
pack [ Word8
0x3d, Word8
0x83, Word8
0xdf, Word8
0x37, Word8
0x17, Word8
0x2c, Word8
0x81, Word8
0xaf, Word8
0xd0, Word8
0xde
                              , Word8
0x11, Word8
0x51, Word8
0x39, Word8
0xfb, Word8
0xf4, Word8
0x39, Word8
0x0c, Word8
0x22, Word8
0xe0, Word8
0x98
                              , Word8
0xc5, Word8
0xaf, Word8
0x4c, Word8
0x5a, Word8
0xb4, Word8
0x85, Word8
0x24, Word8
0x06, Word8
0x51, Word8
0x0b
                              , Word8
0xc0, Word8
0xe6, Word8
0xcf, Word8
0x74, Word8
0x17, Word8
0x69, Word8
0xf4, Word8
0x44, Word8
0x30, Word8
0xc5
                              , Word8
0x27, Word8
0x0f, Word8
0xda, Word8
0xe0, Word8
0xcb, Word8
0x84, Word8
0x9d, Word8
0x71, Word8
0xcb, Word8
0xab ]] -- 400 bits
    -- Test vectors for sha3_256 from SHA3_256ShortMessage.rsp in
    -- https://csrc.nist.gov/CSRC/media/Projects/Cryptographic-Algorithm-Validation-Program/documents/sha3/sha-3bytetestvectors.zip
    ByteString
-> DefaultFun
-> [Type TyName DefaultUni ()]
-> [Term TyName Name DefaultUni DefaultFun ()]
-> TestNested
forall a.
HasTermLevel DefaultUni a =>
a
-> DefaultFun
-> [Type TyName DefaultUni ()]
-> [Term TyName Name DefaultUni DefaultFun ()]
-> TestNested
evals ([Word8] -> ByteString
pack [ Word8
0xa7, Word8
0xff, Word8
0xc6, Word8
0xf8, Word8
0xbf, Word8
0x1e, Word8
0xd7, Word8
0x66, Word8
0x51, Word8
0xc1, Word8
0x47, Word8
0x56, Word8
0xa0, Word8
0x61, Word8
0xd6, Word8
0x62
                , Word8
0xf5, Word8
0x80, Word8
0xff, Word8
0x4d, Word8
0xe4, Word8
0x3b, Word8
0x49, Word8
0xfa, Word8
0x82, Word8
0xd8, Word8
0x0a, Word8
0x4b, Word8
0x80, Word8
0xf8, Word8
0x43, Word8
0x4a ])
        DefaultFun
Sha3_256 [] [ByteString -> Term TyName Name DefaultUni DefaultFun ()
forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons (ByteString -> Term TyName Name DefaultUni DefaultFun ())
-> ByteString -> Term TyName Name DefaultUni DefaultFun ()
forall a b. (a -> b) -> a -> b
$ [Word8] -> ByteString
pack []]
    ByteString
-> DefaultFun
-> [Type TyName DefaultUni ()]
-> [Term TyName Name DefaultUni DefaultFun ()]
-> TestNested
forall a.
HasTermLevel DefaultUni a =>
a
-> DefaultFun
-> [Type TyName DefaultUni ()]
-> [Term TyName Name DefaultUni DefaultFun ()]
-> TestNested
evals ([Word8] -> ByteString
pack [ Word8
0xe2, Word8
0x18, Word8
0x06, Word8
0xce, Word8
0x76, Word8
0x6b, Word8
0xbc, Word8
0xe8, Word8
0xb8, Word8
0xd1, Word8
0xb9, Word8
0x9b, Word8
0xcf, Word8
0x16, Word8
0x2f, Word8
0xd1
                , Word8
0x54, Word8
0xf5, Word8
0x46, Word8
0x92, Word8
0x35, Word8
0x1a, Word8
0xec, Word8
0x8e, Word8
0x69, Word8
0x14, Word8
0xe1, Word8
0xa6, Word8
0x94, Word8
0xbd, Word8
0xa9, Word8
0xee ])
        DefaultFun
Sha3_256 [] [ByteString -> Term TyName Name DefaultUni DefaultFun ()
forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons (ByteString -> Term TyName Name DefaultUni DefaultFun ())
-> ByteString -> Term TyName Name DefaultUni DefaultFun ()
forall a b. (a -> b) -> a -> b
$ [Word8] -> ByteString
pack [ Word8
0xfc, Word8
0x56, Word8
0xca, Word8
0x9a, Word8
0x93, Word8
0x98, Word8
0x2a, Word8
0x46, Word8
0x69, Word8
0xcc
                              , Word8
0xab, Word8
0xa6, Word8
0xe3, Word8
0xd1, Word8
0x84, Word8
0xa1, Word8
0x9d, Word8
0xe4, Word8
0xce, Word8
0x80
                              , Word8
0x0b, Word8
0xb6, Word8
0x43, Word8
0xa3, Word8
0x60, Word8
0xc1, Word8
0x45, Word8
0x72, Word8
0xae, Word8
0xdb
                              , Word8
0x22, Word8
0x97, Word8
0x4f, Word8
0x0c, Word8
0x96, Word8
0x6b, Word8
0x85, Word8
0x9d, Word8
0x91, Word8
0xad
                              , Word8
0x5d, Word8
0x71, Word8
0x3b, Word8
0x7a, Word8
0xd9, Word8
0x99, Word8
0x35, Word8
0x79, Word8
0x4d, Word8
0x22 ]] -- 400 bits

-- | Test that hashes produced by a hash function contain the expected number of bits
test_HashSize :: DefaultFun -> Integer -> TestTree
test_HashSize :: DefaultFun -> Integer -> TestTree
test_HashSize DefaultFun
hashFun Integer
expectedNumBits =
    let testName :: String
testName = String
"HashSize " String -> String -> String
forall a. [a] -> [a] -> [a]
++ DefaultFun -> String
forall a. Show a => a -> String
show DefaultFun
hashFun String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" is " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
expectedNumBits String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" bits"
        propName :: PropertyName
propName = String -> PropertyName
forall a. IsString a => String -> a
fromString (String -> PropertyName) -> String -> PropertyName
forall a b. (a -> b) -> a -> b
$ String
"HashSize " String -> String -> String
forall a. [a] -> [a] -> [a]
++ DefaultFun -> String
forall a. Show a => a -> String
show DefaultFun
hashFun
    in String -> PropertyName -> Property -> TestTree
testPropertyNamed
       String
testName
       PropertyName
propName
       (Property -> TestTree)
-> (PropertyT IO () -> Property) -> PropertyT IO () -> TestTree
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TestLimit -> (TestLimit -> TestLimit) -> Property -> Property
mapTestLimitAtLeast TestLimit
10 (TestLimit -> TestLimit -> TestLimit
forall a. Integral a => a -> a -> a
`div` TestLimit
50) (Property -> Property)
-> (PropertyT IO () -> Property) -> PropertyT IO () -> Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => PropertyT IO () -> Property
PropertyT IO () -> Property
property (PropertyT IO () -> TestTree) -> PropertyT IO () -> TestTree
forall a b. (a -> b) -> a -> b
$ do
         ByteString
bs <- Gen ByteString -> PropertyT IO ByteString
forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll (Gen ByteString -> PropertyT IO ByteString)
-> Gen ByteString -> PropertyT IO ByteString
forall a b. (a -> b) -> a -> b
$ Range Int -> Gen ByteString
forall (m :: * -> *). MonadGen m => Range Int -> m ByteString
Gen.bytes (Int -> Int -> Range Int
forall a. Integral a => a -> a -> Range a
Range.linear Int
0 Int
1000)
         let term :: Term TyName Name DefaultUni DefaultFun ()
term = Term TyName Name DefaultUni DefaultFun ()
-> [Term TyName Name DefaultUni DefaultFun ()]
-> Term TyName Name DefaultUni DefaultFun ()
forall (term :: * -> *) tyname name (uni :: * -> *) fun.
TermLike term tyname name uni fun =>
term () -> [term ()] -> term ()
mkIterAppNoAnn (() -> DefaultFun -> Term TyName Name DefaultUni DefaultFun ()
forall ann.
ann -> DefaultFun -> Term TyName Name DefaultUni DefaultFun ann
forall (term :: * -> *) tyname name (uni :: * -> *) fun ann.
TermLike term tyname name uni fun =>
ann -> fun -> term ann
builtin () DefaultFun
MultiplyInteger)
                    [ forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons @Integer Integer
8
                    , Term TyName Name DefaultUni DefaultFun ()
-> [Term TyName Name DefaultUni DefaultFun ()]
-> Term TyName Name DefaultUni DefaultFun ()
forall (term :: * -> *) tyname name (uni :: * -> *) fun.
TermLike term tyname name uni fun =>
term () -> [term ()] -> term ()
mkIterAppNoAnn (() -> DefaultFun -> Term TyName Name DefaultUni DefaultFun ()
forall ann.
ann -> DefaultFun -> Term TyName Name DefaultUni DefaultFun ann
forall (term :: * -> *) tyname name (uni :: * -> *) fun ann.
TermLike term tyname name uni fun =>
ann -> fun -> term ann
builtin () DefaultFun
LengthOfByteString)
                          [Term TyName Name DefaultUni DefaultFun ()
-> [Term TyName Name DefaultUni DefaultFun ()]
-> Term TyName Name DefaultUni DefaultFun ()
forall (term :: * -> *) tyname name (uni :: * -> *) fun.
TermLike term tyname name uni fun =>
term () -> [term ()] -> term ()
mkIterAppNoAnn (() -> DefaultFun -> Term TyName Name DefaultUni DefaultFun ()
forall ann.
ann -> DefaultFun -> Term TyName Name DefaultUni DefaultFun ann
forall (term :: * -> *) tyname name (uni :: * -> *) fun ann.
TermLike term tyname name uni fun =>
ann -> fun -> term ann
builtin () DefaultFun
hashFun) [forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons @ByteString ByteString
bs]]
                    ]
         BuiltinSemanticsVariant DefaultFun
-> CostingPart DefaultUni DefaultFun
-> Term TyName Name DefaultUni DefaultFun ()
-> Either
     (Error DefaultUni DefaultFun ())
     (EvaluationResult (Term Name DefaultUni DefaultFun ()))
forall (uni :: * -> *) fun (m :: * -> *).
(MonadError (Error uni fun ()) m, Typecheckable uni fun, GEq uni,
 Everywhere uni ExMemoryUsage, PrettyUni uni, Pretty fun) =>
BuiltinSemanticsVariant fun
-> CostingPart uni fun
-> Term TyName Name uni fun ()
-> m (EvaluationResult (Term Name uni fun ()))
typecheckEvaluateCekNoEmit BuiltinSemanticsVariant DefaultFun
forall a. Default a => a
def BuiltinCostModel
CostingPart DefaultUni DefaultFun
defaultBuiltinCostModelForTesting Term TyName Name DefaultUni DefaultFun ()
term Either
  (Error DefaultUni DefaultFun ())
  (EvaluationResult (Term Name DefaultUni DefaultFun ()))
-> Either
     (Error DefaultUni DefaultFun ())
     (EvaluationResult (Term Name DefaultUni DefaultFun ()))
-> PropertyT IO ()
forall (m :: * -> *) a.
(MonadTest m, Eq a, Show a, HasCallStack) =>
a -> a -> m ()
=== EvaluationResult (Term Name DefaultUni DefaultFun ())
-> Either
     (Error DefaultUni DefaultFun ())
     (EvaluationResult (Term Name DefaultUni DefaultFun ()))
forall a b. b -> Either a b
Right (Term Name DefaultUni DefaultFun ()
-> EvaluationResult (Term Name DefaultUni DefaultFun ())
forall a. a -> EvaluationResult a
EvaluationSuccess (forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons @Integer Integer
expectedNumBits))

-- | Check that all hash functions return hashes with the correct number of bits
test_HashSizes :: TestTree
test_HashSizes :: TestTree
test_HashSizes =
    String -> [TestTree] -> TestTree
testGroup String
"Hash sizes"
        [ DefaultFun -> Integer -> TestTree
test_HashSize DefaultFun
Sha2_256        Integer
256
        , DefaultFun -> Integer -> TestTree
test_HashSize DefaultFun
Sha3_256        Integer
256
        , DefaultFun -> Integer -> TestTree
test_HashSize DefaultFun
Blake2b_256     Integer
256
        , DefaultFun -> Integer -> TestTree
test_HashSize DefaultFun
Keccak_256      Integer
256
        , DefaultFun -> Integer -> TestTree
test_HashSize DefaultFun
Blake2b_224     Integer
224
        , DefaultFun -> Integer -> TestTree
test_HashSize DefaultFun
Ripemd_160      Integer
160
        ]

-- Test all remaining builtins of the default universe
test_Other :: TestTree
test_Other :: TestTree
test_Other = String -> Assertion -> TestTree
testCase String
"Other" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ do
    let expr1 :: Term TyName Name DefaultUni DefaultFun ()
expr1 = Term TyName Name DefaultUni DefaultFun ()
-> [Term TyName Name DefaultUni DefaultFun ()]
-> Term TyName Name DefaultUni DefaultFun ()
forall (term :: * -> *) tyname name (uni :: * -> *) fun.
TermLike term tyname name uni fun =>
term () -> [term ()] -> term ()
mkIterAppNoAnn (()
-> Term TyName Name DefaultUni DefaultFun ()
-> Type TyName DefaultUni ()
-> Term TyName Name DefaultUni DefaultFun ()
forall ann.
ann
-> Term TyName Name DefaultUni DefaultFun ann
-> Type TyName DefaultUni ann
-> Term TyName Name DefaultUni DefaultFun ann
forall (term :: * -> *) tyname name (uni :: * -> *) fun ann.
TermLike term tyname name uni fun =>
ann -> term ann -> Type tyname uni ann -> term ann
tyInst () (() -> DefaultFun -> Term TyName Name DefaultUni DefaultFun ()
forall ann.
ann -> DefaultFun -> Term TyName Name DefaultUni DefaultFun ann
forall (term :: * -> *) tyname name (uni :: * -> *) fun ann.
TermLike term tyname name uni fun =>
ann -> fun -> term ann
builtin () DefaultFun
ChooseUnit) Type TyName DefaultUni ()
forall (uni :: * -> *) tyname.
HasTypeLevel uni Bool =>
Type tyname uni ()
bool) [Term TyName Name DefaultUni DefaultFun ()
forall (term :: * -> *) tyname name (uni :: * -> *) fun.
(TermLike term tyname name uni fun, HasTermLevel uni ()) =>
term ()
unitval, Term TyName Name DefaultUni DefaultFun ()
forall (term :: * -> *) tyname name (uni :: * -> *) fun.
(TermLike term tyname name uni fun, HasTermLevel uni Bool) =>
term ()
true]
    EvaluationResult (Term Name DefaultUni DefaultFun ())
-> Either
     (Error DefaultUni DefaultFun ())
     (EvaluationResult (Term Name DefaultUni DefaultFun ()))
forall a b. b -> Either a b
Right (Term Name DefaultUni DefaultFun ()
-> EvaluationResult (Term Name DefaultUni DefaultFun ())
forall a. a -> EvaluationResult a
EvaluationSuccess Term Name DefaultUni DefaultFun ()
forall (term :: * -> *) tyname name (uni :: * -> *) fun.
(TermLike term tyname name uni fun, HasTermLevel uni Bool) =>
term ()
true) Either
  (Error DefaultUni DefaultFun ())
  (EvaluationResult (Term Name DefaultUni DefaultFun ()))
-> Either
     (Error DefaultUni DefaultFun ())
     (EvaluationResult (Term Name DefaultUni DefaultFun ()))
-> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@=? BuiltinSemanticsVariant DefaultFun
-> CostingPart DefaultUni DefaultFun
-> Term TyName Name DefaultUni DefaultFun ()
-> Either
     (Error DefaultUni DefaultFun ())
     (EvaluationResult (Term Name DefaultUni DefaultFun ()))
forall (uni :: * -> *) fun (m :: * -> *).
(MonadError (Error uni fun ()) m, Typecheckable uni fun, GEq uni,
 Everywhere uni ExMemoryUsage, PrettyUni uni, Pretty fun) =>
BuiltinSemanticsVariant fun
-> CostingPart uni fun
-> Term TyName Name uni fun ()
-> m (EvaluationResult (Term Name uni fun ()))
typecheckEvaluateCekNoEmit BuiltinSemanticsVariant DefaultFun
forall a. Default a => a
def BuiltinCostModel
CostingPart DefaultUni DefaultFun
defaultBuiltinCostModelForTesting Term TyName Name DefaultUni DefaultFun ()
expr1

    let expr2 :: Term TyName Name DefaultUni DefaultFun ()
expr2 = Term TyName Name DefaultUni DefaultFun ()
-> [Term TyName Name DefaultUni DefaultFun ()]
-> Term TyName Name DefaultUni DefaultFun ()
forall (term :: * -> *) tyname name (uni :: * -> *) fun.
TermLike term tyname name uni fun =>
term () -> [term ()] -> term ()
mkIterAppNoAnn (()
-> Term TyName Name DefaultUni DefaultFun ()
-> Type TyName DefaultUni ()
-> Term TyName Name DefaultUni DefaultFun ()
forall ann.
ann
-> Term TyName Name DefaultUni DefaultFun ann
-> Type TyName DefaultUni ann
-> Term TyName Name DefaultUni DefaultFun ann
forall (term :: * -> *) tyname name (uni :: * -> *) fun ann.
TermLike term tyname name uni fun =>
ann -> term ann -> Type tyname uni ann -> term ann
tyInst () (() -> DefaultFun -> Term TyName Name DefaultUni DefaultFun ()
forall ann.
ann -> DefaultFun -> Term TyName Name DefaultUni DefaultFun ann
forall (term :: * -> *) tyname name (uni :: * -> *) fun ann.
TermLike term tyname name uni fun =>
ann -> fun -> term ann
builtin () DefaultFun
IfThenElse) Type TyName DefaultUni ()
forall (uni :: * -> *) tyname.
HasTypeLevel uni Integer =>
Type tyname uni ()
integer) [Term TyName Name DefaultUni DefaultFun ()
forall (term :: * -> *) tyname name (uni :: * -> *) fun.
(TermLike term tyname name uni fun, HasTermLevel uni Bool) =>
term ()
true, forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons @Integer Integer
1, forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons @Integer Integer
0]
    EvaluationResult (Term Name DefaultUni DefaultFun ())
-> Either
     (Error DefaultUni DefaultFun ())
     (EvaluationResult (Term Name DefaultUni DefaultFun ()))
forall a b. b -> Either a b
Right (Term Name DefaultUni DefaultFun ()
-> EvaluationResult (Term Name DefaultUni DefaultFun ())
forall a. a -> EvaluationResult a
EvaluationSuccess (Term Name DefaultUni DefaultFun ()
 -> EvaluationResult (Term Name DefaultUni DefaultFun ()))
-> Term Name DefaultUni DefaultFun ()
-> EvaluationResult (Term Name DefaultUni DefaultFun ())
forall a b. (a -> b) -> a -> b
$ forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons @Integer Integer
1) Either
  (Error DefaultUni DefaultFun ())
  (EvaluationResult (Term Name DefaultUni DefaultFun ()))
-> Either
     (Error DefaultUni DefaultFun ())
     (EvaluationResult (Term Name DefaultUni DefaultFun ()))
-> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@=? BuiltinSemanticsVariant DefaultFun
-> CostingPart DefaultUni DefaultFun
-> Term TyName Name DefaultUni DefaultFun ()
-> Either
     (Error DefaultUni DefaultFun ())
     (EvaluationResult (Term Name DefaultUni DefaultFun ()))
forall (uni :: * -> *) fun (m :: * -> *).
(MonadError (Error uni fun ()) m, Typecheckable uni fun, GEq uni,
 Everywhere uni ExMemoryUsage, PrettyUni uni, Pretty fun) =>
BuiltinSemanticsVariant fun
-> CostingPart uni fun
-> Term TyName Name uni fun ()
-> m (EvaluationResult (Term Name uni fun ()))
typecheckEvaluateCekNoEmit BuiltinSemanticsVariant DefaultFun
forall a. Default a => a
def BuiltinCostModel
CostingPart DefaultUni DefaultFun
defaultBuiltinCostModelForTesting Term TyName Name DefaultUni DefaultFun ()
expr2

    let expr3 :: Term TyName Name DefaultUni DefaultFun ()
expr3 = Term TyName Name DefaultUni DefaultFun ()
-> [Term TyName Name DefaultUni DefaultFun ()]
-> Term TyName Name DefaultUni DefaultFun ()
forall (term :: * -> *) tyname name (uni :: * -> *) fun.
TermLike term tyname name uni fun =>
term () -> [term ()] -> term ()
mkIterAppNoAnn (()
-> Term TyName Name DefaultUni DefaultFun ()
-> Type TyName DefaultUni ()
-> Term TyName Name DefaultUni DefaultFun ()
forall ann.
ann
-> Term TyName Name DefaultUni DefaultFun ann
-> Type TyName DefaultUni ann
-> Term TyName Name DefaultUni DefaultFun ann
forall (term :: * -> *) tyname name (uni :: * -> *) fun ann.
TermLike term tyname name uni fun =>
ann -> term ann -> Type tyname uni ann -> term ann
tyInst () (() -> DefaultFun -> Term TyName Name DefaultUni DefaultFun ()
forall ann.
ann -> DefaultFun -> Term TyName Name DefaultUni DefaultFun ann
forall (term :: * -> *) tyname name (uni :: * -> *) fun ann.
TermLike term tyname name uni fun =>
ann -> fun -> term ann
builtin () DefaultFun
Trace) Type TyName DefaultUni ()
forall (uni :: * -> *) tyname.
HasTypeLevel uni Integer =>
Type tyname uni ()
integer) [forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons @Text Text
"hello world", forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons @Integer Integer
1]
    EvaluationResult (Term Name DefaultUni DefaultFun ())
-> Either
     (Error DefaultUni DefaultFun ())
     (EvaluationResult (Term Name DefaultUni DefaultFun ()))
forall a b. b -> Either a b
Right (Term Name DefaultUni DefaultFun ()
-> EvaluationResult (Term Name DefaultUni DefaultFun ())
forall a. a -> EvaluationResult a
EvaluationSuccess (Term Name DefaultUni DefaultFun ()
 -> EvaluationResult (Term Name DefaultUni DefaultFun ()))
-> Term Name DefaultUni DefaultFun ()
-> EvaluationResult (Term Name DefaultUni DefaultFun ())
forall a b. (a -> b) -> a -> b
$ forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons @Integer Integer
1) Either
  (Error DefaultUni DefaultFun ())
  (EvaluationResult (Term Name DefaultUni DefaultFun ()))
-> Either
     (Error DefaultUni DefaultFun ())
     (EvaluationResult (Term Name DefaultUni DefaultFun ()))
-> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@=? BuiltinSemanticsVariant DefaultFun
-> CostingPart DefaultUni DefaultFun
-> Term TyName Name DefaultUni DefaultFun ()
-> Either
     (Error DefaultUni DefaultFun ())
     (EvaluationResult (Term Name DefaultUni DefaultFun ()))
forall (uni :: * -> *) fun (m :: * -> *).
(MonadError (Error uni fun ()) m, Typecheckable uni fun, GEq uni,
 Everywhere uni ExMemoryUsage, PrettyUni uni, Pretty fun) =>
BuiltinSemanticsVariant fun
-> CostingPart uni fun
-> Term TyName Name uni fun ()
-> m (EvaluationResult (Term Name uni fun ()))
typecheckEvaluateCekNoEmit BuiltinSemanticsVariant DefaultFun
forall a. Default a => a
def BuiltinCostModel
CostingPart DefaultUni DefaultFun
defaultBuiltinCostModelForTesting Term TyName Name DefaultUni DefaultFun ()
expr3

-- | Check that 'ExtensionVersion' evaluates correctly.
-- See Note [Builtin semantics variants]
test_Version :: TestTree
test_Version :: TestTree
test_Version =
    String -> Assertion -> TestTree
testCase String
"Version" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ do
        let expr1 :: Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
expr1 = ()
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
forall ann.
ann
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ann
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ann
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ann
forall (term :: * -> *) tyname name (uni :: * -> *) fun ann.
TermLike term tyname name uni fun =>
ann -> term ann -> term ann -> term ann
apply () (()
-> Either DefaultFun ExtensionFun
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
forall ann.
ann
-> Either DefaultFun ExtensionFun
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ann
forall (term :: * -> *) tyname name (uni :: * -> *) fun ann.
TermLike term tyname name uni fun =>
ann -> fun -> term ann
builtin () (Either DefaultFun ExtensionFun
 -> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ())
-> Either DefaultFun ExtensionFun
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
forall a b. (a -> b) -> a -> b
$ ExtensionFun -> Either DefaultFun ExtensionFun
forall a b. b -> Either a b
Right ExtensionFun
ExtensionVersion) Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
forall (term :: * -> *) tyname name (uni :: * -> *) fun.
(TermLike term tyname name uni fun, HasTermLevel uni ()) =>
term ()
unitval
        EvaluationResult
  (Term Name DefaultUni (Either DefaultFun ExtensionFun) ())
-> Either
     (Error DefaultUni (Either DefaultFun ExtensionFun) ())
     (EvaluationResult
        (Term Name DefaultUni (Either DefaultFun ExtensionFun) ()))
forall a b. b -> Either a b
Right (Term Name DefaultUni (Either DefaultFun ExtensionFun) ()
-> EvaluationResult
     (Term Name DefaultUni (Either DefaultFun ExtensionFun) ())
forall a. a -> EvaluationResult a
EvaluationSuccess (Term Name DefaultUni (Either DefaultFun ExtensionFun) ()
 -> EvaluationResult
      (Term Name DefaultUni (Either DefaultFun ExtensionFun) ()))
-> Term Name DefaultUni (Either DefaultFun ExtensionFun) ()
-> EvaluationResult
     (Term Name DefaultUni (Either DefaultFun ExtensionFun) ())
forall a b. (a -> b) -> a -> b
$ forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons @Integer Integer
0) Either
  (Error DefaultUni (Either DefaultFun ExtensionFun) ())
  (EvaluationResult
     (Term Name DefaultUni (Either DefaultFun ExtensionFun) ()))
-> Either
     (Error DefaultUni (Either DefaultFun ExtensionFun) ())
     (EvaluationResult
        (Term Name DefaultUni (Either DefaultFun ExtensionFun) ()))
-> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@=?
            BuiltinSemanticsVariant (Either DefaultFun ExtensionFun)
-> CostingPart DefaultUni (Either DefaultFun ExtensionFun)
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
-> Either
     (Error DefaultUni (Either DefaultFun ExtensionFun) ())
     (EvaluationResult
        (Term Name DefaultUni (Either DefaultFun ExtensionFun) ()))
forall (uni :: * -> *) fun (m :: * -> *).
(MonadError (Error uni fun ()) m, Typecheckable uni fun, GEq uni,
 Everywhere uni ExMemoryUsage, PrettyUni uni, Pretty fun) =>
BuiltinSemanticsVariant fun
-> CostingPart uni fun
-> Term TyName Name uni fun ()
-> m (EvaluationResult (Term Name uni fun ()))
typecheckEvaluateCekNoEmit
                (forall fun1 fun2.
BuiltinSemanticsVariant fun1
-> BuiltinSemanticsVariant fun2
-> BuiltinSemanticsVariant (Either fun1 fun2)
PairV @DefaultFun BuiltinSemanticsVariant DefaultFun
forall a. Default a => a
def BuiltinSemanticsVariant ExtensionFun
ExtensionFunSemanticsVariant0)
                CostingPart DefaultUni (Either DefaultFun ExtensionFun)
defaultBuiltinCostModelExt
                Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
expr1
        EvaluationResult
  (Term Name DefaultUni (Either DefaultFun ExtensionFun) ())
-> Either
     (Error DefaultUni (Either DefaultFun ExtensionFun) ())
     (EvaluationResult
        (Term Name DefaultUni (Either DefaultFun ExtensionFun) ()))
forall a b. b -> Either a b
Right (Term Name DefaultUni (Either DefaultFun ExtensionFun) ()
-> EvaluationResult
     (Term Name DefaultUni (Either DefaultFun ExtensionFun) ())
forall a. a -> EvaluationResult a
EvaluationSuccess (Term Name DefaultUni (Either DefaultFun ExtensionFun) ()
 -> EvaluationResult
      (Term Name DefaultUni (Either DefaultFun ExtensionFun) ()))
-> Term Name DefaultUni (Either DefaultFun ExtensionFun) ()
-> EvaluationResult
     (Term Name DefaultUni (Either DefaultFun ExtensionFun) ())
forall a b. (a -> b) -> a -> b
$ forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons @Integer (Integer
 -> Term Name DefaultUni (Either DefaultFun ExtensionFun) ())
-> Integer
-> Term Name DefaultUni (Either DefaultFun ExtensionFun) ()
forall a b. (a -> b) -> a -> b
$ Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Integer) -> Int -> Integer
forall a b. (a -> b) -> a -> b
$
                BuiltinSemanticsVariant ExtensionFun -> Int
forall a. Enum a => a -> Int
fromEnum (BuiltinSemanticsVariant ExtensionFun
forall a. Bounded a => a
maxBound :: BuiltinSemanticsVariant ExtensionFun)) Either
  (Error DefaultUni (Either DefaultFun ExtensionFun) ())
  (EvaluationResult
     (Term Name DefaultUni (Either DefaultFun ExtensionFun) ()))
-> Either
     (Error DefaultUni (Either DefaultFun ExtensionFun) ())
     (EvaluationResult
        (Term Name DefaultUni (Either DefaultFun ExtensionFun) ()))
-> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@=?
            BuiltinSemanticsVariant (Either DefaultFun ExtensionFun)
-> CostingPart DefaultUni (Either DefaultFun ExtensionFun)
-> Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
-> Either
     (Error DefaultUni (Either DefaultFun ExtensionFun) ())
     (EvaluationResult
        (Term Name DefaultUni (Either DefaultFun ExtensionFun) ()))
forall (uni :: * -> *) fun (m :: * -> *).
(MonadError (Error uni fun ()) m, Typecheckable uni fun, GEq uni,
 Everywhere uni ExMemoryUsage, PrettyUni uni, Pretty fun) =>
BuiltinSemanticsVariant fun
-> CostingPart uni fun
-> Term TyName Name uni fun ()
-> m (EvaluationResult (Term Name uni fun ()))
typecheckEvaluateCekNoEmit
                (forall fun1 fun2.
BuiltinSemanticsVariant fun1
-> BuiltinSemanticsVariant fun2
-> BuiltinSemanticsVariant (Either fun1 fun2)
PairV @DefaultFun BuiltinSemanticsVariant DefaultFun
forall a. Default a => a
def BuiltinSemanticsVariant ExtensionFun
forall a. Default a => a
def)
                CostingPart DefaultUni (Either DefaultFun ExtensionFun)
defaultBuiltinCostModelExt
                Term TyName Name DefaultUni (Either DefaultFun ExtensionFun) ()
expr1

-- | Check that 'ConsByteString' wraps around for plutus' builtin-version == 1, and fails in plutus's builtin-versions >=2.
-- See Note [Builtin semantics variants]
test_ConsByteString :: TestTree
test_ConsByteString :: TestTree
test_ConsByteString =
    String -> Assertion -> TestTree
testCase String
"ConsVersion" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ do
        let asciiBangWrapped :: Integer
asciiBangWrapped = forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word8 @Integer Word8
forall a. Bounded a => a
maxBound
                             Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1 -- to make word8 wraparound
                             Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
33 -- the index of '!' in ascii table
            expr1 :: Term TyName Name DefaultUni DefaultFun ()
expr1 = Term TyName Name DefaultUni DefaultFun ()
-> [Term TyName Name DefaultUni DefaultFun ()]
-> Term TyName Name DefaultUni DefaultFun ()
forall (term :: * -> *) tyname name (uni :: * -> *) fun.
TermLike term tyname name uni fun =>
term () -> [term ()] -> term ()
mkIterAppNoAnn (() -> DefaultFun -> Term TyName Name DefaultUni DefaultFun ()
forall ann.
ann -> DefaultFun -> Term TyName Name DefaultUni DefaultFun ann
forall (term :: * -> *) tyname name (uni :: * -> *) fun ann.
TermLike term tyname name uni fun =>
ann -> fun -> term ann
builtin () DefaultFun
ConsByteString)
                    [forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons @Integer Integer
asciiBangWrapped, forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons @ByteString ByteString
"hello world"]
        [BuiltinSemanticsVariant DefaultFun]
-> (BuiltinSemanticsVariant DefaultFun -> Assertion) -> Assertion
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [BuiltinSemanticsVariant DefaultFun]
forall a. (Enum a, Bounded a) => [a]
enumerate ((BuiltinSemanticsVariant DefaultFun -> Assertion) -> Assertion)
-> (BuiltinSemanticsVariant DefaultFun -> Assertion) -> Assertion
forall a b. (a -> b) -> a -> b
$ \case
            semVar :: BuiltinSemanticsVariant DefaultFun
semVar@BuiltinSemanticsVariant DefaultFun
R:BuiltinSemanticsVariantDefaultFun
DefaultFunSemanticsVariantA ->
                EvaluationResult (Term Name DefaultUni DefaultFun ())
-> Either
     (Error DefaultUni DefaultFun ())
     (EvaluationResult (Term Name DefaultUni DefaultFun ()))
forall a b. b -> Either a b
Right (Term Name DefaultUni DefaultFun ()
-> EvaluationResult (Term Name DefaultUni DefaultFun ())
forall a. a -> EvaluationResult a
EvaluationSuccess (Term Name DefaultUni DefaultFun ()
 -> EvaluationResult (Term Name DefaultUni DefaultFun ()))
-> Term Name DefaultUni DefaultFun ()
-> EvaluationResult (Term Name DefaultUni DefaultFun ())
forall a b. (a -> b) -> a -> b
$ forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons @ByteString ByteString
"!hello world") Either
  (Error DefaultUni DefaultFun ())
  (EvaluationResult (Term Name DefaultUni DefaultFun ()))
-> Either
     (Error DefaultUni DefaultFun ())
     (EvaluationResult (Term Name DefaultUni DefaultFun ()))
-> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@=?
                    BuiltinSemanticsVariant DefaultFun
-> CostingPart DefaultUni DefaultFun
-> Term TyName Name DefaultUni DefaultFun ()
-> Either
     (Error DefaultUni DefaultFun ())
     (EvaluationResult (Term Name DefaultUni DefaultFun ()))
forall (uni :: * -> *) fun (m :: * -> *).
(MonadError (Error uni fun ()) m, Typecheckable uni fun, GEq uni,
 Everywhere uni ExMemoryUsage, PrettyUni uni, Pretty fun) =>
BuiltinSemanticsVariant fun
-> CostingPart uni fun
-> Term TyName Name uni fun ()
-> m (EvaluationResult (Term Name uni fun ()))
typecheckEvaluateCekNoEmit BuiltinSemanticsVariant DefaultFun
semVar BuiltinCostModel
CostingPart DefaultUni DefaultFun
defaultBuiltinCostModelForTesting Term TyName Name DefaultUni DefaultFun ()
expr1
            semVar :: BuiltinSemanticsVariant DefaultFun
semVar@BuiltinSemanticsVariant DefaultFun
R:BuiltinSemanticsVariantDefaultFun
DefaultFunSemanticsVariantB ->
                EvaluationResult (Term Name DefaultUni DefaultFun ())
-> Either
     (Error DefaultUni DefaultFun ())
     (EvaluationResult (Term Name DefaultUni DefaultFun ()))
forall a b. b -> Either a b
Right (Term Name DefaultUni DefaultFun ()
-> EvaluationResult (Term Name DefaultUni DefaultFun ())
forall a. a -> EvaluationResult a
EvaluationSuccess (Term Name DefaultUni DefaultFun ()
 -> EvaluationResult (Term Name DefaultUni DefaultFun ()))
-> Term Name DefaultUni DefaultFun ()
-> EvaluationResult (Term Name DefaultUni DefaultFun ())
forall a b. (a -> b) -> a -> b
$ forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons @ByteString ByteString
"!hello world") Either
  (Error DefaultUni DefaultFun ())
  (EvaluationResult (Term Name DefaultUni DefaultFun ()))
-> Either
     (Error DefaultUni DefaultFun ())
     (EvaluationResult (Term Name DefaultUni DefaultFun ()))
-> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@=?
                      BuiltinSemanticsVariant DefaultFun
-> CostingPart DefaultUni DefaultFun
-> Term TyName Name DefaultUni DefaultFun ()
-> Either
     (Error DefaultUni DefaultFun ())
     (EvaluationResult (Term Name DefaultUni DefaultFun ()))
forall (uni :: * -> *) fun (m :: * -> *).
(MonadError (Error uni fun ()) m, Typecheckable uni fun, GEq uni,
 Everywhere uni ExMemoryUsage, PrettyUni uni, Pretty fun) =>
BuiltinSemanticsVariant fun
-> CostingPart uni fun
-> Term TyName Name uni fun ()
-> m (EvaluationResult (Term Name uni fun ()))
typecheckEvaluateCekNoEmit BuiltinSemanticsVariant DefaultFun
semVar BuiltinCostModel
CostingPart DefaultUni DefaultFun
defaultBuiltinCostModelForTesting Term TyName Name DefaultUni DefaultFun ()
expr1
            semVar :: BuiltinSemanticsVariant DefaultFun
semVar@BuiltinSemanticsVariant DefaultFun
R:BuiltinSemanticsVariantDefaultFun
DefaultFunSemanticsVariantC ->
                EvaluationResult (Term Name DefaultUni DefaultFun ())
-> Either
     (Error DefaultUni DefaultFun ())
     (EvaluationResult (Term Name DefaultUni DefaultFun ()))
forall a b. b -> Either a b
Right EvaluationResult (Term Name DefaultUni DefaultFun ())
forall a. EvaluationResult a
EvaluationFailure Either
  (Error DefaultUni DefaultFun ())
  (EvaluationResult (Term Name DefaultUni DefaultFun ()))
-> Either
     (Error DefaultUni DefaultFun ())
     (EvaluationResult (Term Name DefaultUni DefaultFun ()))
-> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@=?
                    BuiltinSemanticsVariant DefaultFun
-> CostingPart DefaultUni DefaultFun
-> Term TyName Name DefaultUni DefaultFun ()
-> Either
     (Error DefaultUni DefaultFun ())
     (EvaluationResult (Term Name DefaultUni DefaultFun ()))
forall (uni :: * -> *) fun (m :: * -> *).
(MonadError (Error uni fun ()) m, Typecheckable uni fun, GEq uni,
 Everywhere uni ExMemoryUsage, PrettyUni uni, Pretty fun) =>
BuiltinSemanticsVariant fun
-> CostingPart uni fun
-> Term TyName Name uni fun ()
-> m (EvaluationResult (Term Name uni fun ()))
typecheckEvaluateCekNoEmit BuiltinSemanticsVariant DefaultFun
semVar BuiltinCostModel
CostingPart DefaultUni DefaultFun
defaultBuiltinCostModelForTesting Term TyName Name DefaultUni DefaultFun ()
expr1

-- shorthand
cons :: (DefaultUni `HasTermLevel` a, TermLike term tyname name DefaultUni fun) => a -> term ()
cons :: forall a (term :: * -> *) tyname name fun.
(HasTermLevel DefaultUni a,
 TermLike term tyname name DefaultUni fun) =>
a -> term ()
cons = () -> a -> term ()
forall a (uni :: * -> *) fun (term :: * -> *) tyname name ann.
(TermLike term tyname name uni fun, HasTermLevel uni a) =>
ann -> a -> term ann
mkConstant ()

-- Test that the SECP256k1 builtins are behaving correctly
test_SignatureVerification :: TestTree
test_SignatureVerification :: TestTree
test_SignatureVerification =
  String -> [TestTree] -> TestTree
testGroup String
"Signature verification"
      [ String -> [TestTree] -> TestTree
testGroup String
"Ed25519 signatures (VariantA)"
          [ String -> PropertyName -> Property -> TestTree
testPropertyNamed
              String
"Ed25519_VariantA verification behaves correctly on all inputs"
              PropertyName
"ed25519_VariantA_correct"
                (Property -> TestTree)
-> (Property -> Property) -> Property -> TestTree
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TestLimit -> (TestLimit -> TestLimit) -> Property -> Property
mapTestLimitAtLeast TestLimit
99 (TestLimit -> TestLimit -> TestLimit
forall a. Integral a => a -> a -> a
`div` TestLimit
10) (Property -> TestTree) -> Property -> TestTree
forall a b. (a -> b) -> a -> b
$ HasCallStack => PropertyT IO () -> Property
PropertyT IO () -> Property
property PropertyT IO ()
ed25519_VariantAProp
          ]
      , String -> [TestTree] -> TestTree
testGroup String
"Ed25519 signatures (VariantB)"
          [ String -> PropertyName -> Property -> TestTree
testPropertyNamed
              String
"Ed25519_VariantB verification behaves correctly on all inputs"
              PropertyName
"ed25519_VariantB_correct"
                (Property -> TestTree)
-> (Property -> Property) -> Property -> TestTree
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TestLimit -> (TestLimit -> TestLimit) -> Property -> Property
mapTestLimitAtLeast TestLimit
99 (TestLimit -> TestLimit -> TestLimit
forall a. Integral a => a -> a -> a
`div` TestLimit
10) (Property -> TestTree) -> Property -> TestTree
forall a b. (a -> b) -> a -> b
$ HasCallStack => PropertyT IO () -> Property
PropertyT IO () -> Property
property PropertyT IO ()
ed25519_VariantBProp
          ]
      , String -> [TestTree] -> TestTree
testGroup String
"Ed25519 signatures (VariantC)"
          [ String -> PropertyName -> Property -> TestTree
testPropertyNamed
              String
"Ed25519_VariantC verification behaves correctly on all inputs"
              PropertyName
"ed25519_VariantC_correct"
                (Property -> TestTree)
-> (Property -> Property) -> Property -> TestTree
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TestLimit -> (TestLimit -> TestLimit) -> Property -> Property
mapTestLimitAtLeast TestLimit
99 (TestLimit -> TestLimit -> TestLimit
forall a. Integral a => a -> a -> a
`div` TestLimit
10) (Property -> TestTree) -> Property -> TestTree
forall a b. (a -> b) -> a -> b
$ HasCallStack => PropertyT IO () -> Property
PropertyT IO () -> Property
property PropertyT IO ()
ed25519_VariantCProp
          ]
      , String -> [TestTree] -> TestTree
testGroup String
"Signatures on the SECP256k1 curve"
          [ String -> PropertyName -> Property -> TestTree
testPropertyNamed
              String
"ECDSA verification behaves correctly on all inputs"
              PropertyName
"ecdsa_correct"
                (Property -> TestTree)
-> (Property -> Property) -> Property -> TestTree
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TestLimit -> (TestLimit -> TestLimit) -> Property -> Property
mapTestLimitAtLeast TestLimit
99 (TestLimit -> TestLimit -> TestLimit
forall a. Integral a => a -> a -> a
`div` TestLimit
10) (Property -> TestTree) -> Property -> TestTree
forall a b. (a -> b) -> a -> b
$ HasCallStack => PropertyT IO () -> Property
PropertyT IO () -> Property
property PropertyT IO ()
ecdsaSecp256k1Prop
          , String -> PropertyName -> Property -> TestTree
testPropertyNamed
              String
"Schnorr verification behaves correctly on all inputs"
              PropertyName
"schnorr_correct"
                (Property -> TestTree)
-> (Property -> Property) -> Property -> TestTree
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TestLimit -> (TestLimit -> TestLimit) -> Property -> Property
mapTestLimitAtLeast TestLimit
99 (TestLimit -> TestLimit -> TestLimit
forall a. Integral a => a -> a -> a
`div` TestLimit
10) (Property -> TestTree) -> Property -> TestTree
forall a b. (a -> b) -> a -> b
$ HasCallStack => PropertyT IO () -> Property
PropertyT IO () -> Property
property PropertyT IO ()
schnorrSecp256k1Prop
          ]
       ]

-- Test that the Integer <-> ByteString conversion builtins are behaving correctly
test_Conversion :: TestTree
test_Conversion :: TestTree
test_Conversion =
    String -> [TestTree] -> TestTree
testGroup String
"Integer <-> ByteString conversions"
        [ String -> [TestTree] -> TestTree
testGroup String
"Integer -> ByteString"
            [ --- lengthOfByteString (integerToByteString e d 0) = d
              String -> PropertyName -> Property -> TestTree
testPropertyNamed String
"property 1" PropertyName
"i2b_prop1"
                (Property -> TestTree)
-> (Property -> Property) -> Property -> TestTree
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TestLimit -> (TestLimit -> TestLimit) -> Property -> Property
mapTestLimitAtLeast TestLimit
99 (TestLimit -> TestLimit -> TestLimit
forall a. Integral a => a -> a -> a
`div` TestLimit
10) (Property -> TestTree) -> Property -> TestTree
forall a b. (a -> b) -> a -> b
$ HasCallStack => PropertyT IO () -> Property
PropertyT IO () -> Property
property PropertyT IO ()
Conversion.i2bProperty1
            , -- indexByteString (integerToByteString e k 0) j = 0
              String -> PropertyName -> Property -> TestTree
testPropertyNamed String
"property 2" PropertyName
"i2b_prop2"
                (Property -> TestTree)
-> (Property -> Property) -> Property -> TestTree
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TestLimit -> (TestLimit -> TestLimit) -> Property -> Property
mapTestLimitAtLeast TestLimit
99 (TestLimit -> TestLimit -> TestLimit
forall a. Integral a => a -> a -> a
`div` TestLimit
10) (Property -> TestTree) -> Property -> TestTree
forall a b. (a -> b) -> a -> b
$ HasCallStack => PropertyT IO () -> Property
PropertyT IO () -> Property
property PropertyT IO ()
Conversion.i2bProperty2
            , -- lengthOfByteString (integerToByteString e 0 p) > 0
              String -> PropertyName -> Property -> TestTree
testPropertyNamed String
"property 3" PropertyName
"i2b_prop3"
                (Property -> TestTree)
-> (Property -> Property) -> Property -> TestTree
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TestLimit -> (TestLimit -> TestLimit) -> Property -> Property
mapTestLimitAtLeast TestLimit
99 (TestLimit -> TestLimit -> TestLimit
forall a. Integral a => a -> a -> a
`div` TestLimit
10) (Property -> TestTree) -> Property -> TestTree
forall a b. (a -> b) -> a -> b
$ HasCallStack => PropertyT IO () -> Property
PropertyT IO () -> Property
property PropertyT IO ()
Conversion.i2bProperty3
            , -- integerToByteString False 0 (multiplyInteger p 256) = consByteString
              -- 0 (integerToByteString False 0 p)
              String -> PropertyName -> Property -> TestTree
testPropertyNamed String
"property 4" PropertyName
"i2b_prop4"
                (Property -> TestTree)
-> (Property -> Property) -> Property -> TestTree
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TestLimit -> (TestLimit -> TestLimit) -> Property -> Property
mapTestLimitAtLeast TestLimit
50 (TestLimit -> TestLimit -> TestLimit
forall a. Integral a => a -> a -> a
`div` TestLimit
20) (Property -> TestTree) -> Property -> TestTree
forall a b. (a -> b) -> a -> b
$ HasCallStack => PropertyT IO () -> Property
PropertyT IO () -> Property
property PropertyT IO ()
Conversion.i2bProperty4
            , -- integerToByteString True 0 (multiplyInteger p 256) = appendByteString
              -- (integerToByteString True 0 p) (singleton 0)
              String -> PropertyName -> Property -> TestTree
testPropertyNamed String
"property 5" PropertyName
"i2b_prop5"
              (Property -> TestTree)
-> (Property -> Property) -> Property -> TestTree
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TestLimit -> (TestLimit -> TestLimit) -> Property -> Property
mapTestLimitAtLeast TestLimit
50 (TestLimit -> TestLimit -> TestLimit
forall a. Integral a => a -> a -> a
`div` TestLimit
20) (Property -> TestTree) -> Property -> TestTree
forall a b. (a -> b) -> a -> b
$ HasCallStack => PropertyT IO () -> Property
PropertyT IO () -> Property
property PropertyT IO ()
Conversion.i2bProperty5
            , -- integerToByteString False 0 (plusInteger (multiplyInteger q 256) r) =
              -- appendByteString (integerToByteString False 0 r) (integerToByteString False 0 q)
              String -> PropertyName -> Property -> TestTree
testPropertyNamed String
"property 6" PropertyName
"i2b_prop6"
                (Property -> TestTree)
-> (Property -> Property) -> Property -> TestTree
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TestLimit -> (TestLimit -> TestLimit) -> Property -> Property
mapTestLimitAtLeast TestLimit
50 (TestLimit -> TestLimit -> TestLimit
forall a. Integral a => a -> a -> a
`div` TestLimit
20) (Property -> TestTree) -> Property -> TestTree
forall a b. (a -> b) -> a -> b
$ HasCallStack => PropertyT IO () -> Property
PropertyT IO () -> Property
property PropertyT IO ()
Conversion.i2bProperty6
            , -- integerToByteString True 0 (plusInteger (multiplyInteger q 256) r) =
              -- appendByteString (integerToByteString False 0 q)
              -- (integerToByteString False 0 r)
              String -> PropertyName -> Property -> TestTree
testPropertyNamed String
"property 7" PropertyName
"i2b_prop7"
                (Property -> TestTree)
-> (Property -> Property) -> Property -> TestTree
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TestLimit -> (TestLimit -> TestLimit) -> Property -> Property
mapTestLimitAtLeast TestLimit
50 (TestLimit -> TestLimit -> TestLimit
forall a. Integral a => a -> a -> a
`div` TestLimit
20) (Property -> TestTree) -> Property -> TestTree
forall a b. (a -> b) -> a -> b
$ HasCallStack => PropertyT IO () -> Property
PropertyT IO () -> Property
property PropertyT IO ()
Conversion.i2bProperty7
            , String -> [TestTree] -> TestTree
testGroup String
"CIP-121 examples" [TestTree]
Conversion.i2bCipExamples
            , String -> [TestTree] -> TestTree
testGroup String
"Tests for integerToByteString size limit" [TestTree]
Conversion.i2bLimitTests
            ]
        , String -> [TestTree] -> TestTree
testGroup String
"ByteString -> Integer"
            [ -- byteStringToInteger b (integerToByteString b d q) = q
              String -> PropertyName -> Property -> TestTree
testPropertyNamed String
"property 1" PropertyName
"b2i_prop1"
                (Property -> TestTree)
-> (Property -> Property) -> Property -> TestTree
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TestLimit -> (TestLimit -> TestLimit) -> Property -> Property
mapTestLimitAtLeast TestLimit
99 (TestLimit -> TestLimit -> TestLimit
forall a. Integral a => a -> a -> a
`div` TestLimit
10) (Property -> TestTree) -> Property -> TestTree
forall a b. (a -> b) -> a -> b
$ HasCallStack => PropertyT IO () -> Property
PropertyT IO () -> Property
property PropertyT IO ()
Conversion.b2iProperty1
            , -- byteStringToInteger b (consByteString w8 emptyByteString) = w8
              String -> PropertyName -> Property -> TestTree
testPropertyNamed String
"property 2" PropertyName
"b2i_prop2"
                (Property -> TestTree)
-> (Property -> Property) -> Property -> TestTree
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TestLimit -> (TestLimit -> TestLimit) -> Property -> Property
mapTestLimitAtLeast TestLimit
99 (TestLimit -> TestLimit -> TestLimit
forall a. Integral a => a -> a -> a
`div` TestLimit
10) (Property -> TestTree) -> Property -> TestTree
forall a b. (a -> b) -> a -> b
$ HasCallStack => PropertyT IO () -> Property
PropertyT IO () -> Property
property PropertyT IO ()
Conversion.b2iProperty2
            , -- integerToByteString b (lengthOfByteString bs) (byteStringToInteger b bs) = bs
              String -> PropertyName -> Property -> TestTree
testPropertyNamed String
"property 3" PropertyName
"b2i_prop3"
                (Property -> TestTree)
-> (Property -> Property) -> Property -> TestTree
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TestLimit -> (TestLimit -> TestLimit) -> Property -> Property
mapTestLimitAtLeast TestLimit
99 (TestLimit -> TestLimit -> TestLimit
forall a. Integral a => a -> a -> a
`div` TestLimit
10) (Property -> TestTree) -> Property -> TestTree
forall a b. (a -> b) -> a -> b
$ HasCallStack => PropertyT IO () -> Property
PropertyT IO () -> Property
property PropertyT IO ()
Conversion.b2iProperty3
            , String -> [TestTree] -> TestTree
testGroup String
"CIP-121 examples" [TestTree]
Conversion.b2iCipExamples
            ]
        ]

-- Tests for the bitwise logical operations, as per [CIP-122](https://cips.cardano.org/cip/CIP-0122).
test_Bitwise_CIP0122 :: TestTree
test_Bitwise_CIP0122 :: TestTree
test_Bitwise_CIP0122 =
  String -> [TestTree] -> TestTree
testGroup String
"Bitwise operations (CIP0122)"
    [ String -> [TestTree] -> TestTree
testGroup String
"andByteString"
        [ String -> DefaultFun -> Bool -> TestTree
CIP0122.abelianSemigroupLaws String
"truncation" DefaultFun
PLC.AndByteString Bool
False
        , String -> DefaultFun -> Bool -> TestTree
CIP0122.idempotenceLaw String
"truncation" DefaultFun
PLC.AndByteString Bool
False
        , String -> DefaultFun -> Bool -> ByteString -> TestTree
CIP0122.absorbtionLaw String
"truncation" DefaultFun
PLC.AndByteString Bool
False ByteString
""
        , String -> String -> DefaultFun -> DefaultFun -> Bool -> TestTree
CIP0122.leftDistributiveLaw String
"truncation" String
"itself" DefaultFun
PLC.AndByteString DefaultFun
PLC.AndByteString Bool
False
        , String -> String -> DefaultFun -> DefaultFun -> Bool -> TestTree
CIP0122.leftDistributiveLaw String
"truncation" String
"OR" DefaultFun
PLC.AndByteString DefaultFun
PLC.OrByteString Bool
False
        , String -> String -> DefaultFun -> DefaultFun -> Bool -> TestTree
CIP0122.leftDistributiveLaw String
"truncation" String
"XOR" DefaultFun
PLC.AndByteString DefaultFun
PLC.XorByteString Bool
False
        , String -> DefaultFun -> Bool -> ByteString -> TestTree
CIP0122.abelianMonoidLaws String
"padding" DefaultFun
PLC.AndByteString Bool
True ByteString
""
        , String -> DefaultFun -> Bool -> TestTree
CIP0122.distributiveLaws String
"padding" DefaultFun
PLC.AndByteString Bool
True
        ]
    , String -> [TestTree] -> TestTree
testGroup String
"orByteString"
        [ String -> DefaultFun -> Bool -> TestTree
CIP0122.abelianSemigroupLaws String
"truncation" DefaultFun
PLC.OrByteString Bool
False
        , String -> DefaultFun -> Bool -> TestTree
CIP0122.idempotenceLaw String
"truncation" DefaultFun
PLC.OrByteString Bool
False
        , String -> DefaultFun -> Bool -> ByteString -> TestTree
CIP0122.absorbtionLaw String
"truncation" DefaultFun
PLC.OrByteString Bool
False ByteString
""
        , String -> String -> DefaultFun -> DefaultFun -> Bool -> TestTree
CIP0122.leftDistributiveLaw String
"truncation" String
"itself" DefaultFun
PLC.OrByteString DefaultFun
PLC.OrByteString Bool
False
        , String -> String -> DefaultFun -> DefaultFun -> Bool -> TestTree
CIP0122.leftDistributiveLaw String
"truncation" String
"AND" DefaultFun
PLC.OrByteString DefaultFun
PLC.AndByteString Bool
False
        , String -> DefaultFun -> Bool -> ByteString -> TestTree
CIP0122.abelianMonoidLaws String
"padding" DefaultFun
PLC.OrByteString Bool
True ByteString
""
        , String -> DefaultFun -> Bool -> TestTree
CIP0122.distributiveLaws String
"padding" DefaultFun
PLC.OrByteString Bool
True
        ]
    , String -> [TestTree] -> TestTree
testGroup String
"xorByteString"
        [ String -> DefaultFun -> Bool -> TestTree
CIP0122.abelianSemigroupLaws String
"truncation" DefaultFun
PLC.XorByteString Bool
False
        , String -> DefaultFun -> Bool -> ByteString -> TestTree
CIP0122.absorbtionLaw String
"truncation" DefaultFun
PLC.XorByteString Bool
False ByteString
""
        , TestTree
CIP0122.xorInvoluteLaw
        , String -> DefaultFun -> Bool -> ByteString -> TestTree
CIP0122.abelianMonoidLaws String
"padding" DefaultFun
PLC.XorByteString Bool
True ByteString
""
        ]
    , String -> [TestTree] -> TestTree
testGroup String
"complementByteString"
        [ TestTree
CIP0122.complementSelfInverse
        , TestTree
CIP0122.deMorgan
        ]
    , String -> [TestTree] -> TestTree
testGroup String
"bit reading and modification"
        [ TestTree
CIP0122.getSet
        , TestTree
CIP0122.setGet
        , TestTree
CIP0122.setSet
        , TestTree
CIP0122.writeBitsHomomorphismLaws
        ]
    , String -> [TestTree] -> TestTree
testGroup String
"replicateByte"
        [ TestTree
CIP0122.replicateHomomorphismLaws
        , TestTree
CIP0122.replicateIndex
        ]
    ]

-- Tests of the laws for the bitwise operations from [CIP-0123](https://cips.cardano.org/cip/CIP-0123).
test_Bitwise_CIP0123 :: TestTree
test_Bitwise_CIP0123 :: TestTree
test_Bitwise_CIP0123 =
    String -> [TestTree] -> TestTree
testGroup String
"Bitwise operations (CIP0123)"
        [ String -> [TestTree] -> TestTree
testGroup String
"shiftByteString"
            [ String -> [TestTree] -> TestTree
testGroup String
"homomorphism" [TestTree]
CIP0123.shiftHomomorphism
            , String -> PropertyName -> Property -> TestTree
testPropertyNamed String
"shifts over bit length clear input" PropertyName
"shift_too_much" (Property -> TestTree) -> Property -> TestTree
forall a b. (a -> b) -> a -> b
$
                TestLimit -> (TestLimit -> TestLimit) -> Property -> Property
mapTestLimitAtLeast TestLimit
50 (TestLimit -> TestLimit -> TestLimit
forall a. Integral a => a -> a -> a
`div` TestLimit
20) Property
CIP0123.shiftClear
            , String -> PropertyName -> Property -> TestTree
testPropertyNamed String
"positive shifts clear low indexes" PropertyName
"shift_pos_low" (Property -> TestTree) -> Property -> TestTree
forall a b. (a -> b) -> a -> b
$
                TestLimit -> (TestLimit -> TestLimit) -> Property -> Property
mapTestLimitAtLeast TestLimit
99 (TestLimit -> TestLimit -> TestLimit
forall a. Integral a => a -> a -> a
`div` TestLimit
10) Property
CIP0123.shiftPosClearLow
            , String -> PropertyName -> Property -> TestTree
testPropertyNamed String
"negative shifts clear high indexes" PropertyName
"shift_neg_high" (Property -> TestTree) -> Property -> TestTree
forall a b. (a -> b) -> a -> b
$
                TestLimit -> (TestLimit -> TestLimit) -> Property -> Property
mapTestLimitAtLeast TestLimit
99 (TestLimit -> TestLimit -> TestLimit
forall a. Integral a => a -> a -> a
`div` TestLimit
10) Property
CIP0123.shiftNegClearHigh
            , String -> PropertyName -> Property -> TestTree
testPropertyNamed String
"shifts do not break when given minBound" PropertyName
"shift_min_bound" (Property -> TestTree) -> Property -> TestTree
forall a b. (a -> b) -> a -> b
$
                TestLimit -> (TestLimit -> TestLimit) -> Property -> Property
mapTestLimitAtLeast TestLimit
99 (TestLimit -> TestLimit -> TestLimit
forall a. Integral a => a -> a -> a
`div` TestLimit
10) Property
CIP0123.shiftMinBound
            ]
        , String -> [TestTree] -> TestTree
testGroup String
"rotateByteString"
            [ String -> [TestTree] -> TestTree
testGroup String
"homomorphism" [TestTree]
CIP0123.rotateHomomorphism
            , String -> PropertyName -> Property -> TestTree
testPropertyNamed String
"rotations over bit length roll over" PropertyName
"rotate_too_much" (Property -> TestTree) -> Property -> TestTree
forall a b. (a -> b) -> a -> b
$
                TestLimit -> (TestLimit -> TestLimit) -> Property -> Property
mapTestLimitAtLeast TestLimit
50 (TestLimit -> TestLimit -> TestLimit
forall a. Integral a => a -> a -> a
`div` TestLimit
20) Property
CIP0123.rotateRollover
            , String -> PropertyName -> Property -> TestTree
testPropertyNamed String
"rotations move bits but don't change them" PropertyName
"rotate_move" (Property -> TestTree) -> Property -> TestTree
forall a b. (a -> b) -> a -> b
$
                TestLimit -> (TestLimit -> TestLimit) -> Property -> Property
mapTestLimitAtLeast TestLimit
50 (TestLimit -> TestLimit -> TestLimit
forall a. Integral a => a -> a -> a
`div` TestLimit
20) Property
CIP0123.rotateMoveBits
            , String -> PropertyName -> Property -> TestTree
testPropertyNamed String
"rotations do not break when given minBound" PropertyName
"rotate_min_bound" (Property -> TestTree) -> Property -> TestTree
forall a b. (a -> b) -> a -> b
$
                TestLimit -> (TestLimit -> TestLimit) -> Property -> Property
mapTestLimitAtLeast TestLimit
50 (TestLimit -> TestLimit -> TestLimit
forall a. Integral a => a -> a -> a
`div` TestLimit
20) Property
CIP0123.rotateMinBound
            ]
        , String -> [TestTree] -> TestTree
testGroup String
"countSetBits"
            [ String -> [TestTree] -> TestTree
testGroup String
"homomorphism" [TestTree]
CIP0123.csbHomomorphism
            , String -> PropertyName -> Property -> TestTree
testPropertyNamed String
"rotation preserves count" PropertyName
"popcount_rotate" (Property -> TestTree) -> Property -> TestTree
forall a b. (a -> b) -> a -> b
$
                TestLimit -> (TestLimit -> TestLimit) -> Property -> Property
mapTestLimitAtLeast TestLimit
50 (TestLimit -> TestLimit -> TestLimit
forall a. Integral a => a -> a -> a
`div` TestLimit
20) Property
CIP0123.csbRotate
            , String -> PropertyName -> Property -> TestTree
testPropertyNamed String
"count of the complement" PropertyName
"popcount_complement" (Property -> TestTree) -> Property -> TestTree
forall a b. (a -> b) -> a -> b
$
                TestLimit -> (TestLimit -> TestLimit) -> Property -> Property
mapTestLimitAtLeast TestLimit
50 (TestLimit -> TestLimit -> TestLimit
forall a. Integral a => a -> a -> a
`div` TestLimit
20) Property
CIP0123.csbComplement
            , String -> PropertyName -> Property -> TestTree
testPropertyNamed String
"inclusion-exclusion" PropertyName
"popcount_inclusion_exclusion" (Property -> TestTree) -> Property -> TestTree
forall a b. (a -> b) -> a -> b
$
                TestLimit -> (TestLimit -> TestLimit) -> Property -> Property
mapTestLimitAtLeast TestLimit
50 (TestLimit -> TestLimit -> TestLimit
forall a. Integral a => a -> a -> a
`div` TestLimit
20) Property
CIP0123.csbInclusionExclusion
            , String -> PropertyName -> Property -> TestTree
testPropertyNamed String
"count of self-XOR" PropertyName
"popcount_self_xor" (Property -> TestTree) -> Property -> TestTree
forall a b. (a -> b) -> a -> b
$
                TestLimit -> (TestLimit -> TestLimit) -> Property -> Property
mapTestLimitAtLeast TestLimit
99 (TestLimit -> TestLimit -> TestLimit
forall a. Integral a => a -> a -> a
`div` TestLimit
10) Property
CIP0123.csbXor
            ]
        , String -> [TestTree] -> TestTree
testGroup String
"findFirstSetBit"
            [ String -> PropertyName -> Property -> TestTree
testPropertyNamed String
"find first in zero bytestrings" PropertyName
"ffs_zero" (Property -> TestTree) -> Property -> TestTree
forall a b. (a -> b) -> a -> b
$
                TestLimit -> (TestLimit -> TestLimit) -> Property -> Property
mapTestLimitAtLeast TestLimit
99 (TestLimit -> TestLimit -> TestLimit
forall a. Integral a => a -> a -> a
`div` TestLimit
10) Property
CIP0123.ffsZero
            , String -> PropertyName -> Property -> TestTree
testPropertyNamed String
"find first in replicated" PropertyName
"ffs_replicate" (Property -> TestTree) -> Property -> TestTree
forall a b. (a -> b) -> a -> b
$
                TestLimit -> (TestLimit -> TestLimit) -> Property -> Property
mapTestLimitAtLeast TestLimit
50 (TestLimit -> TestLimit -> TestLimit
forall a. Integral a => a -> a -> a
`div` TestLimit
20) Property
CIP0123.ffsReplicate
            , String -> PropertyName -> Property -> TestTree
testPropertyNamed String
"find first of self-XOR" PropertyName
"ffs_xor" (Property -> TestTree) -> Property -> TestTree
forall a b. (a -> b) -> a -> b
$
                TestLimit -> (TestLimit -> TestLimit) -> Property -> Property
mapTestLimitAtLeast TestLimit
99 (TestLimit -> TestLimit -> TestLimit
forall a. Integral a => a -> a -> a
`div` TestLimit
10) Property
CIP0123.ffsXor
            , String -> PropertyName -> Property -> TestTree
testPropertyNamed String
"found index set, lower indices clear" PropertyName
"ffs_index" (Property -> TestTree) -> Property -> TestTree
forall a b. (a -> b) -> a -> b
$
                TestLimit -> (TestLimit -> TestLimit) -> Property -> Property
mapTestLimitAtLeast TestLimit
50 (TestLimit -> TestLimit -> TestLimit
forall a. Integral a => a -> a -> a
`div` TestLimit
20) Property
CIP0123.ffsIndex
            , String -> PropertyName -> Property -> TestTree
testPropertyNamed String
"regression #6453 check" PropertyName
"regression_6453" (Property -> TestTree) -> Property -> TestTree
forall a b. (a -> b) -> a -> b
$
                TestLimit -> (TestLimit -> TestLimit) -> Property -> Property
mapTestLimitAtLeast TestLimit
99 (TestLimit -> TestLimit -> TestLimit
forall a. Integral a => a -> a -> a
`div` TestLimit
10) Property
CIP0123.ffs6453
            ]
        ]

test_definition :: TestTree
test_definition :: TestTree
test_definition =
    String -> [TestTree] -> TestTree
testGroup String
"definition"
        [ TestTree
test_IntegerDistribution
        , TestTree
test_Factorial
        , TestTree
test_ForallFortyTwo
        , TestTree
test_Const
        , TestTree
test_Id
        , TestTree
test_IdFInteger
        , TestTree
test_IdList
        , TestTree
test_IdRank2
        , TestTree
test_ScottToMetaUnit
        , TestTree
test_FailingSucc
        , TestTree
test_ExpensiveSucc
        , TestTree
test_FailingPlus
        , TestTree
test_ExpensivePlus
        , TestTree
test_BuiltinList
        , TestTree
test_IdBuiltinList
        , TestTree
test_BuiltinArray
        , TestTree
test_BuiltinPair
        , TestTree
test_SwapEls
        , TestTree
test_IdBuiltinData
        , TestTree
test_TrackCostsRestricting
        , TestTree
test_TrackCostsRetaining
        , TestTree
test_SerialiseDataImpossible
        , TestTree
test_fixId
        , [TestNested] -> TestTree
runTestNestedHere
            [ TestNested
test_Integer
            , TestNested
test_String
            , TestNested
test_List
            , TestNested
test_Data
            , TestNested
test_Crypto
            ]
        , TestTree
test_HashSizes
        , TestTree
test_SignatureVerification
        , TestTree
test_BLS12_381
        , TestTree
test_Other
        , TestTree
test_Version
        , TestTree
test_ConsByteString
        , TestTree
test_Conversion
        , TestTree
test_Bitwise_CIP0122
        , TestTree
test_Bitwise_CIP0123
        ]