From 06d1a16a6854277f365c9afe77df4db256d3ab4f Mon Sep 17 00:00:00 2001 From: effectfully Date: Thu, 10 Apr 2025 01:45:37 +0200 Subject: [PATCH 01/25] [Builtins] Allow casing on booleans --- .../Data/GoldenTests/sorted.cbor.size.golden | 2 +- .../GoldenTests/sorted.large.budget.golden | 2 +- .../Data/GoldenTests/sorted.pir.golden | 105 +- .../GoldenTests/sorted.small.budget.golden | 2 +- .../Data/GoldenTests/sorted.uplc.golden | 1829 ++++++------ .../GoldenTests/unsorted.cbor.size.golden | 2 +- .../GoldenTests/unsorted.large.budget.golden | 2 +- .../Data/GoldenTests/unsorted.pir.golden | 114 +- .../GoldenTests/unsorted.small.budget.golden | 2 +- .../Data/GoldenTests/unsorted.uplc.golden | 2478 ++++++++-------- .../GoldenTests/sorted.cbor.size.golden | 2 +- .../GoldenTests/sorted.large.budget.golden | 2 +- .../Validator/GoldenTests/sorted.pir.golden | 91 +- .../GoldenTests/sorted.small.budget.golden | 2 +- .../Validator/GoldenTests/sorted.uplc.golden | 1810 ++++++------ .../GoldenTests/unsorted.cbor.size.golden | 2 +- .../GoldenTests/unsorted.large.budget.golden | 2 +- .../Validator/GoldenTests/unsorted.pir.golden | 100 +- .../GoldenTests/unsorted.small.budget.golden | 2 +- .../GoldenTests/unsorted.uplc.golden | 2486 ++++++++--------- .../bitwise/test/9.6/8 queens.budget.golden | 4 +- .../bitwise/test/9.6/8 queens.pir.golden | 22 +- .../bitwise/test/9.6/8 queens.size.golden | 2 +- .../bitwise/test/9.6/Ed25519.budget.golden | 4 +- .../bitwise/test/9.6/Ed25519.pir.golden | 42 +- .../bitwise/test/9.6/Ed25519.size.golden | 2 +- .../test/9.6/bls12-381-costs.golden | 18 +- .../test/9.6/ed25519-costs.golden | 32 +- .../9.6/match-builtin-list-10.budget.golden | 4 +- .../9.6/match-builtin-list-100.budget.golden | 4 +- .../9.6/match-builtin-list-5.budget.golden | 4 +- .../9.6/match-builtin-list-50.budget.golden | 4 +- .../9.6/match-scott-list-10.budget.golden | 4 +- .../9.6/match-scott-list-100.budget.golden | 4 +- .../9.6/match-scott-list-5.budget.golden | 4 +- .../9.6/match-scott-list-50.budget.golden | 4 +- .../test/Sum/9.6/left-fold-data.budget.golden | 4 +- .../Sum/9.6/right-fold-data.budget.golden | 4 +- .../nofib/test/9.6/clausify-F5.budget.golden | 4 +- .../nofib/test/9.6/clausify-F5.pir.golden | 28 +- .../nofib/test/9.6/clausify-F5.size.golden | 2 +- .../test/9.6/knights10-4x4.budget.golden | 4 +- .../nofib/test/9.6/knights10-4x4.pir.golden | 98 +- .../nofib/test/9.6/knights10-4x4.size.golden | 2 +- .../nofib/test/9.6/queens4-bt.budget.golden | 4 +- .../nofib/test/9.6/queens4-bt.pir.golden | 44 +- .../nofib/test/9.6/queens4-bt.size.golden | 2 +- .../nofib/test/9.6/queens5-fc.budget.golden | 4 +- .../nofib/test/9.6/queens5-fc.pir.golden | 44 +- .../nofib/test/9.6/queens5-fc.size.golden | 2 +- .../9.6/checkScriptContext1-20.budget.golden | 4 +- .../9.6/checkScriptContext1-4.budget.golden | 4 +- .../V1/9.6/checkScriptContext1.pir.golden | 104 +- .../V1/9.6/checkScriptContext1.size.golden | 2 +- .../9.6/checkScriptContext2-20.budget.golden | 4 +- .../9.6/checkScriptContext2-4.budget.golden | 4 +- .../V1/9.6/checkScriptContext2.pir.golden | 102 +- .../V1/9.6/checkScriptContext2.size.golden | 2 +- ...ScriptContextEqualityData-20.budget.golden | 4 +- .../9.6/checkScriptContext1-20.budget.golden | 4 +- .../9.6/checkScriptContext1-4.budget.golden | 4 +- .../Data/9.6/checkScriptContext1.pir.golden | 13 +- .../Data/9.6/checkScriptContext1.size.golden | 2 +- ...ScriptContextEqualityData-20.budget.golden | 4 +- .../9.6/checkScriptContext1-20.budget.golden | 4 +- .../9.6/checkScriptContext1-4.budget.golden | 4 +- .../V2/9.6/checkScriptContext1.pir.golden | 112 +- .../V2/9.6/checkScriptContext1.size.golden | 2 +- .../9.6/checkScriptContext2-20.budget.golden | 4 +- .../9.6/checkScriptContext2-4.budget.golden | 4 +- .../V2/9.6/checkScriptContext2.pir.golden | 105 +- .../V2/9.6/checkScriptContext2.size.golden | 2 +- ...ScriptContextEqualityData-20.budget.golden | 4 +- .../V2/9.6/dataFwdStakeTrick.budget.golden | 4 +- .../test/V2/9.6/dataFwdStakeTrick.pir.golden | 11 +- .../test/V2/9.6/dataFwdStakeTrick.size.golden | 2 +- .../test/V2/9.6/dataFwdStakeTrick.uplc.golden | 64 +- .../9.6/dataFwdStakeTrickManual.budget.golden | 4 +- .../V2/9.6/dataFwdStakeTrickManual.pir.golden | 11 +- .../9.6/dataFwdStakeTrickManual.size.golden | 2 +- .../9.6/dataFwdStakeTrickManual.uplc.golden | 46 +- .../V2/9.6/sopFwdStakeTrick.budget.golden | 4 +- .../test/V2/9.6/sopFwdStakeTrick.pir.golden | 111 +- .../test/V2/9.6/sopFwdStakeTrick.size.golden | 2 +- .../test/V2/9.6/sopFwdStakeTrick.uplc.golden | 1755 ++++++------ .../9.6/checkScriptContext1-20.budget.golden | 4 +- .../9.6/checkScriptContext1-4.budget.golden | 4 +- .../Data/9.6/checkScriptContext1.pir.golden | 13 +- .../Data/9.6/checkScriptContext1.size.golden | 2 +- ...ScriptContextEqualityData-20.budget.golden | 4 +- .../9.6/checkScriptContext1-20.budget.golden | 4 +- .../9.6/checkScriptContext1-4.budget.golden | 4 +- .../V3/9.6/checkScriptContext1.pir.golden | 309 +- .../V3/9.6/checkScriptContext1.size.golden | 2 +- .../9.6/checkScriptContext2-20.budget.golden | 4 +- .../9.6/checkScriptContext2-4.budget.golden | 4 +- .../V3/9.6/checkScriptContext2.pir.golden | 308 +- .../V3/9.6/checkScriptContext2.size.golden | 2 +- ...ScriptContextEqualityData-20.budget.golden | 4 +- .../9.6/checkScriptContext1-20.budget.golden | 4 +- .../9.6/checkScriptContext1-4.budget.golden | 4 +- .../Data/9.6/checkScriptContext1.pir.golden | 11 +- .../Data/9.6/checkScriptContext1.size.golden | 2 +- ...ScriptContextEqualityData-20.budget.golden | 4 +- .../9.6/purposeIsWellFormed-4.budget.golden | 4 +- .../Data/9.6/purposeIsWellFormed.pir.golden | 316 +-- .../Data/9.6/purposeIsWellFormed.size.golden | 2 +- plutus-core/plutus-core.cabal | 1 + .../plutus-core/src/PlutusCore/Builtin.hs | 1 + .../src/PlutusCore/Builtin/Case.hs | 20 + .../src/PlutusCore/Compiler/Types.hs | 2 + .../src/PlutusCore/Default/Universe.hs | 44 +- .../plutus-core/src/PlutusCore/TypeCheck.hs | 3 +- .../src/PlutusCore/TypeCheck/Internal.hs | 27 +- .../plutus-ir/src/PlutusIR/Compiler/Types.hs | 2 + plutus-core/plutus-ir/src/PlutusIR/Pass.hs | 7 +- .../src/PlutusIR/Transform/CaseReduce.hs | 19 +- .../src/PlutusIR/TypeCheck/Internal.hs | 16 +- plutus-core/testlib/PlutusCore/Test.hs | 2 + plutus-core/testlib/PlutusIR/Test.hs | 5 + .../Evaluation/Machine/Cek.hs | 12 +- .../Evaluation/Machine/Cek/Internal.hs | 7 +- .../Evaluation/Machine/SteppableCek.hs | 12 +- .../Machine/SteppableCek/Internal.hs | 19 +- .../UntypedPlutusCore/Transform/CaseOfCase.hs | 54 +- .../UntypedPlutusCore/Transform/CaseReduce.hs | 11 +- .../test/Evaluation/Builtins/Common.hs | 3 + .../Evaluation/Golden/caseNonTag.type.golden | 8 +- .../test/Transform/CaseOfCase/1.uplc.golden | 12 +- .../test/Transform/CaseOfCase/3.uplc.golden | 12 +- .../CaseOfCase/withError.uplc.golden | 12 +- .../9.6/currencySymbolValueOf.budget.golden | 4 +- .../9.6/currencySymbolValueOf.pir.golden | 2 +- .../Spec/Budget/9.6/geq1.budget.golden | 4 +- .../Spec/Budget/9.6/geq2.budget.golden | 4 +- .../Spec/Budget/9.6/geq3.budget.golden | 4 +- .../Spec/Budget/9.6/geq4.budget.golden | 4 +- .../Spec/Budget/9.6/geq5.budget.golden | 4 +- .../test-plugin/Spec/Budget/9.6/gt.pir.golden | 11 +- .../Spec/Budget/9.6/gt1.budget.golden | 4 +- .../Spec/Budget/9.6/gt2.budget.golden | 4 +- .../Spec/Budget/9.6/gt3.budget.golden | 4 +- .../Spec/Budget/9.6/gt4.budget.golden | 4 +- .../Spec/Budget/9.6/gt5.budget.golden | 4 +- .../9.6/currencySymbolValueOf.budget.golden | 4 +- .../9.6/currencySymbolValueOf.pir.golden | 7 +- .../Spec/Data/Budget/9.6/geq1.budget.golden | 4 +- .../Spec/Data/Budget/9.6/geq2.budget.golden | 4 +- .../Spec/Data/Budget/9.6/geq3.budget.golden | 4 +- .../Spec/Data/Budget/9.6/geq4.budget.golden | 4 +- .../Spec/Data/Budget/9.6/geq5.budget.golden | 4 +- .../Spec/Data/Budget/9.6/gt.pir.golden | 52 +- .../Spec/Data/Budget/9.6/gt1.budget.golden | 4 +- .../Spec/Data/Budget/9.6/gt2.budget.golden | 4 +- .../Spec/Data/Budget/9.6/gt3.budget.golden | 4 +- .../Spec/Data/Budget/9.6/gt4.budget.golden | 4 +- .../Spec/Data/Budget/9.6/gt5.budget.golden | 4 +- .../9.6/succeedsIfHasDatum.pir.golden | 11 +- .../9.6/succeedsIfHasDatum.uplc.golden | 83 +- .../Spec/Data/Value/9.6/Long.stat.golden | 30 +- .../Spec/Data/Value/9.6/Short.stat.golden | 38 +- .../Spec/Value/9.6/Long.stat.golden | 30 +- .../Spec/Value/9.6/Short.stat.golden | 42 +- .../src/PlutusTx/Compiler/Builtins.hs | 13 +- .../9.6/destructSum-manual.budget.golden | 4 +- .../Budget/9.6/destructSum-manual.pir.golden | 21 +- .../Budget/9.6/destructSum-manual.uplc.golden | 218 +- .../Budget/9.6/destructSum.budget.golden | 4 +- .../AsData/Budget/9.6/destructSum.pir.golden | 21 +- .../AsData/Budget/9.6/destructSum.uplc.golden | 213 +- .../Budget/9.6/patternMatching.budget.golden | 4 +- .../Budget/9.6/patternMatching.pir.golden | 2 +- .../Budget/9.6/patternMatching.uplc.golden | 36 +- .../Budget/9.6/recordFields.budget.golden | 4 +- .../AsData/Budget/9.6/recordFields.pir.golden | 2 +- .../Budget/9.6/recordFields.uplc.golden | 28 +- .../AsData/Budget/9.6/recursive.pir.golden | 2 +- .../AsData/Budget/9.6/recursive.uplc.golden | 14 +- .../test/Budget/9.6/allCheap.budget.golden | 4 +- .../test/Budget/9.6/allCheap.pir.golden | 2 +- .../test/Budget/9.6/allCheap.uplc.golden | 8 +- .../test/Budget/9.6/allEmptyList.pir.golden | 2 +- .../test/Budget/9.6/allEmptyList.uplc.golden | 8 +- .../Budget/9.6/allExpensive.budget.golden | 4 +- .../test/Budget/9.6/allExpensive.pir.golden | 2 +- .../test/Budget/9.6/allExpensive.uplc.golden | 8 +- .../Budget/9.6/andWithGHCOpts.budget.golden | 4 +- .../test/Budget/9.6/andWithGHCOpts.pir.golden | 4 +- .../Budget/9.6/andWithGHCOpts.uplc.golden | 17 +- .../Budget/9.6/andWithLocal.budget.golden | 4 +- .../test/Budget/9.6/andWithLocal.pir.golden | 7 +- .../test/Budget/9.6/andWithLocal.uplc.golden | 16 +- .../9.6/andWithoutGHCOpts.budget.golden | 4 +- .../Budget/9.6/andWithoutGHCOpts.pir.golden | 20 +- .../Budget/9.6/andWithoutGHCOpts.uplc.golden | 7 +- .../test/Budget/9.6/anyCheap.budget.golden | 4 +- .../test/Budget/9.6/anyCheap.pir.golden | 2 +- .../test/Budget/9.6/anyCheap.uplc.golden | 8 +- .../test/Budget/9.6/anyEmptyList.pir.golden | 2 +- .../test/Budget/9.6/anyEmptyList.uplc.golden | 8 +- .../Budget/9.6/anyExpensive.budget.golden | 4 +- .../test/Budget/9.6/anyExpensive.pir.golden | 2 +- .../test/Budget/9.6/anyExpensive.uplc.golden | 8 +- .../9.6/builtinListIndexing.budget.golden | 4 +- .../Budget/9.6/builtinListIndexing.pir.golden | 2 +- .../9.6/builtinListIndexing.uplc.golden | 10 +- .../test/Budget/9.6/constAccL.budget.golden | 4 +- .../test/Budget/9.6/constAccL.pir.golden | 2 +- .../test/Budget/9.6/constAccL.uplc.golden | 13 +- .../test/Budget/9.6/constAccR.budget.golden | 4 +- .../test/Budget/9.6/constAccR.pir.golden | 2 +- .../test/Budget/9.6/constAccR.uplc.golden | 12 +- .../test/Budget/9.6/constElL.budget.golden | 4 +- .../test/Budget/9.6/constElL.pir.golden | 2 +- .../test/Budget/9.6/constElL.uplc.golden | 13 +- .../test/Budget/9.6/constElR.budget.golden | 4 +- .../test/Budget/9.6/constElR.pir.golden | 2 +- .../test/Budget/9.6/constElR.uplc.golden | 12 +- .../test/Budget/9.6/elemCheap.budget.golden | 4 +- .../test/Budget/9.6/elemCheap.pir.golden | 2 +- .../test/Budget/9.6/elemCheap.uplc.golden | 8 +- .../Budget/9.6/elemExpensive.budget.golden | 4 +- .../test/Budget/9.6/elemExpensive.pir.golden | 2 +- .../test/Budget/9.6/elemExpensive.uplc.golden | 8 +- .../test/Budget/9.6/filter.budget.golden | 4 +- .../test/Budget/9.6/filter.pir.golden | 6 +- .../test/Budget/9.6/filter.uplc.golden | 8 +- .../test/Budget/9.6/findCheap.budget.golden | 4 +- .../test/Budget/9.6/findCheap.pir.golden | 2 +- .../test/Budget/9.6/findCheap.uplc.golden | 8 +- .../test/Budget/9.6/findEmptyList.pir.golden | 2 +- .../test/Budget/9.6/findEmptyList.uplc.golden | 8 +- .../Budget/9.6/findExpensive.budget.golden | 4 +- .../test/Budget/9.6/findExpensive.pir.golden | 2 +- .../test/Budget/9.6/findExpensive.uplc.golden | 8 +- .../Budget/9.6/findIndexCheap.budget.golden | 4 +- .../test/Budget/9.6/findIndexCheap.pir.golden | 2 +- .../Budget/9.6/findIndexCheap.uplc.golden | 11 +- .../Budget/9.6/findIndexEmptyList.pir.golden | 2 +- .../Budget/9.6/findIndexEmptyList.uplc.golden | 11 +- .../9.6/findIndexExpensive.budget.golden | 4 +- .../Budget/9.6/findIndexExpensive.pir.golden | 2 +- .../Budget/9.6/findIndexExpensive.uplc.golden | 11 +- .../test/Budget/9.6/gte0.budget.golden | 4 +- .../test/Budget/9.6/gte0.pir.golden | 4 +- .../test/Budget/9.6/gte0.uplc.golden | 20 +- .../Budget/9.6/listIndexing.budget.golden | 4 +- .../test/Budget/9.6/listIndexing.pir.golden | 2 +- .../test/Budget/9.6/listIndexing.uplc.golden | 14 +- .../test/Budget/9.6/lte0.budget.golden | 4 +- .../test/Budget/9.6/lte0.pir.golden | 4 +- .../test/Budget/9.6/lte0.uplc.golden | 20 +- .../test/Budget/9.6/map1.budget.golden | 4 +- .../test/Budget/9.6/map1.pir.golden | 23 +- .../test/Budget/9.6/map1.uplc.golden | 142 +- .../test/Budget/9.6/map2.budget.golden | 4 +- .../test/Budget/9.6/map2.pir.golden | 14 +- .../test/Budget/9.6/map2.uplc.golden | 82 +- .../test/Budget/9.6/map3.budget.golden | 4 +- .../test/Budget/9.6/map3.pir.golden | 20 +- .../test/Budget/9.6/map3.uplc.golden | 191 +- .../Budget/9.6/matchAsDataE.budget.golden | 4 +- .../test/Budget/9.6/not-not.budget.golden | 4 +- .../test/Budget/9.6/not-not.pir.golden | 2 +- .../test/Budget/9.6/not-not.uplc.golden | 8 +- .../Budget/9.6/notElemCheap.budget.golden | 4 +- .../test/Budget/9.6/notElemCheap.pir.golden | 2 +- .../test/Budget/9.6/notElemCheap.uplc.golden | 8 +- .../Budget/9.6/notElemExpensive.budget.golden | 4 +- .../Budget/9.6/notElemExpensive.pir.golden | 2 +- .../Budget/9.6/notElemExpensive.uplc.golden | 8 +- .../Budget/9.6/recursiveGte0.budget.golden | 4 +- .../test/Budget/9.6/recursiveGte0.pir.golden | 4 +- .../test/Budget/9.6/recursiveGte0.uplc.golden | 18 +- .../Budget/9.6/recursiveLte0.budget.golden | 4 +- .../test/Budget/9.6/recursiveLte0.pir.golden | 4 +- .../test/Budget/9.6/recursiveLte0.uplc.golden | 17 +- .../test/Budget/9.6/show.budget.golden | 4 +- .../test/Budget/9.6/show.pir.golden | 104 +- .../test/Budget/9.6/show.uplc.golden | 467 ++-- .../test/Budget/9.6/sumAtIndices.pir.golden | 16 +- .../test/Budget/9.6/sumL.budget.golden | 4 +- .../test/Budget/9.6/sumL.pir.golden | 2 +- .../test/Budget/9.6/sumL.uplc.golden | 14 +- .../test/Budget/9.6/sumR.budget.golden | 4 +- .../test/Budget/9.6/sumR.pir.golden | 2 +- .../test/Budget/9.6/sumR.uplc.golden | 12 +- .../test/Budget/9.6/toFromData.budget.golden | 4 +- .../test/Budget/9.6/toFromData.pir.golden | 18 +- .../test/Budget/9.6/toFromData.uplc.golden | 311 +-- .../DataList/Budget/9.6/any.budget.golden | 4 +- .../test/DataList/Budget/9.6/any.pir.golden | 2 +- .../test/DataList/Budget/9.6/any.uplc.golden | 8 +- .../DataList/Budget/9.6/elem.budget.golden | 4 +- .../test/DataList/Budget/9.6/elem.pir.golden | 2 +- .../test/DataList/Budget/9.6/elem.uplc.golden | 8 +- .../DataList/Budget/9.6/filter.budget.golden | 4 +- .../DataList/Budget/9.6/filter.pir.golden | 2 +- .../DataList/Budget/9.6/filter.uplc.golden | 14 +- .../Budget/9.6/partition.budget.golden | 4 +- .../DataList/Budget/9.6/partition.pir.golden | 2 +- .../DataList/Budget/9.6/partition.uplc.golden | 24 +- .../test/IsData/9.6/dataToData.pir.golden | 3 +- .../IsData/9.6/deconstructData.pir.golden | 3 +- .../test/IsData/9.6/equalityAsData.pir.golden | 3 +- .../test/IsData/9.6/matchAsData.pir.golden | 3 +- .../9.6/unsafeDeconstructData.pir.golden | 3 +- .../Optimization/9.6/matchAsData.pir.golden | 4 +- .../9.6/unsafeDeconstructData.pir.golden | 6 +- .../test/Plugin/Basic/9.6/ifOpt.pir.golden | 3 +- .../test/Plugin/Basic/9.6/letFun.pir.golden | 3 +- .../Coverage/9.6/coverageCode.pir.golden | 3 +- .../test/Plugin/Debug/9.6/fib.pir.golden | 28 +- .../test/Plugin/Debug/9.6/letFun.pir.golden | 28 +- .../Functions/9.6/recursive/even.pir.golden | 3 +- .../Functions/9.6/recursive/fib.pir.golden | 3 +- .../9.6/unfoldings/allDirect.pir.golden | 3 +- .../mutualRecursionUnfoldings.pir.golden | 3 +- .../Primitives/9.6/ifThenElse.pir.golden | 3 +- .../Primitives/9.6/intCompare.pir.golden | 3 +- .../Plugin/Primitives/9.6/intEq.pir.golden | 3 +- .../Plugin/Primitives/9.6/verify.pir.golden | 3 +- .../Plugin/Primitives/9.6/void.pir.golden | 3 +- .../test/Plugin/Profiling/9.6/fib.pir.golden | 3 +- .../Plugin/Strict/9.6/issue4645.pir.golden | 2 +- .../Plugin/Strict/9.6/strictITE.pir.golden | 2 +- .../Typeclasses/9.6/compareTest.pir.golden | 3 +- .../Typeclasses/9.6/multiFunction.pir.golden | 3 +- .../9.6/partialApplication.pir.golden | 3 +- .../Strictness/9.6/let-default.pir.golden | 2 +- .../Strictness/9.6/let-default.uplc.golden | 8 +- .../Strictness/9.6/let-nonstrict.pir.golden | 2 +- .../Strictness/9.6/let-nonstrict.uplc.golden | 8 +- .../test/Strictness/9.6/let-strict.pir.golden | 2 +- .../Strictness/9.6/let-strict.uplc.golden | 8 +- .../Rational/Additive/minus.size.golden | 2 +- .../Golden/Rational/Additive/plus.size.golden | 2 +- .../Rational/Construction/ratio.size.golden | 2 +- .../Construction/unsafeRatio.size.golden | 2 +- .../size/Golden/Rational/Eq/equal.size.golden | 2 +- .../Golden/Rational/Eq/not-equal.size.golden | 2 +- .../Rational/Multiplicative/scale.size.golden | 2 +- .../Rational/Multiplicative/times.size.golden | 2 +- .../Golden/Rational/Ord/compare.size.golden | 2 +- .../Ord/greater-than-equal.size.golden | 2 +- .../Rational/Ord/greater-than.size.golden | 2 +- .../Rational/Ord/less-than-equal.size.golden | 2 +- .../Golden/Rational/Ord/less-than.size.golden | 2 +- .../size/Golden/Rational/Ord/max.size.golden | 2 +- .../size/Golden/Rational/Ord/min.size.golden | 2 +- .../Other/abs-specialized.size.golden | 2 +- .../Golden/Rational/Other/recip.size.golden | 2 +- .../Golden/Rational/Other/round.size.golden | 2 +- .../Serialization/fromBuiltinData.size.golden | 2 +- .../unsafeFromBuiltinData.size.golden | 2 +- plutus-tx/src/PlutusTx/Lift.hs | 33 + plutus-tx/testlib/PlutusTx/Test.hs | 3 + 357 files changed, 7781 insertions(+), 8796 deletions(-) create mode 100644 plutus-core/plutus-core/src/PlutusCore/Builtin/Case.hs diff --git a/cardano-constitution/test/Cardano/Constitution/Validator/Data/GoldenTests/sorted.cbor.size.golden b/cardano-constitution/test/Cardano/Constitution/Validator/Data/GoldenTests/sorted.cbor.size.golden index bdedcd99466..1745aa32477 100644 --- a/cardano-constitution/test/Cardano/Constitution/Validator/Data/GoldenTests/sorted.cbor.size.golden +++ b/cardano-constitution/test/Cardano/Constitution/Validator/Data/GoldenTests/sorted.cbor.size.golden @@ -1 +1 @@ -2164 \ No newline at end of file +2085 \ No newline at end of file diff --git a/cardano-constitution/test/Cardano/Constitution/Validator/Data/GoldenTests/sorted.large.budget.golden b/cardano-constitution/test/Cardano/Constitution/Validator/Data/GoldenTests/sorted.large.budget.golden index e743a441bdd..78ea2c2a9c0 100644 --- a/cardano-constitution/test/Cardano/Constitution/Validator/Data/GoldenTests/sorted.large.budget.golden +++ b/cardano-constitution/test/Cardano/Constitution/Validator/Data/GoldenTests/sorted.large.budget.golden @@ -1 +1 @@ -ExBudget {exBudgetCPU = ExCPU 549796171, exBudgetMemory = ExMemory 2648818} \ No newline at end of file +ExBudget {exBudgetCPU = ExCPU 472454709, exBudgetMemory = ExMemory 2373180} \ No newline at end of file diff --git a/cardano-constitution/test/Cardano/Constitution/Validator/Data/GoldenTests/sorted.pir.golden b/cardano-constitution/test/Cardano/Constitution/Validator/Data/GoldenTests/sorted.pir.golden index 48c3031972a..2d9ed09befc 100644 --- a/cardano-constitution/test/Cardano/Constitution/Validator/Data/GoldenTests/sorted.pir.golden +++ b/cardano-constitution/test/Cardano/Constitution/Validator/Data/GoldenTests/sorted.pir.golden @@ -139,12 +139,12 @@ program !`$fOrdInteger_$ccompare` : integer -> integer -> Ordering = \(eta : integer) (eta : integer) -> Bool_match - (ifThenElse {Bool} (equalsInteger eta eta) True False) + (case Bool (equalsInteger eta eta) [False, True]) {all dead. Ordering} (/\dead -> EQ) (/\dead -> Bool_match - (ifThenElse {Bool} (lessThanEqualsInteger eta eta) True False) + (case Bool (lessThanEqualsInteger eta eta) [False, True]) {all dead. Ordering} (/\dead -> LT) (/\dead -> GT) @@ -162,19 +162,18 @@ program ds {Bool} (\(n' : integer) (d' : integer) -> - ifThenElse - {Bool} + case + Bool (lessThanEqualsInteger (multiplyInteger n d') (multiplyInteger n' d)) - True - False)) + [False, True])) in letrec !euclid : integer -> integer -> integer = \(x : integer) (y : integer) -> Bool_match - (ifThenElse {Bool} (equalsInteger 0 y) True False) + (case Bool (equalsInteger 0 y) [False, True]) {all dead. integer} (/\dead -> x) (/\dead -> euclid y (modInteger x y)) @@ -184,12 +183,12 @@ program !unsafeRatio : integer -> integer -> Rational = \(n : integer) (d : integer) -> Bool_match - (ifThenElse {Bool} (equalsInteger 0 d) True False) + (case Bool (equalsInteger 0 d) [False, True]) {all dead. Rational} (/\dead -> error {Rational}) (/\dead -> Bool_match - (ifThenElse {Bool} (lessThanInteger d 0) True False) + (case Bool (lessThanInteger d 0) [False, True]) {all dead. Rational} (/\dead -> unsafeRatio (subtractInteger 0 n) (subtractInteger 0 d)) @@ -211,6 +210,8 @@ program (\v -> List (Tuple2 PredKey (List v))) Rational -> ParamValue in let + !ifThenElse : all a. bool -> a -> a -> a + = /\a -> \(b : bool) (x : a) (y : a) -> case a b [y, x] data Unit | Unit_match where Unit : Unit in @@ -232,16 +233,12 @@ program (CConsOrd {integer} (\(x : integer) (y : integer) -> - ifThenElse {Bool} (equalsInteger x y) True False) + case Bool (equalsInteger x y) [False, True]) `$fOrdInteger_$ccompare` (\(x : integer) (y : integer) -> - ifThenElse {Bool} (lessThanInteger x y) True False) + case Bool (lessThanInteger x y) [False, True]) (\(x : integer) (y : integer) -> - ifThenElse - {Bool} - (lessThanEqualsInteger x y) - True - False) + case Bool (lessThanEqualsInteger x y) [False, True]) (\(x : integer) (y : integer) -> ifThenElse {Bool} @@ -252,22 +249,14 @@ program ifThenElse {Bool} (lessThanInteger x y) False True) (\(x : integer) (y : integer) -> Bool_match - (ifThenElse - {Bool} - (lessThanEqualsInteger x y) - True - False) + (case Bool (lessThanEqualsInteger x y) [False, True]) {all dead. integer} (/\dead -> y) (/\dead -> x) {all dead. dead}) (\(x : integer) (y : integer) -> Bool_match - (ifThenElse - {Bool} - (lessThanEqualsInteger x y) - True - False) + (case Bool (lessThanEqualsInteger x y) [False, True]) {all dead. integer} (/\dead -> x) (/\dead -> y) @@ -292,18 +281,16 @@ program {Bool} (\(n' : integer) (d' : integer) -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger n n') - True - False) + [False, True]) {all dead. Bool} (/\dead -> - ifThenElse - {Bool} + case + Bool (equalsInteger d d') - True - False) + [False, True]) (/\dead -> False) {all dead. dead}))) (\(ds : Rational) (ds : Rational) -> @@ -327,13 +314,12 @@ program ds {Bool} (\(n' : integer) (d' : integer) -> - ifThenElse - {Bool} + case + Bool (lessThanInteger (multiplyInteger n d') (multiplyInteger n' d)) - True - False))) + [False, True]))) `$fOrdRational0_$c<=` (\(ds : Rational) (ds : Rational) -> Rational_match @@ -344,11 +330,13 @@ program ds {Bool} (\(n' : integer) (d' : integer) -> + let + !x : integer = multiplyInteger n d' + !y : integer = multiplyInteger n' d + in ifThenElse {Bool} - (lessThanEqualsInteger - (multiplyInteger n d') - (multiplyInteger n' d)) + (lessThanEqualsInteger x y) False True))) (\(ds : Rational) (ds : Rational) -> @@ -360,11 +348,13 @@ program ds {Bool} (\(n' : integer) (d' : integer) -> + let + !x : integer = multiplyInteger n d' + !y : integer = multiplyInteger n' d + in ifThenElse {Bool} - (lessThanInteger - (multiplyInteger n d') - (multiplyInteger n' d)) + (lessThanInteger x y) False True))) (\(x : Rational) (y : Rational) -> @@ -399,7 +389,7 @@ program ds {list data -> Bool} (\(eta : list data) -> - ifThenElse {Bool} (nullList {data} eta) True False) + case Bool (nullList {data} eta) [False, True]) (\(paramValueHd : ParamValue) (paramValueTl : List ParamValue) (actualValueData : list data) -> @@ -499,12 +489,12 @@ program !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 1 index) True False) + (case Bool (equalsInteger 1 index) [False, True]) {all dead. Maybe a} (/\dead -> Nothing {a}) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. Maybe a} (/\dead -> Just {a} (`$dUnsafeFromData` (headList {data} args))) @@ -5330,13 +5320,12 @@ program (unConstrData ds))))) in Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 5 (fstPair {integer} {list data} tup)) - True - False) + [False, True]) {all dead. data} (/\dead -> headList @@ -5357,11 +5346,10 @@ program !tup : pair integer (list data) = unConstrData scrut in Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 0 (fstPair {integer} {list data} tup)) - True - False) + [False, True]) {all dead. r} (/\dead -> let @@ -5397,11 +5385,10 @@ program !tup : pair integer (list data) = unConstrData scrut in Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 2 (fstPair {integer} {list data} tup)) - True - False) + [False, True]) {all dead. r} (/\dead -> let diff --git a/cardano-constitution/test/Cardano/Constitution/Validator/Data/GoldenTests/sorted.small.budget.golden b/cardano-constitution/test/Cardano/Constitution/Validator/Data/GoldenTests/sorted.small.budget.golden index 9277fe731e8..134788d79ed 100644 --- a/cardano-constitution/test/Cardano/Constitution/Validator/Data/GoldenTests/sorted.small.budget.golden +++ b/cardano-constitution/test/Cardano/Constitution/Validator/Data/GoldenTests/sorted.small.budget.golden @@ -1 +1 @@ -ExBudget {exBudgetCPU = ExCPU 86181157, exBudgetMemory = ExMemory 380205} \ No newline at end of file +ExBudget {exBudgetCPU = ExCPU 66780110, exBudgetMemory = ExMemory 307802} \ No newline at end of file diff --git a/cardano-constitution/test/Cardano/Constitution/Validator/Data/GoldenTests/sorted.uplc.golden b/cardano-constitution/test/Cardano/Constitution/Validator/Data/GoldenTests/sorted.uplc.golden index def79d103e0..105ddf9b449 100644 --- a/cardano-constitution/test/Cardano/Constitution/Validator/Data/GoldenTests/sorted.uplc.golden +++ b/cardano-constitution/test/Cardano/Constitution/Validator/Data/GoldenTests/sorted.uplc.golden @@ -38,857 +38,840 @@ program (\cse -> (\cse -> (\cse -> - (\cse -> - (\cse -> - (\fun - ds -> - force - (case - ((\cse -> - (\cse -> - force + (\fun + ds -> + force + (case + ((\cse -> + (\cse -> + force + (case + (equalsInteger + 0 + cse) + [ (delay + (force + (case + (equalsInteger + 2 + cse) + [ (delay + error) + , (delay + ((\l -> + constr 1 + [ ]) + (force + (force + sndPair) + cse))) ]))) + , (delay + (constr 0 + [ (force + caseData_go + (unMapData + (force + headList + (force + tailList + (force + (force + sndPair) + cse))))) ])) ])) + (force + (force + fstPair) + cse)) + (unConstrData + (force + headList + (force + tailList + (force + tailList (force (force - ifThenElse - (equalsInteger - 0 - cse) - (delay - (delay - (constr 0 - [ (force - caseData_go - (unMapData + sndPair) + (unConstrData + ((\tup -> + force + (case + (equalsInteger + 5 + (force + (force + fstPair) + tup)) + [ (delay + error) + , (delay + (force + headList (force - headList + tailList (force - tailList (force - (force - sndPair) - cse))))) ]))) - (delay - (delay + sndPair) + tup)))) ])) + (unConstrData (force + headList (force + tailList (force - ifThenElse - (equalsInteger - 2 - cse) - (delay - (delay - ((\l -> - constr 1 - [ ]) - (force - (force - sndPair) - cse)))) - (delay - (delay - error)))))))))) - (force - (force - fstPair) - cse)) - (unConstrData - (force - headList - (force - tailList - (force - tailList - (force - (force - sndPair) - (unConstrData - ((\tup -> - force - (force + tailList (force - ifThenElse - (equalsInteger - 5 - (force - (force - fstPair) - tup)) - (delay - (delay - (force - headList - (force - tailList - (force - (force - sndPair) - tup))))) - (delay - (delay - error))))) - (unConstrData - (force - headList - (force - tailList (force - tailList - (force - (force - sndPair) - (unConstrData - ds)))))))))))))) - [ (\cparams -> - delay - (force - (case - (fun - cparams) - [ (delay - ()) - , (delay - error) ]))) - , (delay - ()) ])) - (runRules - (constr 1 - [ (constr 0 - [ 0 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 30 - , cse ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 1000 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 1 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 100000 - , cse ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 10000000 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 2 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 24576 - , (constr 0 - [ ]) ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 122880 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 3 - , (constr 1 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 32768 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 4 - , (constr 1 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 5000 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 5 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 1000000 - , cse ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 5000000 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 6 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 250000000 - , cse ]) ]) - , cse ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 7 - , (constr 1 - [ (constr 1 - [ cse - , (constr 0 - [ ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 8 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 250 - , cse ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 2000 - , (constr 0 - [ ]) ]) ]) - , cse ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 9 - , (constr 3 - [ (constr 1 - [ cse - , cse ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 10 - , (constr 3 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ (cse - 1000) - , cse ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ (cse - 200) - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 11 - , (constr 3 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ (cse - 10) - , cse ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 16 - , (constr 1 - [ (constr 1 - [ cse - , cse ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 17 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 3000 - , cse ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 6500 - , (constr 0 - [ ]) ]) ]) - , cse ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 18 - , (constr 0 - [ ]) ]) - , (constr 1 - [ (constr 0 - [ 19 - , (constr 2 - [ (constr 1 - [ (constr 3 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ (cse - 25) - , (constr 0 - [ ]) ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ (cse - 5) - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) - , (constr 1 - [ (constr 3 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ (cse - 20000) - , (constr 0 - [ ]) ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ (cse - 5000) - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 20 - , (constr 2 - [ (constr 1 - [ (constr 1 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 40000000 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) - , (constr 1 - [ (constr 1 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 15000000000 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 21 - , (constr 2 - [ (constr 1 - [ (constr 1 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 120000000 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) - , (constr 1 - [ (constr 1 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 40000000000 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 22 - , (constr 1 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 12288 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 23 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 100 - , cse ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 200 - , (constr 0 - [ ]) ]) ]) - , cse ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 24 - , (constr 1 - [ (constr 1 - [ cse - , (constr 0 - [ ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 25 - , (constr 2 - [ (constr 1 - [ cse - , (constr 1 - [ cse - , (constr 1 - [ cse - , (constr 1 - [ cse - , cse ]) ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 26 - , (constr 2 - [ (constr 1 - [ cse - , (constr 1 - [ cse - , (constr 1 - [ cse - , (constr 1 - [ (constr 3 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ cse - , (constr 1 - [ (unsafeRatio - 13 - 20) - , (constr 0 - [ ]) ]) ]) ]) - , cse ]) ]) - , (constr 1 - [ cse - , (constr 1 - [ cse - , (constr 1 - [ cse - , (constr 1 - [ cse - , (constr 1 - [ (constr 3 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ cse - , cse ]) ]) - , cse ]) ]) - , cse ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 27 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 0 - , (constr 1 - [ 3 - , (constr 0 - [ ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 10 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 28 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 0 - , (constr 1 - [ 18 - , (constr 0 - [ ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 293 - , (constr 0 - [ ]) ]) ]) - , cse ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 29 - , (constr 1 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 15 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 30 - , (constr 1 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 10000000000000 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 31 - , (constr 1 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 100000000000 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 32 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 13 - , cse ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 37 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 33 - , (constr 3 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , cse ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ (unsafeRatio - 1000 - 1) - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]))) - (constr 3 - [ (constr 1 - [ cse + sndPair) + (unConstrData + ds)))))))))))))) + [ (\cparams -> + delay + (force + (case + (fun + cparams) + [ (delay + ()) + , (delay + error) ]))) + , (delay + ()) ])) + (runRules + (constr 1 + [ (constr 0 + [ 0 , (constr 1 - [ (constr 0 + [ (constr 1 [ (constr 0 - [ ]) + [ (constr 1 + [ ]) + , (constr 1 + [ 30 + , cse ]) ]) , (constr 1 - [ cse + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 1000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 1 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 100000 + , cse ]) ]) , (constr 1 - [ cse + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 10000000 + , (constr 0 + [ ]) ]) ]) , (constr 0 - [ ]) ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ])) - (constr 3 - [ (constr 1 - [ cse - , cse ]) ])) + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 2 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 24576 + , (constr 0 + [ ]) ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 122880 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 3 + , (constr 1 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 32768 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 4 + , (constr 1 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 5000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 5 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 1000000 + , cse ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 5000000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 6 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 250000000 + , cse ]) ]) + , cse ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 7 + , (constr 1 + [ (constr 1 + [ cse + , (constr 0 + [ ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 8 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 250 + , cse ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 2000 + , (constr 0 + [ ]) ]) ]) + , cse ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 9 + , (constr 3 + [ (constr 1 + [ cse + , cse ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 10 + , (constr 3 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ (cse + 1000) + , cse ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ (cse + 200) + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 11 + , (constr 3 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ (cse + 10) + , cse ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 16 + , (constr 1 + [ (constr 1 + [ cse + , cse ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 17 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 3000 + , cse ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 6500 + , (constr 0 + [ ]) ]) ]) + , cse ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 18 + , (constr 0 + [ ]) ]) + , (constr 1 + [ (constr 0 + [ 19 + , (constr 2 + [ (constr 1 + [ (constr 3 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ (cse + 25) + , (constr 0 + [ ]) ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ (cse + 5) + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) + , (constr 1 + [ (constr 3 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ (cse + 20000) + , (constr 0 + [ ]) ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ (cse + 5000) + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 20 + , (constr 2 + [ (constr 1 + [ (constr 1 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 40000000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) + , (constr 1 + [ (constr 1 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 15000000000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 21 + , (constr 2 + [ (constr 1 + [ (constr 1 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 120000000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) + , (constr 1 + [ (constr 1 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 40000000000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 22 + , (constr 1 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 12288 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 23 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 100 + , cse ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 200 + , (constr 0 + [ ]) ]) ]) + , cse ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 24 + , (constr 1 + [ (constr 1 + [ cse + , (constr 0 + [ ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 25 + , (constr 2 + [ (constr 1 + [ cse + , (constr 1 + [ cse + , (constr 1 + [ cse + , (constr 1 + [ cse + , cse ]) ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 26 + , (constr 2 + [ (constr 1 + [ cse + , (constr 1 + [ cse + , (constr 1 + [ cse + , (constr 1 + [ (constr 3 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ cse + , (constr 1 + [ (unsafeRatio + 13 + 20) + , (constr 0 + [ ]) ]) ]) ]) + , cse ]) ]) + , (constr 1 + [ cse + , (constr 1 + [ cse + , (constr 1 + [ cse + , (constr 1 + [ cse + , (constr 1 + [ (constr 3 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ cse + , cse ]) ]) + , cse ]) ]) + , cse ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 27 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 0 + , (constr 1 + [ 3 + , (constr 0 + [ ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 10 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 28 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 0 + , (constr 1 + [ 18 + , (constr 0 + [ ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 293 + , (constr 0 + [ ]) ]) ]) + , cse ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 29 + , (constr 1 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 15 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 30 + , (constr 1 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 10000000000000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 31 + , (constr 1 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 100000000000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 32 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 13 + , cse ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 37 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 33 + , (constr 3 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , cse ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ (unsafeRatio + 1000 + 1) + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]))) (constr 3 [ (constr 1 [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ cse - , cse ]) ]) - , (constr 0 - [ ]) ]) ]) ])) - (constr 1 - [ (constr 3 - [ (constr 1 + , cse ]) ])) + (constr 3 + [ (constr 1 + [ cse + , (constr 1 [ (constr 0 - [ (constr 1 + [ (constr 0 [ ]) , (constr 1 [ cse - , (constr 0 - [ ]) ]) ]) - , cse ]) ]) - , (constr 0 - [ ]) ])) - (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) + , (constr 1 + [ cse + , (constr 0 + [ ]) ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ])) + (constr 3 + [ (constr 1 + [ cse , (constr 1 - [ cse - , (constr 1 - [ cse - , (constr 0 - [ ]) ]) ]) ]) - , (constr 0 - [ ]) ])) - (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ cse - , (constr 1 - [ cse - , (constr 0 - [ ]) ]) ]) ])) - (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ (cse - 10) - , cse ]) ])) - (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , cse ]) - , (constr 0 - [ ]) ])) + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ cse + , cse ]) ]) + , (constr 0 + [ ]) ]) ]) ])) + (constr 1 + [ (constr 3 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ cse + , (constr 0 + [ ]) ]) ]) + , cse ]) ]) + , (constr 0 + [ ]) ])) + (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ cse + , (constr 1 + [ cse + , (constr 0 + [ ]) ]) ]) ]) + , (constr 0 + [ ]) ])) + (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ cse + , cse ]) ])) (constr 0 [ (constr 1 [ ]) , (constr 1 - [ 0 + [ cse , (constr 1 - [ 1000000 + [ (cse + 100) , (constr 0 [ ]) ]) ]) ])) (constr 1 [ (constr 0 - [ (constr 2 + [ (constr 0 [ ]) , cse ]) , (constr 0 [ ]) ])) - (constr 1 - [ cse - , (constr 0 - [ ]) ])) + (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 0 + , (constr 1 + [ 1000000 + , (constr 0 + [ ]) ]) ]) ])) (constr 1 [ (constr 0 - [ (constr 0 + [ (constr 2 [ ]) - , (constr 1 - [ 500000000 - , (constr 0 - [ ]) ]) ]) + , cse ]) , (constr 0 [ ]) ])) (constr 1 - [ cse + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 500000000 + , (constr 0 + [ ]) ]) ]) , (constr 0 [ ]) ])) (constr 1 [ cse , (constr 0 [ ]) ])) - (cse - 100)) - (constr 0 - [ (constr 1 - [ ]) - , cse ])) + (constr 1 + [ (cse + 4) + , (constr 0 + [ ]) ])) + (constr 1 + [ cse + , (constr 0 + [ ]) ])) (cse - 1)) - (cse 1)) - (cse 10)) - (constr 0 - [ (constr 1 - []) - , (constr 1 - [ 1 - , (constr 0 - [ ]) ]) ])) - (cse 2)) - (cse 5)) - (cse 4)) - (unsafeRatio 9)) - (unsafeRatio 3)) - (unsafeRatio 4)) - (unsafeRatio 51)) - (constr 1 [0, (constr 0 [])])) - (unsafeRatio 0)) - (unsafeRatio 1)) + 10)) + (cse 2)) + (constr 0 + [ (constr 1 + []) + , cse ])) + (cse 1)) + (cse 5)) + (constr 0 + [ (constr 1 []) + , (constr 1 + [ 1 + , (constr 0 + [ ]) ]) ])) + (cse 1)) + (unsafeRatio 9 10)) + (unsafeRatio 4)) + (unsafeRatio 1)) + (unsafeRatio 3)) + (unsafeRatio 51)) + (constr 1 [0, (constr 0 [])])) + (unsafeRatio 0)) ((\s -> s s) (\s arg -> delay @@ -1004,69 +987,58 @@ program (validatePreds (constr 0 [ (\x y -> - force ifThenElse + case (equalsInteger x y) - (constr 0 []) - (constr 1 [])) + [ (constr 1 []) + , (constr 0 []) ]) , `$fOrdInteger_$ccompare` , (\x y -> - force ifThenElse + case (lessThanInteger x y) - (constr 0 []) - (constr 1 [])) + [ (constr 1 []) + , (constr 0 []) ]) , (\x y -> - force ifThenElse + case (lessThanEqualsInteger x y) - (constr 0 []) - (constr 1 [])) + [ (constr 1 []) + , (constr 0 []) ]) , (\x y -> - force ifThenElse + case (lessThanEqualsInteger x y) - (constr 1 []) - (constr 0 [])) + [ (constr 0 []) + , (constr 1 []) ]) , (\x y -> - force ifThenElse + case (lessThanInteger x y) - (constr 1 []) - (constr 0 [])) + [ (constr 0 []) + , (constr 1 []) ]) , (\x y -> force - (force - (force - ifThenElse - (lessThanEqualsInteger - x - y) - (delay - (delay - y)) - (delay - (delay - x))))) + (case + (lessThanEqualsInteger + x + y) + [ (delay x) + , (delay y) ])) , (\x y -> force - (force - (force - ifThenElse - (lessThanEqualsInteger - x - y) - (delay - (delay - x)) - (delay - (delay - y))))) ]) + (case + (lessThanEqualsInteger + x + y) + [ (delay y) + , (delay + x) ])) ]) preds (unIData eta))) , (\paramValues -> @@ -1089,27 +1061,22 @@ program [ (\n' d' -> force - (force - (force - ifThenElse - (equalsInteger - n - n') - (delay - (delay - (force - ifThenElse - (equalsInteger - d - d') - (constr 0 - [ ]) - (constr 1 - [ ])))) - (delay - (delay - (constr 1 - [ ])))))) ]) ]) + (case + (equalsInteger + n + n') + [ (delay + (constr 1 + [ ])) + , (delay + (case + (equalsInteger + d + d') + [ (constr 1 + [ ]) + , (constr 0 + [ ]) ])) ])) ]) ]) , (\ds ds -> case ds @@ -1133,8 +1100,7 @@ program ds [ (\n' d' -> - force - ifThenElse + case (lessThanInteger (multiplyInteger n @@ -1142,10 +1108,10 @@ program (multiplyInteger n' d)) - (constr 0 - [ ]) - (constr 1 - [ ])) ]) ]) + [ (constr 1 + [ ]) + , (constr 0 + [ ]) ]) ]) ]) , `$fOrdRational0_$c<=` , (\ds ds -> case @@ -1155,8 +1121,7 @@ program ds [ (\n' d' -> - force - ifThenElse + case (lessThanEqualsInteger (multiplyInteger n @@ -1164,10 +1129,10 @@ program (multiplyInteger n' d)) - (constr 1 - [ ]) - (constr 0 - [ ])) ]) ]) + [ (constr 0 + [ ]) + , (constr 1 + [ ]) ]) ]) ]) , (\ds ds -> case ds @@ -1176,8 +1141,7 @@ program ds [ (\n' d' -> - force - ifThenElse + case (lessThanInteger (multiplyInteger n @@ -1185,10 +1149,10 @@ program (multiplyInteger n' d)) - (constr 1 - [ ]) - (constr 0 - [ ])) ]) ]) + [ (constr 0 + [ ]) + , (constr 1 + [ ]) ]) ]) ]) , (\x y -> force (case @@ -1210,21 +1174,21 @@ program , (delay y) ])) ]) preds - (force ifThenElse + (case (force nullList (force tailList cse)) - (\ds -> - unsafeRatio - (unIData - (force - headList - cse)) - (unIData - (force - headList - cse))) - (\ds -> error) + [ (\ds -> error) + , (\ds -> + unsafeRatio + (unIData + (force + headList + cse)) + (unIData + (force + headList + cse))) ] (constr 0 []))) (force tailList cse)) (unListData eta))) ])) @@ -1232,10 +1196,9 @@ program case ds [ (\eta -> - force ifThenElse + case (force nullList eta) - (constr 0 []) - (constr 1 [])) + [(constr 1 []), (constr 0 [])]) , (\paramValueHd paramValueTl actualValueData -> @@ -1255,40 +1218,29 @@ program ((\s -> s s) (\s n d -> force - (force - (force ifThenElse - (equalsInteger 0 d) - (delay (delay error)) - (delay - (delay - (force - (force - (force ifThenElse - (lessThanInteger d 0) - (delay - (delay - ((\x -> s s x) - (subtractInteger 0 n) - (subtractInteger 0 d)))) - (delay - (delay - ((\gcd' -> - constr 0 - [ (quotientInteger - n - gcd') - , (quotientInteger - d - gcd') ]) - (euclid n d)))))))))))))) + (case + (equalsInteger 0 d) + [ (delay + (force + (case + (lessThanInteger d 0) + [ (delay + ((\gcd' -> + constr 0 + [ (quotientInteger n gcd') + , (quotientInteger d gcd') ]) + (euclid n d))) + , (delay + ((\x -> s s x) + (subtractInteger 0 n) + (subtractInteger 0 d))) ]))) + , (delay error) ])))) ((\s -> s s) (\s x y -> force - (force - (force ifThenElse - (equalsInteger 0 y) - (delay (delay x)) - (delay (delay (s s y (modInteger x y))))))))) + (case + (equalsInteger 0 y) + [(delay (s s y (modInteger x y))), (delay x)])))) (\`$dOrd` ds ds -> (\s -> s s) (\s ds -> @@ -1357,18 +1309,14 @@ program ds)) (\eta eta -> force - (force - (force ifThenElse - (equalsInteger eta eta) - (delay (delay (constr 0 []))) - (delay - (delay - (force - (force - (force ifThenElse - (lessThanEqualsInteger eta eta) - (delay (delay (constr 2 []))) - (delay (delay (constr 1 [])))))))))))) + (case + (equalsInteger eta eta) + [ (delay + (force + (case + (lessThanEqualsInteger eta eta) + [(delay (constr 1 [])), (delay (constr 2 []))]))) + , (delay (constr 0 [])) ]))) (\ds ds -> case ds @@ -1376,9 +1324,8 @@ program case ds [ (\n' d' -> - force ifThenElse + case (lessThanEqualsInteger (multiplyInteger n d') (multiplyInteger n' d)) - (constr 0 []) - (constr 1 [])) ]) ])) \ No newline at end of file + [(constr 1 []), (constr 0 [])]) ]) ])) \ No newline at end of file diff --git a/cardano-constitution/test/Cardano/Constitution/Validator/Data/GoldenTests/unsorted.cbor.size.golden b/cardano-constitution/test/Cardano/Constitution/Validator/Data/GoldenTests/unsorted.cbor.size.golden index 936a4209aef..1c412146757 100644 --- a/cardano-constitution/test/Cardano/Constitution/Validator/Data/GoldenTests/unsorted.cbor.size.golden +++ b/cardano-constitution/test/Cardano/Constitution/Validator/Data/GoldenTests/unsorted.cbor.size.golden @@ -1 +1 @@ -2159 \ No newline at end of file +2082 \ No newline at end of file diff --git a/cardano-constitution/test/Cardano/Constitution/Validator/Data/GoldenTests/unsorted.large.budget.golden b/cardano-constitution/test/Cardano/Constitution/Validator/Data/GoldenTests/unsorted.large.budget.golden index 0ca87ee85a0..e9b04a5dfe4 100644 --- a/cardano-constitution/test/Cardano/Constitution/Validator/Data/GoldenTests/unsorted.large.budget.golden +++ b/cardano-constitution/test/Cardano/Constitution/Validator/Data/GoldenTests/unsorted.large.budget.golden @@ -1 +1 @@ -ExBudget {exBudgetCPU = ExCPU 864058341, exBudgetMemory = ExMemory 4264788} \ No newline at end of file +ExBudget {exBudgetCPU = ExCPU 660323564, exBudgetMemory = ExMemory 3405515} \ No newline at end of file diff --git a/cardano-constitution/test/Cardano/Constitution/Validator/Data/GoldenTests/unsorted.pir.golden b/cardano-constitution/test/Cardano/Constitution/Validator/Data/GoldenTests/unsorted.pir.golden index 54bad3bb4d7..57e2ec154aa 100644 --- a/cardano-constitution/test/Cardano/Constitution/Validator/Data/GoldenTests/unsorted.pir.golden +++ b/cardano-constitution/test/Cardano/Constitution/Validator/Data/GoldenTests/unsorted.pir.golden @@ -136,18 +136,15 @@ program {all dead. dead} in go ds - !equalsInteger : integer -> integer -> Bool - = \(x : integer) (y : integer) -> - ifThenElse {Bool} (equalsInteger x y) True False !`$fOrdInteger_$ccompare` : integer -> integer -> Ordering = \(eta : integer) (eta : integer) -> Bool_match - (ifThenElse {Bool} (equalsInteger eta eta) True False) + (case Bool (equalsInteger eta eta) [False, True]) {all dead. Ordering} (/\dead -> EQ) (/\dead -> Bool_match - (ifThenElse {Bool} (lessThanEqualsInteger eta eta) True False) + (case Bool (lessThanEqualsInteger eta eta) [False, True]) {all dead. Ordering} (/\dead -> LT) (/\dead -> GT) @@ -165,19 +162,18 @@ program ds {Bool} (\(n' : integer) (d' : integer) -> - ifThenElse - {Bool} + case + Bool (lessThanEqualsInteger (multiplyInteger n d') (multiplyInteger n' d)) - True - False)) + [False, True])) in letrec !euclid : integer -> integer -> integer = \(x : integer) (y : integer) -> Bool_match - (ifThenElse {Bool} (equalsInteger 0 y) True False) + (case Bool (equalsInteger 0 y) [False, True]) {all dead. integer} (/\dead -> x) (/\dead -> euclid y (modInteger x y)) @@ -187,12 +183,12 @@ program !unsafeRatio : integer -> integer -> Rational = \(n : integer) (d : integer) -> Bool_match - (ifThenElse {Bool} (equalsInteger 0 d) True False) + (case Bool (equalsInteger 0 d) [False, True]) {all dead. Rational} (/\dead -> error {Rational}) (/\dead -> Bool_match - (ifThenElse {Bool} (lessThanInteger d 0) True False) + (case Bool (lessThanInteger d 0) [False, True]) {all dead. Rational} (/\dead -> unsafeRatio (subtractInteger 0 n) (subtractInteger 0 d)) @@ -214,6 +210,8 @@ program (\v -> List (Tuple2 PredKey (List v))) Rational -> ParamValue in let + !ifThenElse : all a. bool -> a -> a -> a + = /\a -> \(b : bool) (x : a) (y : a) -> case a b [y, x] data Unit | Unit_match where Unit : Unit in @@ -234,16 +232,13 @@ program {integer} (CConsOrd {integer} - equalsInteger + (\(x : integer) (y : integer) -> + case Bool (equalsInteger x y) [False, True]) `$fOrdInteger_$ccompare` (\(x : integer) (y : integer) -> - ifThenElse {Bool} (lessThanInteger x y) True False) + case Bool (lessThanInteger x y) [False, True]) (\(x : integer) (y : integer) -> - ifThenElse - {Bool} - (lessThanEqualsInteger x y) - True - False) + case Bool (lessThanEqualsInteger x y) [False, True]) (\(x : integer) (y : integer) -> ifThenElse {Bool} @@ -254,22 +249,14 @@ program ifThenElse {Bool} (lessThanInteger x y) False True) (\(x : integer) (y : integer) -> Bool_match - (ifThenElse - {Bool} - (lessThanEqualsInteger x y) - True - False) + (case Bool (lessThanEqualsInteger x y) [False, True]) {all dead. integer} (/\dead -> y) (/\dead -> x) {all dead. dead}) (\(x : integer) (y : integer) -> Bool_match - (ifThenElse - {Bool} - (lessThanEqualsInteger x y) - True - False) + (case Bool (lessThanEqualsInteger x y) [False, True]) {all dead. integer} (/\dead -> x) (/\dead -> y) @@ -294,18 +281,16 @@ program {Bool} (\(n' : integer) (d' : integer) -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger n n') - True - False) + [False, True]) {all dead. Bool} (/\dead -> - ifThenElse - {Bool} + case + Bool (equalsInteger d d') - True - False) + [False, True]) (/\dead -> False) {all dead. dead}))) (\(ds : Rational) (ds : Rational) -> @@ -329,13 +314,12 @@ program ds {Bool} (\(n' : integer) (d' : integer) -> - ifThenElse - {Bool} + case + Bool (lessThanInteger (multiplyInteger n d') (multiplyInteger n' d)) - True - False))) + [False, True]))) `$fOrdRational0_$c<=` (\(ds : Rational) (ds : Rational) -> Rational_match @@ -346,11 +330,13 @@ program ds {Bool} (\(n' : integer) (d' : integer) -> + let + !x : integer = multiplyInteger n d' + !y : integer = multiplyInteger n' d + in ifThenElse {Bool} - (lessThanEqualsInteger - (multiplyInteger n d') - (multiplyInteger n' d)) + (lessThanEqualsInteger x y) False True))) (\(ds : Rational) (ds : Rational) -> @@ -362,11 +348,13 @@ program ds {Bool} (\(n' : integer) (d' : integer) -> + let + !x : integer = multiplyInteger n d' + !y : integer = multiplyInteger n' d + in ifThenElse {Bool} - (lessThanInteger - (multiplyInteger n d') - (multiplyInteger n' d)) + (lessThanInteger x y) False True))) (\(x : Rational) (y : Rational) -> @@ -401,7 +389,7 @@ program ds {list data -> Bool} (\(eta : list data) -> - ifThenElse {Bool} (nullList {data} eta) True False) + case Bool (nullList {data} eta) [False, True]) (\(paramValueHd : ParamValue) (paramValueTl : List ParamValue) (actualValueData : list data) -> @@ -431,12 +419,12 @@ program !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 1 index) True False) + (case Bool (equalsInteger 1 index) [False, True]) {all dead. Maybe a} (/\dead -> Nothing {a}) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. Maybe a} (/\dead -> Just {a} (`$dUnsafeFromData` (headList {data} args))) @@ -5223,7 +5211,10 @@ program {ParamValue} (\(k' : integer) (i : ParamValue) -> Bool_match - (equalsInteger k k') + (case + Bool + (equalsInteger k k') + [False, True]) {all dead. ParamValue} (/\dead -> i) (/\dead -> go xs') @@ -5264,13 +5255,12 @@ program (unConstrData ds))))) in Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 5 (fstPair {integer} {list data} tup)) - True - False) + [False, True]) {all dead. data} (/\dead -> headList @@ -5291,11 +5281,10 @@ program !tup : pair integer (list data) = unConstrData scrut in Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 0 (fstPair {integer} {list data} tup)) - True - False) + [False, True]) {all dead. r} (/\dead -> let @@ -5331,11 +5320,10 @@ program !tup : pair integer (list data) = unConstrData scrut in Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 2 (fstPair {integer} {list data} tup)) - True - False) + [False, True]) {all dead. r} (/\dead -> let diff --git a/cardano-constitution/test/Cardano/Constitution/Validator/Data/GoldenTests/unsorted.small.budget.golden b/cardano-constitution/test/Cardano/Constitution/Validator/Data/GoldenTests/unsorted.small.budget.golden index 26229563502..cc35217a63c 100644 --- a/cardano-constitution/test/Cardano/Constitution/Validator/Data/GoldenTests/unsorted.small.budget.golden +++ b/cardano-constitution/test/Cardano/Constitution/Validator/Data/GoldenTests/unsorted.small.budget.golden @@ -1 +1 @@ -ExBudget {exBudgetCPU = ExCPU 83791267, exBudgetMemory = ExMemory 367803} \ No newline at end of file +ExBudget {exBudgetCPU = ExCPU 64618367, exBudgetMemory = ExMemory 295403} \ No newline at end of file diff --git a/cardano-constitution/test/Cardano/Constitution/Validator/Data/GoldenTests/unsorted.uplc.golden b/cardano-constitution/test/Cardano/Constitution/Validator/Data/GoldenTests/unsorted.uplc.golden index 6851b2fb285..28a44b1a602 100644 --- a/cardano-constitution/test/Cardano/Constitution/Validator/Data/GoldenTests/unsorted.uplc.golden +++ b/cardano-constitution/test/Cardano/Constitution/Validator/Data/GoldenTests/unsorted.uplc.golden @@ -2,14 +2,14 @@ program 1.1.0 ((\`$fOrdRational0_$c<=` -> (\`$fOrdInteger_$ccompare` -> - (\equalsInteger -> - (\validatePreds -> - (\euclid -> - (\unsafeRatio -> - (\cse -> - (\validateParamValue -> - (\validateParamValues -> - (\caseData_go -> + (\validatePreds -> + (\euclid -> + (\unsafeRatio -> + (\cse -> + (\validateParamValue -> + (\validateParamValues -> + (\caseData_go -> + (\cse -> (\cse -> (\cse -> (\cse -> @@ -39,27 +39,74 @@ program (\cse -> (\cse -> (\cse -> - (\cse -> - (\cfg -> - (\fun - ds -> - force - (case - ((\cse -> - (\cse -> - force + (\cfg -> + (\fun + ds -> + force + (case + ((\cse -> + (\cse -> + force + (case + (equalsInteger + 0 + cse) + [ (delay + (force + (case + (equalsInteger + 2 + cse) + [ (delay + error) + , (delay + ((\l -> + constr 1 + [ ]) + (force + (force + sndPair) + cse))) ]))) + , (delay + (constr 0 + [ (force + caseData_go + (unMapData + (force + headList + (force + tailList + (force + (force + sndPair) + cse))))) ])) ])) + (force + (force + fstPair) + cse)) + (unConstrData + (force + headList + (force + tailList (force + tailList (force - ifThenElse - (equalsInteger - 0 - cse) - (delay - (delay - (constr 0 - [ (force - caseData_go - (unMapData + (force + sndPair) + (unConstrData + ((\tup -> + force + (case + (equalsInteger + 5 + (force + (force + fstPair) + tup)) + [ (delay + error) + , (delay (force headList (force @@ -67,765 +114,693 @@ program (force (force sndPair) - cse))))) ]))) - (delay - (delay - (force + tup)))) ])) + (unConstrData (force + headList (force - ifThenElse - (equalsInteger - 2 - cse) - (delay - (delay - ((\l -> - constr 1 - [ ]) - (force - (force - sndPair) - cse)))) - (delay - (delay - error)))))))))) - (force - (force - fstPair) - cse)) - (unConstrData - (force - headList - (force - tailList - (force - tailList - (force - (force - sndPair) - (unConstrData - ((\tup -> - force - (force - (force - ifThenElse - (equalsInteger - 5 - (force - (force - fstPair) - tup)) - (delay - (delay - (force - headList - (force - tailList - (force - (force - sndPair) - tup))))) - (delay - (delay - error))))) - (unConstrData - (force - headList + tailList (force tailList (force - tailList (force - (force - sndPair) - (unConstrData - ds)))))))))))))) - [ (\cparams -> - delay - (force - (case - (fun - cparams) - [ (delay - ()) - , (delay - error) ]))) - , (delay - ()) ])) - ((\go - eta -> - go - eta) - ((\s -> - s - s) - (\s - ds -> - force - (case - ds - [ (delay - (constr 0 - [ ])) - , (\x - xs -> - delay - (force + sndPair) + (unConstrData + ds)))))))))))))) + [ (\cparams -> + delay + (force + (case + (fun + cparams) + [ (delay + ()) + , (delay + error) ]))) + , (delay + ()) ])) + ((\go + eta -> + go + eta) + ((\s -> + s + s) + (\s + ds -> + force + (case + ds + [ (delay + (constr 0 + [ ])) + , (\x + xs -> + delay + (force + (case (case - (case - x - [ (\ds - actualValueData -> - validateParamValue - ((\k -> - (\s -> - s - s) - (\s - ds -> - force - (case - ds - [ (delay - error) - , (\ds - xs' -> - delay - (case - ds - [ (\k' - i -> - force - (case - (equalsInteger - k - k') - [ (delay - i) - , (delay - (s - s - xs')) ])) ])) ]))) - (unIData - ds) - cfg) - actualValueData) ]) - [ (delay - (s - s - xs)) - , (delay - (constr 1 - [ ])) ]))) ]))))) - (constr 1 - [ (constr 0 - [ 0 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 30 - , cse ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 1000 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 1 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 100000 - , cse ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 10000000 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 2 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 24576 - , (constr 0 - [ ]) ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 122880 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 3 - , (constr 1 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 32768 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 4 - , (constr 1 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 5000 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 5 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 1000000 - , cse ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 5000000 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 6 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 250000000 - , cse ]) ]) - , cse ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 7 - , (constr 1 - [ (constr 1 - [ cse - , (constr 0 - [ ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 8 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 250 - , cse ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 2000 - , (constr 0 - [ ]) ]) ]) - , cse ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 9 - , (constr 3 - [ (constr 1 - [ cse - , cse ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 10 - , (constr 3 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ (cse - 1000) - , cse ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ (cse - 200) - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 11 - , (constr 3 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ (cse - 10) - , cse ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 16 - , (constr 1 - [ (constr 1 - [ cse - , cse ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 17 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 3000 - , cse ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 6500 - , (constr 0 - [ ]) ]) ]) - , cse ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 18 - , (constr 0 - [ ]) ]) - , (constr 1 - [ (constr 0 - [ 19 - , (constr 2 - [ (constr 1 - [ (constr 3 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ (cse - 25) - , (constr 0 - [ ]) ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ (cse - 5) - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) - , (constr 1 - [ (constr 3 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ (cse - 20000) - , (constr 0 - [ ]) ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ (cse - 5000) - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 20 - , (constr 2 - [ (constr 1 - [ (constr 1 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 40000000 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) - , (constr 1 - [ (constr 1 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 15000000000 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 21 - , (constr 2 - [ (constr 1 - [ (constr 1 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 120000000 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) - , (constr 1 - [ (constr 1 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 40000000000 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 22 - , (constr 1 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 12288 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 23 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 100 - , cse ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 200 - , (constr 0 - [ ]) ]) ]) - , cse ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 24 - , (constr 1 - [ (constr 1 - [ cse - , (constr 0 - [ ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 25 - , (constr 2 - [ (constr 1 - [ cse - , (constr 1 - [ cse - , (constr 1 - [ cse - , (constr 1 - [ cse - , cse ]) ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 26 - , (constr 2 - [ (constr 1 - [ cse - , (constr 1 - [ cse - , (constr 1 - [ cse - , (constr 1 - [ (constr 3 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ cse - , (constr 1 - [ (unsafeRatio - 13 - 20) - , (constr 0 - [ ]) ]) ]) ]) - , cse ]) ]) - , (constr 1 - [ cse - , (constr 1 - [ cse - , (constr 1 - [ cse - , (constr 1 - [ cse - , (constr 1 - [ (constr 3 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ cse - , cse ]) ]) - , cse ]) ]) - , cse ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 27 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 0 - , (constr 1 - [ 3 - , (constr 0 - [ ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 10 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 28 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 0 - , (constr 1 - [ 18 - , (constr 0 - [ ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 293 - , (constr 0 - [ ]) ]) ]) - , cse ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 29 - , (constr 1 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 15 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 30 - , (constr 1 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 10000000000000 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 31 - , (constr 1 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 100000000000 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 32 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 13 - , cse ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 37 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 33 - , (constr 3 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , cse ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ (unsafeRatio - 1000 - 1) - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ])) - (constr 3 - [ (constr 1 - [ cse - , cse ]) ])) + x + [ (\ds + actualValueData -> + validateParamValue + ((\k -> + (\s -> + s + s) + (\s + ds -> + force + (case + ds + [ (delay + error) + , (\ds + xs' -> + delay + (case + ds + [ (\k' + i -> + force + (case + (equalsInteger + k + k') + [ (delay + (s + s + xs')) + , (delay + i) ])) ])) ]))) + (unIData + ds) + cfg) + actualValueData) ]) + [ (delay + (s + s + xs)) + , (delay + (constr 1 + [ ])) ]))) ]))))) + (constr 1 + [ (constr 0 + [ 0 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 30 + , cse ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 1000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 1 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 100000 + , cse ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 10000000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 2 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 24576 + , (constr 0 + [ ]) ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 122880 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 3 + , (constr 1 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 32768 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 4 + , (constr 1 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 5000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 5 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 1000000 + , cse ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 5000000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 6 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 250000000 + , cse ]) ]) + , cse ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 7 + , (constr 1 + [ (constr 1 + [ cse + , (constr 0 + [ ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 8 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 250 + , cse ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 2000 + , (constr 0 + [ ]) ]) ]) + , cse ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 9 + , (constr 3 + [ (constr 1 + [ cse + , cse ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 10 + , (constr 3 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ (cse + 1000) + , cse ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ (cse + 200) + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 11 + , (constr 3 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ (cse + 10) + , cse ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 16 + , (constr 1 + [ (constr 1 + [ cse + , cse ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 17 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 3000 + , cse ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 6500 + , (constr 0 + [ ]) ]) ]) + , cse ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 18 + , (constr 0 + [ ]) ]) + , (constr 1 + [ (constr 0 + [ 19 + , (constr 2 + [ (constr 1 + [ (constr 3 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ (cse + 25) + , (constr 0 + [ ]) ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ (cse + 5) + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) + , (constr 1 + [ (constr 3 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ (cse + 20000) + , (constr 0 + [ ]) ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ (cse + 5000) + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 20 + , (constr 2 + [ (constr 1 + [ (constr 1 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 40000000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) + , (constr 1 + [ (constr 1 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 15000000000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 21 + , (constr 2 + [ (constr 1 + [ (constr 1 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 120000000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) + , (constr 1 + [ (constr 1 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 40000000000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 22 + , (constr 1 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 12288 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 23 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 100 + , cse ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 200 + , (constr 0 + [ ]) ]) ]) + , cse ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 24 + , (constr 1 + [ (constr 1 + [ cse + , (constr 0 + [ ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 25 + , (constr 2 + [ (constr 1 + [ cse + , (constr 1 + [ cse + , (constr 1 + [ cse + , (constr 1 + [ cse + , cse ]) ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 26 + , (constr 2 + [ (constr 1 + [ cse + , (constr 1 + [ cse + , (constr 1 + [ cse + , (constr 1 + [ (constr 3 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ cse + , (constr 1 + [ (unsafeRatio + 13 + 20) + , (constr 0 + [ ]) ]) ]) ]) + , cse ]) ]) + , (constr 1 + [ cse + , (constr 1 + [ cse + , (constr 1 + [ cse + , (constr 1 + [ cse + , (constr 1 + [ (constr 3 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ cse + , cse ]) ]) + , cse ]) ]) + , cse ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 27 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 0 + , (constr 1 + [ 3 + , (constr 0 + [ ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 10 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 28 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 0 + , (constr 1 + [ 18 + , (constr 0 + [ ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 293 + , (constr 0 + [ ]) ]) ]) + , cse ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 29 + , (constr 1 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 15 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 30 + , (constr 1 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 10000000000000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 31 + , (constr 1 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 100000000000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 32 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 13 + , cse ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 37 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 33 + , (constr 3 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , cse ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ (unsafeRatio + 1000 + 1) + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ])) (constr 3 [ (constr 1 [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ cse - , cse ]) ]) - , (constr 0 - [ ]) ]) ]) ])) + , cse ]) ])) (constr 3 [ (constr 1 [ cse @@ -841,82 +816,90 @@ program [ ]) ]) ]) ]) , (constr 0 [ ]) ]) ]) ])) - (constr 1 - [ (constr 3 - [ (constr 1 + (constr 3 + [ (constr 1 + [ cse + , (constr 1 [ (constr 0 - [ (constr 1 + [ (constr 0 [ ]) , (constr 1 [ cse - , (constr 0 - [ ]) ]) ]) - , cse ]) ]) - , (constr 0 - [ ]) ])) + , cse ]) ]) + , (constr 0 + [ ]) ]) ]) ])) (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ cse - , (constr 1 - [ cse - , (constr 0 - [ ]) ]) ]) ]) + [ (constr 3 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ cse + , (constr 0 + [ ]) ]) ]) + , cse ]) ]) , (constr 0 [ ]) ])) - (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ cse + (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) , (constr 1 [ cse - , (constr 0 - [ ]) ]) ]) ])) + , (constr 1 + [ cse + , (constr 0 + [ ]) ]) ]) ]) + , (constr 0 + [ ]) ])) (constr 0 [ (constr 1 [ ]) , (constr 1 - [ (cse - 10) + [ cse , cse ]) ])) - (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , cse ]) - , (constr 0 - [ ]) ])) - (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 0 - , (constr 1 - [ 1000000 - , (constr 0 - [ ]) ]) ]) ])) - (constr 1 - [ (constr 0 - [ (constr 2 - [ ]) - , cse ]) - , (constr 0 - [ ]) ])) + (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ cse + , (constr 1 + [ (cse + 100) + , (constr 0 + [ ]) ]) ]) ])) + (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , cse ]) + , (constr 0 + [ ]) ])) + (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 0 + , (constr 1 + [ 1000000 + , (constr 0 + [ ]) ]) ]) ])) (constr 1 [ (constr 0 - [ (constr 0 + [ (constr 2 [ ]) - , (constr 1 - [ 500000000 - , (constr 0 - [ ]) ]) ]) + , cse ]) , (constr 0 [ ]) ])) (constr 1 - [ cse + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 500000000 + , (constr 0 + [ ]) ]) ]) , (constr 0 [ ]) ])) (constr 1 @@ -927,467 +910,417 @@ program [ cse , (constr 0 [ ]) ])) - (cse - 5)) + (constr 1 + [ cse + , (constr 0 + [ ]) ])) (cse - 10)) + 2)) (cse - 1)) - (constr 0 - [ (constr 1 - [ ]) - , cse ])) - (cse 4)) + 10)) + (cse 1)) + (cse 1)) (constr 0 [ (constr 1 []) - , (constr 1 - [ 1 - , (constr 0 - [ ]) ]) ])) - (cse 2)) - (cse 100)) - (cse 1)) - (unsafeRatio 3)) - (unsafeRatio 51)) - (unsafeRatio 1)) - (constr 1 [0, (constr 0 [])])) - (unsafeRatio 4)) - (unsafeRatio 9)) - (unsafeRatio 0)) - ((\s -> s s) - (\s arg -> - delay - (\xs -> - force - (force (force chooseList) - xs - (delay (constr 0 [])) - (delay - ((\x -> - constr 1 - [ (constr 0 - [ (force - (force - fstPair) - x) - , (force - (force - sndPair) - x) ]) - , (force - (s - s - (delay - (\x -> x))) - (force tailList - xs)) ]) - (force headList xs)))))) - (delay (\x -> x)))) - (cse (\arg_0 arg_1 -> arg_1))) - (cse (\arg_0 arg_1 -> arg_0))) - (force - ((\s -> s s) - (\s h -> - delay - (\fr -> - (\k -> - fr - (\x -> k (\f_0 f_1 -> f_0 x)) - (\x -> k (\f_0 f_1 -> f_1 x))) - (\fq -> force (s s h) (force h fq)))) - (delay - (\choose - validateParamValue - validateParamValues -> - choose - (\eta eta -> + , cse ])) + (cse 5)) + (cse 10)) + (constr 0 + [ (constr 1 []) + , (constr 1 + [ 1 + , (constr 0 + []) ]) ])) + (cse 4)) + (unsafeRatio 3)) + (unsafeRatio 9)) + (unsafeRatio 1)) + (constr 1 [0, (constr 0 [])])) + (unsafeRatio 51)) + (unsafeRatio 4)) + (unsafeRatio 0)) + ((\s -> s s) + (\s arg -> + delay + (\xs -> force - (case - eta - [ (delay (constr 0 [])) - , (\preds -> - delay - (validatePreds - (constr 0 - [ equalsInteger - , `$fOrdInteger_$ccompare` - , (\x y -> - force ifThenElse - (lessThanInteger - x - y) - (constr 0 []) - (constr 1 [])) - , (\x y -> - force ifThenElse + (force (force chooseList) + xs + (delay (constr 0 [])) + (delay + ((\x -> + constr 1 + [ (constr 0 + [ (force + (force fstPair) + x) + , (force + (force sndPair) + x) ]) + , (force + (s + s + (delay (\x -> x))) + (force tailList + xs)) ]) + (force headList xs)))))) + (delay (\x -> x)))) + (cse (\arg_0 arg_1 -> arg_1))) + (cse (\arg_0 arg_1 -> arg_0))) + (force + ((\s -> s s) + (\s h -> + delay + (\fr -> + (\k -> + fr + (\x -> k (\f_0 f_1 -> f_0 x)) + (\x -> k (\f_0 f_1 -> f_1 x))) + (\fq -> force (s s h) (force h fq)))) + (delay + (\choose validateParamValue validateParamValues -> + choose + (\eta eta -> + force + (case + eta + [ (delay (constr 0 [])) + , (\preds -> + delay + (validatePreds + (constr 0 + [ (\x y -> + case + (equalsInteger + x + y) + [ (constr 1 []) + , (constr 0 []) ]) + , `$fOrdInteger_$ccompare` + , (\x y -> + case + (lessThanInteger + x + y) + [ (constr 1 []) + , (constr 0 []) ]) + , (\x y -> + case + (lessThanEqualsInteger + x + y) + [ (constr 1 []) + , (constr 0 []) ]) + , (\x y -> + case + (lessThanEqualsInteger + x + y) + [ (constr 0 []) + , (constr 1 []) ]) + , (\x y -> + case + (lessThanInteger + x + y) + [ (constr 0 []) + , (constr 1 []) ]) + , (\x y -> + force + (case (lessThanEqualsInteger x y) - (constr 0 []) - (constr 1 [])) - , (\x y -> - force ifThenElse + [ (delay x) + , (delay y) ])) + , (\x y -> + force + (case (lessThanEqualsInteger x y) - (constr 1 []) - (constr 0 [])) - , (\x y -> - force ifThenElse - (lessThanInteger - x - y) - (constr 1 []) - (constr 0 [])) - , (\x y -> - force - (force - (force - ifThenElse - (lessThanEqualsInteger - x - y) - (delay - (delay - y)) - (delay - (delay - x))))) - , (\x y -> - force - (force - (force - ifThenElse - (lessThanEqualsInteger - x - y) - (delay - (delay - x)) - (delay - (delay - y))))) ]) - preds - (unIData eta))) - , (\paramValues -> - delay - (validateParamValues - paramValues - (unListData eta))) - , (\preds -> - delay - ((\cse -> - (\cse -> - validatePreds - (constr 0 - [ (\ds ds -> - case - ds - [ (\n - d -> - case - ds - [ (\n' - d' -> - force - (force - (force - ifThenElse - (equalsInteger - n - n') - (delay - (delay - (force - ifThenElse - (equalsInteger - d - d') - (constr 0 - [ ]) - (constr 1 - [ ])))) - (delay - (delay - (constr 1 - [ ])))))) ]) ]) - , (\ds ds -> - case - ds - [ (\n - d -> - case - ds - [ (\n' - d' -> - `$fOrdInteger_$ccompare` + [ (delay y) + , (delay + x) ])) ]) + preds + (unIData eta))) + , (\paramValues -> + delay + (validateParamValues + paramValues + (unListData eta))) + , (\preds -> + delay + ((\cse -> + (\cse -> + validatePreds + (constr 0 + [ (\ds ds -> + case + ds + [ (\n d -> + case + ds + [ (\n' + d' -> + force + (case + (equalsInteger + n + n') + [ (delay + (constr 1 + [ ])) + , (delay + (case + (equalsInteger + d + d') + [ (constr 1 + [ ]) + , (constr 0 + [ ]) ])) ])) ]) ]) + , (\ds ds -> + case + ds + [ (\n d -> + case + ds + [ (\n' + d' -> + `$fOrdInteger_$ccompare` + (multiplyInteger + n + d') + (multiplyInteger + n' + d)) ]) ]) + , (\ds ds -> + case + ds + [ (\n d -> + case + ds + [ (\n' + d' -> + case + (lessThanInteger (multiplyInteger n d') (multiplyInteger n' - d)) ]) ]) - , (\ds ds -> - case - ds - [ (\n - d -> - case - ds - [ (\n' - d' -> - force - ifThenElse - (lessThanInteger - (multiplyInteger - n - d') - (multiplyInteger - n' - d)) - (constr 0 - [ ]) - (constr 1 - [ ])) ]) ]) - , `$fOrdRational0_$c<=` - , (\ds ds -> - case - ds - [ (\n - d -> - case - ds - [ (\n' - d' -> - force - ifThenElse - (lessThanEqualsInteger - (multiplyInteger - n - d') - (multiplyInteger - n' - d)) - (constr 1 - [ ]) - (constr 0 - [ ])) ]) ]) - , (\ds ds -> - case - ds - [ (\n - d -> - case - ds - [ (\n' - d' -> - force - ifThenElse - (lessThanInteger - (multiplyInteger - n - d') - (multiplyInteger - n' - d)) - (constr 1 - [ ]) - (constr 0 - [ ])) ]) ]) - , (\x y -> - force - (case - (`$fOrdRational0_$c<=` - x - y) - [ (delay - y) - , (delay - x) ])) - , (\x y -> - force - (case - (`$fOrdRational0_$c<=` - x - y) - [ (delay - x) - , (delay - y) ])) ]) - preds - (force ifThenElse - (force nullList - (force - tailList - cse)) - (\ds -> - unsafeRatio - (unIData - (force - headList - cse)) - (unIData - (force - headList - cse))) - (\ds -> error) - (constr 0 []))) - (force tailList cse)) - (unListData eta))) ])) - (\ds -> - case - ds - [ (\eta -> - force ifThenElse - (force nullList eta) - (constr 0 []) - (constr 1 [])) - , (\paramValueHd - paramValueTl - actualValueData -> - force - (case - (validateParamValue - paramValueHd - (force headList - actualValueData)) - [ (delay - (validateParamValues - paramValueTl - (force tailList - actualValueData))) - , (delay - (constr 1 - [])) ])) ])))))) - ((\s -> s s) - (\s n d -> - force - (force - (force ifThenElse - (equalsInteger 0 d) - (delay (delay error)) - (delay - (delay - (force - (force - (force ifThenElse - (lessThanInteger d 0) - (delay - (delay - ((\x -> s s x) - (subtractInteger 0 n) - (subtractInteger - 0 - d)))) - (delay - (delay - ((\gcd' -> - constr 0 - [ (quotientInteger - n - gcd') - , (quotientInteger - d - gcd') ]) - (euclid - n - d)))))))))))))) + d)) + [ (constr 1 + [ ]) + , (constr 0 + [ ]) ]) ]) ]) + , `$fOrdRational0_$c<=` + , (\ds ds -> + case + ds + [ (\n d -> + case + ds + [ (\n' + d' -> + case + (lessThanEqualsInteger + (multiplyInteger + n + d') + (multiplyInteger + n' + d)) + [ (constr 0 + [ ]) + , (constr 1 + [ ]) ]) ]) ]) + , (\ds ds -> + case + ds + [ (\n d -> + case + ds + [ (\n' + d' -> + case + (lessThanInteger + (multiplyInteger + n + d') + (multiplyInteger + n' + d)) + [ (constr 0 + [ ]) + , (constr 1 + [ ]) ]) ]) ]) + , (\x y -> + force + (case + (`$fOrdRational0_$c<=` + x + y) + [ (delay + y) + , (delay + x) ])) + , (\x y -> + force + (case + (`$fOrdRational0_$c<=` + x + y) + [ (delay + x) + , (delay + y) ])) ]) + preds + (case + (force nullList + (force tailList + cse)) + [ (\ds -> error) + , (\ds -> + unsafeRatio + (unIData + (force + headList + cse)) + (unIData + (force + headList + cse))) ] + (constr 0 []))) + (force tailList cse)) + (unListData eta))) ])) + (\ds -> + case + ds + [ (\eta -> + case + (force nullList eta) + [(constr 1 []), (constr 0 [])]) + , (\paramValueHd + paramValueTl + actualValueData -> + force + (case + (validateParamValue + paramValueHd + (force headList + actualValueData)) + [ (delay + (validateParamValues + paramValueTl + (force tailList + actualValueData))) + , (delay + (constr 1 [])) ])) ])))))) ((\s -> s s) - (\s x y -> + (\s n d -> force - (force - (force ifThenElse - (equalsInteger 0 y) - (delay (delay x)) - (delay (delay (s s y (modInteger x y))))))))) - (\`$dOrd` ds ds -> - (\s -> s s) - (\s ds -> - force - (case - ds - [ (delay (constr 0 [])) - , (\x xs -> - delay - (case - x - [ (\predKey expectedPredValues -> - (\meaning -> - (\s -> s s) - (\s ds -> - force + (case + (equalsInteger 0 d) + [ (delay + (force + (case + (lessThanInteger d 0) + [ (delay + ((\gcd' -> + constr 0 + [ (quotientInteger n gcd') + , (quotientInteger d gcd') ]) + (euclid n d))) + , (delay + ((\x -> s s x) + (subtractInteger 0 n) + (subtractInteger 0 d))) ]))) + , (delay error) ])))) + ((\s -> s s) + (\s x y -> + force + (case + (equalsInteger 0 y) + [(delay (s s y (modInteger x y))), (delay x)])))) + (\`$dOrd` ds ds -> + (\s -> s s) + (\s ds -> + force + (case + ds + [ (delay (constr 0 [])) + , (\x xs -> + delay + (case + x + [ (\predKey expectedPredValues -> + (\meaning -> + (\s -> s s) + (\s ds -> + force + (case + ds + [ (delay (s s xs)) + , (\x xs -> + delay + (force + (case + (meaning x ds) + [ (delay + (s s xs)) + , (delay + (constr 1 + [ ])) ]))) ])) + expectedPredValues) + (force + (case + predKey + [ (delay + (case + `$dOrd` + [ (\v v v v v v v v -> + v) ])) + , (delay (case - ds - [ (delay (s s xs)) - , (\x xs -> - delay - (force - (case - (meaning - x - ds) - [ (delay - (s - s - xs)) - , (delay - (constr 1 - [ ])) ]))) ])) - expectedPredValues) - (force - (case - predKey - [ (delay - (case - `$dOrd` - [ (\v v v v v v v v -> - v) ])) - , (delay - (case - `$dOrd` - [ (\v v v v v v v v -> - v) ])) - , (delay - (\x y -> - force + `$dOrd` + [ (\v v v v v v v v -> + v) ])) + , (delay + (\x y -> + force + (case (case - (case - `$dOrd` - [ (\v - v - v - v - v - v - v - v -> - v) ] - x - y) - [ (delay - (constr 1 - [])) - , (delay - (constr 0 - [ ])) ]))) ]))) ])) ])) - ds)) - (\x y -> - force ifThenElse (equalsInteger x y) (constr 0 []) (constr 1 []))) + `$dOrd` + [ (\v + v + v + v + v + v + v + v -> + v) ] + x + y) + [ (delay + (constr 1 [])) + , (delay + (constr 0 + [ ])) ]))) ]))) ])) ])) + ds)) (\eta eta -> force - (force - (force ifThenElse - (equalsInteger eta eta) - (delay (delay (constr 0 []))) - (delay - (delay - (force - (force - (force ifThenElse - (lessThanEqualsInteger eta eta) - (delay (delay (constr 2 []))) - (delay (delay (constr 1 [])))))))))))) + (case + (equalsInteger eta eta) + [ (delay + (force + (case + (lessThanEqualsInteger eta eta) + [(delay (constr 1 [])), (delay (constr 2 []))]))) + , (delay (constr 0 [])) ]))) (\ds ds -> case ds @@ -1395,9 +1328,8 @@ program case ds [ (\n' d' -> - force ifThenElse + case (lessThanEqualsInteger (multiplyInteger n d') (multiplyInteger n' d)) - (constr 0 []) - (constr 1 [])) ]) ])) \ No newline at end of file + [(constr 1 []), (constr 0 [])]) ]) ])) \ No newline at end of file diff --git a/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/sorted.cbor.size.golden b/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/sorted.cbor.size.golden index 2e8bf645b71..9aba31b86d4 100644 --- a/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/sorted.cbor.size.golden +++ b/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/sorted.cbor.size.golden @@ -1 +1 @@ -2166 \ No newline at end of file +2090 \ No newline at end of file diff --git a/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/sorted.large.budget.golden b/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/sorted.large.budget.golden index 09e07144b2f..50d215b9ae2 100644 --- a/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/sorted.large.budget.golden +++ b/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/sorted.large.budget.golden @@ -1 +1 @@ -ExBudget {exBudgetCPU = ExCPU 551332171, exBudgetMemory = ExMemory 2658418} \ No newline at end of file +ExBudget {exBudgetCPU = ExCPU 474038709, exBudgetMemory = ExMemory 2383080} \ No newline at end of file diff --git a/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/sorted.pir.golden b/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/sorted.pir.golden index 3a89a11658f..ba86587c303 100644 --- a/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/sorted.pir.golden +++ b/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/sorted.pir.golden @@ -139,12 +139,12 @@ program !`$fOrdInteger_$ccompare` : integer -> integer -> Ordering = \(eta : integer) (eta : integer) -> Bool_match - (ifThenElse {Bool} (equalsInteger eta eta) True False) + (case Bool (equalsInteger eta eta) [False, True]) {all dead. Ordering} (/\dead -> EQ) (/\dead -> Bool_match - (ifThenElse {Bool} (lessThanEqualsInteger eta eta) True False) + (case Bool (lessThanEqualsInteger eta eta) [False, True]) {all dead. Ordering} (/\dead -> LT) (/\dead -> GT) @@ -162,19 +162,18 @@ program ds {Bool} (\(n' : integer) (d' : integer) -> - ifThenElse - {Bool} + case + Bool (lessThanEqualsInteger (multiplyInteger n d') (multiplyInteger n' d)) - True - False)) + [False, True])) in letrec !euclid : integer -> integer -> integer = \(x : integer) (y : integer) -> Bool_match - (ifThenElse {Bool} (equalsInteger 0 y) True False) + (case Bool (equalsInteger 0 y) [False, True]) {all dead. integer} (/\dead -> x) (/\dead -> euclid y (modInteger x y)) @@ -184,12 +183,12 @@ program !unsafeRatio : integer -> integer -> Rational = \(n : integer) (d : integer) -> Bool_match - (ifThenElse {Bool} (equalsInteger 0 d) True False) + (case Bool (equalsInteger 0 d) [False, True]) {all dead. Rational} (/\dead -> error {Rational}) (/\dead -> Bool_match - (ifThenElse {Bool} (lessThanInteger d 0) True False) + (case Bool (lessThanInteger d 0) [False, True]) {all dead. Rational} (/\dead -> unsafeRatio (subtractInteger 0 n) (subtractInteger 0 d)) @@ -213,6 +212,8 @@ program let data Unit | Unit_match where Unit : Unit + !ifThenElse : all a. bool -> a -> a -> a + = /\a -> \(b : bool) (x : a) (y : a) -> case a b [y, x] in letrec !validateParamValue : ParamValue -> data -> Bool @@ -232,16 +233,12 @@ program (CConsOrd {integer} (\(x : integer) (y : integer) -> - ifThenElse {Bool} (equalsInteger x y) True False) + case Bool (equalsInteger x y) [False, True]) `$fOrdInteger_$ccompare` (\(x : integer) (y : integer) -> - ifThenElse {Bool} (lessThanInteger x y) True False) + case Bool (lessThanInteger x y) [False, True]) (\(x : integer) (y : integer) -> - ifThenElse - {Bool} - (lessThanEqualsInteger x y) - True - False) + case Bool (lessThanEqualsInteger x y) [False, True]) (\(x : integer) (y : integer) -> ifThenElse {Bool} @@ -252,22 +249,14 @@ program ifThenElse {Bool} (lessThanInteger x y) False True) (\(x : integer) (y : integer) -> Bool_match - (ifThenElse - {Bool} - (lessThanEqualsInteger x y) - True - False) + (case Bool (lessThanEqualsInteger x y) [False, True]) {all dead. integer} (/\dead -> y) (/\dead -> x) {all dead. dead}) (\(x : integer) (y : integer) -> Bool_match - (ifThenElse - {Bool} - (lessThanEqualsInteger x y) - True - False) + (case Bool (lessThanEqualsInteger x y) [False, True]) {all dead. integer} (/\dead -> x) (/\dead -> y) @@ -292,18 +281,16 @@ program {Bool} (\(n' : integer) (d' : integer) -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger n n') - True - False) + [False, True]) {all dead. Bool} (/\dead -> - ifThenElse - {Bool} + case + Bool (equalsInteger d d') - True - False) + [False, True]) (/\dead -> False) {all dead. dead}))) (\(ds : Rational) (ds : Rational) -> @@ -327,13 +314,12 @@ program ds {Bool} (\(n' : integer) (d' : integer) -> - ifThenElse - {Bool} + case + Bool (lessThanInteger (multiplyInteger n d') (multiplyInteger n' d)) - True - False))) + [False, True]))) `$fOrdRational0_$c<=` (\(ds : Rational) (ds : Rational) -> Rational_match @@ -344,11 +330,13 @@ program ds {Bool} (\(n' : integer) (d' : integer) -> + let + !x : integer = multiplyInteger n d' + !y : integer = multiplyInteger n' d + in ifThenElse {Bool} - (lessThanEqualsInteger - (multiplyInteger n d') - (multiplyInteger n' d)) + (lessThanEqualsInteger x y) False True))) (\(ds : Rational) (ds : Rational) -> @@ -360,11 +348,13 @@ program ds {Bool} (\(n' : integer) (d' : integer) -> + let + !x : integer = multiplyInteger n d' + !y : integer = multiplyInteger n' d + in ifThenElse {Bool} - (lessThanInteger - (multiplyInteger n d') - (multiplyInteger n' d)) + (lessThanInteger x y) False True))) (\(x : Rational) (y : Rational) -> @@ -399,7 +389,7 @@ program ds {list data -> Bool} (\(eta : list data) -> - ifThenElse {Bool} (nullList {data} eta) True False) + case Bool (nullList {data} eta) [False, True]) (\(paramValueHd : ParamValue) (paramValueTl : List ParamValue) (actualValueData : list data) -> @@ -5308,13 +5298,12 @@ program ~si : pair integer (list data) = unConstrData ds in Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 5 (fstPair {integer} {list data} si)) - True - False) + [False, True]) {all dead. data} (/\dead -> headList @@ -5328,7 +5317,7 @@ program !x : integer = fstPair {integer} {list data} ds in Bool_match - (ifThenElse {Bool} (equalsInteger 0 x) True False) + (case Bool (equalsInteger 0 x) [False, True]) {all dead. Maybe (List (Tuple2 data data))} (/\dead -> Just @@ -5342,7 +5331,7 @@ program caseData_go (unMapData d))) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 2 x) True False) + (case Bool (equalsInteger 2 x) [False, True]) {all dead. Maybe (List (Tuple2 data data))} (/\dead -> Nothing {List (Tuple2 data data)}) (/\dead -> error {Maybe (List (Tuple2 data data))}) diff --git a/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/sorted.small.budget.golden b/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/sorted.small.budget.golden index 50b5078a180..57dab4b5b50 100644 --- a/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/sorted.small.budget.golden +++ b/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/sorted.small.budget.golden @@ -1 +1 @@ -ExBudget {exBudgetCPU = ExCPU 86325157, exBudgetMemory = ExMemory 381105} \ No newline at end of file +ExBudget {exBudgetCPU = ExCPU 66972110, exBudgetMemory = ExMemory 309002} \ No newline at end of file diff --git a/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/sorted.uplc.golden b/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/sorted.uplc.golden index e2e9eed3253..9cc117f657b 100644 --- a/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/sorted.uplc.golden +++ b/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/sorted.uplc.golden @@ -40,800 +40,784 @@ program (\cse -> (\cse -> (\cse -> - (\cse -> - (\fun - ds -> - force - (case - ((\cse -> - (\x -> - force - (force - (force - ifThenElse - (equalsInteger - 0 - x) - (delay - (delay - (constr 0 - [ ((\d -> - force - caseData_go - (unMapData - d)) - (force - headList - (force - tailList - (force - (force - sndPair) - cse)))) ]))) - (delay - (delay - (force - (force - (force - ifThenElse - (equalsInteger - 2 - x) - (delay - (delay - (constr 1 - [ ]))) - (delay - (delay - error)))))))))) + (\fun + ds -> + force + (case + ((\cse -> + (\x -> + force + (case + (equalsInteger + 0 + x) + [ (delay + (force + (case + (equalsInteger + 2 + x) + [ (delay + error) + , (delay + (constr 1 + [ ])) ]))) + , (delay + (constr 0 + [ ((\d -> + force + caseData_go + (unMapData + d)) + (force + headList + (force + tailList + (force + (force + sndPair) + cse)))) ])) ])) + (force (force - (force - fstPair) - cse)) - (unConstrData + fstPair) + cse)) + (unConstrData + (force + headList (force - headList + tailList (force tailList (force - tailList (force - (force - sndPair) - (unConstrData - ((\cse -> - force - (force + sndPair) + (unConstrData + ((\cse -> + force + (case + (equalsInteger + 5 (force - ifThenElse - (equalsInteger - 5 - (force - (force - fstPair) - cse)) - (delay - (delay - (force - headList - (force - tailList - (force - (force - sndPair) - cse))))) - (delay - (delay - error))))) - (unConstrData + (force + fstPair) + cse)) + [ (delay + error) + , (delay + (force + headList + (force + tailList + (force + (force + sndPair) + cse)))) ])) + (unConstrData + (force + headList (force - headList + tailList (force tailList (force - tailList (force - (force - sndPair) - (unConstrData - ds)))))))))))))) - [ (\cparams -> - delay - (force - (case - (fun - cparams) - [ (delay - ()) - , (delay - error) ]))) - , (delay - ()) ])) - (runRules - (constr 1 - [ (constr 0 - [ 0 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 30 - , cse ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 1000 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 1 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 100000 - , cse ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 10000000 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 2 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 24576 - , (constr 0 - [ ]) ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 122880 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 3 - , (constr 1 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 32768 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 4 - , (constr 1 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 5000 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 5 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 1000000 - , cse ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 5000000 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 6 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 250000000 - , cse ]) ]) - , cse ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 7 - , (constr 1 - [ (constr 1 - [ cse - , (constr 0 - [ ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 8 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 250 - , cse ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 2000 - , (constr 0 - [ ]) ]) ]) - , cse ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 9 - , (constr 3 - [ (constr 1 - [ cse - , cse ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 10 - , (constr 3 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ (cse - 1000) - , cse ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ (cse - 200) - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 11 - , (constr 3 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ (cse - 10) - , cse ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 16 - , (constr 1 - [ (constr 1 - [ cse - , cse ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 17 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 3000 - , cse ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 6500 - , (constr 0 - [ ]) ]) ]) - , cse ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 18 - , (constr 0 - [ ]) ]) - , (constr 1 - [ (constr 0 - [ 19 - , (constr 2 - [ (constr 1 - [ (constr 3 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ (cse - 25) - , (constr 0 - [ ]) ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ (cse - 5) - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) - , (constr 1 - [ (constr 3 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ (cse - 20000) - , (constr 0 - [ ]) ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ (cse - 5000) - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 20 - , (constr 2 - [ (constr 1 - [ (constr 1 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 40000000 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) - , (constr 1 - [ (constr 1 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 15000000000 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 21 - , (constr 2 - [ (constr 1 - [ (constr 1 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 120000000 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) - , (constr 1 - [ (constr 1 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 40000000000 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 22 - , (constr 1 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 12288 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 23 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 100 - , cse ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 200 - , (constr 0 - [ ]) ]) ]) - , cse ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 24 - , (constr 1 - [ (constr 1 - [ cse - , (constr 0 - [ ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 25 - , (constr 2 - [ (constr 1 - [ cse - , (constr 1 - [ cse - , (constr 1 - [ cse - , (constr 1 - [ cse - , cse ]) ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 26 - , (constr 2 - [ (constr 1 - [ cse - , (constr 1 - [ cse - , (constr 1 - [ cse - , (constr 1 - [ (constr 3 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ cse - , (constr 1 - [ (unsafeRatio - 13 - 20) - , (constr 0 - [ ]) ]) ]) ]) - , cse ]) ]) - , (constr 1 - [ cse - , (constr 1 - [ cse - , (constr 1 - [ cse - , (constr 1 - [ cse - , (constr 1 - [ (constr 3 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ cse - , cse ]) ]) - , cse ]) ]) - , cse ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 27 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 0 - , (constr 1 - [ 3 - , (constr 0 - [ ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 10 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 28 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 0 - , (constr 1 - [ 18 - , (constr 0 - [ ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 293 - , (constr 0 - [ ]) ]) ]) - , cse ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 29 - , (constr 1 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 15 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 30 - , (constr 1 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 10000000000000 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 31 - , (constr 1 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 100000000000 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 32 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 13 - , cse ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 37 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 33 - , (constr 3 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , cse ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ (unsafeRatio - 1000 - 1) - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]))) - (constr 3 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ cse - , (constr 1 - [ cse - , (constr 0 - [ ]) ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ])) + sndPair) + (unConstrData + ds)))))))))))))) + [ (\cparams -> + delay + (force + (case + (fun + cparams) + [ (delay + ()) + , (delay + error) ]))) + , (delay + ()) ])) + (runRules + (constr 1 + [ (constr 0 + [ 0 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 30 + , cse ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 1000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 1 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 100000 + , cse ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 10000000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 2 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 24576 + , (constr 0 + [ ]) ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 122880 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 3 + , (constr 1 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 32768 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 4 + , (constr 1 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 5000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 5 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 1000000 + , cse ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 5000000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 6 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 250000000 + , cse ]) ]) + , cse ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 7 + , (constr 1 + [ (constr 1 + [ cse + , (constr 0 + [ ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 8 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 250 + , cse ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 2000 + , (constr 0 + [ ]) ]) ]) + , cse ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 9 + , (constr 3 + [ (constr 1 + [ cse + , cse ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 10 + , (constr 3 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ (cse + 1000) + , cse ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ (cse + 200) + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 11 + , (constr 3 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ (cse + 10) + , cse ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 16 + , (constr 1 + [ (constr 1 + [ cse + , cse ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 17 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 3000 + , cse ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 6500 + , (constr 0 + [ ]) ]) ]) + , cse ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 18 + , (constr 0 + [ ]) ]) + , (constr 1 + [ (constr 0 + [ 19 + , (constr 2 + [ (constr 1 + [ (constr 3 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ (cse + 25) + , (constr 0 + [ ]) ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ (cse + 5) + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) + , (constr 1 + [ (constr 3 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ (cse + 20000) + , (constr 0 + [ ]) ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ (cse + 5000) + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 20 + , (constr 2 + [ (constr 1 + [ (constr 1 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 40000000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) + , (constr 1 + [ (constr 1 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 15000000000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 21 + , (constr 2 + [ (constr 1 + [ (constr 1 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 120000000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) + , (constr 1 + [ (constr 1 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 40000000000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 22 + , (constr 1 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 12288 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 23 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 100 + , cse ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 200 + , (constr 0 + [ ]) ]) ]) + , cse ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 24 + , (constr 1 + [ (constr 1 + [ cse + , (constr 0 + [ ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 25 + , (constr 2 + [ (constr 1 + [ cse + , (constr 1 + [ cse + , (constr 1 + [ cse + , (constr 1 + [ cse + , cse ]) ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 26 + , (constr 2 + [ (constr 1 + [ cse + , (constr 1 + [ cse + , (constr 1 + [ cse + , (constr 1 + [ (constr 3 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ cse + , (constr 1 + [ (unsafeRatio + 13 + 20) + , (constr 0 + [ ]) ]) ]) ]) + , cse ]) ]) + , (constr 1 + [ cse + , (constr 1 + [ cse + , (constr 1 + [ cse + , (constr 1 + [ cse + , (constr 1 + [ (constr 3 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ cse + , cse ]) ]) + , cse ]) ]) + , cse ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 27 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 0 + , (constr 1 + [ 3 + , (constr 0 + [ ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 10 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 28 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 0 + , (constr 1 + [ 18 + , (constr 0 + [ ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 293 + , (constr 0 + [ ]) ]) ]) + , cse ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 29 + , (constr 1 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 15 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 30 + , (constr 1 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 10000000000000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 31 + , (constr 1 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 100000000000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 32 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 13 + , cse ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 37 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 33 + , (constr 3 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , cse ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ (unsafeRatio + 1000 + 1) + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]))) (constr 3 [ (constr 1 [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ cse - , cse ]) ]) - , (constr 0 - [ ]) ]) ]) ])) + , cse ]) ])) (constr 3 [ (constr 1 [ cse - , cse ]) ])) - (constr 1 - [ (constr 3 - [ (constr 1 + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ cse + , cse ]) ]) + , (constr 0 + [ ]) ]) ]) ])) + (constr 3 + [ (constr 1 + [ cse + , (constr 1 [ (constr 0 - [ (constr 1 + [ (constr 0 [ ]) , (constr 1 [ cse - , (constr 0 - [ ]) ]) ]) - , cse ]) ]) - , (constr 0 - [ ]) ])) + , (constr 1 + [ cse + , (constr 0 + [ ]) ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ])) (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ cse - , (constr 1 - [ cse - , (constr 0 - [ ]) ]) ]) ]) + [ (constr 3 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ cse + , (constr 0 + [ ]) ]) ]) + , cse ]) ]) , (constr 0 [ ]) ])) - (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ cse - , cse ]) ])) + (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ cse + , (constr 1 + [ cse + , (constr 0 + [ ]) ]) ]) ]) + , (constr 0 + [ ]) ])) (constr 0 [ (constr 1 [ ]) , (constr 1 [ cse , (constr 1 - [ cse + [ (cse + 100) , (constr 0 [ ]) ]) ]) ])) - (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , cse ]) - , (constr 0 - [ ]) ])) - (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 0 - , (constr 1 - [ 1000000 - , (constr 0 - [ ]) ]) ]) ])) - (constr 1 - [ cse - , (constr 0 - [ ]) ])) + (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ cse + , cse ]) ])) + (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , cse ]) + , (constr 0 + [ ]) ])) + (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 0 + , (constr 1 + [ 1000000 + , (constr 0 + [ ]) ]) ]) ])) (constr 1 [ (constr 0 [ (constr 2 @@ -842,52 +826,54 @@ program , (constr 0 [ ]) ])) (constr 1 - [ cse + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 500000000 + , (constr 0 + [ ]) ]) ]) , (constr 0 [ ]) ])) (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 500000000 - , (constr 0 - [ ]) ]) ]) + [ cse , (constr 0 [ ]) ])) (constr 1 [ cse , (constr 0 [ ]) ])) - (cse - 2)) + (constr 1 + [ cse + , (constr 0 + [ ]) ])) (cse - 5)) - (cse - 1)) + 10)) + (constr 0 + [ (constr 1 + [ ]) + , cse ])) (cse 10)) - (cse 10)) + (cse 1)) (constr 0 [ (constr 1 []) - , cse ])) - (cse 100)) + , (constr 1 + [ 1 + , (constr 0 + [ ]) ]) ])) + (cse 5)) (cse 1)) - (constr 0 - [ (constr 1 []) - , (constr 1 - [ 1 - , (constr 0 - [ ]) ]) ])) - (cse 4)) - (unsafeRatio 51)) - (constr 1 [0, (constr 0 [])])) - (unsafeRatio 4)) - (unsafeRatio 1)) - (unsafeRatio 3)) - (unsafeRatio 9)) - (unsafeRatio 0)) + (cse 4)) + (cse 2)) + (unsafeRatio 4)) + (unsafeRatio 51)) + (unsafeRatio 1)) + (constr 1 [0, (constr 0 [])])) + (unsafeRatio 0)) + (unsafeRatio 3)) + (unsafeRatio 9)) ((\s -> s s) (\s arg -> delay @@ -1003,69 +989,58 @@ program (validatePreds (constr 0 [ (\x y -> - force ifThenElse + case (equalsInteger x y) - (constr 0 []) - (constr 1 [])) + [ (constr 1 []) + , (constr 0 []) ]) , `$fOrdInteger_$ccompare` , (\x y -> - force ifThenElse + case (lessThanInteger x y) - (constr 0 []) - (constr 1 [])) + [ (constr 1 []) + , (constr 0 []) ]) , (\x y -> - force ifThenElse + case (lessThanEqualsInteger x y) - (constr 0 []) - (constr 1 [])) + [ (constr 1 []) + , (constr 0 []) ]) , (\x y -> - force ifThenElse + case (lessThanEqualsInteger x y) - (constr 1 []) - (constr 0 [])) + [ (constr 0 []) + , (constr 1 []) ]) , (\x y -> - force ifThenElse + case (lessThanInteger x y) - (constr 1 []) - (constr 0 [])) + [ (constr 0 []) + , (constr 1 []) ]) , (\x y -> force - (force - (force - ifThenElse - (lessThanEqualsInteger - x - y) - (delay - (delay - y)) - (delay - (delay - x))))) + (case + (lessThanEqualsInteger + x + y) + [ (delay x) + , (delay y) ])) , (\x y -> force - (force - (force - ifThenElse - (lessThanEqualsInteger - x - y) - (delay - (delay - x)) - (delay - (delay - y))))) ]) + (case + (lessThanEqualsInteger + x + y) + [ (delay y) + , (delay + x) ])) ]) preds (unIData eta))) , (\paramValues -> @@ -1088,27 +1063,22 @@ program [ (\n' d' -> force - (force - (force - ifThenElse - (equalsInteger - n - n') - (delay - (delay - (force - ifThenElse - (equalsInteger - d - d') - (constr 0 - [ ]) - (constr 1 - [ ])))) - (delay - (delay - (constr 1 - [ ])))))) ]) ]) + (case + (equalsInteger + n + n') + [ (delay + (constr 1 + [ ])) + , (delay + (case + (equalsInteger + d + d') + [ (constr 1 + [ ]) + , (constr 0 + [ ]) ])) ])) ]) ]) , (\ds ds -> case ds @@ -1132,8 +1102,7 @@ program ds [ (\n' d' -> - force - ifThenElse + case (lessThanInteger (multiplyInteger n @@ -1141,10 +1110,10 @@ program (multiplyInteger n' d)) - (constr 0 - [ ]) - (constr 1 - [ ])) ]) ]) + [ (constr 1 + [ ]) + , (constr 0 + [ ]) ]) ]) ]) , `$fOrdRational0_$c<=` , (\ds ds -> case @@ -1154,8 +1123,7 @@ program ds [ (\n' d' -> - force - ifThenElse + case (lessThanEqualsInteger (multiplyInteger n @@ -1163,10 +1131,10 @@ program (multiplyInteger n' d)) - (constr 1 - [ ]) - (constr 0 - [ ])) ]) ]) + [ (constr 0 + [ ]) + , (constr 1 + [ ]) ]) ]) ]) , (\ds ds -> case ds @@ -1175,8 +1143,7 @@ program ds [ (\n' d' -> - force - ifThenElse + case (lessThanInteger (multiplyInteger n @@ -1184,10 +1151,10 @@ program (multiplyInteger n' d)) - (constr 1 - [ ]) - (constr 0 - [ ])) ]) ]) + [ (constr 0 + [ ]) + , (constr 1 + [ ]) ]) ]) ]) , (\x y -> force (case @@ -1209,21 +1176,21 @@ program , (delay y) ])) ]) preds - (force ifThenElse + (case (force nullList (force tailList cse)) - (\ds -> - unsafeRatio - (unIData - (force - headList - cse)) - (unIData - (force - headList - cse))) - (\ds -> error) + [ (\ds -> error) + , (\ds -> + unsafeRatio + (unIData + (force + headList + cse)) + (unIData + (force + headList + cse))) ] (constr 0 []))) (force tailList cse)) (unListData eta))) ])) @@ -1231,10 +1198,9 @@ program case ds [ (\eta -> - force ifThenElse + case (force nullList eta) - (constr 0 []) - (constr 1 [])) + [(constr 1 []), (constr 0 [])]) , (\paramValueHd paramValueTl actualValueData -> @@ -1254,40 +1220,29 @@ program ((\s -> s s) (\s n d -> force - (force - (force ifThenElse - (equalsInteger 0 d) - (delay (delay error)) - (delay - (delay - (force - (force - (force ifThenElse - (lessThanInteger d 0) - (delay - (delay - ((\x -> s s x) - (subtractInteger 0 n) - (subtractInteger 0 d)))) - (delay - (delay - ((\gcd' -> - constr 0 - [ (quotientInteger - n - gcd') - , (quotientInteger - d - gcd') ]) - (euclid n d)))))))))))))) + (case + (equalsInteger 0 d) + [ (delay + (force + (case + (lessThanInteger d 0) + [ (delay + ((\gcd' -> + constr 0 + [ (quotientInteger n gcd') + , (quotientInteger d gcd') ]) + (euclid n d))) + , (delay + ((\x -> s s x) + (subtractInteger 0 n) + (subtractInteger 0 d))) ]))) + , (delay error) ])))) ((\s -> s s) (\s x y -> force - (force - (force ifThenElse - (equalsInteger 0 y) - (delay (delay x)) - (delay (delay (s s y (modInteger x y))))))))) + (case + (equalsInteger 0 y) + [(delay (s s y (modInteger x y))), (delay x)])))) (\`$dOrd` ds ds -> (\s -> s s) (\s ds -> @@ -1356,18 +1311,14 @@ program ds)) (\eta eta -> force - (force - (force ifThenElse - (equalsInteger eta eta) - (delay (delay (constr 0 []))) - (delay - (delay - (force - (force - (force ifThenElse - (lessThanEqualsInteger eta eta) - (delay (delay (constr 2 []))) - (delay (delay (constr 1 [])))))))))))) + (case + (equalsInteger eta eta) + [ (delay + (force + (case + (lessThanEqualsInteger eta eta) + [(delay (constr 1 [])), (delay (constr 2 []))]))) + , (delay (constr 0 [])) ]))) (\ds ds -> case ds @@ -1375,9 +1326,8 @@ program case ds [ (\n' d' -> - force ifThenElse + case (lessThanEqualsInteger (multiplyInteger n d') (multiplyInteger n' d)) - (constr 0 []) - (constr 1 [])) ]) ])) \ No newline at end of file + [(constr 1 []), (constr 0 [])]) ]) ])) \ No newline at end of file diff --git a/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/unsorted.cbor.size.golden b/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/unsorted.cbor.size.golden index 5fdec2130b0..8a162a548d3 100644 --- a/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/unsorted.cbor.size.golden +++ b/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/unsorted.cbor.size.golden @@ -1 +1 @@ -2156 \ No newline at end of file +2079 \ No newline at end of file diff --git a/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/unsorted.large.budget.golden b/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/unsorted.large.budget.golden index a2be9735741..634ab144b2f 100644 --- a/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/unsorted.large.budget.golden +++ b/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/unsorted.large.budget.golden @@ -1 +1 @@ -ExBudget {exBudgetCPU = ExCPU 865498341, exBudgetMemory = ExMemory 4273788} \ No newline at end of file +ExBudget {exBudgetCPU = ExCPU 661763564, exBudgetMemory = ExMemory 3414515} \ No newline at end of file diff --git a/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/unsorted.pir.golden b/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/unsorted.pir.golden index 55d72d55a41..444eb6609ff 100644 --- a/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/unsorted.pir.golden +++ b/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/unsorted.pir.golden @@ -136,18 +136,15 @@ program {all dead. dead} in go ds - !equalsInteger : integer -> integer -> Bool - = \(x : integer) (y : integer) -> - ifThenElse {Bool} (equalsInteger x y) True False !`$fOrdInteger_$ccompare` : integer -> integer -> Ordering = \(eta : integer) (eta : integer) -> Bool_match - (ifThenElse {Bool} (equalsInteger eta eta) True False) + (case Bool (equalsInteger eta eta) [False, True]) {all dead. Ordering} (/\dead -> EQ) (/\dead -> Bool_match - (ifThenElse {Bool} (lessThanEqualsInteger eta eta) True False) + (case Bool (lessThanEqualsInteger eta eta) [False, True]) {all dead. Ordering} (/\dead -> LT) (/\dead -> GT) @@ -165,19 +162,18 @@ program ds {Bool} (\(n' : integer) (d' : integer) -> - ifThenElse - {Bool} + case + Bool (lessThanEqualsInteger (multiplyInteger n d') (multiplyInteger n' d)) - True - False)) + [False, True])) in letrec !euclid : integer -> integer -> integer = \(x : integer) (y : integer) -> Bool_match - (ifThenElse {Bool} (equalsInteger 0 y) True False) + (case Bool (equalsInteger 0 y) [False, True]) {all dead. integer} (/\dead -> x) (/\dead -> euclid y (modInteger x y)) @@ -187,12 +183,12 @@ program !unsafeRatio : integer -> integer -> Rational = \(n : integer) (d : integer) -> Bool_match - (ifThenElse {Bool} (equalsInteger 0 d) True False) + (case Bool (equalsInteger 0 d) [False, True]) {all dead. Rational} (/\dead -> error {Rational}) (/\dead -> Bool_match - (ifThenElse {Bool} (lessThanInteger d 0) True False) + (case Bool (lessThanInteger d 0) [False, True]) {all dead. Rational} (/\dead -> unsafeRatio (subtractInteger 0 n) (subtractInteger 0 d)) @@ -216,6 +212,8 @@ program let data Unit | Unit_match where Unit : Unit + !ifThenElse : all a. bool -> a -> a -> a + = /\a -> \(b : bool) (x : a) (y : a) -> case a b [y, x] in letrec !validateParamValue : ParamValue -> data -> Bool @@ -234,16 +232,13 @@ program {integer} (CConsOrd {integer} - equalsInteger + (\(x : integer) (y : integer) -> + case Bool (equalsInteger x y) [False, True]) `$fOrdInteger_$ccompare` (\(x : integer) (y : integer) -> - ifThenElse {Bool} (lessThanInteger x y) True False) + case Bool (lessThanInteger x y) [False, True]) (\(x : integer) (y : integer) -> - ifThenElse - {Bool} - (lessThanEqualsInteger x y) - True - False) + case Bool (lessThanEqualsInteger x y) [False, True]) (\(x : integer) (y : integer) -> ifThenElse {Bool} @@ -254,22 +249,14 @@ program ifThenElse {Bool} (lessThanInteger x y) False True) (\(x : integer) (y : integer) -> Bool_match - (ifThenElse - {Bool} - (lessThanEqualsInteger x y) - True - False) + (case Bool (lessThanEqualsInteger x y) [False, True]) {all dead. integer} (/\dead -> y) (/\dead -> x) {all dead. dead}) (\(x : integer) (y : integer) -> Bool_match - (ifThenElse - {Bool} - (lessThanEqualsInteger x y) - True - False) + (case Bool (lessThanEqualsInteger x y) [False, True]) {all dead. integer} (/\dead -> x) (/\dead -> y) @@ -294,18 +281,16 @@ program {Bool} (\(n' : integer) (d' : integer) -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger n n') - True - False) + [False, True]) {all dead. Bool} (/\dead -> - ifThenElse - {Bool} + case + Bool (equalsInteger d d') - True - False) + [False, True]) (/\dead -> False) {all dead. dead}))) (\(ds : Rational) (ds : Rational) -> @@ -329,13 +314,12 @@ program ds {Bool} (\(n' : integer) (d' : integer) -> - ifThenElse - {Bool} + case + Bool (lessThanInteger (multiplyInteger n d') (multiplyInteger n' d)) - True - False))) + [False, True]))) `$fOrdRational0_$c<=` (\(ds : Rational) (ds : Rational) -> Rational_match @@ -346,11 +330,13 @@ program ds {Bool} (\(n' : integer) (d' : integer) -> + let + !x : integer = multiplyInteger n d' + !y : integer = multiplyInteger n' d + in ifThenElse {Bool} - (lessThanEqualsInteger - (multiplyInteger n d') - (multiplyInteger n' d)) + (lessThanEqualsInteger x y) False True))) (\(ds : Rational) (ds : Rational) -> @@ -362,11 +348,13 @@ program ds {Bool} (\(n' : integer) (d' : integer) -> + let + !x : integer = multiplyInteger n d' + !y : integer = multiplyInteger n' d + in ifThenElse {Bool} - (lessThanInteger - (multiplyInteger n d') - (multiplyInteger n' d)) + (lessThanInteger x y) False True))) (\(x : Rational) (y : Rational) -> @@ -401,7 +389,7 @@ program ds {list data -> Bool} (\(eta : list data) -> - ifThenElse {Bool} (nullList {data} eta) True False) + case Bool (nullList {data} eta) [False, True]) (\(paramValueHd : ParamValue) (paramValueTl : List ParamValue) (actualValueData : list data) -> @@ -5201,7 +5189,10 @@ program {ParamValue} (\(k' : integer) (i : ParamValue) -> Bool_match - (equalsInteger k k') + (case + Bool + (equalsInteger k k') + [False, True]) {all dead. ParamValue} (/\dead -> i) (/\dead -> go xs') @@ -5242,13 +5233,12 @@ program ~si : pair integer (list data) = unConstrData ds in Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 5 (fstPair {integer} {list data} si)) - True - False) + [False, True]) {all dead. data} (/\dead -> headList @@ -5262,7 +5252,7 @@ program !x : integer = fstPair {integer} {list data} ds in Bool_match - (ifThenElse {Bool} (equalsInteger 0 x) True False) + (case Bool (equalsInteger 0 x) [False, True]) {all dead. Maybe (List (Tuple2 data data))} (/\dead -> Just @@ -5276,7 +5266,7 @@ program caseData_go (unMapData d))) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 2 x) True False) + (case Bool (equalsInteger 2 x) [False, True]) {all dead. Maybe (List (Tuple2 data data))} (/\dead -> Nothing {List (Tuple2 data data)}) (/\dead -> error {Maybe (List (Tuple2 data data))}) diff --git a/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/unsorted.small.budget.golden b/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/unsorted.small.budget.golden index 9cd279c42ba..145ed7f613f 100644 --- a/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/unsorted.small.budget.golden +++ b/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/unsorted.small.budget.golden @@ -1 +1 @@ -ExBudget {exBudgetCPU = ExCPU 83839267, exBudgetMemory = ExMemory 368103} \ No newline at end of file +ExBudget {exBudgetCPU = ExCPU 64666367, exBudgetMemory = ExMemory 295703} \ No newline at end of file diff --git a/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/unsorted.uplc.golden b/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/unsorted.uplc.golden index 2683fdfc973..98ca29299e5 100644 --- a/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/unsorted.uplc.golden +++ b/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/unsorted.uplc.golden @@ -2,14 +2,14 @@ program 1.1.0 ((\`$fOrdRational0_$c<=` -> (\`$fOrdInteger_$ccompare` -> - (\equalsInteger -> - (\validatePreds -> - (\euclid -> - (\unsafeRatio -> - (\cse -> - (\validateParamValue -> - (\validateParamValues -> - (\caseData_go -> + (\validatePreds -> + (\euclid -> + (\unsafeRatio -> + (\cse -> + (\validateParamValue -> + (\validateParamValues -> + (\caseData_go -> + (\cse -> (\cse -> (\cse -> (\cse -> @@ -38,882 +38,864 @@ program (\cse -> (\cse -> (\cse -> - (\cse -> - (\cfg -> - (\fun - ds -> - force - (case - ((\cse -> - (\x -> - force - (force - (force - ifThenElse - (equalsInteger - 0 - x) - (delay - (delay - (constr 0 - [ ((\d -> - force - caseData_go - (unMapData - d)) - (force - headList - (force - tailList - (force - (force - sndPair) - cse)))) ]))) - (delay - (delay - (force - (force - (force - ifThenElse - (equalsInteger - 2 - x) - (delay - (delay - (constr 1 - [ ]))) - (delay - (delay - error)))))))))) + (\cfg -> + (\fun + ds -> + force + (case + ((\cse -> + (\x -> + force + (case + (equalsInteger + 0 + x) + [ (delay + (force + (case + (equalsInteger + 2 + x) + [ (delay + error) + , (delay + (constr 1 + [ ])) ]))) + , (delay + (constr 0 + [ ((\d -> + force + caseData_go + (unMapData + d)) + (force + headList + (force + tailList + (force + (force + sndPair) + cse)))) ])) ])) + (force (force - (force - fstPair) - cse)) - (unConstrData + fstPair) + cse)) + (unConstrData + (force + headList (force - headList + tailList (force tailList (force - tailList (force - (force - sndPair) - (unConstrData - ((\cse -> - force - (force + sndPair) + (unConstrData + ((\cse -> + force + (case + (equalsInteger + 5 (force - ifThenElse - (equalsInteger - 5 - (force - (force - fstPair) - cse)) - (delay - (delay - (force - headList - (force - tailList - (force - (force - sndPair) - cse))))) - (delay - (delay - error))))) - (unConstrData + (force + fstPair) + cse)) + [ (delay + error) + , (delay + (force + headList + (force + tailList + (force + (force + sndPair) + cse)))) ])) + (unConstrData + (force + headList (force - headList + tailList (force tailList (force - tailList (force - (force - sndPair) - (unConstrData - ds)))))))))))))) - [ (\cparams -> - delay - (force - (case - (fun - cparams) - [ (delay - ()) - , (delay - error) ]))) - , (delay - ()) ])) - ((\go - eta -> - go - eta) - ((\s -> - s - s) - (\s - ds -> - force - (case - ds - [ (delay - (constr 0 - [ ])) - , (\x - xs -> - delay - (force + sndPair) + (unConstrData + ds)))))))))))))) + [ (\cparams -> + delay + (force + (case + (fun + cparams) + [ (delay + ()) + , (delay + error) ]))) + , (delay + ()) ])) + ((\go + eta -> + go + eta) + ((\s -> + s + s) + (\s + ds -> + force + (case + ds + [ (delay + (constr 0 + [ ])) + , (\x + xs -> + delay + (force + (case (case - (case - x - [ (\ds - actualValueData -> - validateParamValue - ((\k -> - (\s -> - s - s) - (\s - ds -> - force - (case - ds - [ (delay - error) - , (\ds - xs' -> - delay - (case - ds - [ (\k' - i -> - force - (case - (equalsInteger - k - k') - [ (delay - i) - , (delay - (s - s - xs')) ])) ])) ]))) - (unIData - ds) - cfg) - actualValueData) ]) - [ (delay - (s - s - xs)) - , (delay - (constr 1 - [ ])) ]))) ]))))) - (constr 1 - [ (constr 0 - [ 0 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 30 - , cse ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 1000 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 1 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 100000 - , cse ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 10000000 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 2 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 24576 - , (constr 0 - [ ]) ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 122880 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 3 - , (constr 1 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 32768 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 4 - , (constr 1 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 5000 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 5 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 1000000 - , cse ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 5000000 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 6 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 250000000 - , cse ]) ]) - , cse ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 7 - , (constr 1 - [ (constr 1 - [ cse - , (constr 0 - [ ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 8 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 250 - , cse ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 2000 - , (constr 0 - [ ]) ]) ]) - , cse ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 9 - , (constr 3 - [ (constr 1 - [ cse - , cse ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 10 - , (constr 3 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ (cse - 1000) - , cse ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ (cse - 200) - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 11 - , (constr 3 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ (cse - 10) - , cse ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 16 - , (constr 1 - [ (constr 1 - [ cse - , cse ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 17 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 3000 - , cse ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 6500 - , (constr 0 - [ ]) ]) ]) - , cse ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 18 - , (constr 0 - [ ]) ]) - , (constr 1 - [ (constr 0 - [ 19 - , (constr 2 - [ (constr 1 - [ (constr 3 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ (cse - 25) - , (constr 0 - [ ]) ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ (cse - 5) - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) - , (constr 1 - [ (constr 3 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ (cse - 20000) - , (constr 0 - [ ]) ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ (cse - 5000) - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 20 - , (constr 2 - [ (constr 1 - [ (constr 1 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 40000000 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) - , (constr 1 - [ (constr 1 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 15000000000 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 21 - , (constr 2 - [ (constr 1 - [ (constr 1 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 120000000 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) - , (constr 1 - [ (constr 1 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 40000000000 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 22 - , (constr 1 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 12288 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 23 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 100 - , cse ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 200 - , (constr 0 - [ ]) ]) ]) - , cse ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 24 - , (constr 1 - [ (constr 1 - [ cse - , (constr 0 - [ ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 25 - , (constr 2 - [ (constr 1 - [ cse - , (constr 1 - [ cse - , (constr 1 - [ cse - , (constr 1 - [ cse - , cse ]) ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 26 - , (constr 2 - [ (constr 1 - [ cse - , (constr 1 - [ cse - , (constr 1 - [ cse - , (constr 1 - [ (constr 3 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ cse - , (constr 1 - [ (unsafeRatio - 13 - 20) - , (constr 0 - [ ]) ]) ]) ]) - , cse ]) ]) - , (constr 1 - [ cse - , (constr 1 - [ cse - , (constr 1 - [ cse - , (constr 1 - [ cse - , (constr 1 - [ (constr 3 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ cse - , cse ]) ]) - , cse ]) ]) - , cse ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 27 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 0 - , (constr 1 - [ 3 - , (constr 0 - [ ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 10 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 28 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 0 - , (constr 1 - [ 18 - , (constr 0 - [ ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 293 - , (constr 0 - [ ]) ]) ]) - , cse ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 29 - , (constr 1 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 15 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 30 - , (constr 1 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 10000000000000 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 31 - , (constr 1 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 100000000000 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 32 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 13 - , cse ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 37 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 33 - , (constr 3 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , cse ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ (unsafeRatio - 1000 - 1) - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ])) - (constr 3 - [ (constr 1 - [ cse + x + [ (\ds + actualValueData -> + validateParamValue + ((\k -> + (\s -> + s + s) + (\s + ds -> + force + (case + ds + [ (delay + error) + , (\ds + xs' -> + delay + (case + ds + [ (\k' + i -> + force + (case + (equalsInteger + k + k') + [ (delay + (s + s + xs')) + , (delay + i) ])) ])) ]))) + (unIData + ds) + cfg) + actualValueData) ]) + [ (delay + (s + s + xs)) + , (delay + (constr 1 + [ ])) ]))) ]))))) + (constr 1 + [ (constr 0 + [ 0 , (constr 1 - [ (constr 0 + [ (constr 1 [ (constr 0 - [ ]) + [ (constr 1 + [ ]) + , (constr 1 + [ 30 + , cse ]) ]) , (constr 1 - [ cse + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 1000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 1 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 100000 + , cse ]) ]) , (constr 1 - [ (cse - 5) + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 10000000 + , (constr 0 + [ ]) ]) ]) , (constr 0 - [ ]) ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ])) + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 2 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 24576 + , (constr 0 + [ ]) ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 122880 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 3 + , (constr 1 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 32768 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 4 + , (constr 1 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 5000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 5 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 1000000 + , cse ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 5000000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 6 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 250000000 + , cse ]) ]) + , cse ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 7 + , (constr 1 + [ (constr 1 + [ cse + , (constr 0 + [ ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 8 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 250 + , cse ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 2000 + , (constr 0 + [ ]) ]) ]) + , cse ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 9 + , (constr 3 + [ (constr 1 + [ cse + , cse ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 10 + , (constr 3 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ (cse + 1000) + , cse ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ (cse + 200) + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 11 + , (constr 3 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ (cse + 10) + , cse ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 16 + , (constr 1 + [ (constr 1 + [ cse + , cse ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 17 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 3000 + , cse ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 6500 + , (constr 0 + [ ]) ]) ]) + , cse ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 18 + , (constr 0 + [ ]) ]) + , (constr 1 + [ (constr 0 + [ 19 + , (constr 2 + [ (constr 1 + [ (constr 3 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ (cse + 25) + , (constr 0 + [ ]) ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ (cse + 5) + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) + , (constr 1 + [ (constr 3 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ (cse + 20000) + , (constr 0 + [ ]) ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ (cse + 5000) + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 20 + , (constr 2 + [ (constr 1 + [ (constr 1 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 40000000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) + , (constr 1 + [ (constr 1 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 15000000000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 21 + , (constr 2 + [ (constr 1 + [ (constr 1 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 120000000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) + , (constr 1 + [ (constr 1 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 40000000000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 22 + , (constr 1 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 12288 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 23 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 100 + , cse ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 200 + , (constr 0 + [ ]) ]) ]) + , cse ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 24 + , (constr 1 + [ (constr 1 + [ cse + , (constr 0 + [ ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 25 + , (constr 2 + [ (constr 1 + [ cse + , (constr 1 + [ cse + , (constr 1 + [ cse + , (constr 1 + [ cse + , cse ]) ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 26 + , (constr 2 + [ (constr 1 + [ cse + , (constr 1 + [ cse + , (constr 1 + [ cse + , (constr 1 + [ (constr 3 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ cse + , (constr 1 + [ (unsafeRatio + 13 + 20) + , (constr 0 + [ ]) ]) ]) ]) + , cse ]) ]) + , (constr 1 + [ cse + , (constr 1 + [ cse + , (constr 1 + [ cse + , (constr 1 + [ cse + , (constr 1 + [ (constr 3 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ cse + , cse ]) ]) + , cse ]) ]) + , cse ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 27 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 0 + , (constr 1 + [ 3 + , (constr 0 + [ ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 10 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 28 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 0 + , (constr 1 + [ 18 + , (constr 0 + [ ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 293 + , (constr 0 + [ ]) ]) ]) + , cse ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 29 + , (constr 1 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 15 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 30 + , (constr 1 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 10000000000000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 31 + , (constr 1 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 100000000000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 32 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 13 + , cse ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 37 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 33 + , (constr 3 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , cse ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ (unsafeRatio + 1000 + 1) + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ])) (constr 3 [ (constr 1 [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ cse - , cse ]) ]) - , (constr 0 - [ ]) ]) ]) ])) + , cse ]) ])) (constr 3 [ (constr 1 [ cse - , cse ]) ])) - (constr 1 - [ (constr 3 - [ (constr 1 + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ cse + , cse ]) ]) + , (constr 0 + [ ]) ]) ]) ])) + (constr 3 + [ (constr 1 + [ cse + , (constr 1 [ (constr 0 - [ (constr 1 + [ (constr 0 [ ]) , (constr 1 [ cse - , (constr 0 - [ ]) ]) ]) - , cse ]) ]) - , (constr 0 - [ ]) ])) + , (constr 1 + [ cse + , (constr 0 + [ ]) ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ])) (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ cse - , (constr 1 - [ cse - , (constr 0 - [ ]) ]) ]) ]) + [ (constr 3 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ cse + , (constr 0 + [ ]) ]) ]) + , cse ]) ]) , (constr 0 [ ]) ])) - (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ cse + (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) , (constr 1 [ cse - , (constr 0 - [ ]) ]) ]) ])) + , (constr 1 + [ (cse + 10) + , (constr 0 + [ ]) ]) ]) ]) + , (constr 0 + [ ]) ])) (constr 0 [ (constr 1 [ ]) , (constr 1 - [ (cse - 10) + [ cse , cse ]) ])) - (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , cse ]) - , (constr 0 - [ ]) ])) - (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 0 - , (constr 1 - [ 1000000 - , (constr 0 - [ ]) ]) ]) ])) - (constr 1 - [ (constr 0 - [ (constr 2 - [ ]) - , cse ]) - , (constr 0 - [ ]) ])) + (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ cse + , (constr 1 + [ cse + , (constr 0 + [ ]) ]) ]) ])) + (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , cse ]) + , (constr 0 + [ ]) ])) + (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 0 + , (constr 1 + [ 1000000 + , (constr 0 + [ ]) ]) ]) ])) (constr 1 [ (constr 0 - [ (constr 0 + [ (constr 2 [ ]) - , (constr 1 - [ 500000000 - , (constr 0 - [ ]) ]) ]) + , cse ]) , (constr 0 [ ]) ])) (constr 1 - [ cse + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 500000000 + , (constr 0 + [ ]) ]) ]) , (constr 0 [ ]) ])) (constr 1 @@ -921,16 +903,20 @@ program , (constr 0 [ ]) ])) (constr 1 - [ cse + [ (cse + 1) , (constr 0 [ ]) ])) - (cse - 100)) - (constr 0 - [ (constr 1 - [ ]) - , cse ])) - (cse 1)) + (constr 1 + [ cse + , (constr 0 + [ ]) ])) + (cse + 4)) + (constr 0 + [ (constr 1 + [ ]) + , cse ])) (constr 0 [ (constr 1 []) @@ -938,450 +924,399 @@ program [ 1 , (constr 0 [ ]) ]) ])) - (cse 1)) + (cse 100)) (cse 2)) - (cse 4)) - (cse 10)) - (unsafeRatio 3)) - (unsafeRatio 9)) - (unsafeRatio 1)) - (unsafeRatio 4)) - (constr 1 [0, (constr 0 [])])) - (unsafeRatio 0)) - (unsafeRatio 51)) - ((\s -> s s) - (\s arg -> - delay - (\xs -> - force - (force (force chooseList) - xs - (delay (constr 0 [])) - (delay - ((\x xs -> - constr 1 - [ (constr 0 - [ (force - (force - fstPair) - x) - , (force - (force - sndPair) - x) ]) - , (force - (s - s - (delay - (\x -> x))) - xs) ]) - (force headList xs) - (force tailList xs)))))) - (delay (\x -> x)))) - (cse (\arg_0 arg_1 -> arg_1))) - (cse (\arg_0 arg_1 -> arg_0))) - (force - ((\s -> s s) - (\s h -> - delay - (\fr -> - (\k -> - fr - (\x -> k (\f_0 f_1 -> f_0 x)) - (\x -> k (\f_0 f_1 -> f_1 x))) - (\fq -> force (s s h) (force h fq)))) - (delay - (\choose - validateParamValue - validateParamValues -> - choose - (\eta eta -> + (cse 10)) + (cse 1)) + (cse 5)) + (unsafeRatio 0)) + (unsafeRatio 3)) + (unsafeRatio 51)) + (unsafeRatio 9)) + (unsafeRatio 4)) + (unsafeRatio 1)) + (constr 1 [0, (constr 0 [])])) + ((\s -> s s) + (\s arg -> + delay + (\xs -> force - (case - eta - [ (delay (constr 0 [])) - , (\preds -> - delay - (validatePreds - (constr 0 - [ equalsInteger - , `$fOrdInteger_$ccompare` - , (\x y -> - force ifThenElse - (lessThanInteger - x - y) - (constr 0 []) - (constr 1 [])) - , (\x y -> - force ifThenElse + (force (force chooseList) + xs + (delay (constr 0 [])) + (delay + ((\x xs -> + constr 1 + [ (constr 0 + [ (force + (force fstPair) + x) + , (force + (force sndPair) + x) ]) + , (force + (s + s + (delay (\x -> x))) + xs) ]) + (force headList xs) + (force tailList xs)))))) + (delay (\x -> x)))) + (cse (\arg_0 arg_1 -> arg_1))) + (cse (\arg_0 arg_1 -> arg_0))) + (force + ((\s -> s s) + (\s h -> + delay + (\fr -> + (\k -> + fr + (\x -> k (\f_0 f_1 -> f_0 x)) + (\x -> k (\f_0 f_1 -> f_1 x))) + (\fq -> force (s s h) (force h fq)))) + (delay + (\choose validateParamValue validateParamValues -> + choose + (\eta eta -> + force + (case + eta + [ (delay (constr 0 [])) + , (\preds -> + delay + (validatePreds + (constr 0 + [ (\x y -> + case + (equalsInteger + x + y) + [ (constr 1 []) + , (constr 0 []) ]) + , `$fOrdInteger_$ccompare` + , (\x y -> + case + (lessThanInteger + x + y) + [ (constr 1 []) + , (constr 0 []) ]) + , (\x y -> + case + (lessThanEqualsInteger + x + y) + [ (constr 1 []) + , (constr 0 []) ]) + , (\x y -> + case + (lessThanEqualsInteger + x + y) + [ (constr 0 []) + , (constr 1 []) ]) + , (\x y -> + case + (lessThanInteger + x + y) + [ (constr 0 []) + , (constr 1 []) ]) + , (\x y -> + force + (case (lessThanEqualsInteger x y) - (constr 0 []) - (constr 1 [])) - , (\x y -> - force ifThenElse + [ (delay x) + , (delay y) ])) + , (\x y -> + force + (case (lessThanEqualsInteger x y) - (constr 1 []) - (constr 0 [])) - , (\x y -> - force ifThenElse - (lessThanInteger - x - y) - (constr 1 []) - (constr 0 [])) - , (\x y -> - force - (force - (force - ifThenElse - (lessThanEqualsInteger - x - y) - (delay - (delay - y)) - (delay - (delay - x))))) - , (\x y -> - force - (force - (force - ifThenElse - (lessThanEqualsInteger - x - y) - (delay - (delay - x)) - (delay - (delay - y))))) ]) - preds - (unIData eta))) - , (\paramValues -> - delay - (validateParamValues - paramValues - (unListData eta))) - , (\preds -> - delay - ((\cse -> - (\cse -> - validatePreds - (constr 0 - [ (\ds ds -> - case - ds - [ (\n - d -> - case - ds - [ (\n' - d' -> - force - (force - (force - ifThenElse - (equalsInteger - n - n') - (delay - (delay - (force - ifThenElse - (equalsInteger - d - d') - (constr 0 - [ ]) - (constr 1 - [ ])))) - (delay - (delay - (constr 1 - [ ])))))) ]) ]) - , (\ds ds -> - case - ds - [ (\n - d -> - case - ds - [ (\n' - d' -> - `$fOrdInteger_$ccompare` + [ (delay y) + , (delay + x) ])) ]) + preds + (unIData eta))) + , (\paramValues -> + delay + (validateParamValues + paramValues + (unListData eta))) + , (\preds -> + delay + ((\cse -> + (\cse -> + validatePreds + (constr 0 + [ (\ds ds -> + case + ds + [ (\n d -> + case + ds + [ (\n' + d' -> + force + (case + (equalsInteger + n + n') + [ (delay + (constr 1 + [ ])) + , (delay + (case + (equalsInteger + d + d') + [ (constr 1 + [ ]) + , (constr 0 + [ ]) ])) ])) ]) ]) + , (\ds ds -> + case + ds + [ (\n d -> + case + ds + [ (\n' + d' -> + `$fOrdInteger_$ccompare` + (multiplyInteger + n + d') + (multiplyInteger + n' + d)) ]) ]) + , (\ds ds -> + case + ds + [ (\n d -> + case + ds + [ (\n' + d' -> + case + (lessThanInteger (multiplyInteger n d') (multiplyInteger n' - d)) ]) ]) - , (\ds ds -> - case - ds - [ (\n - d -> - case - ds - [ (\n' - d' -> - force - ifThenElse - (lessThanInteger - (multiplyInteger - n - d') - (multiplyInteger - n' - d)) - (constr 0 - [ ]) - (constr 1 - [ ])) ]) ]) - , `$fOrdRational0_$c<=` - , (\ds ds -> - case - ds - [ (\n - d -> - case - ds - [ (\n' - d' -> - force - ifThenElse - (lessThanEqualsInteger - (multiplyInteger - n - d') - (multiplyInteger - n' - d)) - (constr 1 - [ ]) - (constr 0 - [ ])) ]) ]) - , (\ds ds -> - case - ds - [ (\n - d -> - case - ds - [ (\n' - d' -> - force - ifThenElse - (lessThanInteger - (multiplyInteger - n - d') - (multiplyInteger - n' - d)) - (constr 1 - [ ]) - (constr 0 - [ ])) ]) ]) - , (\x y -> - force - (case - (`$fOrdRational0_$c<=` - x - y) - [ (delay - y) - , (delay - x) ])) - , (\x y -> - force - (case - (`$fOrdRational0_$c<=` - x - y) - [ (delay - x) - , (delay - y) ])) ]) - preds - (force ifThenElse - (force nullList - (force - tailList - cse)) - (\ds -> - unsafeRatio - (unIData - (force - headList - cse)) - (unIData - (force - headList - cse))) - (\ds -> error) - (constr 0 []))) - (force tailList cse)) - (unListData eta))) ])) - (\ds -> - case - ds - [ (\eta -> - force ifThenElse - (force nullList eta) - (constr 0 []) - (constr 1 [])) - , (\paramValueHd - paramValueTl - actualValueData -> - force - (case - (validateParamValue - paramValueHd - (force headList - actualValueData)) - [ (delay - (validateParamValues - paramValueTl - (force tailList - actualValueData))) - , (delay - (constr 1 - [])) ])) ])))))) - ((\s -> s s) - (\s n d -> - force - (force - (force ifThenElse - (equalsInteger 0 d) - (delay (delay error)) - (delay - (delay - (force - (force - (force ifThenElse - (lessThanInteger d 0) - (delay - (delay - ((\x -> s s x) - (subtractInteger 0 n) - (subtractInteger - 0 - d)))) - (delay - (delay - ((\gcd' -> - constr 0 - [ (quotientInteger - n - gcd') - , (quotientInteger - d - gcd') ]) - (euclid - n - d)))))))))))))) + d)) + [ (constr 1 + [ ]) + , (constr 0 + [ ]) ]) ]) ]) + , `$fOrdRational0_$c<=` + , (\ds ds -> + case + ds + [ (\n d -> + case + ds + [ (\n' + d' -> + case + (lessThanEqualsInteger + (multiplyInteger + n + d') + (multiplyInteger + n' + d)) + [ (constr 0 + [ ]) + , (constr 1 + [ ]) ]) ]) ]) + , (\ds ds -> + case + ds + [ (\n d -> + case + ds + [ (\n' + d' -> + case + (lessThanInteger + (multiplyInteger + n + d') + (multiplyInteger + n' + d)) + [ (constr 0 + [ ]) + , (constr 1 + [ ]) ]) ]) ]) + , (\x y -> + force + (case + (`$fOrdRational0_$c<=` + x + y) + [ (delay + y) + , (delay + x) ])) + , (\x y -> + force + (case + (`$fOrdRational0_$c<=` + x + y) + [ (delay + x) + , (delay + y) ])) ]) + preds + (case + (force nullList + (force tailList + cse)) + [ (\ds -> error) + , (\ds -> + unsafeRatio + (unIData + (force + headList + cse)) + (unIData + (force + headList + cse))) ] + (constr 0 []))) + (force tailList cse)) + (unListData eta))) ])) + (\ds -> + case + ds + [ (\eta -> + case + (force nullList eta) + [(constr 1 []), (constr 0 [])]) + , (\paramValueHd + paramValueTl + actualValueData -> + force + (case + (validateParamValue + paramValueHd + (force headList + actualValueData)) + [ (delay + (validateParamValues + paramValueTl + (force tailList + actualValueData))) + , (delay + (constr 1 [])) ])) ])))))) ((\s -> s s) - (\s x y -> + (\s n d -> force - (force - (force ifThenElse - (equalsInteger 0 y) - (delay (delay x)) - (delay (delay (s s y (modInteger x y))))))))) - (\`$dOrd` ds ds -> - (\s -> s s) - (\s ds -> - force - (case - ds - [ (delay (constr 0 [])) - , (\x xs -> - delay - (case - x - [ (\predKey expectedPredValues -> - (\meaning -> - (\s -> s s) - (\s ds -> - force + (case + (equalsInteger 0 d) + [ (delay + (force + (case + (lessThanInteger d 0) + [ (delay + ((\gcd' -> + constr 0 + [ (quotientInteger n gcd') + , (quotientInteger d gcd') ]) + (euclid n d))) + , (delay + ((\x -> s s x) + (subtractInteger 0 n) + (subtractInteger 0 d))) ]))) + , (delay error) ])))) + ((\s -> s s) + (\s x y -> + force + (case + (equalsInteger 0 y) + [(delay (s s y (modInteger x y))), (delay x)])))) + (\`$dOrd` ds ds -> + (\s -> s s) + (\s ds -> + force + (case + ds + [ (delay (constr 0 [])) + , (\x xs -> + delay + (case + x + [ (\predKey expectedPredValues -> + (\meaning -> + (\s -> s s) + (\s ds -> + force + (case + ds + [ (delay (s s xs)) + , (\x xs -> + delay + (force + (case + (meaning x ds) + [ (delay + (s s xs)) + , (delay + (constr 1 + [ ])) ]))) ])) + expectedPredValues) + (force + (case + predKey + [ (delay + (case + `$dOrd` + [ (\v v v v v v v v -> + v) ])) + , (delay (case - ds - [ (delay (s s xs)) - , (\x xs -> - delay - (force - (case - (meaning - x - ds) - [ (delay - (s - s - xs)) - , (delay - (constr 1 - [ ])) ]))) ])) - expectedPredValues) - (force - (case - predKey - [ (delay - (case - `$dOrd` - [ (\v v v v v v v v -> - v) ])) - , (delay - (case - `$dOrd` - [ (\v v v v v v v v -> - v) ])) - , (delay - (\x y -> - force + `$dOrd` + [ (\v v v v v v v v -> + v) ])) + , (delay + (\x y -> + force + (case (case - (case - `$dOrd` - [ (\v - v - v - v - v - v - v - v -> - v) ] - x - y) - [ (delay - (constr 1 - [])) - , (delay - (constr 0 - [ ])) ]))) ]))) ])) ])) - ds)) - (\x y -> - force ifThenElse (equalsInteger x y) (constr 0 []) (constr 1 []))) + `$dOrd` + [ (\v + v + v + v + v + v + v + v -> + v) ] + x + y) + [ (delay + (constr 1 [])) + , (delay + (constr 0 + [ ])) ]))) ]))) ])) ])) + ds)) (\eta eta -> force - (force - (force ifThenElse - (equalsInteger eta eta) - (delay (delay (constr 0 []))) - (delay - (delay - (force - (force - (force ifThenElse - (lessThanEqualsInteger eta eta) - (delay (delay (constr 2 []))) - (delay (delay (constr 1 [])))))))))))) + (case + (equalsInteger eta eta) + [ (delay + (force + (case + (lessThanEqualsInteger eta eta) + [(delay (constr 1 [])), (delay (constr 2 []))]))) + , (delay (constr 0 [])) ]))) (\ds ds -> case ds @@ -1389,9 +1324,8 @@ program case ds [ (\n' d' -> - force ifThenElse + case (lessThanEqualsInteger (multiplyInteger n d') (multiplyInteger n' d)) - (constr 0 []) - (constr 1 [])) ]) ])) \ No newline at end of file + [(constr 1 []), (constr 0 [])]) ]) ])) \ No newline at end of file diff --git a/plutus-benchmark/bitwise/test/9.6/8 queens.budget.golden b/plutus-benchmark/bitwise/test/9.6/8 queens.budget.golden index 4aae65b652a..636dca01865 100644 --- a/plutus-benchmark/bitwise/test/9.6/8 queens.budget.golden +++ b/plutus-benchmark/bitwise/test/9.6/8 queens.budget.golden @@ -1,2 +1,2 @@ -({cpu: 392812454016 -| mem: 1473152147}) \ No newline at end of file +({cpu: 327658552839 +| mem: 1230274574}) \ No newline at end of file diff --git a/plutus-benchmark/bitwise/test/9.6/8 queens.pir.golden b/plutus-benchmark/bitwise/test/9.6/8 queens.pir.golden index 05c8b04779c..97dfc71de7d 100644 --- a/plutus-benchmark/bitwise/test/9.6/8 queens.pir.golden +++ b/plutus-benchmark/bitwise/test/9.6/8 queens.pir.golden @@ -9,7 +9,7 @@ !selectByteString : integer -> bytestring -> integer = \(which : integer) (bs : bytestring) -> Bool_match - (ifThenElse {Bool} (lessThanEqualsInteger which 0) True False) + (case Bool (lessThanEqualsInteger which 0) [False, True]) {all dead. integer} (/\dead -> findFirstSetBit bs) (/\dead -> @@ -17,7 +17,7 @@ !i : integer = selectByteString (subtractInteger which 1) bs in Bool_match - (ifThenElse {Bool} (equalsInteger -1 i) True False) + (case Bool (equalsInteger -1 i) [False, True]) {all dead. integer} (/\dead -> -1) (/\dead -> @@ -80,7 +80,7 @@ (right : bytestring) (control : bytestring) -> Bool_match - (ifThenElse {Bool} (equalsInteger selectIx dim) True False) + (case Bool (equalsInteger selectIx dim) [False, True]) {all dead. List (Tuple2 integer integer)} (/\dead -> Nil {Tuple2 integer integer}) (/\dead -> @@ -88,16 +88,12 @@ !available : integer = selectByteString selectIx control in Bool_match - (ifThenElse {Bool} (equalsInteger -1 available) True False) + (case Bool (equalsInteger -1 available) [False, True]) {all dead. List (Tuple2 integer integer)} (/\dead -> Nil {Tuple2 integer integer}) (/\dead -> Bool_match - (ifThenElse - {Bool} - (equalsInteger row lastRow) - True - False) + (case Bool (equalsInteger row lastRow) [False, True]) {all dead. List (Tuple2 integer integer)} (/\dead -> (let @@ -198,16 +194,12 @@ !bytesNeeded : integer = quotientInteger dim 8 in Bool_match - (ifThenElse {Bool} (lessThanInteger dim 8) True False) + (case Bool (lessThanInteger dim 8) [False, True]) {all dead. List (Tuple2 integer integer)} (/\dead -> Nil {Tuple2 integer integer}) (/\dead -> Bool_match - (ifThenElse - {Bool} - (equalsInteger 0 (remainderInteger dim 8)) - True - False) + (case Bool (equalsInteger 0 (remainderInteger dim 8)) [False, True]) {all dead. List (Tuple2 integer integer)} (/\dead -> let diff --git a/plutus-benchmark/bitwise/test/9.6/8 queens.size.golden b/plutus-benchmark/bitwise/test/9.6/8 queens.size.golden index ffe78b01d34..52f6c1a7a0e 100644 --- a/plutus-benchmark/bitwise/test/9.6/8 queens.size.golden +++ b/plutus-benchmark/bitwise/test/9.6/8 queens.size.golden @@ -1 +1 @@ -401 \ No newline at end of file +352 \ No newline at end of file diff --git a/plutus-benchmark/bitwise/test/9.6/Ed25519.budget.golden b/plutus-benchmark/bitwise/test/9.6/Ed25519.budget.golden index e0b8a0a662d..9d8f39251d0 100644 --- a/plutus-benchmark/bitwise/test/9.6/Ed25519.budget.golden +++ b/plutus-benchmark/bitwise/test/9.6/Ed25519.budget.golden @@ -1,2 +1,2 @@ -({cpu: 2053676319882 -| mem: 6567331074}) \ No newline at end of file +({cpu: 1754036600690 +| mem: 5520448666}) \ No newline at end of file diff --git a/plutus-benchmark/bitwise/test/9.6/Ed25519.pir.golden b/plutus-benchmark/bitwise/test/9.6/Ed25519.pir.golden index de4b86f3f7d..820e3400b90 100644 --- a/plutus-benchmark/bitwise/test/9.6/Ed25519.pir.golden +++ b/plutus-benchmark/bitwise/test/9.6/Ed25519.pir.golden @@ -36,13 +36,13 @@ {all dead. dead}) !even : integer -> Bool = \(n : integer) -> - ifThenElse {Bool} (equalsInteger 0 (modInteger n 2)) True False + case Bool (equalsInteger 0 (modInteger n 2)) [False, True] in letrec !expModManual : integer -> integer -> integer -> integer = \(b' : integer) (e : integer) (m : integer) -> Bool_match - (ifThenElse {Bool} (equalsInteger 0 e) True False) + (case Bool (equalsInteger 0 e) [False, True]) {all dead. integer} (/\dead -> 1) (/\dead -> @@ -178,15 +178,14 @@ {all dead. dead} in Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 0 (modInteger (subtractInteger (multiplyInteger x x) xx) 57896044618658097711785492504343953926634992332820282019728792003956564819949)) - True - False) + [False, True]) {all dead. integer} (/\dead -> `$j` False) (/\dead -> `$j` True) @@ -208,7 +207,7 @@ (Nil {integer})) False) !x : integer = xRecover yInt - !x_ : Bool = ifThenElse {Bool} (readBit bs 7) True False + !x_ : Bool = case Bool (readBit bs 7) [False, True] in Bool_match (even x) @@ -372,11 +371,10 @@ (next : bytestring -> SHA512State -> Tuple2 SHA512State bytestring) (input : bytestring) -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 0 (lengthOfByteString input)) - True - False) + [False, True]) {all dead. SHA512State} (/\dead -> state) (/\dead -> @@ -459,7 +457,7 @@ !scalarMult : Tuple2 integer integer -> integer -> Tuple2 integer integer = \(p : Tuple2 integer integer) (e : integer) -> Bool_match - (ifThenElse {Bool} (equalsInteger 0 e) True False) + (case Bool (equalsInteger 0 e) [False, True]) {all dead. Tuple2 integer integer} (/\dead -> Tuple2 {integer} {integer} 0 1) (/\dead -> @@ -484,11 +482,10 @@ !added : integer = addInteger (byteStringToInteger True x) yI in Bool_match - (ifThenElse - {Bool} + (case + Bool (lessThanInteger 18446744073709551615 added) - True - False) + [False, True]) {all dead. bytestring} (/\dead -> g @@ -582,11 +579,10 @@ (\(x : integer) (y : integer) -> let !xLSBVal : Bool - = ifThenElse - {Bool} + = case + Bool (readBit (integerToByteString False 32 x) 248) - True - False + [False, True] in writeBits (integerToByteString False 32 y) @@ -2242,7 +2238,7 @@ 1 in Bool_match - (ifThenElse {Bool} (lessThanEqualsInteger r -1) True False) + (case Bool (lessThanEqualsInteger r -1) [False, True]) {all dead. bytestring} (/\dead -> `$j` (addInteger 1024 r)) (/\dead -> `$j` r) @@ -2295,9 +2291,9 @@ {Bool} (\(x : integer) (y : integer) -> Bool_match - (ifThenElse {Bool} (equalsInteger x x) True False) + (case Bool (equalsInteger x x) [False, True]) {all dead. Bool} - (/\dead -> ifThenElse {Bool} (equalsInteger y y) True False) + (/\dead -> case Bool (equalsInteger y y) [False, True]) (/\dead -> False) {all dead. dead}))) (B #c080c2932178c2adc2a7c3917a6009c3b37cc383245824c3a9c2a6c3aac080c286c2986c14c3b334c39915c298c2b47b244dc3a352c396c39a25c3b1c29d050e0509c298c28cc2abc3b0c38866c2b8c285c38bc3a37ac2a3c080c2b9c29b59c28bc2b2c3b902) diff --git a/plutus-benchmark/bitwise/test/9.6/Ed25519.size.golden b/plutus-benchmark/bitwise/test/9.6/Ed25519.size.golden index f243121f517..76ce2a5fd9e 100644 --- a/plutus-benchmark/bitwise/test/9.6/Ed25519.size.golden +++ b/plutus-benchmark/bitwise/test/9.6/Ed25519.size.golden @@ -1 +1 @@ -3420 \ No newline at end of file +3355 \ No newline at end of file diff --git a/plutus-benchmark/bls12-381-costs/test/9.6/bls12-381-costs.golden b/plutus-benchmark/bls12-381-costs/test/9.6/bls12-381-costs.golden index f499e4e0924..13bf92d7f2f 100644 --- a/plutus-benchmark/bls12-381-costs/test/9.6/bls12-381-costs.golden +++ b/plutus-benchmark/bls12-381-costs/test/9.6/bls12-381-costs.golden @@ -90,56 +90,56 @@ Apply pairing to two pairs of points in G1 x G2 and run finalVerify on the resul n Script size CPU usage Memory usage ---------------------------------------------------------------------- - - 342 (2.1%) 1097919597 (11.0%) 4654 (0.0%) + - 339 (2.1%) 1097763548 (11.0%) 4153 (0.0%) Groth16 verification example n Script size CPU usage Memory usage ---------------------------------------------------------------------- - - 779 (4.8%) 1996880342 (20.0%) 10904 (0.1%) + - 777 (4.7%) 1996724293 (20.0%) 10403 (0.1%) VRF example n Script size CPU usage Memory usage ---------------------------------------------------------------------- - - 674 (4.1%) 1218869236 (12.2%) 36049 (0.3%) + - 668 (4.1%) 1218525138 (12.2%) 34847 (0.2%) G1 Verify n Script size CPU usage Memory usage ---------------------------------------------------------------------- - - 332 (2.0%) 1190332196 (11.9%) 5754 (0.0%) + - 330 (2.0%) 1190176147 (11.9%) 5253 (0.0%) G2 Verify n Script size CPU usage Memory usage ---------------------------------------------------------------------- - - 380 (2.3%) 1097700554 (11.0%) 5754 (0.0%) + - 378 (2.3%) 1097544505 (11.0%) 5253 (0.0%) Aggregate Single Key n Script size CPU usage Memory usage ---------------------------------------------------------------------- - - 813 (5.0%) 2717766359 (27.2%) 50502 (0.4%) + - 811 (4.9%) 2717610310 (27.2%) 50001 (0.4%) Aggregate Multi Key n Script size CPU usage Memory usage ---------------------------------------------------------------------- - - 1821 (11.1%) 3431779236 (34.3%) 331186 (2.4%) + - 1815 (11.1%) 3430870991 (34.3%) 327881 (2.3%) Schnorr Signature G1 n Script size CPU usage Memory usage ---------------------------------------------------------------------- - - 353 (2.2%) 319926564 (3.2%) 12196 (0.1%) + - 347 (2.1%) 319582466 (3.2%) 10994 (0.1%) Schnorr Signature G2 n Script size CPU usage Memory usage ---------------------------------------------------------------------- - - 497 (3.0%) 552137171 (5.5%) 12364 (0.1%) + - 491 (3.0%) 551793073 (5.5%) 11162 (0.1%) Groth16Verify succeeded Simple Verify succeeded diff --git a/plutus-benchmark/ed25519-costs/test/9.6/ed25519-costs.golden b/plutus-benchmark/ed25519-costs/test/9.6/ed25519-costs.golden index f092d474574..7e489beb25a 100644 --- a/plutus-benchmark/ed25519-costs/test/9.6/ed25519-costs.golden +++ b/plutus-benchmark/ed25519-costs/test/9.6/ed25519-costs.golden @@ -1,20 +1,20 @@ n Script size CPU usage Memory usage ---------------------------------------------------------------------- - 0 454 (2.8%) 4890441 (0.0%) 24222 (0.2%) - 10 2181 (13.3%) 644395741 (6.4%) 501052 (3.6%) - 20 3908 (23.9%) 1283901041 (12.8%) 977882 (7.0%) - 30 5635 (34.4%) 1923406341 (19.2%) 1454712 (10.4%) - 40 7362 (44.9%) 2562911641 (25.6%) 1931542 (13.8%) - 50 9088 (55.5%) 3202416941 (32.0%) 2408372 (17.2%) - 60 10815 (66.0%) 3841922241 (38.4%) 2885202 (20.6%) - 70 12542 (76.6%) 4481427541 (44.8%) 3362032 (24.0%) - 80 14268 (87.1%) 5120932841 (51.2%) 3838862 (27.4%) - 90 15995 (97.6%) 5760438141 (57.6%) 4315692 (30.8%) - 100 17722 (108.2%) 6399943441 (64.0%) 4792522 (34.2%) - 110 19449 (118.7%) 7039448741 (70.4%) 5269352 (37.6%) - 120 21175 (129.2%) 7678954041 (76.8%) 5746182 (41.0%) - 130 22902 (139.8%) 8318459341 (83.2%) 6223012 (44.5%) - 140 24629 (150.3%) 8957964641 (89.6%) 6699842 (47.9%) - 150 26356 (160.9%) 9597469941 (96.0%) 7176672 (51.3%) + 0 440 (2.7%) 4702392 (0.0%) 23521 (0.2%) + 10 2167 (13.2%) 638886222 (6.4%) 481321 (3.4%) + 20 3894 (23.8%) 1273070052 (12.7%) 939121 (6.7%) + 30 5621 (34.3%) 1907253882 (19.1%) 1396921 (10.0%) + 40 7348 (44.8%) 2541437712 (25.4%) 1854721 (13.2%) + 50 9074 (55.4%) 3175621542 (31.8%) 2312521 (16.5%) + 60 10801 (65.9%) 3809805372 (38.1%) 2770321 (19.8%) + 70 12528 (76.5%) 4443989202 (44.4%) 3228121 (23.1%) + 80 14254 (87.0%) 5078173032 (50.8%) 3685921 (26.3%) + 90 15981 (97.5%) 5712356862 (57.1%) 4143721 (29.6%) + 100 17708 (108.1%) 6346540692 (63.5%) 4601521 (32.9%) + 110 19435 (118.6%) 6980724522 (69.8%) 5059321 (36.1%) + 120 21161 (129.2%) 7614908352 (76.1%) 5517121 (39.4%) + 130 22888 (139.7%) 8249092182 (82.5%) 5974921 (42.7%) + 140 24615 (150.2%) 8883276012 (88.8%) 6432721 (45.9%) + 150 26342 (160.8%) 9517459842 (95.2%) 6890521 (49.2%) Off-chain version succeeded on 100 inputs diff --git a/plutus-benchmark/lists/test/Lookup/9.6/match-builtin-list-10.budget.golden b/plutus-benchmark/lists/test/Lookup/9.6/match-builtin-list-10.budget.golden index 7113b97582f..d151ce37f70 100644 --- a/plutus-benchmark/lists/test/Lookup/9.6/match-builtin-list-10.budget.golden +++ b/plutus-benchmark/lists/test/Lookup/9.6/match-builtin-list-10.budget.golden @@ -1,2 +1,2 @@ -({cpu: 186358904 -| mem: 777152}) \ No newline at end of file +({cpu: 165673514 +| mem: 700042}) \ No newline at end of file diff --git a/plutus-benchmark/lists/test/Lookup/9.6/match-builtin-list-100.budget.golden b/plutus-benchmark/lists/test/Lookup/9.6/match-builtin-list-100.budget.golden index 9e57615d2d2..9b0701558cc 100644 --- a/plutus-benchmark/lists/test/Lookup/9.6/match-builtin-list-100.budget.golden +++ b/plutus-benchmark/lists/test/Lookup/9.6/match-builtin-list-100.budget.golden @@ -1,2 +1,2 @@ -({cpu: 15529620194 -| mem: 64424432}) \ No newline at end of file +({cpu: 13630325294 +| mem: 57344332}) \ No newline at end of file diff --git a/plutus-benchmark/lists/test/Lookup/9.6/match-builtin-list-5.budget.golden b/plutus-benchmark/lists/test/Lookup/9.6/match-builtin-list-5.budget.golden index 84c794f9e74..445540a915a 100644 --- a/plutus-benchmark/lists/test/Lookup/9.6/match-builtin-list-5.budget.golden +++ b/plutus-benchmark/lists/test/Lookup/9.6/match-builtin-list-5.budget.golden @@ -1,2 +1,2 @@ -({cpu: 55669074 -| mem: 233692}) \ No newline at end of file +({cpu: 50027604 +| mem: 212662}) \ No newline at end of file diff --git a/plutus-benchmark/lists/test/Lookup/9.6/match-builtin-list-50.budget.golden b/plutus-benchmark/lists/test/Lookup/9.6/match-builtin-list-50.budget.golden index f779c59729e..59304f741d2 100644 --- a/plutus-benchmark/lists/test/Lookup/9.6/match-builtin-list-50.budget.golden +++ b/plutus-benchmark/lists/test/Lookup/9.6/match-builtin-list-50.budget.golden @@ -1,2 +1,2 @@ -({cpu: 3966792144 -| mem: 16464832}) \ No newline at end of file +({cpu: 3487267194 +| mem: 14677282}) \ No newline at end of file diff --git a/plutus-benchmark/lists/test/Lookup/9.6/match-scott-list-10.budget.golden b/plutus-benchmark/lists/test/Lookup/9.6/match-scott-list-10.budget.golden index a62374bc6ee..dce4913a3ec 100644 --- a/plutus-benchmark/lists/test/Lookup/9.6/match-scott-list-10.budget.golden +++ b/plutus-benchmark/lists/test/Lookup/9.6/match-scott-list-10.budget.golden @@ -1,2 +1,2 @@ -({cpu: 105649780 -| mem: 487880}) \ No newline at end of file +({cpu: 81203410 +| mem: 396750}) \ No newline at end of file diff --git a/plutus-benchmark/lists/test/Lookup/9.6/match-scott-list-100.budget.golden b/plutus-benchmark/lists/test/Lookup/9.6/match-scott-list-100.budget.golden index 26f4a865271..b8632c4f2fb 100644 --- a/plutus-benchmark/lists/test/Lookup/9.6/match-scott-list-100.budget.golden +++ b/plutus-benchmark/lists/test/Lookup/9.6/match-scott-list-100.budget.golden @@ -1,2 +1,2 @@ -({cpu: 8446054900 -| mem: 38184200}) \ No newline at end of file +({cpu: 6509150200 +| mem: 30963900}) \ No newline at end of file diff --git a/plutus-benchmark/lists/test/Lookup/9.6/match-scott-list-5.budget.golden b/plutus-benchmark/lists/test/Lookup/9.6/match-scott-list-5.budget.golden index 606143a7917..c29d5ed7589 100644 --- a/plutus-benchmark/lists/test/Lookup/9.6/match-scott-list-5.budget.golden +++ b/plutus-benchmark/lists/test/Lookup/9.6/match-scott-list-5.budget.golden @@ -1,2 +1,2 @@ -({cpu: 32549190 -| mem: 153040}) \ No newline at end of file +({cpu: 25027230 +| mem: 125000}) \ No newline at end of file diff --git a/plutus-benchmark/lists/test/Lookup/9.6/match-scott-list-50.budget.golden b/plutus-benchmark/lists/test/Lookup/9.6/match-scott-list-50.budget.golden index ba48d902719..0925cc389fe 100644 --- a/plutus-benchmark/lists/test/Lookup/9.6/match-scott-list-50.budget.golden +++ b/plutus-benchmark/lists/test/Lookup/9.6/match-scott-list-50.budget.golden @@ -1,2 +1,2 @@ -({cpu: 2169316500 -| mem: 9833800}) \ No newline at end of file +({cpu: 1670986650 +| mem: 7976150}) \ No newline at end of file diff --git a/plutus-benchmark/lists/test/Sum/9.6/left-fold-data.budget.golden b/plutus-benchmark/lists/test/Sum/9.6/left-fold-data.budget.golden index a84f88757da..c8d1c094689 100644 --- a/plutus-benchmark/lists/test/Sum/9.6/left-fold-data.budget.golden +++ b/plutus-benchmark/lists/test/Sum/9.6/left-fold-data.budget.golden @@ -1,2 +1,2 @@ -({cpu: 316399632 -| mem: 1277230}) \ No newline at end of file +({cpu: 278601783 +| mem: 1136329}) \ No newline at end of file diff --git a/plutus-benchmark/lists/test/Sum/9.6/right-fold-data.budget.golden b/plutus-benchmark/lists/test/Sum/9.6/right-fold-data.budget.golden index 57dceffe19f..4f7a7746f19 100644 --- a/plutus-benchmark/lists/test/Sum/9.6/right-fold-data.budget.golden +++ b/plutus-benchmark/lists/test/Sum/9.6/right-fold-data.budget.golden @@ -1,2 +1,2 @@ -({cpu: 321199632 -| mem: 1307230}) \ No newline at end of file +({cpu: 283401783 +| mem: 1166329}) \ No newline at end of file diff --git a/plutus-benchmark/nofib/test/9.6/clausify-F5.budget.golden b/plutus-benchmark/nofib/test/9.6/clausify-F5.budget.golden index a9fc0ed6e8e..197fd484895 100644 --- a/plutus-benchmark/nofib/test/9.6/clausify-F5.budget.golden +++ b/plutus-benchmark/nofib/test/9.6/clausify-F5.budget.golden @@ -1,2 +1,2 @@ -({cpu: 50208867160 -| mem: 293575180}) \ No newline at end of file +({cpu: 45969754450 +| mem: 279787390}) \ No newline at end of file diff --git a/plutus-benchmark/nofib/test/9.6/clausify-F5.pir.golden b/plutus-benchmark/nofib/test/9.6/clausify-F5.pir.golden index 1ab3eca1a70..f72fe3bcd6c 100644 --- a/plutus-benchmark/nofib/test/9.6/clausify-F5.pir.golden +++ b/plutus-benchmark/nofib/test/9.6/clausify-F5.pir.golden @@ -38,46 +38,44 @@ Ord a !equalsInteger : integer -> integer -> Bool = \(x : integer) (y : integer) -> - ifThenElse {Bool} (equalsInteger x y) True False + case Bool (equalsInteger x y) [False, True] + !ifThenElse : all a. bool -> a -> a -> a + = /\a -> \(b : bool) (x : a) (y : a) -> case a b [y, x] !`$fOrdInteger` : Ord integer = CConsOrd {integer} equalsInteger (\(eta : integer) (eta : integer) -> Bool_match - (ifThenElse {Bool} (equalsInteger eta eta) True False) + (case Bool (equalsInteger eta eta) [False, True]) {all dead. Ordering} (/\dead -> EQ) (/\dead -> Bool_match - (ifThenElse - {Bool} - (lessThanEqualsInteger eta eta) - True - False) + (case Bool (lessThanEqualsInteger eta eta) [False, True]) {all dead. Ordering} (/\dead -> LT) (/\dead -> GT) {all dead. dead}) {all dead. dead}) (\(x : integer) (y : integer) -> - ifThenElse {Bool} (lessThanInteger x y) True False) + case Bool (lessThanInteger x y) [False, True]) (\(x : integer) (y : integer) -> - ifThenElse {Bool} (lessThanEqualsInteger x y) True False) + case Bool (lessThanEqualsInteger x y) [False, True]) (\(x : integer) (y : integer) -> ifThenElse {Bool} (lessThanEqualsInteger x y) False True) (\(x : integer) (y : integer) -> ifThenElse {Bool} (lessThanInteger x y) False True) (\(x : integer) (y : integer) -> Bool_match - (ifThenElse {Bool} (lessThanEqualsInteger x y) True False) + (case Bool (lessThanEqualsInteger x y) [False, True]) {all dead. integer} (/\dead -> y) (/\dead -> x) {all dead. dead}) (\(x : integer) (y : integer) -> Bool_match - (ifThenElse {Bool} (lessThanEqualsInteger x y) True False) + (case Bool (lessThanEqualsInteger x y) [False, True]) {all dead. integer} (/\dead -> x) (/\dead -> y) @@ -434,13 +432,13 @@ List integer) -> /\dead -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger y x) - True - False) + [ False + , True ]) {all dead. Bool} (/\dead -> diff --git a/plutus-benchmark/nofib/test/9.6/clausify-F5.size.golden b/plutus-benchmark/nofib/test/9.6/clausify-F5.size.golden index 655c142ccc8..f14fd467eb5 100644 --- a/plutus-benchmark/nofib/test/9.6/clausify-F5.size.golden +++ b/plutus-benchmark/nofib/test/9.6/clausify-F5.size.golden @@ -1 +1 @@ -1615 \ No newline at end of file +1560 \ No newline at end of file diff --git a/plutus-benchmark/nofib/test/9.6/knights10-4x4.budget.golden b/plutus-benchmark/nofib/test/9.6/knights10-4x4.budget.golden index 27b64180b8f..9953c24ce9e 100644 --- a/plutus-benchmark/nofib/test/9.6/knights10-4x4.budget.golden +++ b/plutus-benchmark/nofib/test/9.6/knights10-4x4.budget.golden @@ -1,2 +1,2 @@ -({cpu: 1439822000 -| mem: 7307612}) \ No newline at end of file +({cpu: 1168462754 +| mem: 6301258}) \ No newline at end of file diff --git a/plutus-benchmark/nofib/test/9.6/knights10-4x4.pir.golden b/plutus-benchmark/nofib/test/9.6/knights10-4x4.pir.golden index cc25a8c7b52..3e3385c990d 100644 --- a/plutus-benchmark/nofib/test/9.6/knights10-4x4.pir.golden +++ b/plutus-benchmark/nofib/test/9.6/knights10-4x4.pir.golden @@ -49,48 +49,44 @@ `$fEqChessSet_$c==` (\(x : ChessSet) (y : ChessSet) -> y) (\(x : ChessSet) (y : ChessSet) -> x) - !equalsInteger : integer -> integer -> Bool - = \(x : integer) (y : integer) -> - ifThenElse {Bool} (equalsInteger x y) True False + !ifThenElse : all a. bool -> a -> a -> a + = /\a -> \(b : bool) (x : a) (y : a) -> case a b [y, x] !v : Ord integer = CConsOrd {integer} - equalsInteger + (\(x : integer) (y : integer) -> + case Bool (equalsInteger x y) [False, True]) (\(eta : integer) (eta : integer) -> Bool_match - (ifThenElse {Bool} (equalsInteger eta eta) True False) + (case Bool (equalsInteger eta eta) [False, True]) {all dead. Ordering} (/\dead -> EQ) (/\dead -> Bool_match - (ifThenElse - {Bool} - (lessThanEqualsInteger eta eta) - True - False) + (case Bool (lessThanEqualsInteger eta eta) [False, True]) {all dead. Ordering} (/\dead -> LT) (/\dead -> GT) {all dead. dead}) {all dead. dead}) (\(x : integer) (y : integer) -> - ifThenElse {Bool} (lessThanInteger x y) True False) + case Bool (lessThanInteger x y) [False, True]) (\(x : integer) (y : integer) -> - ifThenElse {Bool} (lessThanEqualsInteger x y) True False) + case Bool (lessThanEqualsInteger x y) [False, True]) (\(x : integer) (y : integer) -> ifThenElse {Bool} (lessThanEqualsInteger x y) False True) (\(x : integer) (y : integer) -> ifThenElse {Bool} (lessThanInteger x y) False True) (\(x : integer) (y : integer) -> Bool_match - (ifThenElse {Bool} (lessThanEqualsInteger x y) True False) + (case Bool (lessThanEqualsInteger x y) [False, True]) {all dead. integer} (/\dead -> y) (/\dead -> x) {all dead. dead}) (\(x : integer) (y : integer) -> Bool_match - (ifThenElse {Bool} (lessThanEqualsInteger x y) True False) + (case Bool (lessThanEqualsInteger x y) [False, True]) {all dead. integer} (/\dead -> x) (/\dead -> y) @@ -171,7 +167,7 @@ (growFn : a -> List a) (finFn : a -> Bool) -> Bool_match - (ifThenElse {Bool} (equalsInteger 0 depth) True False) + (case Bool (equalsInteger 0 depth) [False, True]) {all dead. List a} (/\dead -> Nil {a}) (/\dead -> @@ -625,11 +621,10 @@ {all dead. Bool} (/\dead -> Bool_match - (ifThenElse - {Bool} + (case + Bool (lessThanEqualsInteger x ipv) - True - False) + [False, True]) {all dead. Bool} (/\dead -> Bool_match @@ -641,11 +636,10 @@ {all dead. Bool} (/\dead -> Bool_match - (ifThenElse - {Bool} + (case + Bool (lessThanEqualsInteger y ipv) - True - False) + [False, True]) {all dead. Bool} (/\dead -> notIn @@ -666,20 +660,18 @@ (\(a' : integer) (b' : integer) -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger a a') - True - False) + [False, True]) {all dead. Bool} (/\dead -> - ifThenElse - {Bool} + case + Bool (equalsInteger b b') - True - False) + [False, True]) (/\dead -> False) {all dead. dead}))) t @@ -932,7 +924,7 @@ {Bool} (\(a' : integer) (b' : ChessSet) -> Bool_match - (equalsInteger a a') + (case Bool (equalsInteger a a') [False, True]) {all dead. Bool} (/\dead -> True) (/\dead -> False) @@ -989,15 +981,14 @@ in c (Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 0 (remainderInteger boardSize 2)) - True - False) + [False, True]) {all dead. ChessSet} (/\dead -> Board @@ -1069,11 +1060,7 @@ !go : integer -> List integer = \(n : integer) -> Bool_match - (ifThenElse - {Bool} - (lessThanEqualsInteger n 0) - True - False) + (case Bool (lessThanEqualsInteger n 0) [False, True]) {all dead. List integer} (/\dead -> Nil {integer}) (/\dead -> Cons {integer} x (go (subtractInteger n 1))) @@ -1151,11 +1138,10 @@ {a} (\(y : integer) (x : ChessSet) -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 1 y) - True - False) + [False, True]) {all dead. a} (/\dead -> c x ds) (/\dead -> ds) @@ -1211,13 +1197,12 @@ ipv)) {all dead. dead} in - ifThenElse - {Bool} + case + Bool (equalsInteger 0 (length {Direction} (possibleMoves board))) - True - False) + [False, True]) (/\dead -> False) {all dead. dead}) {all dead. List ChessSet} @@ -1227,7 +1212,7 @@ !l : integer = length {ChessSet} singles in Bool_match - (ifThenElse {Bool} (equalsInteger 0 l) True False) + (case Bool (equalsInteger 0 l) [False, True]) {all dead. List ChessSet} (/\dead -> go @@ -1547,11 +1532,7 @@ (descAndNo y))) (/\dead -> Bool_match - (ifThenElse - {Bool} - (equalsInteger 1 l) - True - False) + (case Bool (equalsInteger 1 l) [False, True]) {all dead. List ChessSet} (/\dead -> singles) (/\dead -> Nil {ChessSet}) @@ -1573,11 +1554,10 @@ (ipv : Maybe (Tuple2 integer integer)) (ipv : List (Tuple2 integer integer)) -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger ipv (multiplyInteger ipv ipv)) - True - False) + [False, True]) {all dead. Bool} (/\dead -> canMoveTo diff --git a/plutus-benchmark/nofib/test/9.6/knights10-4x4.size.golden b/plutus-benchmark/nofib/test/9.6/knights10-4x4.size.golden index 0969ba647e2..bef933cfa1a 100644 --- a/plutus-benchmark/nofib/test/9.6/knights10-4x4.size.golden +++ b/plutus-benchmark/nofib/test/9.6/knights10-4x4.size.golden @@ -1 +1 @@ -2084 \ No newline at end of file +1934 \ No newline at end of file diff --git a/plutus-benchmark/nofib/test/9.6/queens4-bt.budget.golden b/plutus-benchmark/nofib/test/9.6/queens4-bt.budget.golden index 7a33af25f35..b7d2721b1cc 100644 --- a/plutus-benchmark/nofib/test/9.6/queens4-bt.budget.golden +++ b/plutus-benchmark/nofib/test/9.6/queens4-bt.budget.golden @@ -1,2 +1,2 @@ -({cpu: 4489854267 -| mem: 24151930}) \ No newline at end of file +({cpu: 3857821578 +| mem: 21795869}) \ No newline at end of file diff --git a/plutus-benchmark/nofib/test/9.6/queens4-bt.pir.golden b/plutus-benchmark/nofib/test/9.6/queens4-bt.pir.golden index 9063fed4b0d..e571b331db8 100644 --- a/plutus-benchmark/nofib/test/9.6/queens4-bt.pir.golden +++ b/plutus-benchmark/nofib/test/9.6/queens4-bt.pir.golden @@ -136,7 +136,7 @@ Fc : Algorithm !equalsInteger : integer -> integer -> Bool = \(x : integer) (y : integer) -> - ifThenElse {Bool} (equalsInteger x y) True False + case Bool (equalsInteger x y) [False, True] data Unit | Unit_match where Unit : Unit in @@ -281,11 +281,10 @@ (xs : List integer) -> /\dead -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger a x) - True - False) + [False, True]) {all dead. Bool} (/\dead -> False) (/\dead -> go xs) @@ -336,8 +335,8 @@ (ipv : integer) (ipv : Assign -> Assign -> Bool) -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger (List_match {Assign} @@ -350,8 +349,7 @@ {integer} (\(var : integer) (val : integer) -> var))) ipv) - True - False) + [False, True]) {all dead. ConflictSet} (/\dead -> Known (Nil {integer})) (/\dead -> Unknown) @@ -556,7 +554,7 @@ !interval : integer -> integer -> List integer = \(a : integer) (b : integer) -> Bool_match - (ifThenElse {Bool} (lessThanEqualsInteger a b) False True) + (case Bool (lessThanEqualsInteger a b) [True, False]) {all dead. List integer} (/\dead -> Nil {integer}) (/\dead -> Cons {integer} a (interval (addInteger 1 a) b)) @@ -1000,7 +998,7 @@ (\(x : ConflictSet) (xs : List ConflictSet) -> /\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 0 ds) True False) + (case Bool (equalsInteger 0 ds) [False, True]) {all dead. ConflictSet} (/\dead -> x) (/\dead -> go (subtractInteger ds 1) xs) @@ -1072,11 +1070,7 @@ 1 in Bool_match - (ifThenElse - {Bool} - (lessThanInteger n 0) - True - False) + (case Bool (lessThanInteger n 0) [False, True]) {all dead. ConflictSet} (/\dead -> traceError {ConflictSet} "PT6") (/\dead -> go n ds) @@ -1101,7 +1095,7 @@ !abs : integer -> integer = \(n : integer) -> Bool_match - (ifThenElse {Bool} (lessThanInteger n 0) True False) + (case Bool (lessThanInteger n 0) [False, True]) {all dead. integer} (/\dead -> subtractInteger 0 n) (/\dead -> n) @@ -1240,7 +1234,7 @@ (\(j : integer) (n : integer) -> Bool_match (Bool_match - (ifThenElse {Bool} (equalsInteger m n) True False) + (case Bool (equalsInteger m n) [False, True]) {all dead. Bool} (/\dead -> False) (/\dead -> True) @@ -1248,13 +1242,12 @@ {all dead. Bool} (/\dead -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger (abs (subtractInteger i j)) (abs (subtractInteger m n))) - True - False) + [False, True]) {all dead. Bool} (/\dead -> False) (/\dead -> True) @@ -1683,8 +1676,8 @@ {all dead. dead} in Bool_match - (ifThenElse - {Bool} + (case + Bool (lessThanInteger (List_match {Assign} @@ -1700,8 +1693,7 @@ (val : integer) -> var))) ds) - True - False) + [False, True]) {all dead. a} (/\dead -> go vallist) (/\dead -> n) diff --git a/plutus-benchmark/nofib/test/9.6/queens4-bt.size.golden b/plutus-benchmark/nofib/test/9.6/queens4-bt.size.golden index 8c3d94066ac..696ee7741d6 100644 --- a/plutus-benchmark/nofib/test/9.6/queens4-bt.size.golden +++ b/plutus-benchmark/nofib/test/9.6/queens4-bt.size.golden @@ -1 +1 @@ -2097 \ No newline at end of file +2030 \ No newline at end of file diff --git a/plutus-benchmark/nofib/test/9.6/queens5-fc.budget.golden b/plutus-benchmark/nofib/test/9.6/queens5-fc.budget.golden index 39c26223191..b842844daaf 100644 --- a/plutus-benchmark/nofib/test/9.6/queens5-fc.budget.golden +++ b/plutus-benchmark/nofib/test/9.6/queens5-fc.budget.golden @@ -1,2 +1,2 @@ -({cpu: 154541726621 -| mem: 869009466}) \ No newline at end of file +({cpu: 137974261782 +| mem: 812282055}) \ No newline at end of file diff --git a/plutus-benchmark/nofib/test/9.6/queens5-fc.pir.golden b/plutus-benchmark/nofib/test/9.6/queens5-fc.pir.golden index 2dcc21b97f5..570182cbbf2 100644 --- a/plutus-benchmark/nofib/test/9.6/queens5-fc.pir.golden +++ b/plutus-benchmark/nofib/test/9.6/queens5-fc.pir.golden @@ -136,7 +136,7 @@ Fc : Algorithm !equalsInteger : integer -> integer -> Bool = \(x : integer) (y : integer) -> - ifThenElse {Bool} (equalsInteger x y) True False + case Bool (equalsInteger x y) [False, True] data Unit | Unit_match where Unit : Unit in @@ -281,11 +281,10 @@ (xs : List integer) -> /\dead -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger a x) - True - False) + [False, True]) {all dead. Bool} (/\dead -> False) (/\dead -> go xs) @@ -336,8 +335,8 @@ (ipv : integer) (ipv : Assign -> Assign -> Bool) -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger (List_match {Assign} @@ -350,8 +349,7 @@ {integer} (\(var : integer) (val : integer) -> var))) ipv) - True - False) + [False, True]) {all dead. ConflictSet} (/\dead -> Known (Nil {integer})) (/\dead -> Unknown) @@ -556,7 +554,7 @@ !interval : integer -> integer -> List integer = \(a : integer) (b : integer) -> Bool_match - (ifThenElse {Bool} (lessThanEqualsInteger a b) False True) + (case Bool (lessThanEqualsInteger a b) [True, False]) {all dead. List integer} (/\dead -> Nil {integer}) (/\dead -> Cons {integer} a (interval (addInteger 1 a) b)) @@ -1000,7 +998,7 @@ (\(x : ConflictSet) (xs : List ConflictSet) -> /\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 0 ds) True False) + (case Bool (equalsInteger 0 ds) [False, True]) {all dead. ConflictSet} (/\dead -> x) (/\dead -> go (subtractInteger ds 1) xs) @@ -1072,11 +1070,7 @@ 1 in Bool_match - (ifThenElse - {Bool} - (lessThanInteger n 0) - True - False) + (case Bool (lessThanInteger n 0) [False, True]) {all dead. ConflictSet} (/\dead -> traceError {ConflictSet} "PT6") (/\dead -> go n ds) @@ -1101,7 +1095,7 @@ !abs : integer -> integer = \(n : integer) -> Bool_match - (ifThenElse {Bool} (lessThanInteger n 0) True False) + (case Bool (lessThanInteger n 0) [False, True]) {all dead. integer} (/\dead -> subtractInteger 0 n) (/\dead -> n) @@ -1240,7 +1234,7 @@ (\(j : integer) (n : integer) -> Bool_match (Bool_match - (ifThenElse {Bool} (equalsInteger m n) True False) + (case Bool (equalsInteger m n) [False, True]) {all dead. Bool} (/\dead -> False) (/\dead -> True) @@ -1248,13 +1242,12 @@ {all dead. Bool} (/\dead -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger (abs (subtractInteger i j)) (abs (subtractInteger m n))) - True - False) + [False, True]) {all dead. Bool} (/\dead -> False) (/\dead -> True) @@ -1683,8 +1676,8 @@ {all dead. dead} in Bool_match - (ifThenElse - {Bool} + (case + Bool (lessThanInteger (List_match {Assign} @@ -1700,8 +1693,7 @@ (val : integer) -> var))) ds) - True - False) + [False, True]) {all dead. a} (/\dead -> go vallist) (/\dead -> n) diff --git a/plutus-benchmark/nofib/test/9.6/queens5-fc.size.golden b/plutus-benchmark/nofib/test/9.6/queens5-fc.size.golden index 8c3d94066ac..696ee7741d6 100644 --- a/plutus-benchmark/nofib/test/9.6/queens5-fc.size.golden +++ b/plutus-benchmark/nofib/test/9.6/queens5-fc.size.golden @@ -1 +1 @@ -2097 \ No newline at end of file +2030 \ No newline at end of file diff --git a/plutus-benchmark/script-contexts/test/V1/9.6/checkScriptContext1-20.budget.golden b/plutus-benchmark/script-contexts/test/V1/9.6/checkScriptContext1-20.budget.golden index e8a74934f11..cf45d9ad375 100644 --- a/plutus-benchmark/script-contexts/test/V1/9.6/checkScriptContext1-20.budget.golden +++ b/plutus-benchmark/script-contexts/test/V1/9.6/checkScriptContext1-20.budget.golden @@ -1,2 +1,2 @@ -({cpu: 280130639 -| mem: 1103619}) \ No newline at end of file +({cpu: 257752808 +| mem: 1020200}) \ No newline at end of file diff --git a/plutus-benchmark/script-contexts/test/V1/9.6/checkScriptContext1-4.budget.golden b/plutus-benchmark/script-contexts/test/V1/9.6/checkScriptContext1-4.budget.golden index c59f48acffd..22095c55aea 100644 --- a/plutus-benchmark/script-contexts/test/V1/9.6/checkScriptContext1-4.budget.golden +++ b/plutus-benchmark/script-contexts/test/V1/9.6/checkScriptContext1-4.budget.golden @@ -1,2 +1,2 @@ -({cpu: 79058943 -| mem: 312387}) \ No newline at end of file +({cpu: 71725032 +| mem: 285048}) \ No newline at end of file diff --git a/plutus-benchmark/script-contexts/test/V1/9.6/checkScriptContext1.pir.golden b/plutus-benchmark/script-contexts/test/V1/9.6/checkScriptContext1.pir.golden index 25cb76ef560..38cb69a1c58 100644 --- a/plutus-benchmark/script-contexts/test/V1/9.6/checkScriptContext1.pir.golden +++ b/plutus-benchmark/script-contexts/test/V1/9.6/checkScriptContext1.pir.golden @@ -59,7 +59,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. Tuple2 a b} (/\dead -> Tuple2 @@ -116,12 +116,12 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. Credential} (/\dead -> PubKeyCredential (unBData (headList {data} args))) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 1 index) True False) + (case Bool (equalsInteger 1 index) [False, True]) {all dead. Credential} (/\dead -> ScriptCredential (unBData (headList {data} args))) (/\dead -> traceError {Credential} "PT1") @@ -136,7 +136,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. StakingCredential} (/\dead -> StakingHash @@ -144,7 +144,7 @@ (headList {data} args))) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 1 index) True False) + (case Bool (equalsInteger 1 index) [False, True]) {all dead. StakingCredential} (/\dead -> let @@ -193,7 +193,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. DCert} (/\dead -> DCertDelegRegKey @@ -201,7 +201,7 @@ (headList {data} args))) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 1 index) True False) + (case Bool (equalsInteger 1 index) [False, True]) {all dead. DCert} (/\dead -> DCertDelegDeRegKey @@ -209,7 +209,7 @@ (headList {data} args))) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 2 index) True False) + (case Bool (equalsInteger 2 index) [False, True]) {all dead. DCert} (/\dead -> DCertDelegDelegate @@ -218,11 +218,7 @@ (unBData (headList {data} (tailList {data} args)))) (/\dead -> Bool_match - (ifThenElse - {Bool} - (equalsInteger 3 index) - True - False) + (case Bool (equalsInteger 3 index) [False, True]) {all dead. DCert} (/\dead -> DCertPoolRegister @@ -231,11 +227,10 @@ (headList {data} (tailList {data} args)))) (/\dead -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 4 index) - True - False) + [False, True]) {all dead. DCert} (/\dead -> DCertPoolRetire @@ -246,20 +241,18 @@ (tailList {data} args)))) (/\dead -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 5 index) - True - False) + [False, True]) {all dead. DCert} (/\dead -> DCertGenesis) (/\dead -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 6 index) - True - False) + [False, True]) {all dead. DCert} (/\dead -> DCertMir) (/\dead -> traceError {DCert} "PT1") @@ -294,12 +287,12 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 1 index) True False) + (case Bool (equalsInteger 1 index) [False, True]) {all dead. Maybe a} (/\dead -> Nothing {a}) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. Maybe a} (/\dead -> Just {a} (`$dUnsafeFromData` (headList {data} args))) @@ -348,7 +341,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. TxOut} (/\dead -> let @@ -362,7 +355,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. Address} (/\dead -> Address @@ -408,7 +401,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. bytestring} (/\dead -> unBData (headList {data} args)) (/\dead -> traceError {bytestring} "PT1") @@ -423,7 +416,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. TxOutRef} (/\dead -> TxOutRef @@ -450,7 +443,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. TxInInfo} (/\dead -> TxInInfo @@ -471,12 +464,12 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. Bool} (/\dead -> False) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 1 index) True False) + (case Bool (equalsInteger 1 index) [False, True]) {all dead. Bool} (/\dead -> True) (/\dead -> traceError {Bool} "PT1") @@ -496,18 +489,18 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. Extended a} (/\dead -> NegInf {a}) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 1 index) True False) + (case Bool (equalsInteger 1 index) [False, True]) {all dead. Extended a} (/\dead -> Finite {a} (`$dUnsafeFromData` (headList {data} args))) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 2 index) True False) + (case Bool (equalsInteger 2 index) [False, True]) {all dead. Extended a} (/\dead -> PosInf {a}) (/\dead -> traceError {Extended a} "PT1") @@ -553,7 +546,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. ScriptContext} (/\dead -> ScriptContext @@ -564,7 +557,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. TxInfo} (/\dead -> let @@ -613,7 +606,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. Interval integer} (/\dead -> Interval @@ -627,11 +620,7 @@ = sndPair {integer} {list data} tup in Bool_match - (ifThenElse - {Bool} - (equalsInteger 0 index) - True - False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. LowerBound integer} (/\dead -> LowerBound @@ -654,11 +643,7 @@ = sndPair {integer} {list data} tup in Bool_match - (ifThenElse - {Bool} - (equalsInteger 0 index) - True - False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. UpperBound integer} (/\dead -> UpperBound @@ -692,12 +677,12 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. ScriptPurpose} (/\dead -> Minting (unBData (headList {data} args))) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 1 index) True False) + (case Bool (equalsInteger 1 index) [False, True]) {all dead. ScriptPurpose} (/\dead -> Spending @@ -705,7 +690,7 @@ (headList {data} args))) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 2 index) True False) + (case Bool (equalsInteger 2 index) [False, True]) {all dead. ScriptPurpose} (/\dead -> Rewarding @@ -713,11 +698,7 @@ (headList {data} args))) (/\dead -> Bool_match - (ifThenElse - {Bool} - (equalsInteger 3 index) - True - False) + (case Bool (equalsInteger 3 index) [False, True]) {all dead. ScriptPurpose} (/\dead -> Certifying @@ -733,8 +714,8 @@ {Unit} (\(ipv : TxInfo) (ipv : ScriptPurpose) -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 0 (modInteger @@ -767,8 +748,7 @@ in go eta) 2)) - True - False) + [False, True]) {all dead. Unit} (/\dead -> Unit) (/\dead -> diff --git a/plutus-benchmark/script-contexts/test/V1/9.6/checkScriptContext1.size.golden b/plutus-benchmark/script-contexts/test/V1/9.6/checkScriptContext1.size.golden index 34f7d67cb86..1b447646746 100644 --- a/plutus-benchmark/script-contexts/test/V1/9.6/checkScriptContext1.size.golden +++ b/plutus-benchmark/script-contexts/test/V1/9.6/checkScriptContext1.size.golden @@ -1 +1 @@ -1818 \ No newline at end of file +1580 \ No newline at end of file diff --git a/plutus-benchmark/script-contexts/test/V1/9.6/checkScriptContext2-20.budget.golden b/plutus-benchmark/script-contexts/test/V1/9.6/checkScriptContext2-20.budget.golden index a5868b01cbf..fe5067f2b86 100644 --- a/plutus-benchmark/script-contexts/test/V1/9.6/checkScriptContext2-20.budget.golden +++ b/plutus-benchmark/script-contexts/test/V1/9.6/checkScriptContext2-20.budget.golden @@ -1,2 +1,2 @@ -({cpu: 272630167 -| mem: 1070976}) \ No newline at end of file +({cpu: 250440385 +| mem: 988258}) \ No newline at end of file diff --git a/plutus-benchmark/script-contexts/test/V1/9.6/checkScriptContext2-4.budget.golden b/plutus-benchmark/script-contexts/test/V1/9.6/checkScriptContext2-4.budget.golden index 294c534fa4d..42a12c8e5a2 100644 --- a/plutus-benchmark/script-contexts/test/V1/9.6/checkScriptContext2-4.budget.golden +++ b/plutus-benchmark/script-contexts/test/V1/9.6/checkScriptContext2-4.budget.golden @@ -1,2 +1,2 @@ -({cpu: 76761799 -| mem: 302176}) \ No newline at end of file +({cpu: 69615937 +| mem: 275538}) \ No newline at end of file diff --git a/plutus-benchmark/script-contexts/test/V1/9.6/checkScriptContext2.pir.golden b/plutus-benchmark/script-contexts/test/V1/9.6/checkScriptContext2.pir.golden index 5b9fc712d5b..201ebaa85c6 100644 --- a/plutus-benchmark/script-contexts/test/V1/9.6/checkScriptContext2.pir.golden +++ b/plutus-benchmark/script-contexts/test/V1/9.6/checkScriptContext2.pir.golden @@ -21,7 +21,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. Tuple2 a b} (/\dead -> Tuple2 @@ -86,12 +86,12 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. Credential} (/\dead -> PubKeyCredential (unBData (headList {data} args))) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 1 index) True False) + (case Bool (equalsInteger 1 index) [False, True]) {all dead. Credential} (/\dead -> ScriptCredential (unBData (headList {data} args))) (/\dead -> traceError {Credential} "PT1") @@ -109,7 +109,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. StakingCredential} (/\dead -> StakingHash @@ -117,7 +117,7 @@ (headList {data} args))) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 1 index) True False) + (case Bool (equalsInteger 1 index) [False, True]) {all dead. StakingCredential} (/\dead -> let @@ -166,7 +166,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. DCert} (/\dead -> DCertDelegRegKey @@ -174,7 +174,7 @@ (headList {data} args))) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 1 index) True False) + (case Bool (equalsInteger 1 index) [False, True]) {all dead. DCert} (/\dead -> DCertDelegDeRegKey @@ -182,7 +182,7 @@ (headList {data} args))) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 2 index) True False) + (case Bool (equalsInteger 2 index) [False, True]) {all dead. DCert} (/\dead -> DCertDelegDelegate @@ -191,11 +191,7 @@ (unBData (headList {data} (tailList {data} args)))) (/\dead -> Bool_match - (ifThenElse - {Bool} - (equalsInteger 3 index) - True - False) + (case Bool (equalsInteger 3 index) [False, True]) {all dead. DCert} (/\dead -> DCertPoolRegister @@ -204,11 +200,10 @@ (headList {data} (tailList {data} args)))) (/\dead -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 4 index) - True - False) + [False, True]) {all dead. DCert} (/\dead -> DCertPoolRetire @@ -219,20 +214,18 @@ (tailList {data} args)))) (/\dead -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 5 index) - True - False) + [False, True]) {all dead. DCert} (/\dead -> DCertGenesis) (/\dead -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 6 index) - True - False) + [False, True]) {all dead. DCert} (/\dead -> DCertMir) (/\dead -> traceError {DCert} "PT1") @@ -270,12 +263,12 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 1 index) True False) + (case Bool (equalsInteger 1 index) [False, True]) {all dead. Maybe a} (/\dead -> Nothing {a}) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. Maybe a} (/\dead -> Just {a} (`$dUnsafeFromData` (headList {data} args))) @@ -334,7 +327,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. TxOut} (/\dead -> let @@ -348,7 +341,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. Address} (/\dead -> Address @@ -394,7 +387,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. bytestring} (/\dead -> unBData (headList {data} args)) (/\dead -> traceError {bytestring} "PT1") @@ -409,7 +402,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. TxOutRef} (/\dead -> TxOutRef @@ -436,7 +429,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. TxInInfo} (/\dead -> TxInInfo @@ -457,12 +450,12 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. Bool} (/\dead -> False) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 1 index) True False) + (case Bool (equalsInteger 1 index) [False, True]) {all dead. Bool} (/\dead -> True) (/\dead -> traceError {Bool} "PT1") @@ -482,18 +475,18 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. Extended a} (/\dead -> NegInf {a}) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 1 index) True False) + (case Bool (equalsInteger 1 index) [False, True]) {all dead. Extended a} (/\dead -> Finite {a} (`$dUnsafeFromData` (headList {data} args))) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 2 index) True False) + (case Bool (equalsInteger 2 index) [False, True]) {all dead. Extended a} (/\dead -> PosInf {a}) (/\dead -> traceError {Extended a} "PT1") @@ -541,7 +534,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. ScriptContext} (/\dead -> ScriptContext @@ -552,7 +545,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. TxInfo} (/\dead -> let @@ -601,7 +594,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. Interval integer} (/\dead -> Interval @@ -615,11 +608,7 @@ = sndPair {integer} {list data} tup in Bool_match - (ifThenElse - {Bool} - (equalsInteger 0 index) - True - False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. LowerBound integer} (/\dead -> LowerBound @@ -644,11 +633,7 @@ = sndPair {integer} {list data} tup in Bool_match - (ifThenElse - {Bool} - (equalsInteger 0 index) - True - False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. UpperBound integer} (/\dead -> UpperBound @@ -684,12 +669,12 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. ScriptPurpose} (/\dead -> Minting (unBData (headList {data} args))) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 1 index) True False) + (case Bool (equalsInteger 1 index) [False, True]) {all dead. ScriptPurpose} (/\dead -> Spending @@ -697,11 +682,7 @@ (headList {data} args))) (/\dead -> Bool_match - (ifThenElse - {Bool} - (equalsInteger 2 index) - True - False) + (case Bool (equalsInteger 2 index) [False, True]) {all dead. ScriptPurpose} (/\dead -> Rewarding @@ -709,11 +690,10 @@ (headList {data} args))) (/\dead -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 3 index) - True - False) + [False, True]) {all dead. ScriptPurpose} (/\dead -> Certifying diff --git a/plutus-benchmark/script-contexts/test/V1/9.6/checkScriptContext2.size.golden b/plutus-benchmark/script-contexts/test/V1/9.6/checkScriptContext2.size.golden index d2ed50d11b7..129f3d6210c 100644 --- a/plutus-benchmark/script-contexts/test/V1/9.6/checkScriptContext2.size.golden +++ b/plutus-benchmark/script-contexts/test/V1/9.6/checkScriptContext2.size.golden @@ -1 +1 @@ -1751 \ No newline at end of file +1520 \ No newline at end of file diff --git a/plutus-benchmark/script-contexts/test/V1/9.6/checkScriptContextEqualityData-20.budget.golden b/plutus-benchmark/script-contexts/test/V1/9.6/checkScriptContextEqualityData-20.budget.golden index 6eb5e1db6eb..ae7c190a2a0 100644 --- a/plutus-benchmark/script-contexts/test/V1/9.6/checkScriptContextEqualityData-20.budget.golden +++ b/plutus-benchmark/script-contexts/test/V1/9.6/checkScriptContextEqualityData-20.budget.golden @@ -1,2 +1,2 @@ -({cpu: 34806758 -| mem: 31002}) \ No newline at end of file +({cpu: 34618709 +| mem: 30301}) \ No newline at end of file diff --git a/plutus-benchmark/script-contexts/test/V1/Data/9.6/checkScriptContext1-20.budget.golden b/plutus-benchmark/script-contexts/test/V1/Data/9.6/checkScriptContext1-20.budget.golden index c53b903bbf1..5e99d8ef44d 100644 --- a/plutus-benchmark/script-contexts/test/V1/Data/9.6/checkScriptContext1-20.budget.golden +++ b/plutus-benchmark/script-contexts/test/V1/Data/9.6/checkScriptContext1-20.budget.golden @@ -1,2 +1,2 @@ -({cpu: 20308762 -| mem: 73151}) \ No newline at end of file +({cpu: 20120713 +| mem: 72450}) \ No newline at end of file diff --git a/plutus-benchmark/script-contexts/test/V1/Data/9.6/checkScriptContext1-4.budget.golden b/plutus-benchmark/script-contexts/test/V1/Data/9.6/checkScriptContext1-4.budget.golden index 3582aeab6c6..ba885d9dd27 100644 --- a/plutus-benchmark/script-contexts/test/V1/Data/9.6/checkScriptContext1-4.budget.golden +++ b/plutus-benchmark/script-contexts/test/V1/Data/9.6/checkScriptContext1-4.budget.golden @@ -1,2 +1,2 @@ -({cpu: 5732522 -| mem: 20383}) \ No newline at end of file +({cpu: 5544473 +| mem: 19682}) \ No newline at end of file diff --git a/plutus-benchmark/script-contexts/test/V1/Data/9.6/checkScriptContext1.pir.golden b/plutus-benchmark/script-contexts/test/V1/Data/9.6/checkScriptContext1.pir.golden index d763d363386..3c245bbf1b1 100644 --- a/plutus-benchmark/script-contexts/test/V1/Data/9.6/checkScriptContext1.pir.golden +++ b/plutus-benchmark/script-contexts/test/V1/Data/9.6/checkScriptContext1.pir.golden @@ -23,8 +23,8 @@ in \(d : data) -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 0 (modInteger @@ -90,11 +90,7 @@ = sndPair {integer} {list data} tup in Bool_match - (ifThenElse - {Bool} - (equalsInteger 0 index) - True - False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. bytestring} (/\dead -> unBData (headList {data} args)) (/\dead -> @@ -131,8 +127,7 @@ in go ds) 2)) - True - False) + [False, True]) {all dead. Unit} (/\dead -> Unit) (/\dead -> diff --git a/plutus-benchmark/script-contexts/test/V1/Data/9.6/checkScriptContext1.size.golden b/plutus-benchmark/script-contexts/test/V1/Data/9.6/checkScriptContext1.size.golden index d97edbb29fa..69226f7293a 100644 --- a/plutus-benchmark/script-contexts/test/V1/Data/9.6/checkScriptContext1.size.golden +++ b/plutus-benchmark/script-contexts/test/V1/Data/9.6/checkScriptContext1.size.golden @@ -1 +1 @@ -99 \ No newline at end of file +92 \ No newline at end of file diff --git a/plutus-benchmark/script-contexts/test/V1/Data/9.6/checkScriptContextEqualityData-20.budget.golden b/plutus-benchmark/script-contexts/test/V1/Data/9.6/checkScriptContextEqualityData-20.budget.golden index 63deba4a743..1d9f7068fbe 100644 --- a/plutus-benchmark/script-contexts/test/V1/Data/9.6/checkScriptContextEqualityData-20.budget.golden +++ b/plutus-benchmark/script-contexts/test/V1/Data/9.6/checkScriptContextEqualityData-20.budget.golden @@ -1,2 +1,2 @@ -({cpu: 30214758 -| mem: 2302}) \ No newline at end of file +({cpu: 30026709 +| mem: 1601}) \ No newline at end of file diff --git a/plutus-benchmark/script-contexts/test/V2/9.6/checkScriptContext1-20.budget.golden b/plutus-benchmark/script-contexts/test/V2/9.6/checkScriptContext1-20.budget.golden index b22b7dfaa06..cd8852027b6 100644 --- a/plutus-benchmark/script-contexts/test/V2/9.6/checkScriptContext1-20.budget.golden +++ b/plutus-benchmark/script-contexts/test/V2/9.6/checkScriptContext1-20.budget.golden @@ -1,2 +1,2 @@ -({cpu: 309415589 -| mem: 1210915}) \ No newline at end of file +({cpu: 283276778 +| mem: 1113476}) \ No newline at end of file diff --git a/plutus-benchmark/script-contexts/test/V2/9.6/checkScriptContext1-4.budget.golden b/plutus-benchmark/script-contexts/test/V2/9.6/checkScriptContext1-4.budget.golden index 66837cd4e02..881d8ae9a4d 100644 --- a/plutus-benchmark/script-contexts/test/V2/9.6/checkScriptContext1-4.budget.golden +++ b/plutus-benchmark/script-contexts/test/V2/9.6/checkScriptContext1-4.budget.golden @@ -1,2 +1,2 @@ -({cpu: 87453173 -| mem: 346691}) \ No newline at end of file +({cpu: 79367066 +| mem: 316548}) \ No newline at end of file diff --git a/plutus-benchmark/script-contexts/test/V2/9.6/checkScriptContext1.pir.golden b/plutus-benchmark/script-contexts/test/V2/9.6/checkScriptContext1.pir.golden index b7647a809c5..d1a78055417 100644 --- a/plutus-benchmark/script-contexts/test/V2/9.6/checkScriptContext1.pir.golden +++ b/plutus-benchmark/script-contexts/test/V2/9.6/checkScriptContext1.pir.golden @@ -81,12 +81,12 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. Credential} (/\dead -> PubKeyCredential (unBData (headList {data} args))) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 1 index) True False) + (case Bool (equalsInteger 1 index) [False, True]) {all dead. Credential} (/\dead -> ScriptCredential (unBData (headList {data} args))) (/\dead -> traceError {Credential} "PT1") @@ -101,7 +101,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. StakingCredential} (/\dead -> StakingHash @@ -109,7 +109,7 @@ (headList {data} args))) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 1 index) True False) + (case Bool (equalsInteger 1 index) [False, True]) {all dead. StakingCredential} (/\dead -> let @@ -139,7 +139,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. DCert} (/\dead -> DCertDelegRegKey @@ -147,7 +147,7 @@ (headList {data} args))) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 1 index) True False) + (case Bool (equalsInteger 1 index) [False, True]) {all dead. DCert} (/\dead -> DCertDelegDeRegKey @@ -155,7 +155,7 @@ (headList {data} args))) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 2 index) True False) + (case Bool (equalsInteger 2 index) [False, True]) {all dead. DCert} (/\dead -> DCertDelegDelegate @@ -164,11 +164,7 @@ (unBData (headList {data} (tailList {data} args)))) (/\dead -> Bool_match - (ifThenElse - {Bool} - (equalsInteger 3 index) - True - False) + (case Bool (equalsInteger 3 index) [False, True]) {all dead. DCert} (/\dead -> DCertPoolRegister @@ -177,11 +173,10 @@ (headList {data} (tailList {data} args)))) (/\dead -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 4 index) - True - False) + [False, True]) {all dead. DCert} (/\dead -> DCertPoolRetire @@ -192,20 +187,18 @@ (tailList {data} args)))) (/\dead -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 5 index) - True - False) + [False, True]) {all dead. DCert} (/\dead -> DCertGenesis) (/\dead -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 6 index) - True - False) + [False, True]) {all dead. DCert} (/\dead -> DCertMir) (/\dead -> traceError {DCert} "PT1") @@ -240,12 +233,12 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 1 index) True False) + (case Bool (equalsInteger 1 index) [False, True]) {all dead. Maybe a} (/\dead -> Nothing {a}) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. Maybe a} (/\dead -> Just {a} (`$dUnsafeFromData` (headList {data} args))) @@ -294,7 +287,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. TxOut} (/\dead -> let @@ -309,7 +302,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. Address} (/\dead -> Address @@ -334,22 +327,18 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. OutputDatum} (/\dead -> NoOutputDatum) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 1 index) True False) + (case Bool (equalsInteger 1 index) [False, True]) {all dead. OutputDatum} (/\dead -> OutputDatumHash (unBData (headList {data} args))) (/\dead -> Bool_match - (ifThenElse - {Bool} - (equalsInteger 2 index) - True - False) + (case Bool (equalsInteger 2 index) [False, True]) {all dead. OutputDatum} (/\dead -> OutputDatum (headList {data} args)) (/\dead -> traceError {OutputDatum} "PT1") @@ -384,7 +373,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. bytestring} (/\dead -> unBData (headList {data} args)) (/\dead -> traceError {bytestring} "PT1") @@ -399,7 +388,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. TxOutRef} (/\dead -> TxOutRef @@ -418,7 +407,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. TxInInfo} (/\dead -> TxInInfo @@ -464,12 +453,12 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. Bool} (/\dead -> False) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 1 index) True False) + (case Bool (equalsInteger 1 index) [False, True]) {all dead. Bool} (/\dead -> True) (/\dead -> traceError {Bool} "PT1") @@ -489,18 +478,18 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. Extended a} (/\dead -> NegInf {a}) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 1 index) True False) + (case Bool (equalsInteger 1 index) [False, True]) {all dead. Extended a} (/\dead -> Finite {a} (`$dUnsafeFromData` (headList {data} args))) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 2 index) True False) + (case Bool (equalsInteger 2 index) [False, True]) {all dead. Extended a} (/\dead -> PosInf {a}) (/\dead -> traceError {Extended a} "PT1") @@ -521,12 +510,12 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. ScriptPurpose} (/\dead -> Minting (unBData (headList {data} args))) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 1 index) True False) + (case Bool (equalsInteger 1 index) [False, True]) {all dead. ScriptPurpose} (/\dead -> Spending @@ -534,7 +523,7 @@ (headList {data} args))) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 2 index) True False) + (case Bool (equalsInteger 2 index) [False, True]) {all dead. ScriptPurpose} (/\dead -> Rewarding @@ -542,11 +531,7 @@ (headList {data} args))) (/\dead -> Bool_match - (ifThenElse - {Bool} - (equalsInteger 3 index) - True - False) + (case Bool (equalsInteger 3 index) [False, True]) {all dead. ScriptPurpose} (/\dead -> Certifying @@ -593,7 +578,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. ScriptContext} (/\dead -> ScriptContext @@ -604,7 +589,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. TxInfo} (/\dead -> let @@ -661,7 +646,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. Interval integer} (/\dead -> Interval @@ -675,11 +660,7 @@ = sndPair {integer} {list data} tup in Bool_match - (ifThenElse - {Bool} - (equalsInteger 0 index) - True - False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. LowerBound integer} (/\dead -> LowerBound @@ -702,11 +683,7 @@ = sndPair {integer} {list data} tup in Bool_match - (ifThenElse - {Bool} - (equalsInteger 0 index) - True - False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. UpperBound integer} (/\dead -> UpperBound @@ -748,8 +725,8 @@ {Unit} (\(ipv : TxInfo) (ipv : ScriptPurpose) -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 0 (modInteger @@ -788,8 +765,7 @@ in go eta) 2)) - True - False) + [False, True]) {all dead. Unit} (/\dead -> Unit) (/\dead -> diff --git a/plutus-benchmark/script-contexts/test/V2/9.6/checkScriptContext1.size.golden b/plutus-benchmark/script-contexts/test/V2/9.6/checkScriptContext1.size.golden index d7e6ae9fa3a..87a471804ff 100644 --- a/plutus-benchmark/script-contexts/test/V2/9.6/checkScriptContext1.size.golden +++ b/plutus-benchmark/script-contexts/test/V2/9.6/checkScriptContext1.size.golden @@ -1 +1 @@ -1890 \ No newline at end of file +1638 \ No newline at end of file diff --git a/plutus-benchmark/script-contexts/test/V2/9.6/checkScriptContext2-20.budget.golden b/plutus-benchmark/script-contexts/test/V2/9.6/checkScriptContext2-20.budget.golden index c5695edb5e7..6a313e26393 100644 --- a/plutus-benchmark/script-contexts/test/V2/9.6/checkScriptContext2-20.budget.golden +++ b/plutus-benchmark/script-contexts/test/V2/9.6/checkScriptContext2-20.budget.golden @@ -1,2 +1,2 @@ -({cpu: 301883117 -| mem: 1178072}) \ No newline at end of file +({cpu: 275932355 +| mem: 1081334}) \ No newline at end of file diff --git a/plutus-benchmark/script-contexts/test/V2/9.6/checkScriptContext2-4.budget.golden b/plutus-benchmark/script-contexts/test/V2/9.6/checkScriptContext2-4.budget.golden index 15bdf29c61b..c984960b82c 100644 --- a/plutus-benchmark/script-contexts/test/V2/9.6/checkScriptContext2-4.budget.golden +++ b/plutus-benchmark/script-contexts/test/V2/9.6/checkScriptContext2-4.budget.golden @@ -1,2 +1,2 @@ -({cpu: 85124029 -| mem: 336280}) \ No newline at end of file +({cpu: 77225971 +| mem: 306838}) \ No newline at end of file diff --git a/plutus-benchmark/script-contexts/test/V2/9.6/checkScriptContext2.pir.golden b/plutus-benchmark/script-contexts/test/V2/9.6/checkScriptContext2.pir.golden index f40bd55cb13..f90e23cbd5f 100644 --- a/plutus-benchmark/script-contexts/test/V2/9.6/checkScriptContext2.pir.golden +++ b/plutus-benchmark/script-contexts/test/V2/9.6/checkScriptContext2.pir.golden @@ -44,12 +44,12 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. Credential} (/\dead -> PubKeyCredential (unBData (headList {data} args))) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 1 index) True False) + (case Bool (equalsInteger 1 index) [False, True]) {all dead. Credential} (/\dead -> ScriptCredential (unBData (headList {data} args))) (/\dead -> traceError {Credential} "PT1") @@ -67,7 +67,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. StakingCredential} (/\dead -> StakingHash @@ -75,7 +75,7 @@ (headList {data} args))) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 1 index) True False) + (case Bool (equalsInteger 1 index) [False, True]) {all dead. StakingCredential} (/\dead -> let @@ -105,7 +105,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. DCert} (/\dead -> DCertDelegRegKey @@ -113,7 +113,7 @@ (headList {data} args))) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 1 index) True False) + (case Bool (equalsInteger 1 index) [False, True]) {all dead. DCert} (/\dead -> DCertDelegDeRegKey @@ -121,7 +121,7 @@ (headList {data} args))) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 2 index) True False) + (case Bool (equalsInteger 2 index) [False, True]) {all dead. DCert} (/\dead -> DCertDelegDelegate @@ -130,11 +130,7 @@ (unBData (headList {data} (tailList {data} args)))) (/\dead -> Bool_match - (ifThenElse - {Bool} - (equalsInteger 3 index) - True - False) + (case Bool (equalsInteger 3 index) [False, True]) {all dead. DCert} (/\dead -> DCertPoolRegister @@ -143,11 +139,10 @@ (headList {data} (tailList {data} args)))) (/\dead -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 4 index) - True - False) + [False, True]) {all dead. DCert} (/\dead -> DCertPoolRetire @@ -158,20 +153,18 @@ (tailList {data} args)))) (/\dead -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 5 index) - True - False) + [False, True]) {all dead. DCert} (/\dead -> DCertGenesis) (/\dead -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 6 index) - True - False) + [False, True]) {all dead. DCert} (/\dead -> DCertMir) (/\dead -> traceError {DCert} "PT1") @@ -209,12 +202,12 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 1 index) True False) + (case Bool (equalsInteger 1 index) [False, True]) {all dead. Maybe a} (/\dead -> Nothing {a}) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. Maybe a} (/\dead -> Just {a} (`$dUnsafeFromData` (headList {data} args))) @@ -280,7 +273,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. TxOut} (/\dead -> let @@ -295,7 +288,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. Address} (/\dead -> Address @@ -320,22 +313,18 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. OutputDatum} (/\dead -> NoOutputDatum) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 1 index) True False) + (case Bool (equalsInteger 1 index) [False, True]) {all dead. OutputDatum} (/\dead -> OutputDatumHash (unBData (headList {data} args))) (/\dead -> Bool_match - (ifThenElse - {Bool} - (equalsInteger 2 index) - True - False) + (case Bool (equalsInteger 2 index) [False, True]) {all dead. OutputDatum} (/\dead -> OutputDatum (headList {data} args)) (/\dead -> traceError {OutputDatum} "PT1") @@ -370,7 +359,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. bytestring} (/\dead -> unBData (headList {data} args)) (/\dead -> traceError {bytestring} "PT1") @@ -385,7 +374,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. TxOutRef} (/\dead -> TxOutRef @@ -404,7 +393,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. TxInInfo} (/\dead -> TxInInfo @@ -450,12 +439,12 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. Bool} (/\dead -> False) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 1 index) True False) + (case Bool (equalsInteger 1 index) [False, True]) {all dead. Bool} (/\dead -> True) (/\dead -> traceError {Bool} "PT1") @@ -475,18 +464,18 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. Extended a} (/\dead -> NegInf {a}) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 1 index) True False) + (case Bool (equalsInteger 1 index) [False, True]) {all dead. Extended a} (/\dead -> Finite {a} (`$dUnsafeFromData` (headList {data} args))) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 2 index) True False) + (case Bool (equalsInteger 2 index) [False, True]) {all dead. Extended a} (/\dead -> PosInf {a}) (/\dead -> traceError {Extended a} "PT1") @@ -507,12 +496,12 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. ScriptPurpose} (/\dead -> Minting (unBData (headList {data} args))) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 1 index) True False) + (case Bool (equalsInteger 1 index) [False, True]) {all dead. ScriptPurpose} (/\dead -> Spending @@ -520,7 +509,7 @@ (headList {data} args))) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 2 index) True False) + (case Bool (equalsInteger 2 index) [False, True]) {all dead. ScriptPurpose} (/\dead -> Rewarding @@ -528,11 +517,7 @@ (headList {data} args))) (/\dead -> Bool_match - (ifThenElse - {Bool} - (equalsInteger 3 index) - True - False) + (case Bool (equalsInteger 3 index) [False, True]) {all dead. ScriptPurpose} (/\dead -> Certifying @@ -581,7 +566,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. ScriptContext} (/\dead -> ScriptContext @@ -592,7 +577,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. TxInfo} (/\dead -> let @@ -649,7 +634,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. Interval integer} (/\dead -> Interval @@ -663,11 +648,7 @@ = sndPair {integer} {list data} tup in Bool_match - (ifThenElse - {Bool} - (equalsInteger 0 index) - True - False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. LowerBound integer} (/\dead -> LowerBound @@ -692,11 +673,7 @@ = sndPair {integer} {list data} tup in Bool_match - (ifThenElse - {Bool} - (equalsInteger 0 index) - True - False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. UpperBound integer} (/\dead -> UpperBound diff --git a/plutus-benchmark/script-contexts/test/V2/9.6/checkScriptContext2.size.golden b/plutus-benchmark/script-contexts/test/V2/9.6/checkScriptContext2.size.golden index 8a94eeb0aa1..f71ee29d35e 100644 --- a/plutus-benchmark/script-contexts/test/V2/9.6/checkScriptContext2.size.golden +++ b/plutus-benchmark/script-contexts/test/V2/9.6/checkScriptContext2.size.golden @@ -1 +1 @@ -1821 \ No newline at end of file +1576 \ No newline at end of file diff --git a/plutus-benchmark/script-contexts/test/V2/9.6/checkScriptContextEqualityData-20.budget.golden b/plutus-benchmark/script-contexts/test/V2/9.6/checkScriptContextEqualityData-20.budget.golden index c0f1959939c..53e1e94407b 100644 --- a/plutus-benchmark/script-contexts/test/V2/9.6/checkScriptContextEqualityData-20.budget.golden +++ b/plutus-benchmark/script-contexts/test/V2/9.6/checkScriptContextEqualityData-20.budget.golden @@ -1,2 +1,2 @@ -({cpu: 37559310 -| mem: 33202}) \ No newline at end of file +({cpu: 37371261 +| mem: 32501}) \ No newline at end of file diff --git a/plutus-benchmark/script-contexts/test/V2/9.6/dataFwdStakeTrick.budget.golden b/plutus-benchmark/script-contexts/test/V2/9.6/dataFwdStakeTrick.budget.golden index 5ce2bb73a6c..18ea7cd2160 100644 --- a/plutus-benchmark/script-contexts/test/V2/9.6/dataFwdStakeTrick.budget.golden +++ b/plutus-benchmark/script-contexts/test/V2/9.6/dataFwdStakeTrick.budget.golden @@ -1,2 +1,2 @@ -({cpu: 6114120 -| mem: 12280}) \ No newline at end of file +({cpu: 5770022 +| mem: 11078}) \ No newline at end of file diff --git a/plutus-benchmark/script-contexts/test/V2/9.6/dataFwdStakeTrick.pir.golden b/plutus-benchmark/script-contexts/test/V2/9.6/dataFwdStakeTrick.pir.golden index 7dcf0da0787..e12c29c031b 100644 --- a/plutus-benchmark/script-contexts/test/V2/9.6/dataFwdStakeTrick.pir.golden +++ b/plutus-benchmark/script-contexts/test/V2/9.6/dataFwdStakeTrick.pir.golden @@ -24,11 +24,10 @@ in False (\(hd : pair data data) -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsData obsScriptCred (fstPair {data} {data} hd)) - True - False) + [False, True]) {all dead. list (pair data data) -> Bool} (/\dead -> \(ds : list (pair data data)) -> True) (/\dead -> go) @@ -67,12 +66,12 @@ in !wdrlAtOne : data = fstPair {data} {data} (headList {pair data data} rest) in Bool_match - (ifThenElse {Bool} (equalsData obsScriptCred wdrlAtZero) True False) + (case Bool (equalsData obsScriptCred wdrlAtZero) [False, True]) {all dead. Unit} (/\dead -> Unit) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsData obsScriptCred wdrlAtOne) True False) + (case Bool (equalsData obsScriptCred wdrlAtOne) [False, True]) {all dead. Unit} (/\dead -> Unit) (/\dead -> diff --git a/plutus-benchmark/script-contexts/test/V2/9.6/dataFwdStakeTrick.size.golden b/plutus-benchmark/script-contexts/test/V2/9.6/dataFwdStakeTrick.size.golden index 66321c084ca..6547e41559f 100644 --- a/plutus-benchmark/script-contexts/test/V2/9.6/dataFwdStakeTrick.size.golden +++ b/plutus-benchmark/script-contexts/test/V2/9.6/dataFwdStakeTrick.size.golden @@ -1 +1 @@ -189 \ No newline at end of file +171 \ No newline at end of file diff --git a/plutus-benchmark/script-contexts/test/V2/9.6/dataFwdStakeTrick.uplc.golden b/plutus-benchmark/script-contexts/test/V2/9.6/dataFwdStakeTrick.uplc.golden index 23b095cb5b2..462b3b7d119 100644 --- a/plutus-benchmark/script-contexts/test/V2/9.6/dataFwdStakeTrick.uplc.golden +++ b/plutus-benchmark/script-contexts/test/V2/9.6/dataFwdStakeTrick.uplc.golden @@ -1,40 +1,30 @@ (program 1.1.0 (\obsScriptCred -> - (\go - ctx -> + (\go ctx -> (\ds -> (\wdrlAtZero -> (\rest -> (\wdrlAtOne -> force - (force - (force - ifThenElse - (equalsData obsScriptCred wdrlAtZero) - (delay (delay (constr 0 []))) - (delay - (delay - (force - (force - (force - ifThenElse - (equalsData obsScriptCred wdrlAtOne) - (delay (delay (constr 0 []))) - (delay - (delay - (force - (case - (force go rest) - [ (delay (constr 0 [])) - , (delay - ((\x -> - error) - (force - trace - "not found" - (constr 0 - [ ])))) ])))))))))))) + (case + (equalsData obsScriptCred wdrlAtZero) + [ (delay + (force + (case + (equalsData obsScriptCred wdrlAtOne) + [ (delay + (force + (case + (force go rest) + [ (delay (constr 0 [])) + , (delay + ((\x -> error) + (force trace + "not found" + (constr 0 [])))) ]))) + , (delay (constr 0 [])) ]))) + , (delay (constr 0 [])) ])) (force (force fstPair) (force headList rest))) (force tailList ds)) (force (force fstPair) (force headList ds))) @@ -61,15 +51,11 @@ (delay (constr 1 [])) (delay (force - (force - (force ifThenElse - (equalsData - obsScriptCred - (force (force fstPair) - (force headList xs))) - (delay (delay (\ds -> constr 0 []))) - (delay - (delay - (force (s s (delay (\x -> x)))))))) + (case + (equalsData + obsScriptCred + (force (force fstPair) (force headList xs))) + [ (delay (force (s s (delay (\x -> x))))) + , (delay (\ds -> constr 0 [])) ]) (force tailList xs)))))) (delay (\x -> x))))) \ No newline at end of file diff --git a/plutus-benchmark/script-contexts/test/V2/9.6/dataFwdStakeTrickManual.budget.golden b/plutus-benchmark/script-contexts/test/V2/9.6/dataFwdStakeTrickManual.budget.golden index 5ce2bb73a6c..18ea7cd2160 100644 --- a/plutus-benchmark/script-contexts/test/V2/9.6/dataFwdStakeTrickManual.budget.golden +++ b/plutus-benchmark/script-contexts/test/V2/9.6/dataFwdStakeTrickManual.budget.golden @@ -1,2 +1,2 @@ -({cpu: 6114120 -| mem: 12280}) \ No newline at end of file +({cpu: 5770022 +| mem: 11078}) \ No newline at end of file diff --git a/plutus-benchmark/script-contexts/test/V2/9.6/dataFwdStakeTrickManual.pir.golden b/plutus-benchmark/script-contexts/test/V2/9.6/dataFwdStakeTrickManual.pir.golden index 0c0bb1acee3..dda85fd0708 100644 --- a/plutus-benchmark/script-contexts/test/V2/9.6/dataFwdStakeTrickManual.pir.golden +++ b/plutus-benchmark/script-contexts/test/V2/9.6/dataFwdStakeTrickManual.pir.golden @@ -10,11 +10,10 @@ in !lookForCred : pair data data -> list (pair data data) -> Unit = \(p : pair data data) (tl : list (pair data data)) -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsData r_stake_cred (fstPair {data} {data} p)) - True - False) + [False, True]) {all dead. Unit} (/\dead -> Unit) (/\dead -> lookForCred tl) @@ -82,12 +81,12 @@ in !wdrlAtOne : data = fstPair {data} {data} (headList {pair data data} rest) in Bool_match - (ifThenElse {Bool} (equalsData r_stake_cred wdrlAtZero) True False) + (case Bool (equalsData r_stake_cred wdrlAtZero) [False, True]) {all dead. Unit} (/\dead -> Unit) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsData r_stake_cred wdrlAtOne) True False) + (case Bool (equalsData r_stake_cred wdrlAtOne) [False, True]) {all dead. Unit} (/\dead -> Unit) (/\dead -> lookForCred rest) diff --git a/plutus-benchmark/script-contexts/test/V2/9.6/dataFwdStakeTrickManual.size.golden b/plutus-benchmark/script-contexts/test/V2/9.6/dataFwdStakeTrickManual.size.golden index 681cf043cbf..4a8d924028a 100644 --- a/plutus-benchmark/script-contexts/test/V2/9.6/dataFwdStakeTrickManual.size.golden +++ b/plutus-benchmark/script-contexts/test/V2/9.6/dataFwdStakeTrickManual.size.golden @@ -1 +1 @@ -192 \ No newline at end of file +174 \ No newline at end of file diff --git a/plutus-benchmark/script-contexts/test/V2/9.6/dataFwdStakeTrickManual.uplc.golden b/plutus-benchmark/script-contexts/test/V2/9.6/dataFwdStakeTrickManual.uplc.golden index 7083919bbc7..0e6d6c28ad4 100644 --- a/plutus-benchmark/script-contexts/test/V2/9.6/dataFwdStakeTrickManual.uplc.golden +++ b/plutus-benchmark/script-contexts/test/V2/9.6/dataFwdStakeTrickManual.uplc.golden @@ -10,24 +10,17 @@ (\rest -> (\wdrlAtOne -> force - (force - (force ifThenElse - (equalsData r_stake_cred wdrlAtZero) - (delay (delay (constr 0 []))) - (delay - (delay - (force - (force - (force ifThenElse - (equalsData - r_stake_cred - wdrlAtOne) - (delay - (delay (constr 0 []))) - (delay - (delay - (force lookForCred - rest))))))))))) + (case + (equalsData r_stake_cred wdrlAtZero) + [ (delay + (force + (case + (equalsData + r_stake_cred + wdrlAtOne) + [ (delay (force lookForCred rest)) + , (delay (constr 0 [])) ]))) + , (delay (constr 0 [])) ])) (force (force fstPair) (force headList rest))) (force tailList wdrl)) (force (force fstPair) (force headList wdrl))) @@ -80,13 +73,10 @@ (constr 0 []))) (\p tl -> force - (force - (force ifThenElse - (equalsData - r_stake_cred - (force (force fstPair) p)) - (delay (delay (constr 0 []))) - (delay - (delay - (force (lookForCred (delay (\x -> x))) - tl)))))))))))) \ No newline at end of file + (case + (equalsData + r_stake_cred + (force (force fstPair) p)) + [ (delay + (force (lookForCred (delay (\x -> x))) tl)) + , (delay (constr 0 [])) ])))))))) \ No newline at end of file diff --git a/plutus-benchmark/script-contexts/test/V2/9.6/sopFwdStakeTrick.budget.golden b/plutus-benchmark/script-contexts/test/V2/9.6/sopFwdStakeTrick.budget.golden index f5588b26ad2..73dc460beb5 100644 --- a/plutus-benchmark/script-contexts/test/V2/9.6/sopFwdStakeTrick.budget.golden +++ b/plutus-benchmark/script-contexts/test/V2/9.6/sopFwdStakeTrick.budget.golden @@ -1,2 +1,2 @@ -({cpu: 387828993 -| mem: 1499532}) \ No newline at end of file +({cpu: 353003977 +| mem: 1369148}) \ No newline at end of file diff --git a/plutus-benchmark/script-contexts/test/V2/9.6/sopFwdStakeTrick.pir.golden b/plutus-benchmark/script-contexts/test/V2/9.6/sopFwdStakeTrick.pir.golden index c98f5cd36b7..c4fe0ff4361 100644 --- a/plutus-benchmark/script-contexts/test/V2/9.6/sopFwdStakeTrick.pir.golden +++ b/plutus-benchmark/script-contexts/test/V2/9.6/sopFwdStakeTrick.pir.golden @@ -43,12 +43,12 @@ let !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. Credential} (/\dead -> PubKeyCredential (unBData (headList {data} args))) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 1 index) True False) + (case Bool (equalsInteger 1 index) [False, True]) {all dead. Credential} (/\dead -> ScriptCredential (unBData (headList {data} args))) (/\dead -> traceError {Credential} "PT1") @@ -66,7 +66,7 @@ let !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. StakingCredential} (/\dead -> StakingHash @@ -74,7 +74,7 @@ let (headList {data} args))) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 1 index) True False) + (case Bool (equalsInteger 1 index) [False, True]) {all dead. StakingCredential} (/\dead -> let @@ -104,7 +104,7 @@ let !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. DCert} (/\dead -> DCertDelegRegKey @@ -112,7 +112,7 @@ let (headList {data} args))) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 1 index) True False) + (case Bool (equalsInteger 1 index) [False, True]) {all dead. DCert} (/\dead -> DCertDelegDeRegKey @@ -120,7 +120,7 @@ let (headList {data} args))) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 2 index) True False) + (case Bool (equalsInteger 2 index) [False, True]) {all dead. DCert} (/\dead -> DCertDelegDelegate @@ -129,7 +129,7 @@ let (unBData (headList {data} (tailList {data} args)))) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 3 index) True False) + (case Bool (equalsInteger 3 index) [False, True]) {all dead. DCert} (/\dead -> DCertPoolRegister @@ -138,11 +138,7 @@ let (headList {data} (tailList {data} args)))) (/\dead -> Bool_match - (ifThenElse - {Bool} - (equalsInteger 4 index) - True - False) + (case Bool (equalsInteger 4 index) [False, True]) {all dead. DCert} (/\dead -> DCertPoolRetire @@ -151,20 +147,18 @@ let (headList {data} (tailList {data} args)))) (/\dead -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 5 index) - True - False) + [False, True]) {all dead. DCert} (/\dead -> DCertGenesis) (/\dead -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 6 index) - True - False) + [False, True]) {all dead. DCert} (/\dead -> DCertMir) (/\dead -> traceError {DCert} "PT1") @@ -202,12 +196,12 @@ let !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 1 index) True False) + (case Bool (equalsInteger 1 index) [False, True]) {all dead. Maybe a} (/\dead -> Nothing {a}) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. Maybe a} (/\dead -> Just {a} (`$dUnsafeFromData` (headList {data} args))) @@ -273,7 +267,7 @@ let !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. TxOut} (/\dead -> let @@ -288,7 +282,7 @@ let !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. Address} (/\dead -> Address @@ -313,22 +307,18 @@ let !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. OutputDatum} (/\dead -> NoOutputDatum) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 1 index) True False) + (case Bool (equalsInteger 1 index) [False, True]) {all dead. OutputDatum} (/\dead -> OutputDatumHash (unBData (headList {data} args))) (/\dead -> Bool_match - (ifThenElse - {Bool} - (equalsInteger 2 index) - True - False) + (case Bool (equalsInteger 2 index) [False, True]) {all dead. OutputDatum} (/\dead -> OutputDatum (headList {data} args)) (/\dead -> traceError {OutputDatum} "PT1") @@ -363,7 +353,7 @@ let !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. bytestring} (/\dead -> unBData (headList {data} args)) (/\dead -> traceError {bytestring} "PT1") @@ -378,7 +368,7 @@ let !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. TxOutRef} (/\dead -> TxOutRef @@ -397,7 +387,7 @@ let !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. TxInInfo} (/\dead -> TxInInfo @@ -433,9 +423,6 @@ letrec (go xs)) in let - !equalsByteString : bytestring -> bytestring -> Bool - = \(x : bytestring) (y : bytestring) -> - ifThenElse {Bool} (equalsByteString x y) True False !`$fEqStakingCredential_$c==` : StakingCredential -> StakingCredential -> Bool = \(ds : StakingCredential) (ds : StakingCredential) -> StakingCredential_match @@ -453,14 +440,16 @@ let Credential_match r {Bool} - (\(r : bytestring) -> equalsByteString l r) + (\(r : bytestring) -> + case Bool (equalsByteString l r) [False, True]) (\(ipv : bytestring) -> False)) (\(a : bytestring) -> Credential_match r {Bool} (\(ipv : bytestring) -> False) - (\(a' : bytestring) -> equalsByteString a a'))) + (\(a' : bytestring) -> + case Bool (equalsByteString a a') [False, True]))) (\(ipv : integer) (ipv : integer) (ipv : integer) -> False)) (\(a : integer) (b : integer) (c : integer) -> StakingCredential_match @@ -469,14 +458,14 @@ let (\(ipv : Credential) -> False) (\(a' : integer) (b' : integer) (c' : integer) -> Bool_match - (ifThenElse {Bool} (equalsInteger a a') True False) + (case Bool (equalsInteger a a') [False, True]) {all dead. Bool} (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger b b') True False) + (case Bool (equalsInteger b b') [False, True]) {all dead. Bool} (/\dead -> - ifThenElse {Bool} (equalsInteger c c') True False) + case Bool (equalsInteger c c') [False, True]) (/\dead -> False) {all dead. dead}) (/\dead -> False) @@ -491,12 +480,12 @@ let !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. Bool} (/\dead -> False) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 1 index) True False) + (case Bool (equalsInteger 1 index) [False, True]) {all dead. Bool} (/\dead -> True) (/\dead -> traceError {Bool} "PT1") @@ -516,18 +505,18 @@ let !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. Extended a} (/\dead -> NegInf {a}) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 1 index) True False) + (case Bool (equalsInteger 1 index) [False, True]) {all dead. Extended a} (/\dead -> Finite {a} (`$dUnsafeFromData` (headList {data} args))) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 2 index) True False) + (case Bool (equalsInteger 2 index) [False, True]) {all dead. Extended a} (/\dead -> PosInf {a}) (/\dead -> traceError {Extended a} "PT1") @@ -548,12 +537,12 @@ let !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. ScriptPurpose} (/\dead -> Minting (unBData (headList {data} args))) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 1 index) True False) + (case Bool (equalsInteger 1 index) [False, True]) {all dead. ScriptPurpose} (/\dead -> Spending @@ -561,7 +550,7 @@ let (headList {data} args))) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 2 index) True False) + (case Bool (equalsInteger 2 index) [False, True]) {all dead. ScriptPurpose} (/\dead -> Rewarding @@ -569,7 +558,7 @@ let (headList {data} args))) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 3 index) True False) + (case Bool (equalsInteger 3 index) [False, True]) {all dead. ScriptPurpose} (/\dead -> Certifying @@ -617,7 +606,7 @@ in !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. ScriptContext} (/\dead -> ScriptContext @@ -628,7 +617,7 @@ in !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. TxInfo} (/\dead -> let @@ -685,7 +674,7 @@ in !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. Interval integer} (/\dead -> Interval @@ -697,11 +686,7 @@ in !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse - {Bool} - (equalsInteger 0 index) - True - False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. LowerBound integer} (/\dead -> LowerBound @@ -722,11 +707,7 @@ in !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse - {Bool} - (equalsInteger 0 index) - True - False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. UpperBound integer} (/\dead -> UpperBound diff --git a/plutus-benchmark/script-contexts/test/V2/9.6/sopFwdStakeTrick.size.golden b/plutus-benchmark/script-contexts/test/V2/9.6/sopFwdStakeTrick.size.golden index 40a31ff8c66..51474464464 100644 --- a/plutus-benchmark/script-contexts/test/V2/9.6/sopFwdStakeTrick.size.golden +++ b/plutus-benchmark/script-contexts/test/V2/9.6/sopFwdStakeTrick.size.golden @@ -1 +1 @@ -2071 \ No newline at end of file +1798 \ No newline at end of file diff --git a/plutus-benchmark/script-contexts/test/V2/9.6/sopFwdStakeTrick.uplc.golden b/plutus-benchmark/script-contexts/test/V2/9.6/sopFwdStakeTrick.uplc.golden index 526db5707a4..5d3d109b38a 100644 --- a/plutus-benchmark/script-contexts/test/V2/9.6/sopFwdStakeTrick.uplc.golden +++ b/plutus-benchmark/script-contexts/test/V2/9.6/sopFwdStakeTrick.uplc.golden @@ -22,494 +22,438 @@ (\index -> (\args -> force - (force - (force - ifThenElse - (equalsInteger - 0 - index) - (delay - (delay - ((\`$fUnsafeFromDataScriptContext_$cunsafeFromBuiltinData` -> - constr 0 - [ ((\tup -> - (\index -> - (\args -> - force - (force - (force - ifThenElse - (equalsInteger - 0 - index) - (delay - (delay - ((\l -> - (\l -> - (\l -> - (\l -> - (\l -> - (\l -> - (\l -> - (\l -> - (\l -> - (\l -> - (\`$fUnsafeFromDataBuiltinData_$cunsafeFromBuiltinData` -> - (\cse -> - (\cse -> - (\arg_0 - arg_1 - arg_2 - arg_3 - arg_4 - arg_5 - arg_6 - arg_7 - arg_8 - arg_9 - arg_10 - arg_11 -> - constr 0 - [ arg_0 - , arg_1 - , arg_2 - , arg_3 - , arg_4 - , arg_5 - , arg_6 - , arg_7 - , arg_8 - , arg_9 - , arg_10 - , arg_11 ]) - ((\d -> - force - go - (unListData - d)) - (force - headList - args)) - ((\d -> - force - go - (unListData - d)) - (force - headList - l)) - ((\d -> - force - go - (unListData - d)) - (force - headList - l)) - (cse - (force - headList - l)) - (cse - (force - headList - l)) - ((\d -> - force - go - (unListData - d)) - (force - headList - l)) - (`$fUnsafeFromDataMap_$cunsafeFromBuiltinData` - `$fUnsafeFromDataStakingCredential_$cunsafeFromBuiltinData` - unIData - (force - headList - l)) - ((\tup -> - (\index -> - (\args -> - force - (force - (force - ifThenElse - (equalsInteger - 0 - index) - (delay - (delay - ((\`$fUnsafeFromDataExtended_$cunsafeFromBuiltinData` -> - (\`$fUnsafeFromDataBool_$cunsafeFromBuiltinData` -> - constr 0 - [ ((\tup -> - (\index -> - (\args -> - force - (force - (force - ifThenElse - (equalsInteger - 0 - index) - (delay - (delay - (constr 0 - [ (`$fUnsafeFromDataExtended_$cunsafeFromBuiltinData` - unIData - (force - headList - args)) - , (`$fUnsafeFromDataBool_$cunsafeFromBuiltinData` - (force - headList - (force - tailList - args))) ]))) - (delay - (delay - (traceError - "PT1")))))) - (force - (force - sndPair) - tup)) - (force - (force - fstPair) - tup)) - (unConstrData - (force - headList - args))) - , ((\tup -> - (\index -> - (\args -> - force - (force - (force - ifThenElse - (equalsInteger - 0 - index) - (delay - (delay - (constr 0 - [ (`$fUnsafeFromDataExtended_$cunsafeFromBuiltinData` - unIData - (force - headList - args)) - , (`$fUnsafeFromDataBool_$cunsafeFromBuiltinData` - (force - headList - (force - tailList - args))) ]))) - (delay - (delay + (case + (equalsInteger + 0 + index) + [ (delay + (traceError + "PT1")) + , (delay + ((\`$fUnsafeFromDataScriptContext_$cunsafeFromBuiltinData` -> + constr 0 + [ ((\tup -> + (\index -> + (\args -> + force + (case + (equalsInteger + 0 + index) + [ (delay + (traceError + "PT1")) + , (delay + ((\l -> + (\l -> + (\l -> + (\l -> + (\l -> + (\l -> + (\l -> + (\l -> + (\l -> + (\l -> + (\`$fUnsafeFromDataBuiltinData_$cunsafeFromBuiltinData` -> + (\cse -> + (\cse -> + (\arg_0 + arg_1 + arg_2 + arg_3 + arg_4 + arg_5 + arg_6 + arg_7 + arg_8 + arg_9 + arg_10 + arg_11 -> + constr 0 + [ arg_0 + , arg_1 + , arg_2 + , arg_3 + , arg_4 + , arg_5 + , arg_6 + , arg_7 + , arg_8 + , arg_9 + , arg_10 + , arg_11 ]) + ((\d -> + force + go + (unListData + d)) + (force + headList + args)) + ((\d -> + force + go + (unListData + d)) + (force + headList + l)) + ((\d -> + force + go + (unListData + d)) + (force + headList + l)) + (cse + (force + headList + l)) + (cse + (force + headList + l)) + ((\d -> + force + go + (unListData + d)) + (force + headList + l)) + (`$fUnsafeFromDataMap_$cunsafeFromBuiltinData` + `$fUnsafeFromDataStakingCredential_$cunsafeFromBuiltinData` + unIData + (force + headList + l)) + ((\tup -> + (\index -> + (\args -> + force + (case + (equalsInteger + 0 + index) + [ (delay + (traceError + "PT1")) + , (delay + ((\`$fUnsafeFromDataExtended_$cunsafeFromBuiltinData` -> + (\`$fUnsafeFromDataBool_$cunsafeFromBuiltinData` -> + constr 0 + [ ((\tup -> + (\index -> + (\args -> + force + (case + (equalsInteger + 0 + index) + [ (delay + (traceError + "PT1")) + , (delay + (constr 0 + [ (`$fUnsafeFromDataExtended_$cunsafeFromBuiltinData` + unIData + (force + headList + args)) + , (`$fUnsafeFromDataBool_$cunsafeFromBuiltinData` + (force + headList + (force + tailList + args))) ])) ])) + (force + (force + sndPair) + tup)) + (force + (force + fstPair) + tup)) + (unConstrData + (force + headList + args))) + , ((\tup -> + (\index -> + (\args -> + force + (case + (equalsInteger + 0 + index) + [ (delay + (traceError + "PT1")) + , (delay + (constr 0 + [ (`$fUnsafeFromDataExtended_$cunsafeFromBuiltinData` + unIData + (force + headList + args)) + , (`$fUnsafeFromDataBool_$cunsafeFromBuiltinData` + (force + headList + (force + tailList + args))) ])) ])) + (force + (force + sndPair) + tup)) + (force + (force + fstPair) + tup)) + (unConstrData + (force + headList + (force + tailList + args)))) ]) + (\d -> + (\tup -> + (\index -> + (\args -> + force + (case + (equalsInteger + 0 + index) + [ (delay + (force + (case + (equalsInteger + 1 + index) + [ (delay + (traceError + "PT1")) + , (delay + (constr 0 + [ ])) ]))) + , (delay + (constr 1 + [ ])) ])) + (force + (force + sndPair) + tup)) + (force + (force + fstPair) + tup)) + (unConstrData + d))) + (\`$dUnsafeFromData` + d -> + (\tup -> + (\index -> + (\args -> + force + (case + (equalsInteger + 0 + index) + [ (delay + (force + (case + (equalsInteger + 1 + index) + [ (delay + (force + (case + (equalsInteger + 2 + index) + [ (delay (traceError - "PT1")))))) - (force - (force - sndPair) - tup)) - (force - (force - fstPair) - tup)) - (unConstrData - (force - headList - (force - tailList - args)))) ]) - (\d -> - (\tup -> - (\index -> - (\args -> - force - (force - (force - ifThenElse - (equalsInteger - 0 - index) - (delay - (delay - (constr 1 - [ ]))) - (delay - (delay - (force - (force - (force - ifThenElse - (equalsInteger - 1 - index) - (delay - (delay - (constr 0 - [ ]))) - (delay - (delay - (traceError - "PT1"))))))))))) - (force - (force - sndPair) - tup)) - (force - (force - fstPair) - tup)) - (unConstrData - d))) - (\`$dUnsafeFromData` - d -> - (\tup -> - (\index -> - (\args -> - force - (force - (force - ifThenElse - (equalsInteger - 0 - index) - (delay - (delay - (constr 1 - [ ]))) - (delay - (delay - (force + "PT1")) + , (delay + (constr 2 + [ ])) ]))) + , (delay + (constr 0 + [ (`$dUnsafeFromData` (force - (force - ifThenElse - (equalsInteger - 1 - index) - (delay - (delay - (constr 0 - [ (`$dUnsafeFromData` - (force - headList - args)) ]))) - (delay - (delay - (force - (force - (force - ifThenElse - (equalsInteger - 2 - index) - (delay - (delay - (constr 2 - [ ]))) - (delay - (delay - (traceError - "PT1")))))))))))))))) - (force - (force - sndPair) - tup)) - (force - (force - fstPair) - tup)) - (unConstrData - d))))) - (delay - (delay - (traceError - "PT1")))))) - (force - (force - sndPair) - tup)) - (force - (force - fstPair) - tup)) - (unConstrData - (force - headList - l))) - ((\d -> - force - go - (unListData - d)) - (force - headList - l)) - (`$fUnsafeFromDataMap_$cunsafeFromBuiltinData` - `$fUnsafeFromDataScriptContext_$cunsafeFromBuiltinData` - `$fUnsafeFromDataBuiltinData_$cunsafeFromBuiltinData` - (force - headList - l)) - (cse - `$fUnsafeFromDataBuiltinData_$cunsafeFromBuiltinData` - (force - headList - l))) - (cse - (cse - unIData))) - (`$fUnsafeFromDataMap_$cunsafeFromBuiltinData` - unBData)) - (\d -> - d) - (`$fUnsafeFromDataTxId_$cunsafeFromBuiltinData` - (force - headList - (force - tailList - l)))) - (force - tailList - l)) - (force - tailList - l)) - (force - tailList - l)) - (force - tailList - l)) - (force - tailList - l)) - (force - tailList - l)) - (force - tailList - l)) - (force - tailList - l)) - (force - tailList - l)) - (force - tailList - args)))) - (delay - (delay - (traceError - "PT1")))))) - (force - (force - sndPair) - tup)) - (force - (force - fstPair) - tup)) - (unConstrData - (force - headList - args))) - , (`$fUnsafeFromDataScriptContext_$cunsafeFromBuiltinData` - (force - headList - (force - tailList - args))) ]) - (\d -> - (\tup -> - (\index -> - (\args -> - force - (force - (force - ifThenElse - (equalsInteger - 0 - index) - (delay - (delay - (constr 1 - [ (unBData - (force - headList - args)) ]))) - (delay - (delay - (force + headList + args)) ])) ]))) + , (delay + (constr 1 + [ ])) ])) + (force + (force + sndPair) + tup)) + (force + (force + fstPair) + tup)) + (unConstrData + d)))) ])) + (force + (force + sndPair) + tup)) + (force + (force + fstPair) + tup)) + (unConstrData + (force + headList + l))) + ((\d -> + force + go + (unListData + d)) + (force + headList + l)) + (`$fUnsafeFromDataMap_$cunsafeFromBuiltinData` + `$fUnsafeFromDataScriptContext_$cunsafeFromBuiltinData` + `$fUnsafeFromDataBuiltinData_$cunsafeFromBuiltinData` + (force + headList + l)) + (cse + `$fUnsafeFromDataBuiltinData_$cunsafeFromBuiltinData` + (force + headList + l))) + (cse + (cse + unIData))) + (`$fUnsafeFromDataMap_$cunsafeFromBuiltinData` + unBData)) + (\d -> + d) + (`$fUnsafeFromDataTxId_$cunsafeFromBuiltinData` + (force + headList + (force + tailList + l)))) + (force + tailList + l)) + (force + tailList + l)) + (force + tailList + l)) + (force + tailList + l)) + (force + tailList + l)) + (force + tailList + l)) + (force + tailList + l)) + (force + tailList + l)) + (force + tailList + l)) + (force + tailList + args))) ])) + (force + (force + sndPair) + tup)) + (force + (force + fstPair) + tup)) + (unConstrData + (force + headList + args))) + , (`$fUnsafeFromDataScriptContext_$cunsafeFromBuiltinData` + (force + headList + (force + tailList + args))) ]) + (\d -> + (\tup -> + (\index -> + (\args -> + force + (case + (equalsInteger + 0 + index) + [ (delay + (force + (case + (equalsInteger + 1 + index) + [ (delay (force - (force - ifThenElse + (case (equalsInteger - 1 + 2 index) - (delay - (delay - (constr 3 - [ (`$fUnsafeFromDataTxOutRef_$cunsafeFromBuiltinData` - (force - headList - args)) ]))) - (delay - (delay - (force - (force - (force - ifThenElse - (equalsInteger - 2 - index) - (delay - (delay - (constr 2 - [ (`$fUnsafeFromDataStakingCredential_$cunsafeFromBuiltinData` - (force - headList - args)) ]))) - (delay - (delay - (force + [ (delay + (force + (case + (equalsInteger + 3 + index) + [ (delay + (traceError + "PT1")) + , (delay + (constr 0 + [ (`$fUnsafeFromDataDCert_$cunsafeFromBuiltinData` (force - (force - ifThenElse - (equalsInteger - 3 - index) - (delay - (delay - (constr 0 - [ (`$fUnsafeFromDataDCert_$cunsafeFromBuiltinData` - (force - headList - args)) ]))) - (delay - (delay - (traceError - "PT1"))))))))))))))))))))) - (force - (force - sndPair) - tup)) - (force - (force - fstPair) - tup)) - (unConstrData - d))))) - (delay - (delay - (traceError - "PT1")))))) + headList + args)) ])) ]))) + , (delay + (constr 2 + [ (`$fUnsafeFromDataStakingCredential_$cunsafeFromBuiltinData` + (force + headList + args)) ])) ]))) + , (delay + (constr 3 + [ (`$fUnsafeFromDataTxOutRef_$cunsafeFromBuiltinData` + (force + headList + args)) ])) ]))) + , (delay + (constr 1 + [ (unBData + (force + headList + args)) ])) ])) + (force + (force + sndPair) + tup)) + (force + (force + fstPair) + tup)) + (unConstrData + d)))) ])) (force (force sndPair) tup)) @@ -673,40 +617,38 @@ case ds [ (\r -> - (\equalsByteString -> - case - l - [ (\l -> - case - r - [ (\r -> - equalsByteString + case + l + [ (\l -> + case + r + [ (\r -> + case + (equalsByteString l r) - , (\ipv -> - constr 1 - [ ]) ]) - , (\a -> - case - r - [ (\ipv -> - constr 1 - [ ]) - , (\a' -> - equalsByteString + [ (constr 1 + [ ]) + , (constr 0 + [ ]) ]) + , (\ipv -> + constr 1 + [ ]) ]) + , (\a -> + case + r + [ (\ipv -> + constr 1 + [ ]) + , (\a' -> + case + (equalsByteString a - a') ]) ]) - (\x - y -> - force - ifThenElse - (equalsByteString - x - y) - (constr 0 - [ ]) - (constr 1 - [ ]))) + a') + [ (constr 1 + [ ]) + , (constr 0 + [ ]) ]) ]) ]) , (\ipv ipv ipv -> @@ -724,40 +666,31 @@ b' c' -> force - (force - (force - ifThenElse - (equalsInteger - a - a') - (delay - (delay - (force - (force - (force - ifThenElse - (equalsInteger - b - b') - (delay - (delay - (force - ifThenElse - (equalsInteger - c - c') - (constr 0 - [ ]) - (constr 1 - [ ])))) - (delay - (delay - (constr 1 - [ ])))))))) - (delay - (delay - (constr 1 - [ ])))))) ]) ])) + (case + (equalsInteger + a + a') + [ (delay + (constr 1 + [ ])) + , (delay + (force + (case + (equalsInteger + b + b') + [ (delay + (constr 1 + [ ])) + , (delay + (case + (equalsInteger + c + c') + [ (constr 1 + [ ]) + , (constr 0 + [ ]) ])) ]))) ])) ]) ])) (`$fUnsafeFromDataStakingCredential_$cunsafeFromBuiltinData` obsScriptCred)))))))) ]) ]) ((\s -> @@ -805,29 +738,25 @@ (\index -> (\args -> force - (force - (force - ifThenElse - (equalsInteger - 0 - index) - (delay - (delay - (constr 0 - [ (`$fUnsafeFromDataTxOutRef_$cunsafeFromBuiltinData` - (force - headList - args)) - , (`$fUnsafeFromDataTxOut_$cunsafeFromBuiltinData` - (force - headList - (force - tailList - args))) ]))) - (delay - (delay - (traceError - "PT1")))))) + (case + (equalsInteger + 0 + index) + [ (delay + (traceError + "PT1")) + , (delay + (constr 0 + [ (`$fUnsafeFromDataTxOutRef_$cunsafeFromBuiltinData` + (force + headList + args)) + , (`$fUnsafeFromDataTxOut_$cunsafeFromBuiltinData` + (force + headList + (force + tailList + args))) ])) ])) (force (force sndPair) tup)) (force (force fstPair) tup)) @@ -837,29 +766,22 @@ (\index -> (\args -> force - (force - (force - ifThenElse - (equalsInteger - 0 - index) - (delay - (delay - (constr 0 - [ (`$fUnsafeFromDataTxId_$cunsafeFromBuiltinData` - (force - headList - args)) - , (unIData - (force - headList - (force - tailList - args))) ]))) - (delay - (delay - (traceError - "PT1")))))) + (case + (equalsInteger 0 index) + [ (delay + (traceError "PT1")) + , (delay + (constr 0 + [ (`$fUnsafeFromDataTxId_$cunsafeFromBuiltinData` + (force + headList + args)) + , (unIData + (force + headList + (force + tailList + args))) ])) ])) (force (force sndPair) tup)) (force (force fstPair) tup)) (unConstrData d))) @@ -868,18 +790,14 @@ (\index -> (\args -> force - (force - (force ifThenElse - (equalsInteger 0 index) - (delay - (delay - (unBData - (force headList - args)))) - (delay - (delay - (traceError - "PT1")))))) + (case + (equalsInteger 0 index) + [ (delay + (traceError "PT1")) + , (delay + (unBData + (force headList + args))) ])) (force (force sndPair) tup)) (force (force fstPair) tup)) (unConstrData d))) @@ -904,186 +822,156 @@ (\index -> (\args -> force - (force - (force - ifThenElse - (equalsInteger 0 index) - (delay - (delay - ((\l -> - (\l -> - (\`$fUnsafeFromDataMaybe_$cunsafeFromBuiltinData` -> - (\cse -> - constr 0 - [ ((\tup -> - (\index -> - (\args -> - force - (force - (force - ifThenElse - (equalsInteger - 0 - index) - (delay - (delay - (constr 0 - [ (`$fUnsafeFromDataCredential_$cunsafeFromBuiltinData` - (force - headList - args)) - , (`$fUnsafeFromDataMaybe_$cunsafeFromBuiltinData` - `$fUnsafeFromDataStakingCredential_$cunsafeFromBuiltinData` - (force - headList - (force - tailList - args))) ]))) - (delay - (delay - (traceError - "PT1")))))) - (force - (force - sndPair) - tup)) - (force - (force - fstPair) - tup)) - (unConstrData - (force - headList - args))) - , (cse - (cse - unIData) - (force - headList - l)) - , ((\tup -> - (\index -> - (\args -> - force - (force - (force - ifThenElse - (equalsInteger - 0 - index) - (delay - (delay - (constr 0 - [ ]))) - (delay - (delay + (case + (equalsInteger 0 index) + [ (delay (traceError "PT1")) + , (delay + ((\l -> + (\l -> + (\`$fUnsafeFromDataMaybe_$cunsafeFromBuiltinData` -> + (\cse -> + constr 0 + [ ((\tup -> + (\index -> + (\args -> + force + (case + (equalsInteger + 0 + index) + [ (delay + (traceError + "PT1")) + , (delay + (constr 0 + [ (`$fUnsafeFromDataCredential_$cunsafeFromBuiltinData` + (force + headList + args)) + , (`$fUnsafeFromDataMaybe_$cunsafeFromBuiltinData` + `$fUnsafeFromDataStakingCredential_$cunsafeFromBuiltinData` (force + headList (force - (force - ifThenElse + tailList + args))) ])) ])) + (force + (force + sndPair) + tup)) + (force + (force + fstPair) + tup)) + (unConstrData + (force + headList + args))) + , (cse + (cse + unIData) + (force + headList + l)) + , ((\tup -> + (\index -> + (\args -> + force + (case + (equalsInteger + 0 + index) + [ (delay + (force + (case + (equalsInteger + 1 + index) + [ (delay + (force + (case (equalsInteger - 1 + 2 index) - (delay - (delay - (constr 2 - [ (unBData - (force - headList - args)) ]))) - (delay - (delay - (force - (force - (force - ifThenElse - (equalsInteger - 2 - index) - (delay - (delay - (constr 1 - [ (force - headList - args) ]))) - (delay - (delay - (traceError - "PT1")))))))))))))))) - (force - (force - sndPair) - tup)) - (force - (force - fstPair) - tup)) - (unConstrData - (force - headList - l))) - , (`$fUnsafeFromDataMaybe_$cunsafeFromBuiltinData` - unBData - (force - headList - (force - tailList - l))) ]) - (`$fUnsafeFromDataMap_$cunsafeFromBuiltinData` - unBData)) - (\`$dUnsafeFromData` - d -> - (\tup -> - (\index -> - (\args -> - force - (force - (force - ifThenElse - (equalsInteger - 1 - index) - (delay - (delay - (constr 1 - [ ]))) - (delay - (delay - (force - (force - (force - ifThenElse - (equalsInteger - 0 - index) - (delay - (delay - (constr 0 - [ (`$dUnsafeFromData` - (force - headList - args)) ]))) - (delay - (delay - (traceError - "PT1"))))))))))) - (force - (force - sndPair) - tup)) - (force - (force - fstPair) - tup)) - (unConstrData - d))) - (force tailList - l)) - (force tailList - args)))) - (delay - (delay - (traceError "PT1")))))) + [ (delay + (traceError + "PT1")) + , (delay + (constr 1 + [ (force + headList + args) ])) ]))) + , (delay + (constr 2 + [ (unBData + (force + headList + args)) ])) ]))) + , (delay + (constr 0 + [ ])) ])) + (force + (force + sndPair) + tup)) + (force + (force + fstPair) + tup)) + (unConstrData + (force + headList + l))) + , (`$fUnsafeFromDataMaybe_$cunsafeFromBuiltinData` + unBData + (force + headList + (force + tailList + l))) ]) + (`$fUnsafeFromDataMap_$cunsafeFromBuiltinData` + unBData)) + (\`$dUnsafeFromData` + d -> + (\tup -> + (\index -> + (\args -> + force + (case + (equalsInteger + 1 + index) + [ (delay + (force + (case + (equalsInteger + 0 + index) + [ (delay + (traceError + "PT1")) + , (delay + (constr 0 + [ (`$dUnsafeFromData` + (force + headList + args)) ])) ]))) + , (delay + (constr 1 + [ ])) ])) + (force + (force + sndPair) + tup)) + (force + (force + fstPair) + tup)) + (unConstrData + d))) + (force tailList l)) + (force tailList + args))) ])) (force (force sndPair) tup)) (force (force fstPair) tup)) (unConstrData eta))) @@ -1126,126 +1014,97 @@ (\index -> (\args -> force - (force - (force - ifThenElse - (equalsInteger 0 index) - (delay - (delay - (constr 2 - [ (`$fUnsafeFromDataStakingCredential_$cunsafeFromBuiltinData` - (force headList - args)) ]))) - (delay - (delay - (force - (force - (force - ifThenElse - (equalsInteger 1 index) - (delay - (delay - (constr 0 - [ (`$fUnsafeFromDataStakingCredential_$cunsafeFromBuiltinData` - (force - headList - args)) ]))) - (delay - (delay - (force + (case + (equalsInteger 0 index) + [ (delay + (force + (case + (equalsInteger 1 index) + [ (delay + (force + (case + (equalsInteger + 2 + index) + [ (delay (force - (force - ifThenElse + (case (equalsInteger - 2 + 3 index) - (delay - (delay - (constr 1 - [ (`$fUnsafeFromDataStakingCredential_$cunsafeFromBuiltinData` - (force - headList - args)) - , (unBData - (force - headList - (force - tailList - args))) ]))) - (delay - (delay - (force - (force - (force - ifThenElse - (equalsInteger - 3 - index) - (delay - (delay - (constr 5 - [ (unBData - (force - headList - args)) - , (unBData - (force - headList - (force - tailList - args))) ]))) - (delay - (delay - (force + [ (delay + (force + (case + (equalsInteger + 4 + index) + [ (delay + (force + (case + (equalsInteger + 5 + index) + [ (delay + (force + (case + (equalsInteger + 6 + index) + [ (delay + (traceError + "PT1")) + , (delay + (constr 4 + [ ])) ]))) + , (delay + (constr 3 + [ ])) ]))) + , (delay + (constr 6 + [ (unBData + (force + headList + args)) + , (unIData (force + headList (force - ifThenElse - (equalsInteger - 4 - index) - (delay - (delay - (constr 6 - [ (unBData - (force - headList - args)) - , (unIData - (force - headList - (force - tailList - args))) ]))) - (delay - (delay - (force - (force - (force - ifThenElse - (equalsInteger - 5 - index) - (delay - (delay - (constr 3 - [ ]))) - (delay - (delay - (force - (force - (force - ifThenElse - (equalsInteger - 6 - index) - (delay - (delay - (constr 4 - [ ]))) - (delay - (delay - (traceError - "PT1")))))))))))))))))))))))))))))))))))) + tailList + args))) ])) ]))) + , (delay + (constr 5 + [ (unBData + (force + headList + args)) + , (unBData + (force + headList + (force + tailList + args))) ])) ]))) + , (delay + (constr 1 + [ (`$fUnsafeFromDataStakingCredential_$cunsafeFromBuiltinData` + (force + headList + args)) + , (unBData + (force + headList + (force + tailList + args))) ])) ]))) + , (delay + (constr 0 + [ (`$fUnsafeFromDataStakingCredential_$cunsafeFromBuiltinData` + (force headList + args)) ])) ]))) + , (delay + (constr 2 + [ (`$fUnsafeFromDataStakingCredential_$cunsafeFromBuiltinData` + (force headList + args)) ])) ])) (force (force sndPair) tup)) (force (force fstPair) tup)) (unConstrData d))) @@ -1254,46 +1113,32 @@ (\index -> (\args -> force - (force - (force - ifThenElse - (equalsInteger 0 index) - (delay - (delay - (constr 0 - [ (`$fUnsafeFromDataCredential_$cunsafeFromBuiltinData` - (force headList args)) ]))) - (delay - (delay - (force - (force - (force - ifThenElse - (equalsInteger 1 index) - (delay - (delay - ((\l -> - constr 1 - [ (unIData - (force - headList - args)) - , (unIData - (force - headList - l)) - , (unIData - (force - headList - (force - tailList - l))) ]) - (force tailList - args)))) - (delay - (delay - (traceError - "PT1"))))))))))) + (case + (equalsInteger 0 index) + [ (delay + (force + (case + (equalsInteger 1 index) + [ (delay (traceError "PT1")) + , (delay + ((\l -> + constr 1 + [ (unIData + (force headList + args)) + , (unIData + (force headList + l)) + , (unIData + (force headList + (force tailList + l))) ]) + (force tailList + args))) ]))) + , (delay + (constr 0 + [ (`$fUnsafeFromDataCredential_$cunsafeFromBuiltinData` + (force headList args)) ])) ])) (force (force sndPair) tup)) (force (force fstPair) tup)) (unConstrData d))) @@ -1302,29 +1147,21 @@ (\index -> (\args -> force - (force - (force ifThenElse - (equalsInteger 0 index) - (delay - (delay - (constr 0 - [(unBData (force headList args))]))) - (delay - (delay - (force - (force - (force ifThenElse - (equalsInteger 1 index) - (delay - (delay - (constr 1 - [ (unBData - (force headList - args)) ]))) - (delay - (delay - (traceError - "PT1"))))))))))) + (case + (equalsInteger 0 index) + [ (delay + (force + (case + (equalsInteger 1 index) + [ (delay (traceError "PT1")) + , (delay + (constr 1 + [ (unBData + (force headList + args)) ])) ]))) + , (delay + (constr 0 + [(unBData (force headList args))])) ])) (force (force sndPair) tup)) (force (force fstPair) tup)) (unConstrData d))) diff --git a/plutus-benchmark/script-contexts/test/V2/Data/9.6/checkScriptContext1-20.budget.golden b/plutus-benchmark/script-contexts/test/V2/Data/9.6/checkScriptContext1-20.budget.golden index 176a9fd3473..e0f985fab96 100644 --- a/plutus-benchmark/script-contexts/test/V2/Data/9.6/checkScriptContext1-20.budget.golden +++ b/plutus-benchmark/script-contexts/test/V2/Data/9.6/checkScriptContext1-20.budget.golden @@ -1,2 +1,2 @@ -({cpu: 20438425 -| mem: 73483}) \ No newline at end of file +({cpu: 20250376 +| mem: 72782}) \ No newline at end of file diff --git a/plutus-benchmark/script-contexts/test/V2/Data/9.6/checkScriptContext1-4.budget.golden b/plutus-benchmark/script-contexts/test/V2/Data/9.6/checkScriptContext1-4.budget.golden index fbff59469fc..7c592070dfe 100644 --- a/plutus-benchmark/script-contexts/test/V2/Data/9.6/checkScriptContext1-4.budget.golden +++ b/plutus-benchmark/script-contexts/test/V2/Data/9.6/checkScriptContext1-4.budget.golden @@ -1,2 +1,2 @@ -({cpu: 5862185 -| mem: 20715}) \ No newline at end of file +({cpu: 5674136 +| mem: 20014}) \ No newline at end of file diff --git a/plutus-benchmark/script-contexts/test/V2/Data/9.6/checkScriptContext1.pir.golden b/plutus-benchmark/script-contexts/test/V2/Data/9.6/checkScriptContext1.pir.golden index d4afbd20d72..e712dccca43 100644 --- a/plutus-benchmark/script-contexts/test/V2/Data/9.6/checkScriptContext1.pir.golden +++ b/plutus-benchmark/script-contexts/test/V2/Data/9.6/checkScriptContext1.pir.golden @@ -22,8 +22,8 @@ in \(d : data) -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 0 (modInteger @@ -95,11 +95,7 @@ = sndPair {integer} {list data} tup in Bool_match - (ifThenElse - {Bool} - (equalsInteger 0 index) - True - False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. bytestring} (/\dead -> unBData (headList {data} args)) (/\dead -> @@ -138,8 +134,7 @@ in go ds) 2)) - True - False) + [False, True]) {all dead. Unit} (/\dead -> Unit) (/\dead -> diff --git a/plutus-benchmark/script-contexts/test/V2/Data/9.6/checkScriptContext1.size.golden b/plutus-benchmark/script-contexts/test/V2/Data/9.6/checkScriptContext1.size.golden index 0aede4a000a..90be1cdd8ee 100644 --- a/plutus-benchmark/script-contexts/test/V2/Data/9.6/checkScriptContext1.size.golden +++ b/plutus-benchmark/script-contexts/test/V2/Data/9.6/checkScriptContext1.size.golden @@ -1 +1 @@ -102 \ No newline at end of file +95 \ No newline at end of file diff --git a/plutus-benchmark/script-contexts/test/V2/Data/9.6/checkScriptContextEqualityData-20.budget.golden b/plutus-benchmark/script-contexts/test/V2/Data/9.6/checkScriptContextEqualityData-20.budget.golden index 62362a0e8e4..cab9ab99906 100644 --- a/plutus-benchmark/script-contexts/test/V2/Data/9.6/checkScriptContextEqualityData-20.budget.golden +++ b/plutus-benchmark/script-contexts/test/V2/Data/9.6/checkScriptContextEqualityData-20.budget.golden @@ -1,2 +1,2 @@ -({cpu: 32615310 -| mem: 2302}) \ No newline at end of file +({cpu: 32427261 +| mem: 1601}) \ No newline at end of file diff --git a/plutus-benchmark/script-contexts/test/V3/9.6/checkScriptContext1-20.budget.golden b/plutus-benchmark/script-contexts/test/V3/9.6/checkScriptContext1-20.budget.golden index 679657b1bdf..d0f3144f55b 100644 --- a/plutus-benchmark/script-contexts/test/V3/9.6/checkScriptContext1-20.budget.golden +++ b/plutus-benchmark/script-contexts/test/V3/9.6/checkScriptContext1-20.budget.golden @@ -1,2 +1,2 @@ -({cpu: 312502695 -| mem: 1221729}) \ No newline at end of file +({cpu: 286175835 +| mem: 1123589}) \ No newline at end of file diff --git a/plutus-benchmark/script-contexts/test/V3/9.6/checkScriptContext1-4.budget.golden b/plutus-benchmark/script-contexts/test/V3/9.6/checkScriptContext1-4.budget.golden index 87290b83627..6e7629ae678 100644 --- a/plutus-benchmark/script-contexts/test/V3/9.6/checkScriptContext1-4.budget.golden +++ b/plutus-benchmark/script-contexts/test/V3/9.6/checkScriptContext1-4.budget.golden @@ -1,2 +1,2 @@ -({cpu: 91308279 -| mem: 362305}) \ No newline at end of file +({cpu: 83034123 +| mem: 331461}) \ No newline at end of file diff --git a/plutus-benchmark/script-contexts/test/V3/9.6/checkScriptContext1.pir.golden b/plutus-benchmark/script-contexts/test/V3/9.6/checkScriptContext1.pir.golden index fff044db914..7544fbcb5d2 100644 --- a/plutus-benchmark/script-contexts/test/V3/9.6/checkScriptContext1.pir.golden +++ b/plutus-benchmark/script-contexts/test/V3/9.6/checkScriptContext1.pir.golden @@ -63,7 +63,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. GovernanceActionId} (/\dead -> GovernanceActionId @@ -103,12 +103,12 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. Credential} (/\dead -> PubKeyCredential (unBData (headList {data} args))) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 1 index) True False) + (case Bool (equalsInteger 1 index) [False, True]) {all dead. Credential} (/\dead -> ScriptCredential (unBData (headList {data} args))) (/\dead -> traceError {Credential} "PT1") @@ -124,12 +124,12 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 1 index) True False) + (case Bool (equalsInteger 1 index) [False, True]) {all dead. Maybe a} (/\dead -> Nothing {a}) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. Maybe a} (/\dead -> Just {a} (`$dUnsafeFromData` (headList {data} args))) @@ -193,7 +193,7 @@ !euclid : integer -> integer -> integer = \(x : integer) (y : integer) -> Bool_match - (ifThenElse {Bool} (equalsInteger 0 y) True False) + (case Bool (equalsInteger 0 y) [False, True]) {all dead. integer} (/\dead -> x) (/\dead -> euclid y (modInteger x y)) @@ -203,12 +203,12 @@ !unsafeRatio : integer -> integer -> Rational = \(n : integer) (d : integer) -> Bool_match - (ifThenElse {Bool} (equalsInteger 0 d) True False) + (case Bool (equalsInteger 0 d) [False, True]) {all dead. Rational} (/\dead -> traceError {Rational} "PT3") (/\dead -> Bool_match - (ifThenElse {Bool} (lessThanInteger d 0) True False) + (case Bool (lessThanInteger d 0) [False, True]) {all dead. Rational} (/\dead -> unsafeRatio (subtractInteger 0 n) (subtractInteger 0 d)) @@ -230,7 +230,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. ProposalProcedure} (/\dead -> let @@ -247,7 +247,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. GovernanceAction} (/\dead -> let @@ -265,7 +265,7 @@ (headList {data} (tailList {data} l)))) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 1 index) True False) + (case Bool (equalsInteger 1 index) [False, True]) {all dead. GovernanceAction} (/\dead -> HardForkInitiation @@ -283,11 +283,7 @@ = sndPair {integer} {list data} tup in Bool_match - (ifThenElse - {Bool} - (equalsInteger 0 index) - True - False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. ProtocolVersion} (/\dead -> ProtocolVersion @@ -300,11 +296,7 @@ {all dead. dead})) (/\dead -> Bool_match - (ifThenElse - {Bool} - (equalsInteger 2 index) - True - False) + (case Bool (equalsInteger 2 index) [False, True]) {all dead. GovernanceAction} (/\dead -> TreasuryWithdrawals @@ -320,11 +312,10 @@ (headList {data} (tailList {data} args)))) (/\dead -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 3 index) - True - False) + [False, True]) {all dead. GovernanceAction} (/\dead -> NoConfidence @@ -334,11 +325,10 @@ (headList {data} args))) (/\dead -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 4 index) - True - False) + [False, True]) {all dead. GovernanceAction} (/\dead -> let @@ -385,11 +375,10 @@ tup in Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 0 index) - True - False) + [False, True]) {all dead. Tuple2 integer integer} (/\dead -> @@ -414,11 +403,10 @@ unsafeRatio a b))) (/\dead -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 5 index) - True - False) + [False, True]) {all dead. GovernanceAction} (/\dead -> NewConstitution @@ -447,11 +435,10 @@ tup in Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 0 index) - True - False) + [False, True]) {all dead. Maybe bytestring} (/\dead -> `$fUnsafeFromDataMaybe_$cunsafeFromBuiltinData` @@ -465,11 +452,10 @@ {all dead. dead})) (/\dead -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 6 index) - True - False) + [False, True]) {all dead. GovernanceAction} (/\dead -> InfoAction) (/\dead -> @@ -511,7 +497,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. DRep} (/\dead -> DRep @@ -519,12 +505,12 @@ (headList {data} args))) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 1 index) True False) + (case Bool (equalsInteger 1 index) [False, True]) {all dead. DRep} (/\dead -> DRepAlwaysAbstain) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 2 index) True False) + (case Bool (equalsInteger 2 index) [False, True]) {all dead. DRep} (/\dead -> DRepAlwaysNoConfidence) (/\dead -> traceError {DRep} "PT1") @@ -543,12 +529,12 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. Delegatee} (/\dead -> DelegStake (unBData (headList {data} args))) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 1 index) True False) + (case Bool (equalsInteger 1 index) [False, True]) {all dead. Delegatee} (/\dead -> DelegVote @@ -556,7 +542,7 @@ (headList {data} args))) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 2 index) True False) + (case Bool (equalsInteger 2 index) [False, True]) {all dead. Delegatee} (/\dead -> DelegStakeVote @@ -588,7 +574,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. TxCert} (/\dead -> TxCertRegStaking @@ -600,7 +586,7 @@ (headList {data} (tailList {data} args)))) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 1 index) True False) + (case Bool (equalsInteger 1 index) [False, True]) {all dead. TxCert} (/\dead -> TxCertUnRegStaking @@ -612,7 +598,7 @@ (headList {data} (tailList {data} args)))) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 2 index) True False) + (case Bool (equalsInteger 2 index) [False, True]) {all dead. TxCert} (/\dead -> TxCertDelegStaking @@ -622,11 +608,7 @@ (headList {data} (tailList {data} args)))) (/\dead -> Bool_match - (ifThenElse - {Bool} - (equalsInteger 3 index) - True - False) + (case Bool (equalsInteger 3 index) [False, True]) {all dead. TxCert} (/\dead -> let @@ -640,11 +622,10 @@ (unIData (headList {data} (tailList {data} l)))) (/\dead -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 4 index) - True - False) + [False, True]) {all dead. TxCert} (/\dead -> TxCertRegDRep @@ -656,11 +637,10 @@ (tailList {data} args)))) (/\dead -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 5 index) - True - False) + [False, True]) {all dead. TxCert} (/\dead -> TxCertUpdateDRep @@ -668,11 +648,10 @@ (headList {data} args))) (/\dead -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 6 index) - True - False) + [False, True]) {all dead. TxCert} (/\dead -> TxCertUnRegDRep @@ -684,11 +663,10 @@ (tailList {data} args)))) (/\dead -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 7 index) - True - False) + [False, True]) {all dead. TxCert} (/\dead -> TxCertPoolRegister @@ -702,11 +680,10 @@ args)))) (/\dead -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 8 index) - True - False) + [False, True]) {all dead. TxCert} (/\dead -> TxCertPoolRetire @@ -722,13 +699,12 @@ args)))) (/\dead -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 9 index) - True - False) + [False, True]) {all dead. TxCert} (/\dead -> TxCertAuthHotCommittee @@ -744,13 +720,12 @@ args)))) (/\dead -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 10 index) - True - False) + [False, True]) {all dead. TxCert} (/\dead -> TxCertResignColdCommittee @@ -796,7 +771,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. TxOut} (/\dead -> let @@ -811,7 +786,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. Address} (/\dead -> Address @@ -828,11 +803,10 @@ = sndPair {integer} {list data} tup in Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 0 index) - True - False) + [False, True]) {all dead. StakingCredential} (/\dead -> StakingHash @@ -840,11 +814,10 @@ (headList {data} args))) (/\dead -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 1 index) - True - False) + [False, True]) {all dead. StakingCredential} (/\dead -> let @@ -881,22 +854,18 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. OutputDatum} (/\dead -> NoOutputDatum) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 1 index) True False) + (case Bool (equalsInteger 1 index) [False, True]) {all dead. OutputDatum} (/\dead -> OutputDatumHash (unBData (headList {data} args))) (/\dead -> Bool_match - (ifThenElse - {Bool} - (equalsInteger 2 index) - True - False) + (case Bool (equalsInteger 2 index) [False, True]) {all dead. OutputDatum} (/\dead -> OutputDatum (headList {data} args)) (/\dead -> traceError {OutputDatum} "PT1") @@ -933,7 +902,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. TxOutRef} (/\dead -> TxOutRef @@ -951,7 +920,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. TxInInfo} (/\dead -> TxInInfo @@ -997,12 +966,12 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. Bool} (/\dead -> False) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 1 index) True False) + (case Bool (equalsInteger 1 index) [False, True]) {all dead. Bool} (/\dead -> True) (/\dead -> traceError {Bool} "PT1") @@ -1022,18 +991,18 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. Extended a} (/\dead -> NegInf {a}) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 1 index) True False) + (case Bool (equalsInteger 1 index) [False, True]) {all dead. Extended a} (/\dead -> Finite {a} (`$dUnsafeFromData` (headList {data} args))) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 2 index) True False) + (case Bool (equalsInteger 2 index) [False, True]) {all dead. Extended a} (/\dead -> PosInf {a}) (/\dead -> traceError {Extended a} "PT1") @@ -1052,7 +1021,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. Voter} (/\dead -> CommitteeVoter @@ -1060,7 +1029,7 @@ (headList {data} args))) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 1 index) True False) + (case Bool (equalsInteger 1 index) [False, True]) {all dead. Voter} (/\dead -> DRepVoter @@ -1068,7 +1037,7 @@ (headList {data} args))) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 2 index) True False) + (case Bool (equalsInteger 2 index) [False, True]) {all dead. Voter} (/\dead -> StakePoolVoter (unBData (headList {data} args))) @@ -1134,7 +1103,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. ScriptContext} (/\dead -> let @@ -1148,7 +1117,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. TxInfo} (/\dead -> let @@ -1208,7 +1177,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. Interval integer} (/\dead -> Interval @@ -1222,11 +1191,7 @@ = sndPair {integer} {list data} tup in Bool_match - (ifThenElse - {Bool} - (equalsInteger 0 index) - True - False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. LowerBound integer} (/\dead -> LowerBound @@ -1249,11 +1214,7 @@ = sndPair {integer} {list data} tup in Bool_match - (ifThenElse - {Bool} - (equalsInteger 0 index) - True - False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. UpperBound integer} (/\dead -> UpperBound @@ -1283,20 +1244,15 @@ = sndPair {integer} {list data} tup in Bool_match - (ifThenElse - {Bool} - (equalsInteger 0 index) - True - False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. ScriptPurpose} (/\dead -> Minting (unBData (headList {data} args))) (/\dead -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 1 index) - True - False) + [False, True]) {all dead. ScriptPurpose} (/\dead -> Spending @@ -1304,11 +1260,10 @@ (headList {data} args))) (/\dead -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 2 index) - True - False) + [False, True]) {all dead. ScriptPurpose} (/\dead -> Rewarding @@ -1316,11 +1271,10 @@ (headList {data} args))) (/\dead -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 3 index) - True - False) + [False, True]) {all dead. ScriptPurpose} (/\dead -> Certifying @@ -1331,11 +1285,10 @@ (tailList {data} args)))) (/\dead -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 4 index) - True - False) + [False, True]) {all dead. ScriptPurpose} (/\dead -> Voting @@ -1343,11 +1296,10 @@ (headList {data} args))) (/\dead -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 5 index) - True - False) + [False, True]) {all dead. ScriptPurpose} (/\dead -> Proposing @@ -1397,29 +1349,23 @@ = sndPair {integer} {list data} tup in Bool_match - (ifThenElse - {Bool} - (equalsInteger 0 index) - True - False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. Vote} (/\dead -> VoteNo) (/\dead -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 1 index) - True - False) + [False, True]) {all dead. Vote} (/\dead -> VoteYes) (/\dead -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 2 index) - True - False) + [False, True]) {all dead. Vote} (/\dead -> Abstain) (/\dead -> traceError {Vote} "PT1") @@ -1449,12 +1395,12 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. ScriptInfo} (/\dead -> MintingScript (unBData (headList {data} args))) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 1 index) True False) + (case Bool (equalsInteger 1 index) [False, True]) {all dead. ScriptInfo} (/\dead -> SpendingScript @@ -1466,7 +1412,7 @@ (headList {data} (tailList {data} args)))) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 2 index) True False) + (case Bool (equalsInteger 2 index) [False, True]) {all dead. ScriptInfo} (/\dead -> RewardingScript @@ -1474,11 +1420,7 @@ (headList {data} args))) (/\dead -> Bool_match - (ifThenElse - {Bool} - (equalsInteger 3 index) - True - False) + (case Bool (equalsInteger 3 index) [False, True]) {all dead. ScriptInfo} (/\dead -> CertifyingScript @@ -1487,11 +1429,10 @@ (headList {data} (tailList {data} args)))) (/\dead -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 4 index) - True - False) + [False, True]) {all dead. ScriptInfo} (/\dead -> VotingScript @@ -1499,11 +1440,10 @@ (headList {data} args))) (/\dead -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 5 index) - True - False) + [False, True]) {all dead. ScriptInfo} (/\dead -> ProposingScript @@ -1525,8 +1465,8 @@ {Unit} (\(ipv : TxInfo) (ipv : data) (ipv : ScriptInfo) -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 0 (modInteger @@ -1567,8 +1507,7 @@ in go eta) 2)) - True - False) + [False, True]) {all dead. Unit} (/\dead -> Unit) (/\dead -> diff --git a/plutus-benchmark/script-contexts/test/V3/9.6/checkScriptContext1.size.golden b/plutus-benchmark/script-contexts/test/V3/9.6/checkScriptContext1.size.golden index 66bb036074b..7dccddc002b 100644 --- a/plutus-benchmark/script-contexts/test/V3/9.6/checkScriptContext1.size.golden +++ b/plutus-benchmark/script-contexts/test/V3/9.6/checkScriptContext1.size.golden @@ -1 +1 @@ -3371 \ No newline at end of file +2853 \ No newline at end of file diff --git a/plutus-benchmark/script-contexts/test/V3/9.6/checkScriptContext2-20.budget.golden b/plutus-benchmark/script-contexts/test/V3/9.6/checkScriptContext2-20.budget.golden index 464288510cc..e3b391bb1df 100644 --- a/plutus-benchmark/script-contexts/test/V3/9.6/checkScriptContext2-20.budget.golden +++ b/plutus-benchmark/script-contexts/test/V3/9.6/checkScriptContext2-20.budget.golden @@ -1,2 +1,2 @@ -({cpu: 304890223 -| mem: 1188386}) \ No newline at end of file +({cpu: 278751412 +| mem: 1090947}) \ No newline at end of file diff --git a/plutus-benchmark/script-contexts/test/V3/9.6/checkScriptContext2-4.budget.golden b/plutus-benchmark/script-contexts/test/V3/9.6/checkScriptContext2-4.budget.golden index 519c3663aab..acfd07ca92d 100644 --- a/plutus-benchmark/script-contexts/test/V3/9.6/checkScriptContext2-4.budget.golden +++ b/plutus-benchmark/script-contexts/test/V3/9.6/checkScriptContext2-4.budget.golden @@ -1,2 +1,2 @@ -({cpu: 88899135 -| mem: 351394}) \ No newline at end of file +({cpu: 80813028 +| mem: 321251}) \ No newline at end of file diff --git a/plutus-benchmark/script-contexts/test/V3/9.6/checkScriptContext2.pir.golden b/plutus-benchmark/script-contexts/test/V3/9.6/checkScriptContext2.pir.golden index 5041a1a5626..61060148716 100644 --- a/plutus-benchmark/script-contexts/test/V3/9.6/checkScriptContext2.pir.golden +++ b/plutus-benchmark/script-contexts/test/V3/9.6/checkScriptContext2.pir.golden @@ -18,7 +18,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. GovernanceActionId} (/\dead -> GovernanceActionId @@ -68,12 +68,12 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. Credential} (/\dead -> PubKeyCredential (unBData (headList {data} args))) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 1 index) True False) + (case Bool (equalsInteger 1 index) [False, True]) {all dead. Credential} (/\dead -> ScriptCredential (unBData (headList {data} args))) (/\dead -> traceError {Credential} "PT1") @@ -92,12 +92,12 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 1 index) True False) + (case Bool (equalsInteger 1 index) [False, True]) {all dead. Maybe a} (/\dead -> Nothing {a}) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. Maybe a} (/\dead -> Just {a} (`$dUnsafeFromData` (headList {data} args))) @@ -163,7 +163,7 @@ !euclid : integer -> integer -> integer = \(x : integer) (y : integer) -> Bool_match - (ifThenElse {Bool} (equalsInteger 0 y) True False) + (case Bool (equalsInteger 0 y) [False, True]) {all dead. integer} (/\dead -> x) (/\dead -> euclid y (modInteger x y)) @@ -173,12 +173,12 @@ !unsafeRatio : integer -> integer -> Rational = \(n : integer) (d : integer) -> Bool_match - (ifThenElse {Bool} (equalsInteger 0 d) True False) + (case Bool (equalsInteger 0 d) [False, True]) {all dead. Rational} (/\dead -> traceError {Rational} "PT3") (/\dead -> Bool_match - (ifThenElse {Bool} (lessThanInteger d 0) True False) + (case Bool (lessThanInteger d 0) [False, True]) {all dead. Rational} (/\dead -> unsafeRatio (subtractInteger 0 n) (subtractInteger 0 d)) @@ -200,7 +200,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. ProposalProcedure} (/\dead -> let @@ -217,7 +217,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. GovernanceAction} (/\dead -> let @@ -235,7 +235,7 @@ (headList {data} (tailList {data} l)))) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 1 index) True False) + (case Bool (equalsInteger 1 index) [False, True]) {all dead. GovernanceAction} (/\dead -> HardForkInitiation @@ -253,11 +253,7 @@ = sndPair {integer} {list data} tup in Bool_match - (ifThenElse - {Bool} - (equalsInteger 0 index) - True - False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. ProtocolVersion} (/\dead -> ProtocolVersion @@ -270,11 +266,7 @@ {all dead. dead})) (/\dead -> Bool_match - (ifThenElse - {Bool} - (equalsInteger 2 index) - True - False) + (case Bool (equalsInteger 2 index) [False, True]) {all dead. GovernanceAction} (/\dead -> TreasuryWithdrawals @@ -290,11 +282,10 @@ (headList {data} (tailList {data} args)))) (/\dead -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 3 index) - True - False) + [False, True]) {all dead. GovernanceAction} (/\dead -> NoConfidence @@ -304,11 +295,10 @@ (headList {data} args))) (/\dead -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 4 index) - True - False) + [False, True]) {all dead. GovernanceAction} (/\dead -> let @@ -355,11 +345,10 @@ tup in Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 0 index) - True - False) + [False, True]) {all dead. Tuple2 integer integer} (/\dead -> @@ -384,11 +373,10 @@ unsafeRatio a b))) (/\dead -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 5 index) - True - False) + [False, True]) {all dead. GovernanceAction} (/\dead -> NewConstitution @@ -417,11 +405,10 @@ tup in Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 0 index) - True - False) + [False, True]) {all dead. Maybe bytestring} (/\dead -> `$fUnsafeFromDataMaybe_$cunsafeFromBuiltinData` @@ -435,11 +422,10 @@ {all dead. dead})) (/\dead -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 6 index) - True - False) + [False, True]) {all dead. GovernanceAction} (/\dead -> InfoAction) (/\dead -> @@ -481,7 +467,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. DRep} (/\dead -> DRep @@ -489,12 +475,12 @@ (headList {data} args))) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 1 index) True False) + (case Bool (equalsInteger 1 index) [False, True]) {all dead. DRep} (/\dead -> DRepAlwaysAbstain) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 2 index) True False) + (case Bool (equalsInteger 2 index) [False, True]) {all dead. DRep} (/\dead -> DRepAlwaysNoConfidence) (/\dead -> traceError {DRep} "PT1") @@ -513,12 +499,12 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. Delegatee} (/\dead -> DelegStake (unBData (headList {data} args))) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 1 index) True False) + (case Bool (equalsInteger 1 index) [False, True]) {all dead. Delegatee} (/\dead -> DelegVote @@ -526,7 +512,7 @@ (headList {data} args))) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 2 index) True False) + (case Bool (equalsInteger 2 index) [False, True]) {all dead. Delegatee} (/\dead -> DelegStakeVote @@ -558,7 +544,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. TxCert} (/\dead -> TxCertRegStaking @@ -570,7 +556,7 @@ (headList {data} (tailList {data} args)))) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 1 index) True False) + (case Bool (equalsInteger 1 index) [False, True]) {all dead. TxCert} (/\dead -> TxCertUnRegStaking @@ -582,7 +568,7 @@ (headList {data} (tailList {data} args)))) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 2 index) True False) + (case Bool (equalsInteger 2 index) [False, True]) {all dead. TxCert} (/\dead -> TxCertDelegStaking @@ -592,11 +578,7 @@ (headList {data} (tailList {data} args)))) (/\dead -> Bool_match - (ifThenElse - {Bool} - (equalsInteger 3 index) - True - False) + (case Bool (equalsInteger 3 index) [False, True]) {all dead. TxCert} (/\dead -> let @@ -610,11 +592,10 @@ (unIData (headList {data} (tailList {data} l)))) (/\dead -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 4 index) - True - False) + [False, True]) {all dead. TxCert} (/\dead -> TxCertRegDRep @@ -626,11 +607,10 @@ (tailList {data} args)))) (/\dead -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 5 index) - True - False) + [False, True]) {all dead. TxCert} (/\dead -> TxCertUpdateDRep @@ -638,11 +618,10 @@ (headList {data} args))) (/\dead -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 6 index) - True - False) + [False, True]) {all dead. TxCert} (/\dead -> TxCertUnRegDRep @@ -654,11 +633,10 @@ (tailList {data} args)))) (/\dead -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 7 index) - True - False) + [False, True]) {all dead. TxCert} (/\dead -> TxCertPoolRegister @@ -672,11 +650,10 @@ args)))) (/\dead -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 8 index) - True - False) + [False, True]) {all dead. TxCert} (/\dead -> TxCertPoolRetire @@ -692,13 +669,12 @@ args)))) (/\dead -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 9 index) - True - False) + [False, True]) {all dead. TxCert} (/\dead -> TxCertAuthHotCommittee @@ -714,13 +690,12 @@ args)))) (/\dead -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 10 index) - True - False) + [False, True]) {all dead. TxCert} (/\dead -> TxCertResignColdCommittee @@ -784,7 +759,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. TxOut} (/\dead -> let @@ -799,7 +774,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. Address} (/\dead -> Address @@ -816,11 +791,10 @@ = sndPair {integer} {list data} tup in Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 0 index) - True - False) + [False, True]) {all dead. StakingCredential} (/\dead -> StakingHash @@ -828,11 +802,10 @@ (headList {data} args))) (/\dead -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 1 index) - True - False) + [False, True]) {all dead. StakingCredential} (/\dead -> let @@ -869,22 +842,18 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. OutputDatum} (/\dead -> NoOutputDatum) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 1 index) True False) + (case Bool (equalsInteger 1 index) [False, True]) {all dead. OutputDatum} (/\dead -> OutputDatumHash (unBData (headList {data} args))) (/\dead -> Bool_match - (ifThenElse - {Bool} - (equalsInteger 2 index) - True - False) + (case Bool (equalsInteger 2 index) [False, True]) {all dead. OutputDatum} (/\dead -> OutputDatum (headList {data} args)) (/\dead -> traceError {OutputDatum} "PT1") @@ -921,7 +890,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. TxOutRef} (/\dead -> TxOutRef @@ -939,7 +908,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. TxInInfo} (/\dead -> TxInInfo @@ -985,12 +954,12 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. Bool} (/\dead -> False) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 1 index) True False) + (case Bool (equalsInteger 1 index) [False, True]) {all dead. Bool} (/\dead -> True) (/\dead -> traceError {Bool} "PT1") @@ -1010,18 +979,18 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. Extended a} (/\dead -> NegInf {a}) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 1 index) True False) + (case Bool (equalsInteger 1 index) [False, True]) {all dead. Extended a} (/\dead -> Finite {a} (`$dUnsafeFromData` (headList {data} args))) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 2 index) True False) + (case Bool (equalsInteger 2 index) [False, True]) {all dead. Extended a} (/\dead -> PosInf {a}) (/\dead -> traceError {Extended a} "PT1") @@ -1040,7 +1009,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. Voter} (/\dead -> CommitteeVoter @@ -1048,7 +1017,7 @@ (headList {data} args))) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 1 index) True False) + (case Bool (equalsInteger 1 index) [False, True]) {all dead. Voter} (/\dead -> DRepVoter @@ -1056,7 +1025,7 @@ (headList {data} args))) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 2 index) True False) + (case Bool (equalsInteger 2 index) [False, True]) {all dead. Voter} (/\dead -> StakePoolVoter (unBData (headList {data} args))) @@ -1124,7 +1093,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. ScriptContext} (/\dead -> let @@ -1138,7 +1107,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. TxInfo} (/\dead -> let @@ -1198,7 +1167,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. Interval integer} (/\dead -> Interval @@ -1212,11 +1181,7 @@ = sndPair {integer} {list data} tup in Bool_match - (ifThenElse - {Bool} - (equalsInteger 0 index) - True - False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. LowerBound integer} (/\dead -> LowerBound @@ -1241,11 +1206,7 @@ = sndPair {integer} {list data} tup in Bool_match - (ifThenElse - {Bool} - (equalsInteger 0 index) - True - False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. UpperBound integer} (/\dead -> UpperBound @@ -1278,21 +1239,16 @@ = sndPair {integer} {list data} tup in Bool_match - (ifThenElse - {Bool} - (equalsInteger 0 index) - True - False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. ScriptPurpose} (/\dead -> Minting (unBData (headList {data} args))) (/\dead -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 1 index) - True - False) + [False, True]) {all dead. ScriptPurpose} (/\dead -> Spending @@ -1300,11 +1256,10 @@ (headList {data} args))) (/\dead -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 2 index) - True - False) + [False, True]) {all dead. ScriptPurpose} (/\dead -> Rewarding @@ -1312,11 +1267,10 @@ (headList {data} args))) (/\dead -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 3 index) - True - False) + [False, True]) {all dead. ScriptPurpose} (/\dead -> Certifying @@ -1330,11 +1284,10 @@ args)))) (/\dead -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 4 index) - True - False) + [False, True]) {all dead. ScriptPurpose} (/\dead -> Voting @@ -1344,13 +1297,12 @@ args))) (/\dead -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 5 index) - True - False) + [False, True]) {all dead. ScriptPurpose} (/\dead -> Proposing @@ -1401,29 +1353,26 @@ = sndPair {integer} {list data} tup in Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 0 index) - True - False) + [False, True]) {all dead. Vote} (/\dead -> VoteNo) (/\dead -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 1 index) - True - False) + [False, True]) {all dead. Vote} (/\dead -> VoteYes) (/\dead -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 2 index) - True - False) + [False, True]) {all dead. Vote} (/\dead -> Abstain) (/\dead -> traceError {Vote} "PT1") @@ -1453,12 +1402,12 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. ScriptInfo} (/\dead -> MintingScript (unBData (headList {data} args))) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 1 index) True False) + (case Bool (equalsInteger 1 index) [False, True]) {all dead. ScriptInfo} (/\dead -> SpendingScript @@ -1470,11 +1419,7 @@ (headList {data} (tailList {data} args)))) (/\dead -> Bool_match - (ifThenElse - {Bool} - (equalsInteger 2 index) - True - False) + (case Bool (equalsInteger 2 index) [False, True]) {all dead. ScriptInfo} (/\dead -> RewardingScript @@ -1482,11 +1427,10 @@ (headList {data} args))) (/\dead -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 3 index) - True - False) + [False, True]) {all dead. ScriptInfo} (/\dead -> CertifyingScript @@ -1497,11 +1441,10 @@ (tailList {data} args)))) (/\dead -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 4 index) - True - False) + [False, True]) {all dead. ScriptInfo} (/\dead -> VotingScript @@ -1509,11 +1452,10 @@ (headList {data} args))) (/\dead -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 5 index) - True - False) + [False, True]) {all dead. ScriptInfo} (/\dead -> ProposingScript diff --git a/plutus-benchmark/script-contexts/test/V3/9.6/checkScriptContext2.size.golden b/plutus-benchmark/script-contexts/test/V3/9.6/checkScriptContext2.size.golden index 4dbebb27ee7..ccbd16b55b0 100644 --- a/plutus-benchmark/script-contexts/test/V3/9.6/checkScriptContext2.size.golden +++ b/plutus-benchmark/script-contexts/test/V3/9.6/checkScriptContext2.size.golden @@ -1 +1 @@ -3297 \ No newline at end of file +2786 \ No newline at end of file diff --git a/plutus-benchmark/script-contexts/test/V3/9.6/checkScriptContextEqualityData-20.budget.golden b/plutus-benchmark/script-contexts/test/V3/9.6/checkScriptContextEqualityData-20.budget.golden index 3304d39424f..1f3f482aa65 100644 --- a/plutus-benchmark/script-contexts/test/V3/9.6/checkScriptContextEqualityData-20.budget.golden +++ b/plutus-benchmark/script-contexts/test/V3/9.6/checkScriptContextEqualityData-20.budget.golden @@ -1,2 +1,2 @@ -({cpu: 38146332 -| mem: 33802}) \ No newline at end of file +({cpu: 37958283 +| mem: 33101}) \ No newline at end of file diff --git a/plutus-benchmark/script-contexts/test/V3/Data/9.6/checkScriptContext1-20.budget.golden b/plutus-benchmark/script-contexts/test/V3/Data/9.6/checkScriptContext1-20.budget.golden index 176a9fd3473..e0f985fab96 100644 --- a/plutus-benchmark/script-contexts/test/V3/Data/9.6/checkScriptContext1-20.budget.golden +++ b/plutus-benchmark/script-contexts/test/V3/Data/9.6/checkScriptContext1-20.budget.golden @@ -1,2 +1,2 @@ -({cpu: 20438425 -| mem: 73483}) \ No newline at end of file +({cpu: 20250376 +| mem: 72782}) \ No newline at end of file diff --git a/plutus-benchmark/script-contexts/test/V3/Data/9.6/checkScriptContext1-4.budget.golden b/plutus-benchmark/script-contexts/test/V3/Data/9.6/checkScriptContext1-4.budget.golden index fbff59469fc..7c592070dfe 100644 --- a/plutus-benchmark/script-contexts/test/V3/Data/9.6/checkScriptContext1-4.budget.golden +++ b/plutus-benchmark/script-contexts/test/V3/Data/9.6/checkScriptContext1-4.budget.golden @@ -1,2 +1,2 @@ -({cpu: 5862185 -| mem: 20715}) \ No newline at end of file +({cpu: 5674136 +| mem: 20014}) \ No newline at end of file diff --git a/plutus-benchmark/script-contexts/test/V3/Data/9.6/checkScriptContext1.pir.golden b/plutus-benchmark/script-contexts/test/V3/Data/9.6/checkScriptContext1.pir.golden index a8b75fa7863..3fac13a8524 100644 --- a/plutus-benchmark/script-contexts/test/V3/Data/9.6/checkScriptContext1.pir.golden +++ b/plutus-benchmark/script-contexts/test/V3/Data/9.6/checkScriptContext1.pir.golden @@ -32,12 +32,12 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 1 index) True False) + (case Bool (equalsInteger 1 index) [False, True]) {all dead. Maybe a} (/\dead -> Nothing {a}) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. Maybe a} (/\dead -> Just {a} (`$dUnsafeFromData` (headList {data} args))) @@ -75,8 +75,8 @@ {Unit} (\(ipv : data) -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 0 (modInteger @@ -191,8 +191,7 @@ in go ds) 2)) - True - False) + [False, True]) {all dead. Unit} (/\dead -> Unit) (/\dead -> diff --git a/plutus-benchmark/script-contexts/test/V3/Data/9.6/checkScriptContext1.size.golden b/plutus-benchmark/script-contexts/test/V3/Data/9.6/checkScriptContext1.size.golden index 0aede4a000a..90be1cdd8ee 100644 --- a/plutus-benchmark/script-contexts/test/V3/Data/9.6/checkScriptContext1.size.golden +++ b/plutus-benchmark/script-contexts/test/V3/Data/9.6/checkScriptContext1.size.golden @@ -1 +1 @@ -102 \ No newline at end of file +95 \ No newline at end of file diff --git a/plutus-benchmark/script-contexts/test/V3/Data/9.6/checkScriptContextEqualityData-20.budget.golden b/plutus-benchmark/script-contexts/test/V3/Data/9.6/checkScriptContextEqualityData-20.budget.golden index 8db993b6233..803b7bff1ed 100644 --- a/plutus-benchmark/script-contexts/test/V3/Data/9.6/checkScriptContextEqualityData-20.budget.golden +++ b/plutus-benchmark/script-contexts/test/V3/Data/9.6/checkScriptContextEqualityData-20.budget.golden @@ -1,2 +1,2 @@ -({cpu: 33106332 -| mem: 2302}) \ No newline at end of file +({cpu: 32918283 +| mem: 1601}) \ No newline at end of file diff --git a/plutus-benchmark/script-contexts/test/V3/Data/9.6/purposeIsWellFormed-4.budget.golden b/plutus-benchmark/script-contexts/test/V3/Data/9.6/purposeIsWellFormed-4.budget.golden index 0d2d2d775f4..d26d4a01a7b 100644 --- a/plutus-benchmark/script-contexts/test/V3/Data/9.6/purposeIsWellFormed-4.budget.golden +++ b/plutus-benchmark/script-contexts/test/V3/Data/9.6/purposeIsWellFormed-4.budget.golden @@ -1,2 +1,2 @@ -({cpu: 64879735 -| mem: 302496}) \ No newline at end of file +({cpu: 62247049 +| mem: 292682}) \ No newline at end of file diff --git a/plutus-benchmark/script-contexts/test/V3/Data/9.6/purposeIsWellFormed.pir.golden b/plutus-benchmark/script-contexts/test/V3/Data/9.6/purposeIsWellFormed.pir.golden index d62adba4b4d..b2ca968bdce 100644 --- a/plutus-benchmark/script-contexts/test/V3/Data/9.6/purposeIsWellFormed.pir.golden +++ b/plutus-benchmark/script-contexts/test/V3/Data/9.6/purposeIsWellFormed.pir.golden @@ -16,7 +16,7 @@ let in \(c : integer -> a -> a) (n : a) -> Bool_match - (ifThenElse {Bool} (lessThanEqualsInteger x 0) False True) + (case Bool (lessThanEqualsInteger x 0) [True, False]) {all dead. a} (/\dead -> c x n) (/\dead -> n) @@ -341,26 +341,24 @@ let !tup : pair integer (list data) = unConstrData ds in Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 1 (fstPair {integer} {list data} tup)) - True - False) + [False, True]) {all dead. Bool} (/\dead -> let !tup : pair integer (list data) = unConstrData ds in Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 1 (fstPair {integer} {list data} tup)) - True - False) + [False, True]) {all dead. Bool} (/\dead -> - ifThenElse - {Bool} + case + Bool (equalsByteString (unBData (headList @@ -370,8 +368,7 @@ let (headList {data} (sndPair {integer} {list data} tup)))) - True - False) + [False, True]) (/\dead -> False) {all dead. dead}) (/\dead -> False) @@ -379,26 +376,24 @@ let !tup : pair integer (list data) = unConstrData ds in Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 0 (fstPair {integer} {list data} tup)) - True - False) + [False, True]) {all dead. Bool} (/\dead -> let !tup : pair integer (list data) = unConstrData ds in Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 0 (fstPair {integer} {list data} tup)) - True - False) + [False, True]) {all dead. Bool} (/\dead -> - ifThenElse - {Bool} + case + Bool (equalsByteString (unBData (headList {data} (sndPair {integer} {list data} tup))) @@ -406,8 +401,7 @@ let (headList {data} (sndPair {integer} {list data} tup)))) - True - False) + [False, True]) (/\dead -> fail ()) {all dead. dead}) (/\dead -> fail ()) @@ -418,44 +412,40 @@ let !fail : unit -> Bool = \(ds : unit) -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 2 (fstPair {integer} {list data} (unConstrData ds))) - True - False) + [False, True]) {all dead. Bool} (/\dead -> - ifThenElse - {Bool} + case + Bool (equalsInteger 2 (fstPair {integer} {list data} (unConstrData ds))) - True - False) + [False, True]) (/\dead -> False) {all dead. dead} !fail : unit -> Bool = \(ds : unit) -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 1 (fstPair {integer} {list data} (unConstrData ds))) - True - False) + [False, True]) {all dead. Bool} (/\dead -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 1 (fstPair {integer} {list data} (unConstrData ds))) - True - False) + [False, True]) {all dead. Bool} (/\dead -> True) (/\dead -> fail ()) @@ -465,22 +455,20 @@ let !tup : pair integer (list data) = unConstrData ds in Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 0 (fstPair {integer} {list data} tup)) - True - False) + [False, True]) {all dead. Bool} (/\dead -> let !tup : pair integer (list data) = unConstrData ds in Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 0 (fstPair {integer} {list data} tup)) - True - False) + [False, True]) {all dead. Bool} (/\dead -> `$fEqCredential_$c==` @@ -498,11 +486,10 @@ let !tup : pair integer (list data) = unConstrData scrut in Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 2 (fstPair {integer} {list data} tup)) - True - False) + [False, True]) {all dead. r} (/\dead -> let @@ -527,11 +514,7 @@ let ds (\(a' : bytestring) (b' : data) -> Bool_match - (ifThenElse - {Bool} - (equalsByteString a a') - True - False) + (case Bool (equalsByteString a a') [False, True]) {all dead. Bool} (/\dead -> `$fEqDRep0_$c==` b b') (/\dead -> False) @@ -544,22 +527,20 @@ let !tup : pair integer (list data) = unConstrData ds in Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 1 (fstPair {integer} {list data} tup)) - True - False) + [False, True]) {all dead. Bool} (/\dead -> let !tup : pair integer (list data) = unConstrData ds in Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 1 (fstPair {integer} {list data} tup)) - True - False) + [False, True]) {all dead. Bool} (/\dead -> `$fEqDRep0_$c==` @@ -576,26 +557,24 @@ let !tup : pair integer (list data) = unConstrData ds in Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 0 (fstPair {integer} {list data} tup)) - True - False) + [False, True]) {all dead. Bool} (/\dead -> let !tup : pair integer (list data) = unConstrData ds in Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 0 (fstPair {integer} {list data} tup)) - True - False) + [False, True]) {all dead. Bool} (/\dead -> - ifThenElse - {Bool} + case + Bool (equalsByteString (unBData (headList {data} (sndPair {integer} {list data} tup))) @@ -603,8 +582,7 @@ let (headList {data} (sndPair {integer} {list data} tup)))) - True - False) + [False, True]) (/\dead -> fail ()) {all dead. dead}) (/\dead -> fail ()) @@ -617,11 +595,10 @@ let !tup : pair integer (list data) = unConstrData scrut in Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 9 (fstPair {integer} {list data} tup)) - True - False) + [False, True]) {all dead. r} (/\dead -> let @@ -638,11 +615,10 @@ let !tup : pair integer (list data) = unConstrData scrut in Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 2 (fstPair {integer} {list data} tup)) - True - False) + [False, True]) {all dead. r} (/\dead -> let @@ -658,11 +634,10 @@ let !tup : pair integer (list data) = unConstrData scrut in Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 4 (fstPair {integer} {list data} tup)) - True - False) + [False, True]) {all dead. r} (/\dead -> let @@ -683,11 +658,10 @@ let !tup : pair integer (list data) = unConstrData scrut in Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 3 (fstPair {integer} {list data} tup)) - True - False) + [False, True]) {all dead. r} (/\dead -> let @@ -718,12 +692,12 @@ let !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 1 index) True False) + (case Bool (equalsInteger 1 index) [False, True]) {all dead. Maybe a} (/\dead -> Nothing {a}) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. Maybe a} (/\dead -> Just {a} (`$dUnsafeFromData` (headList {data} args))) @@ -740,11 +714,10 @@ let !tup : pair integer (list data) = unConstrData scrut in Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 0 (fstPair {integer} {list data} tup)) - True - False) + [False, True]) {all dead. r} (/\dead -> let @@ -766,11 +739,10 @@ let !tup : pair integer (list data) = unConstrData scrut in Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 6 (fstPair {integer} {list data} tup)) - True - False) + [False, True]) {all dead. r} (/\dead -> let @@ -791,11 +763,10 @@ let !tup : pair integer (list data) = unConstrData scrut in Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 1 (fstPair {integer} {list data} tup)) - True - False) + [False, True]) {all dead. r} (/\dead -> let @@ -859,13 +830,12 @@ let False (\(hd : pair data data) -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsData (`$dToData` ds) (fstPair {data} {data} hd)) - True - False) + [False, True]) {all dead. list (pair data data) -> Bool} (/\dead -> \(ds : list (pair data data)) -> True) (/\dead -> go) @@ -875,7 +845,7 @@ let !null : all a. (\a -> list data) a -> Bool = /\a -> \(eta : (\a -> list data) a) -> - ifThenElse {Bool} (nullList {data} eta) True False + case Bool (nullList {data} eta) [False, True] !txOutRefId : data -> bytestring = \(ds : data) -> unBData @@ -905,11 +875,10 @@ in !tup : pair integer (list data) = unConstrData scriptInfo in Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 0 (fstPair {integer} {list data} tup)) - True - False) + [False, True]) {all dead. Bool} (/\dead -> (let @@ -960,11 +929,10 @@ in !tup : pair integer (list data) = unConstrData scriptInfo in Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 1 (fstPair {integer} {list data} tup)) - True - False) + [False, True]) {all dead. Bool} (/\dead -> let @@ -1001,20 +969,18 @@ in !l : data = headList {data} l in Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsByteString (txOutRefId l) (txOutRefId v)) - True - False) + [False, True]) {all dead. Bool} (/\dead -> - ifThenElse - {Bool} + case + Bool (equalsInteger (txOutRefIdx l) (txOutRefIdx v)) - True - False) + [False, True]) (/\dead -> False) {all dead. dead}) (unListData (headList {data} l)))) @@ -1024,11 +990,10 @@ in !tup : pair integer (list data) = unConstrData scriptInfo in Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 2 (fstPair {integer} {list data} tup)) - True - False) + [False, True]) {all dead. Bool} (/\dead -> member @@ -1042,11 +1007,10 @@ in !tup : pair integer (list data) = unConstrData scriptInfo in Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 3 (fstPair {integer} {list data} tup)) - True - False) + [False, True]) {all dead. Bool} (/\dead -> let @@ -1073,16 +1037,15 @@ in = unConstrData eta in Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 10 (fstPair {integer} {list data} tup)) - True - False) + [False, True]) {all dead. Bool} (/\dead -> let @@ -1090,16 +1053,15 @@ in = unConstrData v in Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 10 (fstPair {integer} {list data} tup)) - True - False) + [False, True]) {all dead. Bool} (/\dead -> `$fEqCredential_$c==` @@ -1154,11 +1116,10 @@ in (`$fEqCredential_$c==` a a') {all dead. Bool} (/\dead -> - ifThenElse - {Bool} + case + Bool (equalsInteger b b') - True - False) + [False, True]) (/\dead -> False) {all dead. dead}) (\(void : unit) -> fail ())) @@ -1170,16 +1131,15 @@ in = unConstrData eta in Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 5 (fstPair {integer} {list data} tup)) - True - False) + [False, True]) {all dead. Bool} (/\dead -> let @@ -1187,16 +1147,15 @@ in = unConstrData v in Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 5 (fstPair {integer} {list data} tup)) - True - False) + [False, True]) {all dead. Bool} (/\dead -> `$fEqCredential_$c==` @@ -1230,11 +1189,10 @@ in (`$fEqCredential_$c==` a a') {all dead. Bool} (/\dead -> - ifThenElse - {Bool} + case + Bool (equalsInteger b b') - True - False) + [False, True]) (/\dead -> False) {all dead. dead}) (\(void : unit) -> fail ())) @@ -1263,13 +1221,12 @@ in b') {all dead. Bool} (/\dead -> - ifThenElse - {Bool} + case + Bool (equalsInteger c c') - True - False) + [False, True]) (/\dead -> False) {all dead. dead}) (/\dead -> False) @@ -1327,13 +1284,13 @@ in (\(a : integer) -> /\dead -> - ifThenElse - {Bool} + case + Bool (equalsInteger a a) - True - False) + [ False + , True ]) (/\dead -> False) {all dead. @@ -1379,13 +1336,12 @@ in {all dead. Bool} (\(a : integer) -> /\dead -> - ifThenElse - {Bool} + case + Bool (equalsInteger a a) - True - False) + [False, True]) (/\dead -> False) {all dead. dead}) (/\dead -> @@ -1409,13 +1365,12 @@ in = unConstrData scriptInfo in Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 4 (fstPair {integer} {list data} tup)) - True - False) + [False, True]) {all dead. Bool} (/\dead -> member @@ -1445,13 +1400,12 @@ in = unConstrData scriptInfo in Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 5 (fstPair {integer} {list data} tup)) - True - False) + [False, True]) {all dead. Bool} (/\dead -> let diff --git a/plutus-benchmark/script-contexts/test/V3/Data/9.6/purposeIsWellFormed.size.golden b/plutus-benchmark/script-contexts/test/V3/Data/9.6/purposeIsWellFormed.size.golden index 5a67c112f3c..9f0eb1a9203 100644 --- a/plutus-benchmark/script-contexts/test/V3/Data/9.6/purposeIsWellFormed.size.golden +++ b/plutus-benchmark/script-contexts/test/V3/Data/9.6/purposeIsWellFormed.size.golden @@ -1 +1 @@ -2644 \ No newline at end of file +2339 \ No newline at end of file diff --git a/plutus-core/plutus-core.cabal b/plutus-core/plutus-core.cabal index 16c4a42d9df..03ffad63291 100644 --- a/plutus-core/plutus-core.cabal +++ b/plutus-core/plutus-core.cabal @@ -228,6 +228,7 @@ library Data.Aeson.Flatten Data.Functor.Foldable.Monadic Data.Vector.Orphans + PlutusCore.Builtin.Case PlutusCore.Builtin.HasConstant PlutusCore.Builtin.KnownKind PlutusCore.Builtin.KnownType diff --git a/plutus-core/plutus-core/src/PlutusCore/Builtin.hs b/plutus-core/plutus-core/src/PlutusCore/Builtin.hs index fc34b3d4d70..f95c0427f6d 100644 --- a/plutus-core/plutus-core/src/PlutusCore/Builtin.hs +++ b/plutus-core/plutus-core/src/PlutusCore/Builtin.hs @@ -4,6 +4,7 @@ module PlutusCore.Builtin ( module Export ) where +import PlutusCore.Builtin.Case as Export import PlutusCore.Builtin.HasConstant as Export import PlutusCore.Builtin.KnownKind as Export import PlutusCore.Builtin.KnownType as Export diff --git a/plutus-core/plutus-core/src/PlutusCore/Builtin/Case.hs b/plutus-core/plutus-core/src/PlutusCore/Builtin/Case.hs new file mode 100644 index 00000000000..430420bd4c9 --- /dev/null +++ b/plutus-core/plutus-core/src/PlutusCore/Builtin/Case.hs @@ -0,0 +1,20 @@ +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE TypeOperators #-} + +module PlutusCore.Builtin.Case where + +import PlutusCore.Core.Type (Type, UniOf) +import PlutusCore.Name.Unique + +import Data.Vector (Vector) +import Universe + +class AnnotateCaseBuiltin uni where + annotateCaseBuiltin + :: UniOf term ~ uni + => SomeTypeIn uni + -> [term] + -> Either () [(term, [Type TyName uni ann])] + +class UniOf term ~ uni => CaseBuiltin term uni where + caseBuiltin :: Some (ValueOf uni) -> Vector term -> Either () term diff --git a/plutus-core/plutus-core/src/PlutusCore/Compiler/Types.hs b/plutus-core/plutus-core/src/PlutusCore/Compiler/Types.hs index a32d6096ff1..dd2612a5255 100644 --- a/plutus-core/plutus-core/src/PlutusCore/Compiler/Types.hs +++ b/plutus-core/plutus-core/src/PlutusCore/Compiler/Types.hs @@ -6,10 +6,12 @@ import Data.Hashable import PlutusCore.Builtin import PlutusCore.Name.Unique import PlutusCore.Quote +import UntypedPlutusCore.Core.Type (Term) type Compiling m uni fun name a = ( ToBuiltinMeaning uni fun , MonadQuote m + , CaseBuiltin (Term name uni fun a) uni , HasUnique name TermUnique , Ord name , Typeable name diff --git a/plutus-core/plutus-core/src/PlutusCore/Default/Universe.hs b/plutus-core/plutus-core/src/PlutusCore/Default/Universe.hs index ce1160bccce..d13ab81bf77 100644 --- a/plutus-core/plutus-core/src/PlutusCore/Default/Universe.hs +++ b/plutus-core/plutus-core/src/PlutusCore/Default/Universe.hs @@ -20,6 +20,7 @@ {-# LANGUAGE PolyKinds #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE StandaloneKindSignatures #-} +{-# LANGUAGE TupleSections #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} @@ -43,6 +44,7 @@ module PlutusCore.Default.Universe import PlutusCore.Builtin import PlutusPrelude +import PlutusCore.Core.Type (UniOf) import PlutusCore.Crypto.BLS12_381.G1 qualified as BLS12_381.G1 import PlutusCore.Crypto.BLS12_381.G2 qualified as BLS12_381.G2 import PlutusCore.Crypto.BLS12_381.Pairing qualified as BLS12_381.Pairing @@ -59,7 +61,8 @@ import Data.Proxy (Proxy (Proxy)) import Data.Text (Text) import Data.Text qualified as Text import Data.Typeable (typeRep) -import Data.Vector.Strict (Vector) +import Data.Vector qualified as Vector +import Data.Vector.Strict qualified as Strict (Vector) import Data.Word (Word16, Word32, Word64) import GHC.Exts (inline, oneShot) import Text.PrettyBy.Fixity (RenderContext, inContextM, juxtPrettyM) @@ -107,7 +110,7 @@ data DefaultUni a where DefaultUniString :: DefaultUni (Esc Text) DefaultUniUnit :: DefaultUni (Esc ()) DefaultUniBool :: DefaultUni (Esc Bool) - DefaultUniProtoArray :: DefaultUni (Esc Vector) + DefaultUniProtoArray :: DefaultUni (Esc Strict.Vector) DefaultUniProtoList :: DefaultUni (Esc []) DefaultUniProtoPair :: DefaultUni (Esc (,)) DefaultUniApply :: !(DefaultUni (Esc f)) -> !(DefaultUni (Esc a)) -> DefaultUni (Esc (f a)) @@ -262,7 +265,7 @@ instance DefaultUni `Contains` Bool where knownUni = DefaultUniBool instance DefaultUni `Contains` [] where knownUni = DefaultUniProtoList -instance DefaultUni `Contains` Vector where +instance DefaultUni `Contains` Strict.Vector where knownUni = DefaultUniProtoArray instance DefaultUni `Contains` (,) where knownUni = DefaultUniProtoPair @@ -287,8 +290,8 @@ instance KnownBuiltinTypeAst tyname DefaultUni Bool => KnownTypeAst tyname DefaultUni Bool instance KnownBuiltinTypeAst tyname DefaultUni [a] => KnownTypeAst tyname DefaultUni [a] -instance KnownBuiltinTypeAst tyname DefaultUni (Vector a) => - KnownTypeAst tyname DefaultUni (Vector a) +instance KnownBuiltinTypeAst tyname DefaultUni (Strict.Vector a) => + KnownTypeAst tyname DefaultUni (Strict.Vector a) instance KnownBuiltinTypeAst tyname DefaultUni (a, b) => KnownTypeAst tyname DefaultUni (a, b) instance KnownBuiltinTypeAst tyname DefaultUni Data => @@ -314,8 +317,8 @@ instance KnownBuiltinTypeIn DefaultUni term Data => ReadKnownIn DefaultUni term Data instance KnownBuiltinTypeIn DefaultUni term [a] => ReadKnownIn DefaultUni term [a] -instance KnownBuiltinTypeIn DefaultUni term (Vector a) => - ReadKnownIn DefaultUni term (Vector a) +instance KnownBuiltinTypeIn DefaultUni term (Strict.Vector a) => + ReadKnownIn DefaultUni term (Strict.Vector a) instance KnownBuiltinTypeIn DefaultUni term (a, b) => ReadKnownIn DefaultUni term (a, b) instance KnownBuiltinTypeIn DefaultUni term BLS12_381.G1.Element => @@ -339,8 +342,8 @@ instance KnownBuiltinTypeIn DefaultUni term Data => MakeKnownIn DefaultUni term Data instance KnownBuiltinTypeIn DefaultUni term [a] => MakeKnownIn DefaultUni term [a] -instance KnownBuiltinTypeIn DefaultUni term (Vector a) => - MakeKnownIn DefaultUni term (Vector a) +instance KnownBuiltinTypeIn DefaultUni term (Strict.Vector a) => + MakeKnownIn DefaultUni term (Strict.Vector a) instance KnownBuiltinTypeIn DefaultUni term (a, b) => MakeKnownIn DefaultUni term (a, b) instance KnownBuiltinTypeIn DefaultUni term BLS12_381.G1.Element => @@ -508,9 +511,9 @@ deriving newtype instance KnownBuiltinTypeIn DefaultUni term [a] => deriving newtype instance KnownTypeAst tyname DefaultUni a => KnownTypeAst tyname DefaultUni (ArrayCostedByLength a) -deriving newtype instance KnownBuiltinTypeIn DefaultUni term (Vector a) => +deriving newtype instance KnownBuiltinTypeIn DefaultUni term (Strict.Vector a) => MakeKnownIn DefaultUni term (ArrayCostedByLength a) -deriving newtype instance KnownBuiltinTypeIn DefaultUni term (Vector a) => +deriving newtype instance KnownBuiltinTypeIn DefaultUni term (Strict.Vector a) => ReadKnownIn DefaultUni term (ArrayCostedByLength a) deriving via AsInteger Natural instance @@ -533,6 +536,23 @@ instance KnownBuiltinTypeIn DefaultUni term Integer => ReadKnownIn DefaultUni te ] {-# INLINE readKnown #-} +instance UniOf term ~ DefaultUni => CaseBuiltin term DefaultUni where + caseBuiltin (Some (ValueOf uni x)) branches = case uni of + DefaultUniBool + | Vector.length branches == 2 -> Right $ branches Vector.! fromEnum x + | otherwise -> Left () + DefaultUniInteger + | 0 <= x && x < fromIntegral (Vector.length branches) -> + Right $ branches Vector.! fromIntegral x + | otherwise -> Left () + _ -> Left () + +instance AnnotateCaseBuiltin DefaultUni where + annotateCaseBuiltin (SomeTypeIn uni) branches = case uni of + DefaultUniBool -> Right $ map (, []) branches + DefaultUniInteger -> Right $ map (, []) branches + _ -> Left () + {- Note [Stable encoding of tags] 'encodeUni' and 'decodeUni' are used for serialisation and deserialisation of types from the universe and we need serialised things to be extremely stable, hence the definitions of 'encodeUni' @@ -549,7 +569,7 @@ instance Closed DefaultUni where , constr `Permits` () , constr `Permits` Bool , constr `Permits` [] - , constr `Permits` Vector + , constr `Permits` Strict.Vector , constr `Permits` (,) , constr `Permits` Data , constr `Permits` BLS12_381.G1.Element diff --git a/plutus-core/plutus-core/src/PlutusCore/TypeCheck.hs b/plutus-core/plutus-core/src/PlutusCore/TypeCheck.hs index 995f944c372..a96249c019e 100644 --- a/plutus-core/plutus-core/src/PlutusCore/TypeCheck.hs +++ b/plutus-core/plutus-core/src/PlutusCore/TypeCheck.hs @@ -43,7 +43,8 @@ import PlutusCore.TypeCheck.Internal -- instantiated and builtins don't. Another reason is that 'Typecheckable' is not required during -- type checking, since it's only needed for computing 'BuiltinTypes', which is passed as a regular -- argument to the worker of the type checker. -type Typecheckable uni fun = (ToKind uni, HasUniApply uni, ToBuiltinMeaning uni fun) +type Typecheckable uni fun = + (ToKind uni, HasUniApply uni, ToBuiltinMeaning uni fun, AnnotateCaseBuiltin uni) -- | The default kind checking config. defKindCheckConfig :: KindCheckConfig diff --git a/plutus-core/plutus-core/src/PlutusCore/TypeCheck/Internal.hs b/plutus-core/plutus-core/src/PlutusCore/TypeCheck/Internal.hs index a8675b1ccf4..f4e9738ed3c 100644 --- a/plutus-core/plutus-core/src/PlutusCore/TypeCheck/Internal.hs +++ b/plutus-core/plutus-core/src/PlutusCore/TypeCheck/Internal.hs @@ -18,8 +18,7 @@ module PlutusCore.TypeCheck.Internal , MonadNormalizeType ) where -import PlutusCore.Builtin.KnownKind (ToKind, kindOfBuiltinType) -import PlutusCore.Builtin.Result (throwing) +import PlutusCore.Builtin import PlutusCore.Core.Type (Kind (..), Normalized (..), Term (..), Type (..), toPatFuncKind) import PlutusCore.Error (AsTypeError (_TypeError), ExpectedShapeOr (ExpectedExact, ExpectedShape), TypeError (FreeTypeVariableE, FreeVariableE, KindMismatch, NameMismatch, TyNameMismatch, TypeMismatch, UnknownBuiltinFunctionE)) @@ -200,12 +199,13 @@ type MonadKindCheck err term uni fun ann m = -- | The general constraints that are required for type checking a Plutus AST. type MonadTypeCheck err term uni fun ann m = - ( MonadKindCheck err term uni fun ann m -- Kind checking is run during type checking - -- (this includes the constraint for throwing errors). + ( MonadKindCheck err term uni fun ann m -- Kind checking is run during type checking (this + -- includes the constraint for throwing errors). , Norm.MonadNormalizeType uni m -- Type lambdas open up type computation. + , AnnotateCaseBuiltin uni , GEq uni -- For checking equality of built-in types. - , Ix fun -- For indexing into the precomputed array of types of - -- built-in functions. + , Ix fun -- For indexing into the precomputed array of + -- types of built-in functions. ) -- | The constraints that are required for type checking Plutus Core. @@ -557,22 +557,27 @@ inferTypeM t@(Constr ann resTy i args) = do -- s_n = [p_n_0 ... p_n_m] [check| G !- c_n : p_n_0 -> ... -> p_n_m -> vResTy] -- ----------------------------------------------------------------------------- -- [infer| G !- case resTy scrut c_0 ... c_n : vResTy] -inferTypeM (Case ann resTy scrut cases) = do +inferTypeM (Case ann resTy scrut branches) = do vResTy <- normalizeTypeM $ void resTy vScrutTy <- inferTypeM scrut -- We don't know exactly what to expect, we only know that it should -- be a SOP with the right number of sum alternatives - let prods = map (\j -> "prod_" <> Text.pack (show j)) [0 .. length cases - 1] + let prods = map (\j -> "prod_" <> Text.pack (show j)) [0 .. length branches - 1] expectedSop = ExpectedShape (Text.intercalate " " $ "sop" : prods) prods case unNormalized vScrutTy of - TySOP _ sTys -> case zipExact cases sTys of - Just casesAndArgTypes -> for_ casesAndArgTypes $ \(c, argTypes) -> + TySOP _ sTys -> case zipExact branches sTys of + Just branchesAndArgTypes -> for_ branchesAndArgTypes $ \(c, argTypes) -> -- made of sub-parts of a normalized type, so normalized checkTypeM ann c (Normalized $ mkIterTyFun () argTypes (unNormalized vResTy)) -- scrutinee does not have a SOP type with the right number of alternatives - -- for the number of cases + -- for the number of branches Nothing -> throwing _TypeError (TypeMismatch ann (void scrut) expectedSop vScrutTy) + TyBuiltin _ someUni -> case annotateCaseBuiltin someUni branches of + Right branchesAndArgTypes -> for_ branchesAndArgTypes $ \(c, argTypes) -> + -- made of sub-parts of a normalized type, so normalized + checkTypeM ann c (Normalized $ mkIterTyFun () argTypes (unNormalized vResTy)) + Left () -> undefined -- scrutinee does not have a SOP type at all _ -> throwing _TypeError (TypeMismatch ann (void scrut) expectedSop vScrutTy) diff --git a/plutus-core/plutus-ir/src/PlutusIR/Compiler/Types.hs b/plutus-core/plutus-ir/src/PlutusIR/Compiler/Types.hs index 02ad57d66e9..22ed3cea05e 100644 --- a/plutus-core/plutus-ir/src/PlutusIR/Compiler/Types.hs +++ b/plutus-core/plutus-ir/src/PlutusIR/Compiler/Types.hs @@ -220,6 +220,8 @@ type Compiling m e uni fun a = , AsTypeError e (PIR.Term PIR.TyName PIR.Name uni fun ()) uni fun (Provenance a) , AsTypeErrorExt e uni (Provenance a) , AsError e uni fun (Provenance a) + , PLC.AnnotateCaseBuiltin uni + , PLC.CaseBuiltin (PIR.Term PIR.TyName PIR.Name uni fun (Provenance a)) uni , MonadError e m , MonadQuote m , Ord a diff --git a/plutus-core/plutus-ir/src/PlutusIR/Pass.hs b/plutus-core/plutus-ir/src/PlutusIR/Pass.hs index 94ecd890e29..2fc3b1f34d6 100644 --- a/plutus-core/plutus-ir/src/PlutusIR/Pass.hs +++ b/plutus-core/plutus-ir/src/PlutusIR/Pass.hs @@ -9,6 +9,7 @@ import PlutusIR.Error import PlutusIR.TypeCheck qualified as TC import PlutusCore qualified as PLC +import PlutusCore.Builtin (AnnotateCaseBuiltin) import PlutusCore.Name.Unique import Control.Monad (void, when) @@ -41,7 +42,7 @@ data BiCondition tyname name uni fun a where -> BiCondition tyname name uni fun a checkCondition - :: MonadError (Error uni fun a) m + :: (MonadError (Error uni fun a) m, AnnotateCaseBuiltin uni) => Condition tyname name uni fun a -> Term tyname name uni fun a -> m () @@ -56,7 +57,7 @@ checkCondition c t = case c of Nothing -> pure () checkBiCondition - :: MonadError (Error uni fun a) m + :: (MonadError (Error uni fun a) m, AnnotateCaseBuiltin uni) => BiCondition tyname name uni fun a -> Term tyname name uni fun a -> Term tyname name uni fun a @@ -94,7 +95,7 @@ hoistPass f p = case p of NoOpPass -> NoOpPass runPass - :: Monad m + :: (Monad m, AnnotateCaseBuiltin uni) => (String -> m ()) -> Bool -> Pass m tyname name uni fun a diff --git a/plutus-core/plutus-ir/src/PlutusIR/Transform/CaseReduce.hs b/plutus-core/plutus-ir/src/PlutusIR/Transform/CaseReduce.hs index c0efcb8ee09..a7de96028b0 100644 --- a/plutus-core/plutus-ir/src/PlutusIR/Transform/CaseReduce.hs +++ b/plutus-core/plutus-ir/src/PlutusIR/Transform/CaseReduce.hs @@ -6,25 +6,36 @@ module PlutusIR.Transform.CaseReduce , caseReducePass ) where +import PlutusCore.Builtin (CaseBuiltin (..)) import PlutusCore.MkPlc import PlutusIR.Core import Control.Lens (transformOf, (^?)) import Data.List.Extras +import GHC.IsList (fromList) import PlutusCore qualified as PLC import PlutusIR.Pass import PlutusIR.TypeCheck qualified as TC caseReducePass - :: (PLC.Typecheckable uni fun, PLC.GEq uni, Applicative m) + :: ( PLC.Typecheckable uni fun, CaseBuiltin (Term TyName Name uni fun a) uni + , PLC.GEq uni, Applicative m + ) => TC.PirTCConfig uni fun -> Pass m TyName Name uni fun a caseReducePass tcconfig = simplePass "case reduce" tcconfig caseReduce -caseReduce :: Term tyname name uni fun a -> Term tyname name uni fun a +caseReduce + :: CaseBuiltin (Term tyname name uni fun a) uni + => Term tyname name uni fun a -> Term tyname name uni fun a caseReduce = transformOf termSubterms processTerm -processTerm :: Term tyname name uni fun a -> Term tyname name uni fun a +processTerm + :: CaseBuiltin (Term tyname name uni fun a) uni + => Term tyname name uni fun a -> Term tyname name uni fun a processTerm = \case Case ann _ (Constr _ _ i args) cs | Just c <- cs ^? wix i -> mkIterApp c ((ann,) <$> args) - t -> t + Case ann resTy (Constant _ con) cs -> case caseBuiltin con $ fromList cs of + Left _ -> Error ann resTy + Right res -> res + t -> t diff --git a/plutus-core/plutus-ir/src/PlutusIR/TypeCheck/Internal.hs b/plutus-core/plutus-ir/src/PlutusIR/TypeCheck/Internal.hs index e990b6f5df8..2c588fecf5b 100644 --- a/plutus-core/plutus-ir/src/PlutusIR/TypeCheck/Internal.hs +++ b/plutus-core/plutus-ir/src/PlutusIR/TypeCheck/Internal.hs @@ -34,6 +34,7 @@ import PlutusIR.MkPir qualified as PIR import PlutusIR.Transform.Rename () import PlutusCore (toPatFuncKind, tyVarDeclName, typeAnn) +import PlutusCore.Builtin (annotateCaseBuiltin) import PlutusCore.Core qualified as PLC import PlutusCore.Error as PLC import PlutusCore.MkPlc (mkIterTyFun) @@ -271,22 +272,27 @@ inferTypeM t@(Constr ann resTy i args) = do -- s_n = [p_n_0 ... p_n_m] [check| G !- c_n : p_n_0 -> ... -> p_n_m -> vResTy] -- ----------------------------------------------------------------------------- -- [infer| G !- case resTy scrut c_0 ... c_n : vResTy] -inferTypeM (Case ann resTy scrut cases) = do +inferTypeM (Case ann resTy scrut branches) = do vResTy <- normalizeTypeM $ void resTy vScrutTy <- inferTypeM scrut -- We don't know exactly what to expect, we only know that it should -- be a SOP with the right number of sum alternatives - let prods = map (\j -> "prod_" <> Text.pack (show j)) [0 .. length cases - 1] + let prods = map (\j -> "prod_" <> Text.pack (show j)) [0 .. length branches - 1] expectedSop = ExpectedShape (Text.intercalate " " $ "sop" : prods) prods case unNormalized vScrutTy of - TySOP _ sTys -> case zipExact cases sTys of - Just casesAndArgTypes -> for_ casesAndArgTypes $ \(c, argTypes) -> + TySOP _ sTys -> case zipExact branches sTys of + Just branchesAndArgTypes -> for_ branchesAndArgTypes $ \(c, argTypes) -> -- made of sub-parts of a normalized type, so normalized checkTypeM ann c (Normalized $ mkIterTyFun () argTypes (unNormalized vResTy)) -- scrutinee does not have a SOP type with the right number of alternatives - -- for the number of cases + -- for the number of branches Nothing -> throwing _TypeError (TypeMismatch ann (void scrut) expectedSop vScrutTy) + TyBuiltin _ someUni -> case annotateCaseBuiltin someUni branches of + Right branchesAndArgTypes -> for_ branchesAndArgTypes $ \(c, argTypes) -> + -- made of sub-parts of a normalized type, so normalized + checkTypeM ann c (Normalized $ mkIterTyFun () argTypes (unNormalized vResTy)) + Left () -> undefined -- scrutinee does not have a SOP type at all _ -> throwing _TypeError (TypeMismatch ann (void scrut) expectedSop vScrutTy) diff --git a/plutus-core/testlib/PlutusCore/Test.hs b/plutus-core/testlib/PlutusCore/Test.hs index faf78e60369..d62e1bcf610 100644 --- a/plutus-core/testlib/PlutusCore/Test.hs +++ b/plutus-core/testlib/PlutusCore/Test.hs @@ -61,6 +61,7 @@ import PlutusPrelude import PlutusCore qualified as TPLC import PlutusCore.Annotation +import PlutusCore.Builtin import PlutusCore.Check.Scoping import PlutusCore.Compiler qualified as TPLC import PlutusCore.DeBruijn @@ -188,6 +189,7 @@ instance ToUPlc (UPLC.Program TPLC.Name uni fun ()) uni fun where instance ( TPLC.Typecheckable uni fun + , CaseBuiltin (UPLC.Term TPLC.Name uni fun ()) uni , Hashable fun ) => ToUPlc (TPLC.Program TPLC.TyName UPLC.Name uni fun ()) uni fun where diff --git a/plutus-core/testlib/PlutusIR/Test.hs b/plutus-core/testlib/PlutusIR/Test.hs index 4bff5117b4f..c8dd321d125 100644 --- a/plutus-core/testlib/PlutusIR/Test.hs +++ b/plutus-core/testlib/PlutusIR/Test.hs @@ -42,6 +42,7 @@ import PlutusIR.Parser (Parser, pTerm, parse) import PlutusIR.Transform.RewriteRules import PlutusIR.TypeCheck import System.FilePath (joinPath, ()) +import UntypedPlutusCore qualified as UPLC import Data.Hashable import Data.Text qualified as T @@ -53,6 +54,7 @@ import Prettyprinter.Render.Text instance ( PLC.GEq uni , PLC.Typecheckable uni fun + , PLC.CaseBuiltin (Term PIR.TyName PIR.Name uni fun (Provenance a)) uni , PLC.PrettyUni uni , Pretty fun , Pretty a @@ -70,6 +72,8 @@ instance instance ( PLC.GEq uni , PLC.Typecheckable uni fun + , PLC.CaseBuiltin (Term PIR.TyName PIR.Name uni fun (Provenance a)) uni + , PLC.CaseBuiltin (UPLC.Term PIR.Name uni fun ()) uni , PLC.PrettyUni uni , Pretty fun , Hashable fun @@ -110,6 +114,7 @@ asIfThrown = withExceptT SomeException . hoist (pure . runIdentity) compileWithOpts :: ( PLC.GEq uni , PLC.Typecheckable uni fun + , PLC.CaseBuiltin (Term PIR.TyName PIR.Name uni fun (Provenance a)) uni , Ord a , PLC.AnnInline a , PLC.PrettyUni uni diff --git a/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Evaluation/Machine/Cek.hs b/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Evaluation/Machine/Cek.hs index 480ccdf8950..81f18b29899 100644 --- a/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Evaluation/Machine/Cek.hs +++ b/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Evaluation/Machine/Cek.hs @@ -67,7 +67,7 @@ A wrapper around the internal runCek to debruijn input and undebruijn output. *THIS FUNCTION IS PARTIAL if the input term contains free variables* -} runCek - :: ThrowableBuiltins uni fun + :: (ThrowableBuiltins uni fun, CaseBuiltin (NTerm uni fun ann) uni) => MachineParameters CekMachineCosts fun (CekValue uni fun ann) -> ExBudgetMode cost uni fun -> EmitterMode uni fun @@ -78,7 +78,7 @@ runCek = Common.runCek runCekDeBruijn -- | Evaluate a term using the CEK machine with logging disabled and keep track of costing. -- *THIS FUNCTION IS PARTIAL if the input term contains free variables* runCekNoEmit - :: ThrowableBuiltins uni fun + :: (ThrowableBuiltins uni fun, CaseBuiltin (NTerm uni fun ann) uni) => MachineParameters CekMachineCosts fun (CekValue uni fun ann) -> ExBudgetMode cost uni fun -> Term Name uni fun ann @@ -88,7 +88,7 @@ runCekNoEmit = Common.runCekNoEmit runCekDeBruijn -- | Evaluate a term using the CEK machine with logging enabled. -- *THIS FUNCTION IS PARTIAL if the input term contains free variables* evaluateCek - :: ThrowableBuiltins uni fun + :: (ThrowableBuiltins uni fun, CaseBuiltin (NTerm uni fun ann) uni) => EmitterMode uni fun -> MachineParameters CekMachineCosts fun (CekValue uni fun ann) -> Term Name uni fun ann @@ -98,7 +98,7 @@ evaluateCek = Common.evaluateCek runCekDeBruijn -- | Evaluate a term using the CEK machine with logging disabled. -- *THIS FUNCTION IS PARTIAL if the input term contains free variables* evaluateCekNoEmit - :: ThrowableBuiltins uni fun + :: (ThrowableBuiltins uni fun, CaseBuiltin (NTerm uni fun ann) uni) => MachineParameters CekMachineCosts fun (CekValue uni fun ann) -> Term Name uni fun ann -> Either (CekEvaluationException Name uni fun) (Term Name uni fun ()) @@ -107,7 +107,9 @@ evaluateCekNoEmit = Common.evaluateCekNoEmit runCekDeBruijn -- | Unlift a value using the CEK machine. -- *THIS FUNCTION IS PARTIAL if the input term contains free variables* readKnownCek - :: (ThrowableBuiltins uni fun, ReadKnown (Term Name uni fun ()) a) + :: ( ThrowableBuiltins uni fun, CaseBuiltin (NTerm uni fun ann) uni + , ReadKnown (Term Name uni fun ()) a + ) => MachineParameters CekMachineCosts fun (CekValue uni fun ann) -> Term Name uni fun ann -> Either (CekEvaluationException Name uni fun) a diff --git a/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Evaluation/Machine/Cek/Internal.hs b/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Evaluation/Machine/Cek/Internal.hs index 7f710eb0877..6fb862fabbe 100644 --- a/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Evaluation/Machine/Cek/Internal.hs +++ b/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Evaluation/Machine/Cek/Internal.hs @@ -674,7 +674,7 @@ runCekM (MachineParameters costs runtime) (ExBudgetMode getExBudgetInfo) (Emitte -- | The entering point to the CEK machine's engine. enterComputeCek :: forall uni fun ann s - . (ThrowableBuiltins uni fun, GivenCekReqs uni fun ann s) + . (ThrowableBuiltins uni fun, CaseBuiltin (NTerm uni fun ann) uni, GivenCekReqs uni fun ann s) => Context uni fun ann -> CekValEnv uni fun ann -> NTerm uni fun ann @@ -785,6 +785,9 @@ enterComputeCek = computeCek (VConstr i args) -> case (V.!?) cs (fromIntegral i) of Just t -> computeCek (transferArgStack args ctx) env t Nothing -> throwingDischarged _MachineError (MissingCaseBranchMachineError i) e + VCon val -> case caseBuiltin val cs of + Left () -> throwingDischarged _MachineError undefined e + Right res -> computeCek ctx env res _ -> throwingDischarged _MachineError NonConstrScrutinizedMachineError e -- | Evaluate a 'HeadSpine' by pushing the arguments (if any) onto the stack and proceeding with @@ -937,7 +940,7 @@ enterComputeCek = computeCek -- See Note [Compilation peculiarities]. -- | Evaluate a term using the CEK machine and keep track of costing, logging is optional. runCekDeBruijn - :: ThrowableBuiltins uni fun + :: (ThrowableBuiltins uni fun, CaseBuiltin (NTerm uni fun ann) uni) => MachineParameters CekMachineCosts fun (CekValue uni fun ann) -> ExBudgetMode cost uni fun -> EmitterMode uni fun diff --git a/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Evaluation/Machine/SteppableCek.hs b/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Evaluation/Machine/SteppableCek.hs index 5f68a18e624..9bb81ebb6e4 100644 --- a/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Evaluation/Machine/SteppableCek.hs +++ b/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Evaluation/Machine/SteppableCek.hs @@ -64,7 +64,7 @@ A wrapper around the internal runCek to debruijn input and undebruijn output. *THIS FUNCTION IS PARTIAL if the input term contains free variables* -} runCek - :: ThrowableBuiltins uni fun + :: (ThrowableBuiltins uni fun, CaseBuiltin (NTerm uni fun ann) uni) => MachineParameters CekMachineCosts fun (CekValue uni fun ann) -> ExBudgetMode cost uni fun -> EmitterMode uni fun @@ -76,7 +76,7 @@ runCek = Common.runCek S.runCekDeBruijn -- keep track of costing. -- *THIS FUNCTION IS PARTIAL if the input term contains free variables* runCekNoEmit - :: ThrowableBuiltins uni fun + :: (ThrowableBuiltins uni fun, CaseBuiltin (NTerm uni fun ann) uni) => MachineParameters CekMachineCosts fun (CekValue uni fun ann) -> ExBudgetMode cost uni fun -> Term Name uni fun ann @@ -86,7 +86,7 @@ runCekNoEmit = Common.runCekNoEmit S.runCekDeBruijn -- | Evaluate a term using the Steppable CEK machine with logging enabled. -- *THIS FUNCTION IS PARTIAL if the input term contains free variables* evaluateCek - :: ThrowableBuiltins uni fun + :: (ThrowableBuiltins uni fun, CaseBuiltin (NTerm uni fun ann) uni) => EmitterMode uni fun -> MachineParameters CekMachineCosts fun (CekValue uni fun ann) -> Term Name uni fun ann @@ -96,7 +96,7 @@ evaluateCek = Common.evaluateCek S.runCekDeBruijn -- | Evaluate a term using the Steppable CEK machine with logging disabled. -- *THIS FUNCTION IS PARTIAL if the input term contains free variables* evaluateCekNoEmit - :: ThrowableBuiltins uni fun + :: (ThrowableBuiltins uni fun, CaseBuiltin (NTerm uni fun ann) uni) => MachineParameters CekMachineCosts fun (CekValue uni fun ann) -> Term Name uni fun ann -> Either (CekEvaluationException Name uni fun) (Term Name uni fun ()) @@ -105,7 +105,9 @@ evaluateCekNoEmit = Common.evaluateCekNoEmit S.runCekDeBruijn -- | Unlift a value using the Steppable CEK machine. -- *THIS FUNCTION IS PARTIAL if the input term contains free variables* readKnownCek - :: (ThrowableBuiltins uni fun, ReadKnown (Term Name uni fun ()) a) + :: ( ThrowableBuiltins uni fun, CaseBuiltin (NTerm uni fun ann) uni + , ReadKnown (Term Name uni fun ()) a + ) => MachineParameters CekMachineCosts fun (CekValue uni fun ann) -> Term Name uni fun ann -> Either (CekEvaluationException Name uni fun) a diff --git a/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Evaluation/Machine/SteppableCek/Internal.hs b/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Evaluation/Machine/SteppableCek/Internal.hs index 0d795d334f3..b6da81525e3 100644 --- a/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Evaluation/Machine/SteppableCek/Internal.hs +++ b/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Evaluation/Machine/SteppableCek/Internal.hs @@ -170,7 +170,7 @@ computeCek !_ !_ (Error _) = returnCek :: forall uni fun ann s - . (ThrowableBuiltins uni fun, GivenCekReqs uni fun ann s) + . (ThrowableBuiltins uni fun, CaseBuiltin (NTerm uni fun ann) uni, GivenCekReqs uni fun ann s) => Context uni fun ann -> CekValue uni fun ann -> CekM uni fun s (CekState uni fun ann) @@ -211,6 +211,9 @@ returnCek (FrameCases ann env cs ctx) e = case e of let ctx' = transferArgStack ann args ctx in computeCek ctx' env t Nothing -> throwingDischarged _MachineError (MissingCaseBranchMachineError i) e + VCon val -> case caseBuiltin val cs of + Left () -> throwingDischarged _MachineError undefined e + Right res -> pure $ Computing ctx env res _ -> throwingDischarged _MachineError NonConstrScrutinizedMachineError e -- | @force@ a term and proceed. @@ -221,7 +224,7 @@ returnCek (FrameCases ann env cs ctx) e = case e of -- if v is anything else, fail. forceEvaluate :: forall uni fun ann s - . (ThrowableBuiltins uni fun, GivenCekReqs uni fun ann s) + . (ThrowableBuiltins uni fun, CaseBuiltin (NTerm uni fun ann) uni, GivenCekReqs uni fun ann s) => ann -> Context uni fun ann -> CekValue uni fun ann @@ -253,7 +256,7 @@ forceEvaluate _ !_ val = -- If v is anything else, fail. applyEvaluate :: forall uni fun ann s - . (ThrowableBuiltins uni fun, GivenCekReqs uni fun ann s) + . (ThrowableBuiltins uni fun, CaseBuiltin (NTerm uni fun ann) uni, GivenCekReqs uni fun ann s) => ann -> Context uni fun ann -> CekValue uni fun ann -- lhs of application @@ -279,7 +282,7 @@ applyEvaluate _ !_ val _ = -- MAYBE: runCekDeBruijn can be shared between original&debug ceks by passing a `enterComputeCek` func. runCekDeBruijn - :: ThrowableBuiltins uni fun + :: (ThrowableBuiltins uni fun, CaseBuiltin (NTerm uni fun ann) uni) => MachineParameters CekMachineCosts fun (CekValue uni fun ann) -> ExBudgetMode cost uni fun -> EmitterMode uni fun @@ -294,7 +297,7 @@ runCekDeBruijn params mode emitMode term = -- | The entering point to the CEK machine's engine. enterComputeCek :: forall uni fun ann s - . (ThrowableBuiltins uni fun, GivenCekReqs uni fun ann s) + . (ThrowableBuiltins uni fun, CaseBuiltin (NTerm uni fun ann) uni, GivenCekReqs uni fun ann s) => Context uni fun ann -> CekValEnv uni fun ann -> NTerm uni fun ann @@ -322,7 +325,7 @@ type CekTrans uni fun ann s = Trans (CekM uni fun s) (CekState uni fun ann) -- | The state transition function of the machine. cekTrans :: forall uni fun ann s - . (ThrowableBuiltins uni fun, GivenCekReqs uni fun ann s) + . (ThrowableBuiltins uni fun, CaseBuiltin (NTerm uni fun ann) uni, GivenCekReqs uni fun ann s) => CekTrans uni fun ann s cekTrans = \case Starting term -> pure $ Computing NoFrame Env.empty term @@ -335,7 +338,7 @@ cekTrans = \case -- Returns the constructed transition function paired with the methods to live access the running budget. mkCekTrans :: forall cost uni fun ann m s - . ( ThrowableBuiltins uni fun + . ( ThrowableBuiltins uni fun, CaseBuiltin (NTerm uni fun ann) uni , PrimMonad m, s ~ PrimState m) -- the outer monad that initializes the transition function => MachineParameters CekMachineCosts fun (CekValue uni fun ann) -> ExBudgetMode cost uni fun @@ -454,7 +457,7 @@ returnCekHeadSpine ann ctx (HeadSpine f xs) = pure $ Returning (transferSpine an -- -- and proceed with the returning phase of the CEK machine. evalBuiltinApp - :: (GivenCekReqs uni fun ann s, ThrowableBuiltins uni fun) + :: (ThrowableBuiltins uni fun, CaseBuiltin (NTerm uni fun ann) uni, GivenCekReqs uni fun ann s) => ann -> Context uni fun ann -> fun diff --git a/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Transform/CaseOfCase.hs b/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Transform/CaseOfCase.hs index 096bdf4ce76..fdc200fb325 100644 --- a/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Transform/CaseOfCase.hs +++ b/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Transform/CaseOfCase.hs @@ -2,33 +2,40 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} -{- | A special case of case-of-case optimisation: transforms +{- | +Perform the case-of-case transformation. This pushes +case expressions into the case branches of other case +expressions, which can often yield optimization opportunities. +Example: @ - case ((force ifThenElse) b (constr t) (constr f)) alts -@ + case (case s of { C1 a -> x; C2 b -> y; }) of + D1 -> w + D2 -> z -into + --> + case s of + C1 a -> case x of { D1 -> w; D2 -> z; } + C2 b -> case y of { D1 -> w; D2 -> z; } @ - force ifThenElse b (delay (case (constr t) alts)) (delay (case (constr f) alts)) -@ - -This is always an improvement. -} module UntypedPlutusCore.Transform.CaseOfCase (caseOfCase) where +import PlutusPrelude + import PlutusCore qualified as PLC -import PlutusCore.MkPlc +import PlutusCore.Builtin (CaseBuiltin (..)) import UntypedPlutusCore.Core +import UntypedPlutusCore.Transform.CaseReduce qualified as CaseReduce import UntypedPlutusCore.Transform.Simplifier (SimplifierStage (CaseOfCase), SimplifierT, recordSimplification) import Control.Lens +import Data.Set qualified as Set caseOfCase - :: fun ~ PLC.DefaultFun - => Monad m + :: (fun ~ PLC.DefaultFun, Monad m, CaseBuiltin (Term name uni fun a) uni) => Term name uni fun a -> SimplifierT name uni fun a m (Term name uni fun a) caseOfCase term = do @@ -36,18 +43,17 @@ caseOfCase term = do recordSimplification term CaseOfCase result return result -processTerm :: (fun ~ PLC.DefaultFun) => Term name uni fun a -> Term name uni fun a +processTerm :: CaseBuiltin (Term name uni fun a) uni => Term name uni fun a -> Term name uni fun a processTerm = \case - Case ann scrut alts - | ( ite@(Force a (Builtin _ PLC.IfThenElse)) - , [cond, (trueAnn, true@Constr{}), (falseAnn, false@Constr{})] - ) <- - splitApplication scrut -> - Force a $ - mkIterApp - ite - [ cond - , (trueAnn, Delay trueAnn (Case ann true alts)) - , (falseAnn, Delay falseAnn (Case ann false alts)) - ] + original@(Case annOuter (Case annInner scrut altsInner) altsOuter) -> + maybe + original + (Case annInner scrut) + (do + constrs <- for altsInner $ \case + c@(Constr _ i _) -> Just (i, c) + _ -> Nothing + -- See Note [Case-of-case and duplicating code]. + guard $ length (Set.fromList . toList $ fmap fst constrs) == length constrs + pure $ constrs <&> \(_, c) -> CaseReduce.processTerm $ Case annOuter c altsOuter) other -> other diff --git a/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Transform/CaseReduce.hs b/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Transform/CaseReduce.hs index d17a44236ae..de0d99ff445 100644 --- a/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Transform/CaseReduce.hs +++ b/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Transform/CaseReduce.hs @@ -2,8 +2,10 @@ {-# LANGUAGE TupleSections #-} module UntypedPlutusCore.Transform.CaseReduce ( caseReduce + , processTerm ) where +import PlutusCore.Builtin (CaseBuiltin (..)) import PlutusCore.MkPlc import UntypedPlutusCore.Core import UntypedPlutusCore.Transform.Simplifier (SimplifierStage (CaseReduce), SimplifierT, @@ -13,7 +15,7 @@ import Control.Lens (transformOf) import Data.Vector qualified as V caseReduce - :: Monad m + :: (Monad m, CaseBuiltin (Term name uni fun a) uni) => Term name uni fun a -> SimplifierT name uni fun a m (Term name uni fun a) caseReduce term = do @@ -21,8 +23,11 @@ caseReduce term = do recordSimplification term CaseReduce result return result -processTerm :: Term name uni fun a -> Term name uni fun a +processTerm :: CaseBuiltin (Term name uni fun a) uni => Term name uni fun a -> Term name uni fun a processTerm = \case Case ann (Constr _ i args) cs | Just c <- (V.!?) cs (fromIntegral i) -> mkIterApp c ((ann,) <$> args) - t -> t + Case ann (Constant _ con) cs -> case caseBuiltin con cs of + Left _ -> Error ann + Right res -> res + t -> t diff --git a/plutus-core/untyped-plutus-core/test/Evaluation/Builtins/Common.hs b/plutus-core/untyped-plutus-core/test/Evaluation/Builtins/Common.hs index 0603aab3f96..d293fb5e59f 100644 --- a/plutus-core/untyped-plutus-core/test/Evaluation/Builtins/Common.hs +++ b/plutus-core/untyped-plutus-core/test/Evaluation/Builtins/Common.hs @@ -55,6 +55,7 @@ typecheckAnd semvar action costingPart term = TPLC.runQuoteT $ do typecheckEvaluateCek :: ( MonadError (TPLC.Error uni fun ()) m, TPLC.Typecheckable uni fun, GEq uni , uni `Everywhere` ExMemoryUsage, PrettyUni uni, Pretty fun + , CaseBuiltin (UPLC.Term UPLC.NamedDeBruijn uni fun ()) uni ) => BuiltinSemanticsVariant fun -> CostingPart uni fun @@ -68,6 +69,7 @@ typecheckEvaluateCek semvar = typecheckEvaluateCekNoEmit :: ( MonadError (TPLC.Error uni fun ()) m, TPLC.Typecheckable uni fun, GEq uni , uni `Everywhere` ExMemoryUsage, PrettyUni uni, Pretty fun + , CaseBuiltin (UPLC.Term UPLC.NamedDeBruijn uni fun ()) uni ) => BuiltinSemanticsVariant fun -> CostingPart uni fun @@ -81,6 +83,7 @@ typecheckEvaluateCekNoEmit semvar = typecheckReadKnownCek :: ( MonadError (TPLC.Error uni fun ()) m, TPLC.Typecheckable uni fun, GEq uni , uni `Everywhere` ExMemoryUsage, PrettyUni uni, Pretty fun + , CaseBuiltin (UPLC.Term UPLC.NamedDeBruijn uni fun ()) uni , ReadKnown (UPLC.Term Name uni fun ()) a ) => BuiltinSemanticsVariant fun diff --git a/plutus-core/untyped-plutus-core/test/Evaluation/Golden/caseNonTag.type.golden b/plutus-core/untyped-plutus-core/test/Evaluation/Golden/caseNonTag.type.golden index 756e3336916..557f8ffd629 100644 --- a/plutus-core/untyped-plutus-core/test/Evaluation/Golden/caseNonTag.type.golden +++ b/plutus-core/untyped-plutus-core/test/Evaluation/Golden/caseNonTag.type.golden @@ -1,7 +1 @@ -(Left Type mismatch at () -Expected a term of type - '(sop)' -But found one of type - '(con integer)' -Namely, - '(con integer 1)') \ No newline at end of file +(Right (con integer)) \ No newline at end of file diff --git a/plutus-core/untyped-plutus-core/test/Transform/CaseOfCase/1.uplc.golden b/plutus-core/untyped-plutus-core/test/Transform/CaseOfCase/1.uplc.golden index 9cf88689c14..7622ec1cb45 100644 --- a/plutus-core/untyped-plutus-core/test/Transform/CaseOfCase/1.uplc.golden +++ b/plutus-core/untyped-plutus-core/test/Transform/CaseOfCase/1.uplc.golden @@ -1,9 +1,5 @@ -(force - [ - [ - [ (force (builtin ifThenElse)) b ] - (delay (case (constr 0) (con integer 1) (con integer 2))) - ] - (delay (case (constr 1) (con integer 1) (con integer 2))) - ] +(case + [ [ [ (force (builtin ifThenElse)) b ] (constr 0) ] (constr 1) ] + (con integer 1) + (con integer 2) ) \ No newline at end of file diff --git a/plutus-core/untyped-plutus-core/test/Transform/CaseOfCase/3.uplc.golden b/plutus-core/untyped-plutus-core/test/Transform/CaseOfCase/3.uplc.golden index 9e7f8874321..8d6ae17569b 100644 --- a/plutus-core/untyped-plutus-core/test/Transform/CaseOfCase/3.uplc.golden +++ b/plutus-core/untyped-plutus-core/test/Transform/CaseOfCase/3.uplc.golden @@ -1,9 +1,5 @@ -(force - [ - [ - [ (force (builtin ifThenElse)) b ] - (delay (case (constr 0 x xs) f (con integer 2))) - ] - (delay (case (constr 1) f (con integer 2))) - ] +(case + [ [ [ (force (builtin ifThenElse)) b ] (constr 0 x xs) ] (constr 1) ] + f + (con integer 2) ) \ No newline at end of file diff --git a/plutus-core/untyped-plutus-core/test/Transform/CaseOfCase/withError.uplc.golden b/plutus-core/untyped-plutus-core/test/Transform/CaseOfCase/withError.uplc.golden index 7cdbc9b7363..926050fd444 100644 --- a/plutus-core/untyped-plutus-core/test/Transform/CaseOfCase/withError.uplc.golden +++ b/plutus-core/untyped-plutus-core/test/Transform/CaseOfCase/withError.uplc.golden @@ -1,9 +1,5 @@ -(force - [ - [ - [ (force (builtin ifThenElse)) (con bool True) ] - (delay (case (constr 0) (con unit ()) (error))) - ] - (delay (case (constr 1) (con unit ()) (error))) - ] +(case + [ [ [ (force (builtin ifThenElse)) (con bool True) ] (constr 0) ] (constr 1) ] + (con unit ()) + (error) ) \ No newline at end of file diff --git a/plutus-ledger-api/test-plugin/Spec/Budget/9.6/currencySymbolValueOf.budget.golden b/plutus-ledger-api/test-plugin/Spec/Budget/9.6/currencySymbolValueOf.budget.golden index 3009caf4260..5a5fc8a638a 100644 --- a/plutus-ledger-api/test-plugin/Spec/Budget/9.6/currencySymbolValueOf.budget.golden +++ b/plutus-ledger-api/test-plugin/Spec/Budget/9.6/currencySymbolValueOf.budget.golden @@ -1,2 +1,2 @@ -({cpu: 8280858 -| mem: 44124}) \ No newline at end of file +({cpu: 7152564 +| mem: 39918}) \ No newline at end of file diff --git a/plutus-ledger-api/test-plugin/Spec/Budget/9.6/currencySymbolValueOf.pir.golden b/plutus-ledger-api/test-plugin/Spec/Budget/9.6/currencySymbolValueOf.pir.golden index 8da8925e8d2..a5119220bf7 100644 --- a/plutus-ledger-api/test-plugin/Spec/Budget/9.6/currencySymbolValueOf.pir.golden +++ b/plutus-ledger-api/test-plugin/Spec/Budget/9.6/currencySymbolValueOf.pir.golden @@ -69,7 +69,7 @@ in (\(c' : bytestring) (i : (\k v -> List (Tuple2 k v)) bytestring integer) -> Bool_match - (ifThenElse {Bool} (equalsByteString c' cur) True False) + (case Bool (equalsByteString c' cur) [False, True]) {all dead. integer} (/\dead -> go i) (/\dead -> go xs') diff --git a/plutus-ledger-api/test-plugin/Spec/Budget/9.6/geq1.budget.golden b/plutus-ledger-api/test-plugin/Spec/Budget/9.6/geq1.budget.golden index 77a4a933eb5..425cbb02564 100644 --- a/plutus-ledger-api/test-plugin/Spec/Budget/9.6/geq1.budget.golden +++ b/plutus-ledger-api/test-plugin/Spec/Budget/9.6/geq1.budget.golden @@ -1,2 +1,2 @@ -({cpu: 118186685 -| mem: 661630}) \ No newline at end of file +({cpu: 98753050 +| mem: 594715}) \ No newline at end of file diff --git a/plutus-ledger-api/test-plugin/Spec/Budget/9.6/geq2.budget.golden b/plutus-ledger-api/test-plugin/Spec/Budget/9.6/geq2.budget.golden index dbc92567565..3aaee3f9bd3 100644 --- a/plutus-ledger-api/test-plugin/Spec/Budget/9.6/geq2.budget.golden +++ b/plutus-ledger-api/test-plugin/Spec/Budget/9.6/geq2.budget.golden @@ -1,2 +1,2 @@ -({cpu: 126563949 -| mem: 709942}) \ No newline at end of file +({cpu: 106098020 +| mem: 639421}) \ No newline at end of file diff --git a/plutus-ledger-api/test-plugin/Spec/Budget/9.6/geq3.budget.golden b/plutus-ledger-api/test-plugin/Spec/Budget/9.6/geq3.budget.golden index 3be67241c41..d513ae51926 100644 --- a/plutus-ledger-api/test-plugin/Spec/Budget/9.6/geq3.budget.golden +++ b/plutus-ledger-api/test-plugin/Spec/Budget/9.6/geq3.budget.golden @@ -1,2 +1,2 @@ -({cpu: 130466644 -| mem: 730552}) \ No newline at end of file +({cpu: 108740470 +| mem: 654526}) \ No newline at end of file diff --git a/plutus-ledger-api/test-plugin/Spec/Budget/9.6/geq4.budget.golden b/plutus-ledger-api/test-plugin/Spec/Budget/9.6/geq4.budget.golden index 20517645423..827a2487877 100644 --- a/plutus-ledger-api/test-plugin/Spec/Budget/9.6/geq4.budget.golden +++ b/plutus-ledger-api/test-plugin/Spec/Budget/9.6/geq4.budget.golden @@ -1,2 +1,2 @@ -({cpu: 113756728 -| mem: 638020}) \ No newline at end of file +({cpu: 95871338 +| mem: 578410}) \ No newline at end of file diff --git a/plutus-ledger-api/test-plugin/Spec/Budget/9.6/geq5.budget.golden b/plutus-ledger-api/test-plugin/Spec/Budget/9.6/geq5.budget.golden index 424216c66fc..5a6625fa8fd 100644 --- a/plutus-ledger-api/test-plugin/Spec/Budget/9.6/geq5.budget.golden +++ b/plutus-ledger-api/test-plugin/Spec/Budget/9.6/geq5.budget.golden @@ -1,2 +1,2 @@ -({cpu: 121872779 -| mem: 681938}) \ No newline at end of file +({cpu: 101718948 +| mem: 612419}) \ No newline at end of file diff --git a/plutus-ledger-api/test-plugin/Spec/Budget/9.6/gt.pir.golden b/plutus-ledger-api/test-plugin/Spec/Budget/9.6/gt.pir.golden index 249f98ee29d..47612889de1 100644 --- a/plutus-ledger-api/test-plugin/Spec/Budget/9.6/gt.pir.golden +++ b/plutus-ledger-api/test-plugin/Spec/Budget/9.6/gt.pir.golden @@ -28,7 +28,7 @@ letrec {Bool} (\(ds : bytestring) (x : integer) -> Bool_match - (ifThenElse {Bool} (equalsInteger 0 x) True False) + (case Bool (equalsInteger 0 x) [False, True]) {all dead. Bool} (/\dead -> go xs) (/\dead -> False) @@ -36,6 +36,8 @@ letrec {all dead. dead} in let + !ifThenElse : all a. bool -> a -> a -> a + = /\a -> \(b : bool) (x : a) (y : a) -> case a b [y, x] data (These :: * -> * -> *) a b | These_match where That : b -> These a b These : a -> b -> These a b @@ -200,7 +202,7 @@ in let !equalsByteString : bytestring -> bytestring -> Bool = \(x : bytestring) (y : bytestring) -> - ifThenElse {Bool} (equalsByteString x y) True False + case Bool (equalsByteString x y) [False, True] !union : all k v r. (\a -> a -> a -> Bool) k -> @@ -796,10 +798,9 @@ in {bytestring} {integer} equalsByteString - (\(v : integer) -> - ifThenElse {Bool} (equalsInteger 0 v) True False) + (\(v : integer) -> case Bool (equalsInteger 0 v) [False, True]) (\(x : integer) (y : integer) -> - ifThenElse {Bool} (equalsInteger x y) True False)) + case Bool (equalsInteger x y) [False, True])) l r) {all dead. Bool} diff --git a/plutus-ledger-api/test-plugin/Spec/Budget/9.6/gt1.budget.golden b/plutus-ledger-api/test-plugin/Spec/Budget/9.6/gt1.budget.golden index 2dc6e93581e..01abbc7c839 100644 --- a/plutus-ledger-api/test-plugin/Spec/Budget/9.6/gt1.budget.golden +++ b/plutus-ledger-api/test-plugin/Spec/Budget/9.6/gt1.budget.golden @@ -1,2 +1,2 @@ -({cpu: 148560115 -| mem: 826300}) \ No newline at end of file +({cpu: 122592765 +| mem: 735150}) \ No newline at end of file diff --git a/plutus-ledger-api/test-plugin/Spec/Budget/9.6/gt2.budget.golden b/plutus-ledger-api/test-plugin/Spec/Budget/9.6/gt2.budget.golden index c83b6f12c02..30f871119ed 100644 --- a/plutus-ledger-api/test-plugin/Spec/Budget/9.6/gt2.budget.golden +++ b/plutus-ledger-api/test-plugin/Spec/Budget/9.6/gt2.budget.golden @@ -1,2 +1,2 @@ -({cpu: 125187949 -| mem: 701342}) \ No newline at end of file +({cpu: 106306020 +| mem: 640721}) \ No newline at end of file diff --git a/plutus-ledger-api/test-plugin/Spec/Budget/9.6/gt3.budget.golden b/plutus-ledger-api/test-plugin/Spec/Budget/9.6/gt3.budget.golden index e37d30f2f68..694d198ecd8 100644 --- a/plutus-ledger-api/test-plugin/Spec/Budget/9.6/gt3.budget.golden +++ b/plutus-ledger-api/test-plugin/Spec/Budget/9.6/gt3.budget.golden @@ -1,2 +1,2 @@ -({cpu: 161144456 -| mem: 896324}) \ No newline at end of file +({cpu: 133272518 +| mem: 798962}) \ No newline at end of file diff --git a/plutus-ledger-api/test-plugin/Spec/Budget/9.6/gt4.budget.golden b/plutus-ledger-api/test-plugin/Spec/Budget/9.6/gt4.budget.golden index cef904472d1..a11131d00b1 100644 --- a/plutus-ledger-api/test-plugin/Spec/Budget/9.6/gt4.budget.golden +++ b/plutus-ledger-api/test-plugin/Spec/Budget/9.6/gt4.budget.golden @@ -1,2 +1,2 @@ -({cpu: 113244728 -| mem: 634820}) \ No newline at end of file +({cpu: 96079338 +| mem: 579710}) \ No newline at end of file diff --git a/plutus-ledger-api/test-plugin/Spec/Budget/9.6/gt5.budget.golden b/plutus-ledger-api/test-plugin/Spec/Budget/9.6/gt5.budget.golden index 038df101973..13cb76789dc 100644 --- a/plutus-ledger-api/test-plugin/Spec/Budget/9.6/gt5.budget.golden +++ b/plutus-ledger-api/test-plugin/Spec/Budget/9.6/gt5.budget.golden @@ -1,2 +1,2 @@ -({cpu: 135849718 -| mem: 757770}) \ No newline at end of file +({cpu: 113631103 +| mem: 682935}) \ No newline at end of file diff --git a/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/currencySymbolValueOf.budget.golden b/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/currencySymbolValueOf.budget.golden index f2768eba0f1..a29071f3804 100644 --- a/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/currencySymbolValueOf.budget.golden +++ b/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/currencySymbolValueOf.budget.golden @@ -1,2 +1,2 @@ -({cpu: 23991162 -| mem: 70780}) \ No newline at end of file +({cpu: 22862868 +| mem: 66574}) \ No newline at end of file diff --git a/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/currencySymbolValueOf.pir.golden b/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/currencySymbolValueOf.pir.golden index 6f3287c399a..9540776aa7e 100644 --- a/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/currencySymbolValueOf.pir.golden +++ b/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/currencySymbolValueOf.pir.golden @@ -45,11 +45,10 @@ in (Nothing {data}) (\(hd : pair data data) -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsData k (fstPair {data} {data} hd)) - True - False) + [False, True]) {all dead. list (pair data data) -> Maybe data} (/\dead -> \(ds : list (pair data data)) -> diff --git a/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/geq1.budget.golden b/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/geq1.budget.golden index 83e9f462f33..7b062b81f65 100644 --- a/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/geq1.budget.golden +++ b/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/geq1.budget.golden @@ -1,2 +1,2 @@ -({cpu: 641714560 -| mem: 2003750}) \ No newline at end of file +({cpu: 598395535 +| mem: 1839725}) \ No newline at end of file diff --git a/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/geq2.budget.golden b/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/geq2.budget.golden index a399957d511..01301c4719b 100644 --- a/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/geq2.budget.golden +++ b/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/geq2.budget.golden @@ -1,2 +1,2 @@ -({cpu: 677786509 -| mem: 2129370}) \ No newline at end of file +({cpu: 632522994 +| mem: 1957935}) \ No newline at end of file diff --git a/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/geq3.budget.golden b/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/geq3.budget.golden index 35c8ec17c42..91b1f631983 100644 --- a/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/geq3.budget.golden +++ b/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/geq3.budget.golden @@ -1,2 +1,2 @@ -({cpu: 708217054 -| mem: 2231956}) \ No newline at end of file +({cpu: 660188902 +| mem: 2049408}) \ No newline at end of file diff --git a/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/geq4.budget.golden b/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/geq4.budget.golden index ac5f8884a31..5715ede1564 100644 --- a/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/geq4.budget.golden +++ b/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/geq4.budget.golden @@ -1,2 +1,2 @@ -({cpu: 615310155 -| mem: 1889242}) \ No newline at end of file +({cpu: 578144600 +| mem: 1749447}) \ No newline at end of file diff --git a/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/geq5.budget.golden b/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/geq5.budget.golden index 2afd61797b8..45ff9940857 100644 --- a/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/geq5.budget.golden +++ b/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/geq5.budget.golden @@ -1,2 +1,2 @@ -({cpu: 665311047 -| mem: 2075858}) \ No newline at end of file +({cpu: 620423630 +| mem: 1905825}) \ No newline at end of file diff --git a/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/gt.pir.golden b/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/gt.pir.golden index 4caafef008b..c35d2a1e4cc 100644 --- a/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/gt.pir.golden +++ b/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/gt.pir.golden @@ -21,11 +21,10 @@ letrec True (\(hd : pair data data) -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 0 (unIData (sndPair {data} {data} hd))) - True - False) + [False, True]) {all dead. list (pair data data) -> Bool} (/\dead -> go) (/\dead -> \(ds : list (pair data data)) -> False) @@ -78,18 +77,18 @@ let !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. These a b} (/\dead -> This {a} {b} (`$dUnsafeFromData` (headList {data} args))) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 1 index) True False) + (case Bool (equalsInteger 1 index) [False, True]) {all dead. These a b} (/\dead -> That {a} {b} (`$dUnsafeFromData` (headList {data} args))) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 2 index) True False) + (case Bool (equalsInteger 2 index) [False, True]) {all dead. These a b} (/\dead -> These @@ -106,6 +105,8 @@ let {all dead. dead}) {all dead. dead}) {all dead. dead} + !ifThenElse : all a. bool -> a -> a -> a + = /\a -> \(b : bool) (x : a) (y : a) -> case a b [y, x] in letrec ~go : list (pair data data) -> Bool @@ -198,11 +199,10 @@ letrec nilCase (\(hd : pair data data) -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsData k (fstPair {data} {data} hd)) - True - False) + [False, True]) {all dead. list (pair data data) -> list (pair data data)} (/\dead -> mkCons {pair data data} (mkPairData k v)) @@ -228,11 +228,10 @@ let (Nothing {data}) (\(hd : pair data data) -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsData k (fstPair {data} {data} hd)) - True - False) + [False, True]) {all dead. list (pair data data) -> Maybe data} (/\dead -> \(ds : list (pair data data)) -> @@ -461,16 +460,15 @@ let (/\dead -> goRight acc xs) (/\dead -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsData (fstPair {data} {data} x) d) - True - False) + [False, True]) {all dead. Bool} (/\dead -> Bool_match @@ -500,11 +498,10 @@ let Unit in Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsData d (fstPair {data} {data} x)) - True - False) + [False, True]) {all dead. Bool} (/\dead -> Bool_match @@ -639,13 +636,12 @@ in (\(v : data) (v : data) -> unordEqWith (\(v : data) -> - ifThenElse {Bool} (equalsInteger 0 (unIData v)) True False) + case Bool (equalsInteger 0 (unIData v)) [False, True]) (\(v : data) (v : data) -> - ifThenElse - {Bool} + case + Bool (equalsInteger (unIData v) (unIData v)) - True - False) + [False, True]) (unMapData v) (unMapData v)) l diff --git a/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/gt1.budget.golden b/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/gt1.budget.golden index 1edf266b81c..fb3bcff5b7d 100644 --- a/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/gt1.budget.golden +++ b/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/gt1.budget.golden @@ -1,2 +1,2 @@ -({cpu: 745296368 -| mem: 2347584}) \ No newline at end of file +({cpu: 697363628 +| mem: 2171324}) \ No newline at end of file diff --git a/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/gt2.budget.golden b/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/gt2.budget.golden index 123889575aa..e2b315d0976 100644 --- a/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/gt2.budget.golden +++ b/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/gt2.budget.golden @@ -1,2 +1,2 @@ -({cpu: 676650509 -| mem: 2122270}) \ No newline at end of file +({cpu: 632970994 +| mem: 1960735}) \ No newline at end of file diff --git a/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/gt3.budget.golden b/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/gt3.budget.golden index 48577652399..b92fc429f4c 100644 --- a/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/gt3.budget.golden +++ b/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/gt3.budget.golden @@ -1,2 +1,2 @@ -({cpu: 814233022 -| mem: 2583776}) \ No newline at end of file +({cpu: 761979106 +| mem: 2391892}) \ No newline at end of file diff --git a/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/gt4.budget.golden b/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/gt4.budget.golden index 41264059109..a14d9167a9c 100644 --- a/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/gt4.budget.golden +++ b/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/gt4.budget.golden @@ -1,2 +1,2 @@ -({cpu: 615038155 -| mem: 1887542}) \ No newline at end of file +({cpu: 578592600 +| mem: 1752247}) \ No newline at end of file diff --git a/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/gt5.budget.golden b/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/gt5.budget.golden index ad8e3e5f9de..ceb22d3e444 100644 --- a/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/gt5.budget.golden +++ b/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/gt5.budget.golden @@ -1,2 +1,2 @@ -({cpu: 714159527 -| mem: 2240162}) \ No newline at end of file +({cpu: 668071326 +| mem: 2070213}) \ No newline at end of file diff --git a/plutus-ledger-api/test-plugin/Spec/Data/SriptContext/9.6/succeedsIfHasDatum.pir.golden b/plutus-ledger-api/test-plugin/Spec/Data/SriptContext/9.6/succeedsIfHasDatum.pir.golden index 77342b99c62..10175783576 100644 --- a/plutus-ledger-api/test-plugin/Spec/Data/SriptContext/9.6/succeedsIfHasDatum.pir.golden +++ b/plutus-ledger-api/test-plugin/Spec/Data/SriptContext/9.6/succeedsIfHasDatum.pir.golden @@ -25,11 +25,10 @@ in (sndPair {integer} {list data} (unConstrData d))))) in Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 1 (fstPair {integer} {list data} tup)) - True - False) + [False, True]) {all dead. Bool} (/\dead -> let @@ -44,12 +43,12 @@ in !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 1 index) True False) + (case Bool (equalsInteger 1 index) [False, True]) {all dead. Maybe data} (/\dead -> Nothing {data}) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. Maybe data} (/\dead -> Just {data} (headList {data} args)) (/\dead -> traceError {Maybe data} "PT1") diff --git a/plutus-ledger-api/test-plugin/Spec/Data/SriptContext/9.6/succeedsIfHasDatum.uplc.golden b/plutus-ledger-api/test-plugin/Spec/Data/SriptContext/9.6/succeedsIfHasDatum.uplc.golden index 41b5059e087..b45d679ea4f 100644 --- a/plutus-ledger-api/test-plugin/Spec/Data/SriptContext/9.6/succeedsIfHasDatum.uplc.golden +++ b/plutus-ledger-api/test-plugin/Spec/Data/SriptContext/9.6/succeedsIfHasDatum.uplc.golden @@ -6,54 +6,41 @@ case ((\tup -> force - (force - (force - ifThenElse - (equalsInteger 1 (force (force fstPair) tup)) - (delay - (delay - (force - (case - ((\tup -> - (\index -> - (\args -> - force - (force - (force - ifThenElse - (equalsInteger 1 index) - (delay - (delay - (constr 1 []))) - (delay - (delay - (force - (force - (force - ifThenElse - (equalsInteger - 0 - index) - (delay - (delay - (constr 0 - [ (force - headList - args) ]))) - (delay - (delay - (traceError - "PT1"))))))))))) - (force (force sndPair) tup)) - (force (force fstPair) tup)) - (unConstrData - (force headList - (force tailList - (force (force sndPair) - tup))))) - [ (\ds -> delay (constr 0 [])) - , (delay (constr 1 [])) ])))) - (delay (delay (constr 1 [])))))) + (case + (equalsInteger 1 (force (force fstPair) tup)) + [ (delay (constr 1 [])) + , (delay + (force + (case + ((\tup -> + (\index -> + (\args -> + force + (case + (equalsInteger 1 index) + [ (delay + (force + (case + (equalsInteger + 0 + index) + [ (delay + (traceError + "PT1")) + , (delay + (constr 0 + [ (force + headList + args) ])) ]))) + , (delay (constr 1 [])) ])) + (force (force sndPair) tup)) + (force (force fstPair) tup)) + (unConstrData + (force headList + (force tailList + (force (force sndPair) tup))))) + [ (\ds -> delay (constr 0 [])) + , (delay (constr 1 [])) ]))) ])) (unConstrData (force headList (force tailList diff --git a/plutus-ledger-api/test-plugin/Spec/Data/Value/9.6/Long.stat.golden b/plutus-ledger-api/test-plugin/Spec/Data/Value/9.6/Long.stat.golden index 20cf4347241..0866f3e4839 100644 --- a/plutus-ledger-api/test-plugin/Spec/Data/Value/9.6/Long.stat.golden +++ b/plutus-ledger-api/test-plugin/Spec/Data/Value/9.6/Long.stat.golden @@ -1,15 +1,15 @@ -({cpu: 8508584589 | mem: 13270258}) -({cpu: 9439052 | mem: 38876}) -({cpu: 6051508712 | mem: 9265258}) -({cpu: 9439052 | mem: 38876}) -({cpu: 6051508712 | mem: 9265258}) -({cpu: 9439052 | mem: 38876}) -({cpu: 3594432835 | mem: 5260258}) -({cpu: 9439052 | mem: 38876}) -({cpu: 6051508712 | mem: 9265258}) -({cpu: 9439052 | mem: 38876}) -({cpu: 3594432835 | mem: 5260258}) -({cpu: 9439052 | mem: 38876}) -({cpu: 3594432835 | mem: 5260258}) -({cpu: 9439052 | mem: 38876}) -({cpu: 1137356958 | mem: 1255258}) \ No newline at end of file +({cpu: 8253180510 | mem: 12371687}) +({cpu: 9094954 | mem: 37674}) +({cpu: 5873198389 | mem: 8637931}) +({cpu: 9094954 | mem: 37674}) +({cpu: 5873198389 | mem: 8637931}) +({cpu: 9094954 | mem: 37674}) +({cpu: 3493216268 | mem: 4904175}) +({cpu: 9094954 | mem: 37674}) +({cpu: 5873198389 | mem: 8637931}) +({cpu: 9094954 | mem: 37674}) +({cpu: 3493216268 | mem: 4904175}) +({cpu: 9094954 | mem: 37674}) +({cpu: 3493216268 | mem: 4904175}) +({cpu: 9094954 | mem: 37674}) +({cpu: 1113234147 | mem: 1170419}) \ No newline at end of file diff --git a/plutus-ledger-api/test-plugin/Spec/Data/Value/9.6/Short.stat.golden b/plutus-ledger-api/test-plugin/Spec/Data/Value/9.6/Short.stat.golden index 61807b3b6f7..5d1c3ab6063 100644 --- a/plutus-ledger-api/test-plugin/Spec/Data/Value/9.6/Short.stat.golden +++ b/plutus-ledger-api/test-plugin/Spec/Data/Value/9.6/Short.stat.golden @@ -1,21 +1,21 @@ ({cpu: 2442088 | mem: 13764}) ({cpu: 4985311 | mem: 24352}) -({cpu: 8695302 | mem: 37114}) -({cpu: 11070034 | mem: 46672}) -({cpu: 13459152 | mem: 52002}) -({cpu: 16469312 | mem: 63588}) -({cpu: 24667169 | mem: 90240}) -({cpu: 26322199 | mem: 101360}) -({cpu: 30920383 | mem: 113590}) -({cpu: 19019460 | mem: 68718}) -({cpu: 47083203 | mem: 166716}) -({cpu: 14393855 | mem: 53764}) -({cpu: 68009873 | mem: 234730}) -({cpu: 79124749 | mem: 276286}) -({cpu: 96182782 | mem: 317632}) -({cpu: 107297658 | mem: 359188}) -({cpu: 129310494 | mem: 415422}) -({cpu: 132320654 | mem: 427008}) -({cpu: 167393009 | mem: 528100}) -({cpu: 62442101 | mem: 221392}) -({cpu: 1137356958 | mem: 1255258}) \ No newline at end of file +({cpu: 8507253 | mem: 36413}) +({cpu: 10725936 | mem: 45470}) +({cpu: 12927005 | mem: 50099}) +({cpu: 15749116 | mem: 60984}) +({cpu: 23602875 | mem: 86434}) +({cpu: 25257905 | mem: 97554}) +({cpu: 29668040 | mem: 109083}) +({cpu: 18143215 | mem: 65613}) +({cpu: 44954615 | mem: 159104}) +({cpu: 13705659 | mem: 51360}) +({cpu: 64660942 | mem: 222811}) +({cpu: 74615524 | mem: 259961}) +({cpu: 91269410 | mem: 300204}) +({cpu: 101223992 | mem: 337354}) +({cpu: 122488583 | mem: 391283}) +({cpu: 125310694 | mem: 402168}) +({cpu: 158318461 | mem: 496048}) +({cpu: 58809121 | mem: 208172}) +({cpu: 1113234147 | mem: 1170419}) \ No newline at end of file diff --git a/plutus-ledger-api/test-plugin/Spec/Value/9.6/Long.stat.golden b/plutus-ledger-api/test-plugin/Spec/Value/9.6/Long.stat.golden index 8332fcf76b2..1b75a818d08 100644 --- a/plutus-ledger-api/test-plugin/Spec/Value/9.6/Long.stat.golden +++ b/plutus-ledger-api/test-plugin/Spec/Value/9.6/Long.stat.golden @@ -1,15 +1,15 @@ -({cpu: 1248344408 | mem: 6701342}) -({cpu: 23834067 | mem: 147604}) -({cpu: 875833026 | mem: 4704454}) -({cpu: 22522067 | mem: 139404}) -({cpu: 875833026 | mem: 4704454}) -({cpu: 19434067 | mem: 120104}) -({cpu: 500153644 | mem: 2687766}) -({cpu: 19530067 | mem: 120704}) -({cpu: 875833026 | mem: 4704454}) -({cpu: 19434067 | mem: 120104}) -({cpu: 500153644 | mem: 2687766}) -({cpu: 16538067 | mem: 102004}) -({cpu: 500153644 | mem: 2687766}) -({cpu: 13114067 | mem: 80604}) -({cpu: 123802262 | mem: 666878}) \ No newline at end of file +({cpu: 915324329 | mem: 5317671}) +({cpu: 23345969 | mem: 145502}) +({cpu: 643330703 | mem: 3738427}) +({cpu: 22033969 | mem: 137302}) +({cpu: 643330703 | mem: 3738427}) +({cpu: 18945969 | mem: 118002}) +({cpu: 368169077 | mem: 2139383}) +({cpu: 19041969 | mem: 118602}) +({cpu: 643330703 | mem: 3738427}) +({cpu: 18945969 | mem: 118002}) +({cpu: 368169077 | mem: 2139383}) +({cpu: 16049969 | mem: 99902}) +({cpu: 368169077 | mem: 2139383}) +({cpu: 12625969 | mem: 78502}) +({cpu: 92335451 | mem: 536139}) \ No newline at end of file diff --git a/plutus-ledger-api/test-plugin/Spec/Value/9.6/Short.stat.golden b/plutus-ledger-api/test-plugin/Spec/Value/9.6/Short.stat.golden index 7f8bf798a6d..0a302a98523 100644 --- a/plutus-ledger-api/test-plugin/Spec/Value/9.6/Short.stat.golden +++ b/plutus-ledger-api/test-plugin/Spec/Value/9.6/Short.stat.golden @@ -1,21 +1,21 @@ -({cpu: 1840100 | mem: 11600}) -({cpu: 2384100 | mem: 15000}) -({cpu: 3449685 | mem: 21002}) -({cpu: 4186067 | mem: 24804}) -({cpu: 5091652 | mem: 29806}) -({cpu: 6004034 | mem: 34708}) -({cpu: 8343470 | mem: 48012}) -({cpu: 8766267 | mem: 50512}) -({cpu: 9953055 | mem: 57414}) -({cpu: 7144897 | mem: 41210}) -({cpu: 14879106 | mem: 84624}) -({cpu: 6452300 | mem: 37508}) -({cpu: 21447124 | mem: 120638}) -({cpu: 25871440 | mem: 143550}) -({cpu: 29340567 | mem: 163456}) -({cpu: 33860883 | mem: 186968}) -({cpu: 38940243 | mem: 215478}) -({cpu: 39996625 | mem: 221280}) -({cpu: 50054152 | mem: 275504}) -({cpu: 24044401 | mem: 135740}) -({cpu: 123802262 | mem: 666878}) \ No newline at end of file +({cpu: 1792100 | mem: 11300}) +({cpu: 2336100 | mem: 14700}) +({cpu: 3117636 | mem: 19401}) +({cpu: 3697969 | mem: 22702}) +({cpu: 4319505 | mem: 26403}) +({cpu: 5043838 | mem: 30604}) +({cpu: 6847176 | mem: 41506}) +({cpu: 7365973 | mem: 44606}) +({cpu: 8172712 | mem: 49607}) +({cpu: 5932652 | mem: 36005}) +({cpu: 11934518 | mem: 71912}) +({cpu: 5524104 | mem: 33604}) +({cpu: 16898193 | mem: 101219}) +({cpu: 20162215 | mem: 119725}) +({cpu: 22747195 | mem: 135528}) +({cpu: 26107217 | mem: 154634}) +({cpu: 29862332 | mem: 177239}) +({cpu: 30730665 | mem: 182340}) +({cpu: 38051604 | mem: 225152}) +({cpu: 19499421 | mem: 116820}) +({cpu: 92335451 | mem: 536139}) \ No newline at end of file diff --git a/plutus-tx-plugin/src/PlutusTx/Compiler/Builtins.hs b/plutus-tx-plugin/src/PlutusTx/Compiler/Builtins.hs index eeb09503397..4dc4a261139 100644 --- a/plutus-tx-plugin/src/PlutusTx/Compiler/Builtins.hs +++ b/plutus-tx-plugin/src/PlutusTx/Compiler/Builtins.hs @@ -364,7 +364,18 @@ defineBuiltinTerms = do for_ enumerate $ \fun -> let defineBuiltinInl impl = defineBuiltinTerm annMayInline impl $ mkBuiltin fun in case fun of - PLC.IfThenElse -> defineBuiltinInl 'Builtins.ifThenElse + PLC.IfThenElse -> defineBuiltinTerm annMayInline 'Builtins.ifThenElse $ + fmap (const annMayInline) . runQuote $ do + a <- freshTyName "a" + b <- freshName "b" + x <- freshName "x" + y <- freshName "y" + return + . PIR.tyAbs () a (PLC.Type ()) + . PIR.lamAbs () b (PLC.mkTyBuiltin @_ @Bool ()) + . PIR.lamAbs () x (PLC.TyVar () a) + . PIR.lamAbs () y (PLC.TyVar () a) + $ PIR.kase () (PLC.TyVar () a) (PIR.Var () b) [PIR.Var () y, PIR.Var () x] PLC.ChooseUnit -> defineBuiltinInl 'Builtins.chooseUnit -- Bytestrings diff --git a/plutus-tx-plugin/test/AsData/Budget/9.6/destructSum-manual.budget.golden b/plutus-tx-plugin/test/AsData/Budget/9.6/destructSum-manual.budget.golden index f3e5165e996..ecb00f317de 100644 --- a/plutus-tx-plugin/test/AsData/Budget/9.6/destructSum-manual.budget.golden +++ b/plutus-tx-plugin/test/AsData/Budget/9.6/destructSum-manual.budget.golden @@ -1,2 +1,2 @@ -({cpu: 7401268 -| mem: 26925}) \ No newline at end of file +({cpu: 6917121 +| mem: 25322}) \ No newline at end of file diff --git a/plutus-tx-plugin/test/AsData/Budget/9.6/destructSum-manual.pir.golden b/plutus-tx-plugin/test/AsData/Budget/9.6/destructSum-manual.pir.golden index 9aba66f43ad..1cbc354a4c6 100644 --- a/plutus-tx-plugin/test/AsData/Budget/9.6/destructSum-manual.pir.golden +++ b/plutus-tx-plugin/test/AsData/Budget/9.6/destructSum-manual.pir.golden @@ -32,11 +32,10 @@ in !tup : pair integer (list data) = unConstrData d in Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 0 (fstPair {integer} {list data} tup)) - True - False) + [False, True]) {all dead. data} (/\dead -> headList {data} (sndPair {integer} {list data} tup)) (/\dead -> @@ -44,11 +43,10 @@ in !tup : pair integer (list data) = unConstrData d in Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 0 (fstPair {integer} {list data} tup)) - True - False) + [False, True]) {all dead. data} (/\dead -> headList {data} (sndPair {integer} {list data} tup)) (/\dead -> @@ -56,11 +54,10 @@ in !tup : pair integer (list data) = unConstrData d in Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 2 (fstPair {integer} {list data} tup)) - True - False) + [False, True]) {all dead. data} (/\dead -> let diff --git a/plutus-tx-plugin/test/AsData/Budget/9.6/destructSum-manual.uplc.golden b/plutus-tx-plugin/test/AsData/Budget/9.6/destructSum-manual.uplc.golden index 366cb20b32b..58448b0e130 100644 --- a/plutus-tx-plugin/test/AsData/Budget/9.6/destructSum-manual.uplc.golden +++ b/plutus-tx-plugin/test/AsData/Budget/9.6/destructSum-manual.uplc.golden @@ -5,124 +5,108 @@ (\cse -> (\cse -> force - (force - (cse - (delay - (delay - (force - (force - (cse - (delay - (delay - (force - (force - (force - ifThenElse - (equalsInteger 2 cse) - (delay - (delay - ((\args -> - (\y -> - (\`$mInts` -> - `$mInts` - (force - headList - args) - (\x - y - z - w -> - `$mInts` - y - (\x - y - z - w -> - constrData - 0 - (force - mkCons - (iData - (addInteger - x - x)) - (force - mkCons - (iData - (addInteger - y - y)) - (force - mkCons - (iData - (addInteger - z - z)) - (force - mkCons - (iData - (addInteger - w - w)) - [ ]))))) - (\void -> - case - error - [ error ]))) - (\scrut - cont - fail -> - (\l -> - (\l -> - (\l -> - cont - (unIData - (force - headList - l)) - (unIData - (force - headList - l)) - (unIData - (force - headList - l)) - (unIData - (force - headList - (force - tailList - l)))) - (force - tailList - l)) - (force - tailList - l)) + (case + cse + [ (delay + (force + (case + cse + [ (delay + (force + (case + (equalsInteger 2 cse) + [ (delay (case error [error])) + , (delay + ((\args -> + (\y -> + (\`$mInts` -> + `$mInts` + (force headList args) + (\x + y + z + w -> + `$mInts` + y + (\x + y + z + w -> + constrData + 0 + (force + mkCons + (iData + (addInteger + x + x)) + (force + mkCons + (iData + (addInteger + y + y)) + (force + mkCons + (iData + (addInteger + z + z)) + (force + mkCons + (iData + (addInteger + w + w)) + [ ]))))) + (\void -> + case + error + [error]))) + (\scrut + cont + fail -> + (\l -> + (\l -> + (\l -> + cont + (unIData + (force + headList + l)) + (unIData (force + headList + l)) + (unIData + (force + headList + l)) + (unIData + (force + headList (force - sndPair) - (unConstrData - scrut))) - (\void -> - case - error - [ error ])) - (force headList - (force - tailList - args))) - (force - (force sndPair) - cse)))) - (delay - (delay - (case - error - [ error ])))))))))))))))) - (force ifThenElse - (equalsInteger 0 cse) - (delay (delay (force headList (force (force sndPair) cse)))))) + tailList + l)))) + (force + tailList + l)) + (force tailList + l)) + (force + (force sndPair) + (unConstrData + scrut))) + (\void -> + case error [error])) + (force headList + (force tailList args))) + (force (force sndPair) + cse))) ]))) + , (delay + (force headList + (force (force sndPair) cse))) ]))) + , (delay (force headList (force (force sndPair) cse))) ])) + (equalsInteger 0 cse)) (force (force fstPair) cse)) (unConstrData d))) \ No newline at end of file diff --git a/plutus-tx-plugin/test/AsData/Budget/9.6/destructSum.budget.golden b/plutus-tx-plugin/test/AsData/Budget/9.6/destructSum.budget.golden index b03e55b2b62..12ebf0730f2 100644 --- a/plutus-tx-plugin/test/AsData/Budget/9.6/destructSum.budget.golden +++ b/plutus-tx-plugin/test/AsData/Budget/9.6/destructSum.budget.golden @@ -1,2 +1,2 @@ -({cpu: 7501601 -| mem: 27226}) \ No newline at end of file +({cpu: 6937454 +| mem: 25123}) \ No newline at end of file diff --git a/plutus-tx-plugin/test/AsData/Budget/9.6/destructSum.pir.golden b/plutus-tx-plugin/test/AsData/Budget/9.6/destructSum.pir.golden index 5caa521c1fd..b9a3b0465ed 100644 --- a/plutus-tx-plugin/test/AsData/Budget/9.6/destructSum.pir.golden +++ b/plutus-tx-plugin/test/AsData/Budget/9.6/destructSum.pir.golden @@ -32,11 +32,10 @@ in !tup : pair integer (list data) = unConstrData d in Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 0 (fstPair {integer} {list data} tup)) - True - False) + [False, True]) {all dead. data} (/\dead -> headList {data} (sndPair {integer} {list data} tup)) (/\dead -> @@ -44,11 +43,10 @@ in !tup : pair integer (list data) = unConstrData d in Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 1 (fstPair {integer} {list data} tup)) - True - False) + [False, True]) {all dead. data} (/\dead -> headList {data} (sndPair {integer} {list data} tup)) (/\dead -> @@ -56,11 +54,10 @@ in !tup : pair integer (list data) = unConstrData d in Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 2 (fstPair {integer} {list data} tup)) - True - False) + [False, True]) {all dead. data} (/\dead -> let diff --git a/plutus-tx-plugin/test/AsData/Budget/9.6/destructSum.uplc.golden b/plutus-tx-plugin/test/AsData/Budget/9.6/destructSum.uplc.golden index 3408ebb9ccc..19d855f44ea 100644 --- a/plutus-tx-plugin/test/AsData/Budget/9.6/destructSum.uplc.golden +++ b/plutus-tx-plugin/test/AsData/Budget/9.6/destructSum.uplc.golden @@ -4,128 +4,99 @@ (\cse -> (\cse -> force - (force - (force - ifThenElse - (equalsInteger 0 cse) - (delay (delay (force headList (force (force sndPair) cse)))) - (delay - (delay - (force - (force - (force - ifThenElse - (equalsInteger 1 cse) - (delay - (delay - (force headList - (force (force sndPair) cse)))) - (delay - (delay - (force - (force - (force - ifThenElse - (equalsInteger 2 cse) - (delay - (delay - ((\l -> - (\`$mInts` -> - `$mInts` - (force headList - l) - (\x - y - z - w -> - `$mInts` - (force - headList - (force - tailList - l)) - (\x - y - z - w -> - constrData - 0 - (force - mkCons - (iData - (addInteger - x - x)) - (force - mkCons - (iData - (addInteger - y - y)) - (force - mkCons - (iData - (addInteger - z - z)) - (force - mkCons - (iData - (addInteger - w - w)) - [ ]))))) - (\void -> - case - error - [ error ]))) - (\scrut - cont - fail -> - (\l -> - (\l -> - (\l -> - cont - (unIData - (force - headList - l)) - (unIData - (force - headList - l)) - (unIData - (force - headList - l)) - (unIData - (force - headList - (force - tailList - l)))) - (force - tailList - l)) - (force - tailList - l)) + (case + (equalsInteger 0 cse) + [ (delay + (force + (case + (equalsInteger 1 cse) + [ (delay + (force + (case + (equalsInteger 2 cse) + [ (delay (case error [error])) + , (delay + ((\l -> + (\`$mInts` -> + `$mInts` + (force headList l) + (\x + y + z + w -> + `$mInts` + (force headList + (force tailList l)) + (\x + y + z + w -> + constrData + 0 + (force + mkCons + (iData + (addInteger + x + x)) + (force + mkCons + (iData + (addInteger + y + y)) + (force + mkCons + (iData + (addInteger + z + z)) + (force + mkCons + (iData + (addInteger + w + w)) + [ ]))))) + (\void -> + case + error + [error]))) + (\scrut + cont + fail -> + (\l -> + (\l -> + (\l -> + cont + (unIData + (force + headList + l)) + (unIData (force + headList + l)) + (unIData + (force + headList + l)) + (unIData + (force + headList (force - sndPair) - (unConstrData - scrut))) - (\void -> - case - error - [error])) - (force - (force sndPair) - cse)))) - (delay - (delay - (case - error - [ error ])))))))))))))))) + tailList + l)))) + (force tailList l)) + (force tailList l)) + (force (force sndPair) + (unConstrData scrut))) + (\void -> case error [error])) + (force (force sndPair) + cse))) ]))) + , (delay + (force headList + (force (force sndPair) cse))) ]))) + , (delay (force headList (force (force sndPair) cse))) ])) (force (force fstPair) cse)) (unConstrData d))) \ No newline at end of file diff --git a/plutus-tx-plugin/test/AsData/Budget/9.6/patternMatching.budget.golden b/plutus-tx-plugin/test/AsData/Budget/9.6/patternMatching.budget.golden index 271d4407332..0d13015aab8 100644 --- a/plutus-tx-plugin/test/AsData/Budget/9.6/patternMatching.budget.golden +++ b/plutus-tx-plugin/test/AsData/Budget/9.6/patternMatching.budget.golden @@ -1,2 +1,2 @@ -({cpu: 4567211 -| mem: 15442}) \ No newline at end of file +({cpu: 3951113 +| mem: 12540}) \ No newline at end of file diff --git a/plutus-tx-plugin/test/AsData/Budget/9.6/patternMatching.pir.golden b/plutus-tx-plugin/test/AsData/Budget/9.6/patternMatching.pir.golden index 8124d6e9593..7a46b352306 100644 --- a/plutus-tx-plugin/test/AsData/Budget/9.6/patternMatching.pir.golden +++ b/plutus-tx-plugin/test/AsData/Budget/9.6/patternMatching.pir.golden @@ -8,7 +8,7 @@ let False : Bool !lessThanInteger : integer -> integer -> Bool = \(x : integer) (y : integer) -> - ifThenElse {Bool} (lessThanInteger x y) True False + case Bool (lessThanInteger x y) [False, True] in \(d : data) -> let diff --git a/plutus-tx-plugin/test/AsData/Budget/9.6/patternMatching.uplc.golden b/plutus-tx-plugin/test/AsData/Budget/9.6/patternMatching.uplc.golden index 58c9ad4cde5..8636717fe5c 100644 --- a/plutus-tx-plugin/test/AsData/Budget/9.6/patternMatching.uplc.golden +++ b/plutus-tx-plugin/test/AsData/Budget/9.6/patternMatching.uplc.golden @@ -8,31 +8,23 @@ (\y -> (\z -> (\w -> - (\lessThanInteger -> - addInteger - (addInteger - (addInteger - (addInteger (addInteger x y) z) - w) - (force - (case - (lessThanInteger - (addInteger y z) - (addInteger x w)) - [ (delay (addInteger x z)) - , (delay (addInteger y w)) ]))) + addInteger + (addInteger + (addInteger (addInteger (addInteger x y) z) w) (force (case (lessThanInteger - (addInteger z y) - (addInteger w x)) - [ (delay (addInteger z x)) - , (delay (addInteger w y)) ]))) - (\x y -> - force ifThenElse - (lessThanInteger x y) - (constr 0 []) - (constr 1 []))) + (addInteger y z) + (addInteger x w)) + [ (delay (addInteger y w)) + , (delay (addInteger x z)) ]))) + (force + (case + (lessThanInteger + (addInteger z y) + (addInteger w x)) + [ (delay (addInteger w y)) + , (delay (addInteger z x)) ]))) (unIData (force headList (force tailList l)))) (unIData (force headList l))) (unIData (force headList l))) diff --git a/plutus-tx-plugin/test/AsData/Budget/9.6/recordFields.budget.golden b/plutus-tx-plugin/test/AsData/Budget/9.6/recordFields.budget.golden index eae78e7e6b5..5c46b1bb984 100644 --- a/plutus-tx-plugin/test/AsData/Budget/9.6/recordFields.budget.golden +++ b/plutus-tx-plugin/test/AsData/Budget/9.6/recordFields.budget.golden @@ -1,2 +1,2 @@ -({cpu: 10360646 -| mem: 37390}) \ No newline at end of file +({cpu: 9744548 +| mem: 34488}) \ No newline at end of file diff --git a/plutus-tx-plugin/test/AsData/Budget/9.6/recordFields.pir.golden b/plutus-tx-plugin/test/AsData/Budget/9.6/recordFields.pir.golden index 86294e2bf7e..d5d777a70c9 100644 --- a/plutus-tx-plugin/test/AsData/Budget/9.6/recordFields.pir.golden +++ b/plutus-tx-plugin/test/AsData/Budget/9.6/recordFields.pir.golden @@ -54,7 +54,7 @@ let False : Bool !lessThanInteger : integer -> integer -> Bool = \(x : integer) (y : integer) -> - ifThenElse {Bool} (lessThanInteger x y) True False + case Bool (lessThanInteger x y) [False, True] in \(d : data) -> let diff --git a/plutus-tx-plugin/test/AsData/Budget/9.6/recordFields.uplc.golden b/plutus-tx-plugin/test/AsData/Budget/9.6/recordFields.uplc.golden index 5574b26769f..83341fcc3f9 100644 --- a/plutus-tx-plugin/test/AsData/Budget/9.6/recordFields.uplc.golden +++ b/plutus-tx-plugin/test/AsData/Budget/9.6/recordFields.uplc.golden @@ -6,19 +6,9 @@ (\cse -> (\cse -> (\cse -> - (\lessThanInteger -> - addInteger - (addInteger - (addInteger - (addInteger (addInteger cse cse) cse) - cse) - (force - (case - (lessThanInteger - (addInteger cse cse) - (addInteger cse cse)) - [ (delay (addInteger cse cse)) - , (delay (addInteger cse cse)) ]))) + addInteger + (addInteger + (addInteger (addInteger (addInteger cse cse) cse) cse) (force (case (lessThanInteger @@ -26,11 +16,13 @@ (addInteger cse cse)) [ (delay (addInteger cse cse)) , (delay (addInteger cse cse)) ]))) - (\x y -> - force ifThenElse - (lessThanInteger x y) - (constr 0 []) - (constr 1 []))) + (force + (case + (lessThanInteger + (addInteger cse cse) + (addInteger cse cse)) + [ (delay (addInteger cse cse)) + , (delay (addInteger cse cse)) ]))) (cse (\ds ds ds ds -> ds) (\void -> error))) (cse (\ds ds ds ds -> ds) (\void -> error))) (cse (\ds ds ds ds -> ds) (\void -> error))) diff --git a/plutus-tx-plugin/test/AsData/Budget/9.6/recursive.pir.golden b/plutus-tx-plugin/test/AsData/Budget/9.6/recursive.pir.golden index f08566f884b..70b5fd19012 100644 --- a/plutus-tx-plugin/test/AsData/Budget/9.6/recursive.pir.golden +++ b/plutus-tx-plugin/test/AsData/Budget/9.6/recursive.pir.golden @@ -7,7 +7,7 @@ letrec !factorial : integer -> integer = \(x : integer) -> Bool_match - (ifThenElse {Bool} (equalsInteger 0 x) True False) + (case Bool (equalsInteger 0 x) [False, True]) {all dead. integer} (/\dead -> 1) (/\dead -> multiplyInteger x (factorial (subtractInteger x 1))) diff --git a/plutus-tx-plugin/test/AsData/Budget/9.6/recursive.uplc.golden b/plutus-tx-plugin/test/AsData/Budget/9.6/recursive.uplc.golden index 7969d93c55d..618108a1ee0 100644 --- a/plutus-tx-plugin/test/AsData/Budget/9.6/recursive.uplc.golden +++ b/plutus-tx-plugin/test/AsData/Budget/9.6/recursive.uplc.golden @@ -7,12 +7,8 @@ ((\s -> s s) (\s x -> force - (force - (force ifThenElse - (equalsInteger 0 x) - (delay (delay 1)) - (delay - (delay - (multiplyInteger - x - ((\x -> s s x) (subtractInteger x 1))))))))))) \ No newline at end of file + (case + (equalsInteger 0 x) + [ (delay + (multiplyInteger x ((\x -> s s x) (subtractInteger x 1)))) + , (delay 1) ]))))) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/allCheap.budget.golden b/plutus-tx-plugin/test/Budget/9.6/allCheap.budget.golden index 454c71d258a..8ca5042b2f7 100644 --- a/plutus-tx-plugin/test/Budget/9.6/allCheap.budget.golden +++ b/plutus-tx-plugin/test/Budget/9.6/allCheap.budget.golden @@ -1,2 +1,2 @@ -({cpu: 935986 -| mem: 5202}) \ No newline at end of file +({cpu: 747937 +| mem: 4501}) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/allCheap.pir.golden b/plutus-tx-plugin/test/Budget/9.6/allCheap.pir.golden index b3641241f20..0e28570d15e 100644 --- a/plutus-tx-plugin/test/Budget/9.6/allCheap.pir.golden +++ b/plutus-tx-plugin/test/Budget/9.6/allCheap.pir.golden @@ -19,7 +19,7 @@ letrec (\(x : integer) (xs : List integer) -> /\dead -> Bool_match - (ifThenElse {Bool} (lessThanEqualsInteger 1 x) False True) + (case Bool (lessThanEqualsInteger 1 x) [True, False]) {all dead. Bool} (/\dead -> go xs) (/\dead -> False) diff --git a/plutus-tx-plugin/test/Budget/9.6/allCheap.uplc.golden b/plutus-tx-plugin/test/Budget/9.6/allCheap.uplc.golden index f72945d7c15..e8c8fab9613 100644 --- a/plutus-tx-plugin/test/Budget/9.6/allCheap.uplc.golden +++ b/plutus-tx-plugin/test/Budget/9.6/allCheap.uplc.golden @@ -10,11 +10,9 @@ , (\x xs -> delay (force - (force - (force ifThenElse - (lessThanEqualsInteger 1 x) - (delay (delay (constr 1 []))) - (delay (delay (s s xs))))))) ])) + (case + (lessThanEqualsInteger 1 x) + [(delay (s s xs)), (delay (constr 1 []))]))) ])) (constr 1 [ 1 , (constr 1 diff --git a/plutus-tx-plugin/test/Budget/9.6/allEmptyList.pir.golden b/plutus-tx-plugin/test/Budget/9.6/allEmptyList.pir.golden index 465487cc399..34ea745ca03 100644 --- a/plutus-tx-plugin/test/Budget/9.6/allEmptyList.pir.golden +++ b/plutus-tx-plugin/test/Budget/9.6/allEmptyList.pir.golden @@ -19,7 +19,7 @@ letrec (\(x : integer) (xs : List integer) -> /\dead -> Bool_match - (ifThenElse {Bool} (lessThanEqualsInteger 1 x) False True) + (case Bool (lessThanEqualsInteger 1 x) [True, False]) {all dead. Bool} (/\dead -> go xs) (/\dead -> False) diff --git a/plutus-tx-plugin/test/Budget/9.6/allEmptyList.uplc.golden b/plutus-tx-plugin/test/Budget/9.6/allEmptyList.uplc.golden index 7f5ac34f297..6a4d705bc97 100644 --- a/plutus-tx-plugin/test/Budget/9.6/allEmptyList.uplc.golden +++ b/plutus-tx-plugin/test/Budget/9.6/allEmptyList.uplc.golden @@ -9,9 +9,7 @@ , (\x xs -> delay (force - (force - (force ifThenElse - (lessThanEqualsInteger 1 x) - (delay (delay (constr 1 []))) - (delay (delay (s s xs))))))) ])) + (case + (lessThanEqualsInteger 1 x) + [(delay (s s xs)), (delay (constr 1 []))]))) ])) (constr 0 []))) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/allExpensive.budget.golden b/plutus-tx-plugin/test/Budget/9.6/allExpensive.budget.golden index 0fcf3e05164..19abb2b978a 100644 --- a/plutus-tx-plugin/test/Budget/9.6/allExpensive.budget.golden +++ b/plutus-tx-plugin/test/Budget/9.6/allExpensive.budget.golden @@ -1,2 +1,2 @@ -({cpu: 6062960 -| mem: 30520}) \ No newline at end of file +({cpu: 4182470 +| mem: 23510}) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/allExpensive.pir.golden b/plutus-tx-plugin/test/Budget/9.6/allExpensive.pir.golden index e04d471f59a..68a4611925f 100644 --- a/plutus-tx-plugin/test/Budget/9.6/allExpensive.pir.golden +++ b/plutus-tx-plugin/test/Budget/9.6/allExpensive.pir.golden @@ -19,7 +19,7 @@ letrec (\(x : integer) (xs : List integer) -> /\dead -> Bool_match - (ifThenElse {Bool} (lessThanEqualsInteger 11 x) False True) + (case Bool (lessThanEqualsInteger 11 x) [True, False]) {all dead. Bool} (/\dead -> go xs) (/\dead -> False) diff --git a/plutus-tx-plugin/test/Budget/9.6/allExpensive.uplc.golden b/plutus-tx-plugin/test/Budget/9.6/allExpensive.uplc.golden index b23a61ea97d..07c92796bcb 100644 --- a/plutus-tx-plugin/test/Budget/9.6/allExpensive.uplc.golden +++ b/plutus-tx-plugin/test/Budget/9.6/allExpensive.uplc.golden @@ -10,11 +10,9 @@ , (\x xs -> delay (force - (force - (force ifThenElse - (lessThanEqualsInteger 11 x) - (delay (delay (constr 1 []))) - (delay (delay (s s xs))))))) ])) + (case + (lessThanEqualsInteger 11 x) + [(delay (s s xs)), (delay (constr 1 []))]))) ])) (constr 1 [ 1 , (constr 1 diff --git a/plutus-tx-plugin/test/Budget/9.6/andWithGHCOpts.budget.golden b/plutus-tx-plugin/test/Budget/9.6/andWithGHCOpts.budget.golden index f857d53e9e1..84e7005991d 100644 --- a/plutus-tx-plugin/test/Budget/9.6/andWithGHCOpts.budget.golden +++ b/plutus-tx-plugin/test/Budget/9.6/andWithGHCOpts.budget.golden @@ -1,2 +1,2 @@ -({cpu: 473439 -| mem: 2302}) \ No newline at end of file +({cpu: 285390 +| mem: 1601}) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/andWithGHCOpts.pir.golden b/plutus-tx-plugin/test/Budget/9.6/andWithGHCOpts.pir.golden index 7fcc2da7cfc..07539e0e01a 100644 --- a/plutus-tx-plugin/test/Budget/9.6/andWithGHCOpts.pir.golden +++ b/plutus-tx-plugin/test/Budget/9.6/andWithGHCOpts.pir.golden @@ -5,9 +5,9 @@ in \(x : integer) (y : integer) -> Bool_match - (ifThenElse {Bool} (lessThanInteger x 3) True False) + (case Bool (lessThanInteger x 3) [False, True]) {all dead. Bool} - (/\dead -> ifThenElse {Bool} (lessThanInteger y 3) True False) + (/\dead -> case Bool (lessThanInteger y 3) [False, True]) (/\dead -> False) {all dead. dead}) 4 diff --git a/plutus-tx-plugin/test/Budget/9.6/andWithGHCOpts.uplc.golden b/plutus-tx-plugin/test/Budget/9.6/andWithGHCOpts.uplc.golden index de616d547c6..d651596113f 100644 --- a/plutus-tx-plugin/test/Budget/9.6/andWithGHCOpts.uplc.golden +++ b/plutus-tx-plugin/test/Budget/9.6/andWithGHCOpts.uplc.golden @@ -2,15 +2,12 @@ 1.1.0 ((\x y -> force - (force - (force ifThenElse - (lessThanInteger x 3) - (delay - (delay - (force ifThenElse - (lessThanInteger y 3) - (constr 0 []) - (constr 1 [])))) - (delay (delay (constr 1 [])))))) + (case + (lessThanInteger x 3) + [ (delay (constr 1 [])) + , (delay + (case + (lessThanInteger y 3) + [(constr 1 []), (constr 0 [])])) ])) 4 4)) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/andWithLocal.budget.golden b/plutus-tx-plugin/test/Budget/9.6/andWithLocal.budget.golden index b6e6df83b49..84e7005991d 100644 --- a/plutus-tx-plugin/test/Budget/9.6/andWithLocal.budget.golden +++ b/plutus-tx-plugin/test/Budget/9.6/andWithLocal.budget.golden @@ -1,2 +1,2 @@ -({cpu: 617439 -| mem: 3202}) \ No newline at end of file +({cpu: 285390 +| mem: 1601}) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/andWithLocal.pir.golden b/plutus-tx-plugin/test/Budget/9.6/andWithLocal.pir.golden index 805dfd6aed2..07539e0e01a 100644 --- a/plutus-tx-plugin/test/Budget/9.6/andWithLocal.pir.golden +++ b/plutus-tx-plugin/test/Budget/9.6/andWithLocal.pir.golden @@ -2,15 +2,12 @@ data Bool | Bool_match where True : Bool False : Bool - !lessThanInteger : integer -> integer -> Bool - = \(x : integer) (y : integer) -> - ifThenElse {Bool} (lessThanInteger x y) True False in \(x : integer) (y : integer) -> Bool_match - (lessThanInteger x 3) + (case Bool (lessThanInteger x 3) [False, True]) {all dead. Bool} - (/\dead -> lessThanInteger y 3) + (/\dead -> case Bool (lessThanInteger y 3) [False, True]) (/\dead -> False) {all dead. dead}) 4 diff --git a/plutus-tx-plugin/test/Budget/9.6/andWithLocal.uplc.golden b/plutus-tx-plugin/test/Budget/9.6/andWithLocal.uplc.golden index 94abf5891ab..d651596113f 100644 --- a/plutus-tx-plugin/test/Budget/9.6/andWithLocal.uplc.golden +++ b/plutus-tx-plugin/test/Budget/9.6/andWithLocal.uplc.golden @@ -2,14 +2,12 @@ 1.1.0 ((\x y -> force - ((\lessThanInteger -> - case - (lessThanInteger x 3) - [(delay (lessThanInteger y 3)), (delay (constr 1 []))]) - (\x y -> - force ifThenElse - (lessThanInteger x y) - (constr 0 []) - (constr 1 [])))) + (case + (lessThanInteger x 3) + [ (delay (constr 1 [])) + , (delay + (case + (lessThanInteger y 3) + [(constr 1 []), (constr 0 [])])) ])) 4 4)) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/andWithoutGHCOpts.budget.golden b/plutus-tx-plugin/test/Budget/9.6/andWithoutGHCOpts.budget.golden index f857d53e9e1..63ec8300551 100644 --- a/plutus-tx-plugin/test/Budget/9.6/andWithoutGHCOpts.budget.golden +++ b/plutus-tx-plugin/test/Budget/9.6/andWithoutGHCOpts.budget.golden @@ -1,2 +1,2 @@ -({cpu: 473439 -| mem: 2302}) \ No newline at end of file +({cpu: 317390 +| mem: 1801}) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/andWithoutGHCOpts.pir.golden b/plutus-tx-plugin/test/Budget/9.6/andWithoutGHCOpts.pir.golden index 03e2f3fb3ad..8bb760d8caf 100644 --- a/plutus-tx-plugin/test/Budget/9.6/andWithoutGHCOpts.pir.golden +++ b/plutus-tx-plugin/test/Budget/9.6/andWithoutGHCOpts.pir.golden @@ -17,46 +17,44 @@ (a -> a -> a) -> (a -> a -> a) -> Ord a + !ifThenElse : all a. bool -> a -> a -> a + = /\a -> \(b : bool) (x : a) (y : a) -> case a b [y, x] !`$fOrdInteger` : Ord integer = CConsOrd {integer} (\(x : integer) (y : integer) -> - ifThenElse {Bool} (equalsInteger x y) True False) + case Bool (equalsInteger x y) [False, True]) (\(eta : integer) (eta : integer) -> Bool_match - (ifThenElse {Bool} (equalsInteger eta eta) True False) + (case Bool (equalsInteger eta eta) [False, True]) {all dead. Ordering} (/\dead -> EQ) (/\dead -> Bool_match - (ifThenElse - {Bool} - (lessThanEqualsInteger eta eta) - True - False) + (case Bool (lessThanEqualsInteger eta eta) [False, True]) {all dead. Ordering} (/\dead -> LT) (/\dead -> GT) {all dead. dead}) {all dead. dead}) (\(x : integer) (y : integer) -> - ifThenElse {Bool} (lessThanInteger x y) True False) + case Bool (lessThanInteger x y) [False, True]) (\(x : integer) (y : integer) -> - ifThenElse {Bool} (lessThanEqualsInteger x y) True False) + case Bool (lessThanEqualsInteger x y) [False, True]) (\(x : integer) (y : integer) -> ifThenElse {Bool} (lessThanEqualsInteger x y) False True) (\(x : integer) (y : integer) -> ifThenElse {Bool} (lessThanInteger x y) False True) (\(x : integer) (y : integer) -> Bool_match - (ifThenElse {Bool} (lessThanEqualsInteger x y) True False) + (case Bool (lessThanEqualsInteger x y) [False, True]) {all dead. integer} (/\dead -> y) (/\dead -> x) {all dead. dead}) (\(x : integer) (y : integer) -> Bool_match - (ifThenElse {Bool} (lessThanEqualsInteger x y) True False) + (case Bool (lessThanEqualsInteger x y) [False, True]) {all dead. integer} (/\dead -> x) (/\dead -> y) diff --git a/plutus-tx-plugin/test/Budget/9.6/andWithoutGHCOpts.uplc.golden b/plutus-tx-plugin/test/Budget/9.6/andWithoutGHCOpts.uplc.golden index 85a233cb9d1..2471e38142e 100644 --- a/plutus-tx-plugin/test/Budget/9.6/andWithoutGHCOpts.uplc.golden +++ b/plutus-tx-plugin/test/Budget/9.6/andWithoutGHCOpts.uplc.golden @@ -3,12 +3,9 @@ ((\x y -> force (case - (force ifThenElse (lessThanInteger x 3) (constr 0 []) (constr 1 [])) + (case (lessThanInteger x 3) [(constr 1 []), (constr 0 [])]) [ (delay - (force ifThenElse - (lessThanInteger y 3) - (constr 0 []) - (constr 1 []))) + (case (lessThanInteger y 3) [(constr 1 []), (constr 0 [])])) , (delay (constr 1 [])) ])) 4 4)) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/anyCheap.budget.golden b/plutus-tx-plugin/test/Budget/9.6/anyCheap.budget.golden index 454c71d258a..8ca5042b2f7 100644 --- a/plutus-tx-plugin/test/Budget/9.6/anyCheap.budget.golden +++ b/plutus-tx-plugin/test/Budget/9.6/anyCheap.budget.golden @@ -1,2 +1,2 @@ -({cpu: 935986 -| mem: 5202}) \ No newline at end of file +({cpu: 747937 +| mem: 4501}) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/anyCheap.pir.golden b/plutus-tx-plugin/test/Budget/9.6/anyCheap.pir.golden index 18b0845a444..edef1fd6728 100644 --- a/plutus-tx-plugin/test/Budget/9.6/anyCheap.pir.golden +++ b/plutus-tx-plugin/test/Budget/9.6/anyCheap.pir.golden @@ -19,7 +19,7 @@ letrec (\(x : integer) (xs : List integer) -> /\dead -> Bool_match - (ifThenElse {Bool} (lessThanEqualsInteger 10 x) False True) + (case Bool (lessThanEqualsInteger 10 x) [True, False]) {all dead. Bool} (/\dead -> True) (/\dead -> go xs) diff --git a/plutus-tx-plugin/test/Budget/9.6/anyCheap.uplc.golden b/plutus-tx-plugin/test/Budget/9.6/anyCheap.uplc.golden index f8ea3ee5874..6b6ae95b67c 100644 --- a/plutus-tx-plugin/test/Budget/9.6/anyCheap.uplc.golden +++ b/plutus-tx-plugin/test/Budget/9.6/anyCheap.uplc.golden @@ -10,11 +10,9 @@ , (\x xs -> delay (force - (force - (force ifThenElse - (lessThanEqualsInteger 10 x) - (delay (delay (s s xs))) - (delay (delay (constr 0 []))))))) ])) + (case + (lessThanEqualsInteger 10 x) + [(delay (constr 0 [])), (delay (s s xs))]))) ])) (constr 1 [ 1 , (constr 1 diff --git a/plutus-tx-plugin/test/Budget/9.6/anyEmptyList.pir.golden b/plutus-tx-plugin/test/Budget/9.6/anyEmptyList.pir.golden index b476d418c66..f1aa7db5931 100644 --- a/plutus-tx-plugin/test/Budget/9.6/anyEmptyList.pir.golden +++ b/plutus-tx-plugin/test/Budget/9.6/anyEmptyList.pir.golden @@ -19,7 +19,7 @@ letrec (\(x : integer) (xs : List integer) -> /\dead -> Bool_match - (ifThenElse {Bool} (lessThanEqualsInteger 1 x) False True) + (case Bool (lessThanEqualsInteger 1 x) [True, False]) {all dead. Bool} (/\dead -> True) (/\dead -> go xs) diff --git a/plutus-tx-plugin/test/Budget/9.6/anyEmptyList.uplc.golden b/plutus-tx-plugin/test/Budget/9.6/anyEmptyList.uplc.golden index 449b242be9a..2d8192471bc 100644 --- a/plutus-tx-plugin/test/Budget/9.6/anyEmptyList.uplc.golden +++ b/plutus-tx-plugin/test/Budget/9.6/anyEmptyList.uplc.golden @@ -9,9 +9,7 @@ , (\x xs -> delay (force - (force - (force ifThenElse - (lessThanEqualsInteger 1 x) - (delay (delay (s s xs))) - (delay (delay (constr 0 []))))))) ])) + (case + (lessThanEqualsInteger 1 x) + [(delay (constr 0 [])), (delay (s s xs))]))) ])) (constr 0 []))) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/anyExpensive.budget.golden b/plutus-tx-plugin/test/Budget/9.6/anyExpensive.budget.golden index 0fcf3e05164..19abb2b978a 100644 --- a/plutus-tx-plugin/test/Budget/9.6/anyExpensive.budget.golden +++ b/plutus-tx-plugin/test/Budget/9.6/anyExpensive.budget.golden @@ -1,2 +1,2 @@ -({cpu: 6062960 -| mem: 30520}) \ No newline at end of file +({cpu: 4182470 +| mem: 23510}) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/anyExpensive.pir.golden b/plutus-tx-plugin/test/Budget/9.6/anyExpensive.pir.golden index d9c1b3a0257..ed82fc95fb4 100644 --- a/plutus-tx-plugin/test/Budget/9.6/anyExpensive.pir.golden +++ b/plutus-tx-plugin/test/Budget/9.6/anyExpensive.pir.golden @@ -19,7 +19,7 @@ letrec (\(x : integer) (xs : List integer) -> /\dead -> Bool_match - (ifThenElse {Bool} (lessThanEqualsInteger 1 x) False True) + (case Bool (lessThanEqualsInteger 1 x) [True, False]) {all dead. Bool} (/\dead -> True) (/\dead -> go xs) diff --git a/plutus-tx-plugin/test/Budget/9.6/anyExpensive.uplc.golden b/plutus-tx-plugin/test/Budget/9.6/anyExpensive.uplc.golden index 2d4571c1c61..332c7ea6904 100644 --- a/plutus-tx-plugin/test/Budget/9.6/anyExpensive.uplc.golden +++ b/plutus-tx-plugin/test/Budget/9.6/anyExpensive.uplc.golden @@ -10,11 +10,9 @@ , (\x xs -> delay (force - (force - (force ifThenElse - (lessThanEqualsInteger 1 x) - (delay (delay (s s xs))) - (delay (delay (constr 0 []))))))) ])) + (case + (lessThanEqualsInteger 1 x) + [(delay (constr 0 [])), (delay (s s xs))]))) ])) (constr 1 [ 1 , (constr 1 diff --git a/plutus-tx-plugin/test/Budget/9.6/builtinListIndexing.budget.golden b/plutus-tx-plugin/test/Budget/9.6/builtinListIndexing.budget.golden index 98c445bb648..5803b941e0b 100644 --- a/plutus-tx-plugin/test/Budget/9.6/builtinListIndexing.budget.golden +++ b/plutus-tx-plugin/test/Budget/9.6/builtinListIndexing.budget.golden @@ -1,2 +1,2 @@ -({cpu: 8593207 -| mem: 35130}) \ No newline at end of file +({cpu: 7464913 +| mem: 30924}) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/builtinListIndexing.pir.golden b/plutus-tx-plugin/test/Budget/9.6/builtinListIndexing.pir.golden index d9c9486ec77..daa3adc5a2d 100644 --- a/plutus-tx-plugin/test/Budget/9.6/builtinListIndexing.pir.golden +++ b/plutus-tx-plugin/test/Budget/9.6/builtinListIndexing.pir.golden @@ -26,7 +26,7 @@ letrec error {Unit -> data}) (\(x : data) (xs : list data) (ds : Unit) (eta : Unit) -> Bool_match - (ifThenElse {Bool} (equalsInteger 0 i) True False) + (case Bool (equalsInteger 0 i) [False, True]) {all dead. data} (/\dead -> x) (/\dead -> go xs (subtractInteger i 1)) diff --git a/plutus-tx-plugin/test/Budget/9.6/builtinListIndexing.uplc.golden b/plutus-tx-plugin/test/Budget/9.6/builtinListIndexing.uplc.golden index 4cbecd88288..3cce3053238 100644 --- a/plutus-tx-plugin/test/Budget/9.6/builtinListIndexing.uplc.golden +++ b/plutus-tx-plugin/test/Budget/9.6/builtinListIndexing.uplc.golden @@ -11,12 +11,10 @@ (delay ((\x xs ds eta -> force - (force - (force ifThenElse - (equalsInteger 0 i) - (delay (delay x)) - (delay - (delay (s s xs (subtractInteger i 1))))))) + (case + (equalsInteger 0 i) + [ (delay (s s xs (subtractInteger i 1))) + , (delay x) ])) (force headList xs) (force tailList xs)))) (constr 0 []) diff --git a/plutus-tx-plugin/test/Budget/9.6/constAccL.budget.golden b/plutus-tx-plugin/test/Budget/9.6/constAccL.budget.golden index a6ea83c6160..6fb2fa8565b 100644 --- a/plutus-tx-plugin/test/Budget/9.6/constAccL.budget.golden +++ b/plutus-tx-plugin/test/Budget/9.6/constAccL.budget.golden @@ -1,2 +1,2 @@ -({cpu: 941965986 -| mem: 4508802}) \ No newline at end of file +({cpu: 753728937 +| mem: 3807101}) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/constAccL.pir.golden b/plutus-tx-plugin/test/Budget/9.6/constAccL.pir.golden index a1cc5a80c47..59f3d1fe69c 100644 --- a/plutus-tx-plugin/test/Budget/9.6/constAccL.pir.golden +++ b/plutus-tx-plugin/test/Budget/9.6/constAccL.pir.golden @@ -23,7 +23,7 @@ letrec !go : integer -> List integer = \(n : integer) -> Bool_match - (ifThenElse {Bool} (lessThanEqualsInteger n 0) True False) + (case Bool (lessThanEqualsInteger n 0) [False, True]) {all dead. List integer} (/\dead -> Nil {integer}) (/\dead -> Cons {integer} 1 (go (subtractInteger n 1))) diff --git a/plutus-tx-plugin/test/Budget/9.6/constAccL.uplc.golden b/plutus-tx-plugin/test/Budget/9.6/constAccL.uplc.golden index 1b2f05b83c8..7bae0f8146c 100644 --- a/plutus-tx-plugin/test/Budget/9.6/constAccL.uplc.golden +++ b/plutus-tx-plugin/test/Budget/9.6/constAccL.uplc.golden @@ -5,14 +5,11 @@ ((\s -> s s) (\s n -> force - (force - (force ifThenElse - (lessThanEqualsInteger n 0) - (delay (delay (constr 0 []))) - (delay - (delay - (constr 1 - [1, ((\x -> s s x) (subtractInteger n 1))])))))) + (case + (lessThanEqualsInteger n 0) + [ (delay + (constr 1 [1, ((\x -> s s x) (subtractInteger n 1))])) + , (delay (constr 0 [])) ])) 1000)) ((\s -> s s) (\s acc ds -> diff --git a/plutus-tx-plugin/test/Budget/9.6/constAccR.budget.golden b/plutus-tx-plugin/test/Budget/9.6/constAccR.budget.golden index f715b40e326..d296c10c090 100644 --- a/plutus-tx-plugin/test/Budget/9.6/constAccR.budget.golden +++ b/plutus-tx-plugin/test/Budget/9.6/constAccR.budget.golden @@ -1,2 +1,2 @@ -({cpu: 893821986 -| mem: 4207902}) \ No newline at end of file +({cpu: 705584937 +| mem: 3506201}) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/constAccR.pir.golden b/plutus-tx-plugin/test/Budget/9.6/constAccR.pir.golden index c6123acd46d..cc3ae7a2967 100644 --- a/plutus-tx-plugin/test/Budget/9.6/constAccR.pir.golden +++ b/plutus-tx-plugin/test/Budget/9.6/constAccR.pir.golden @@ -23,7 +23,7 @@ letrec !go : integer -> List integer = \(n : integer) -> Bool_match - (ifThenElse {Bool} (lessThanEqualsInteger n 0) True False) + (case Bool (lessThanEqualsInteger n 0) [False, True]) {all dead. List integer} (/\dead -> Nil {integer}) (/\dead -> Cons {integer} 1 (go (subtractInteger n 1))) diff --git a/plutus-tx-plugin/test/Budget/9.6/constAccR.uplc.golden b/plutus-tx-plugin/test/Budget/9.6/constAccR.uplc.golden index 3d663cfab76..aacac5bb489 100644 --- a/plutus-tx-plugin/test/Budget/9.6/constAccR.uplc.golden +++ b/plutus-tx-plugin/test/Budget/9.6/constAccR.uplc.golden @@ -5,12 +5,8 @@ ((\s -> s s) (\s n -> force - (force - (force ifThenElse - (lessThanEqualsInteger n 0) - (delay (delay (constr 0 []))) - (delay - (delay - (constr 1 - [1, ((\x -> s s x) (subtractInteger n 1))])))))) + (case + (lessThanEqualsInteger n 0) + [ (delay (constr 1 [1, ((\x -> s s x) (subtractInteger n 1))])) + , (delay (constr 0 [])) ])) 1000))) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/constElL.budget.golden b/plutus-tx-plugin/test/Budget/9.6/constElL.budget.golden index a6ea83c6160..6fb2fa8565b 100644 --- a/plutus-tx-plugin/test/Budget/9.6/constElL.budget.golden +++ b/plutus-tx-plugin/test/Budget/9.6/constElL.budget.golden @@ -1,2 +1,2 @@ -({cpu: 941965986 -| mem: 4508802}) \ No newline at end of file +({cpu: 753728937 +| mem: 3807101}) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/constElL.pir.golden b/plutus-tx-plugin/test/Budget/9.6/constElL.pir.golden index 00e07b5f2f0..01856f77c01 100644 --- a/plutus-tx-plugin/test/Budget/9.6/constElL.pir.golden +++ b/plutus-tx-plugin/test/Budget/9.6/constElL.pir.golden @@ -23,7 +23,7 @@ letrec !go : integer -> List integer = \(n : integer) -> Bool_match - (ifThenElse {Bool} (lessThanEqualsInteger n 0) True False) + (case Bool (lessThanEqualsInteger n 0) [False, True]) {all dead. List integer} (/\dead -> Nil {integer}) (/\dead -> Cons {integer} 1 (go (subtractInteger n 1))) diff --git a/plutus-tx-plugin/test/Budget/9.6/constElL.uplc.golden b/plutus-tx-plugin/test/Budget/9.6/constElL.uplc.golden index 1b95be3171d..966bef99b3e 100644 --- a/plutus-tx-plugin/test/Budget/9.6/constElL.uplc.golden +++ b/plutus-tx-plugin/test/Budget/9.6/constElL.uplc.golden @@ -5,14 +5,11 @@ ((\s -> s s) (\s n -> force - (force - (force ifThenElse - (lessThanEqualsInteger n 0) - (delay (delay (constr 0 []))) - (delay - (delay - (constr 1 - [1, ((\x -> s s x) (subtractInteger n 1))])))))) + (case + (lessThanEqualsInteger n 0) + [ (delay + (constr 1 [1, ((\x -> s s x) (subtractInteger n 1))])) + , (delay (constr 0 [])) ])) 1000)) ((\s -> s s) (\s acc ds -> diff --git a/plutus-tx-plugin/test/Budget/9.6/constElR.budget.golden b/plutus-tx-plugin/test/Budget/9.6/constElR.budget.golden index 7566ffbe8dc..9f67707330d 100644 --- a/plutus-tx-plugin/test/Budget/9.6/constElR.budget.golden +++ b/plutus-tx-plugin/test/Budget/9.6/constElR.budget.golden @@ -1,2 +1,2 @@ -({cpu: 941821986 -| mem: 4507902}) \ No newline at end of file +({cpu: 753584937 +| mem: 3806201}) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/constElR.pir.golden b/plutus-tx-plugin/test/Budget/9.6/constElR.pir.golden index ce7fe4cdd5e..fb4fb6e04f2 100644 --- a/plutus-tx-plugin/test/Budget/9.6/constElR.pir.golden +++ b/plutus-tx-plugin/test/Budget/9.6/constElR.pir.golden @@ -24,7 +24,7 @@ letrec !go : integer -> List integer = \(n : integer) -> Bool_match - (ifThenElse {Bool} (lessThanEqualsInteger n 0) True False) + (case Bool (lessThanEqualsInteger n 0) [False, True]) {all dead. List integer} (/\dead -> Nil {integer}) (/\dead -> Cons {integer} 1 (go (subtractInteger n 1))) diff --git a/plutus-tx-plugin/test/Budget/9.6/constElR.uplc.golden b/plutus-tx-plugin/test/Budget/9.6/constElR.uplc.golden index d06e0bf63ac..4a14c6ccee0 100644 --- a/plutus-tx-plugin/test/Budget/9.6/constElR.uplc.golden +++ b/plutus-tx-plugin/test/Budget/9.6/constElR.uplc.golden @@ -6,12 +6,8 @@ ((\s -> s s) (\s n -> force - (force - (force ifThenElse - (lessThanEqualsInteger n 0) - (delay (delay (constr 0 []))) - (delay - (delay - (constr 1 - [1, ((\x -> s s x) (subtractInteger n 1))])))))) + (case + (lessThanEqualsInteger n 0) + [ (delay (constr 1 [1, ((\x -> s s x) (subtractInteger n 1))])) + , (delay (constr 0 [])) ])) 1000))) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/elemCheap.budget.golden b/plutus-tx-plugin/test/Budget/9.6/elemCheap.budget.golden index 78391dbcf1a..a9d3f93c910 100644 --- a/plutus-tx-plugin/test/Budget/9.6/elemCheap.budget.golden +++ b/plutus-tx-plugin/test/Budget/9.6/elemCheap.budget.golden @@ -1,2 +1,2 @@ -({cpu: 944482 -| mem: 5202}) \ No newline at end of file +({cpu: 756433 +| mem: 4501}) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/elemCheap.pir.golden b/plutus-tx-plugin/test/Budget/9.6/elemCheap.pir.golden index 9141c23e19e..70776a7aff6 100644 --- a/plutus-tx-plugin/test/Budget/9.6/elemCheap.pir.golden +++ b/plutus-tx-plugin/test/Budget/9.6/elemCheap.pir.golden @@ -19,7 +19,7 @@ letrec (\(x : integer) (xs : List integer) -> /\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 1 x) True False) + (case Bool (equalsInteger 1 x) [False, True]) {all dead. Bool} (/\dead -> True) (/\dead -> go xs) diff --git a/plutus-tx-plugin/test/Budget/9.6/elemCheap.uplc.golden b/plutus-tx-plugin/test/Budget/9.6/elemCheap.uplc.golden index fa3edc63c34..cd1fa66f96f 100644 --- a/plutus-tx-plugin/test/Budget/9.6/elemCheap.uplc.golden +++ b/plutus-tx-plugin/test/Budget/9.6/elemCheap.uplc.golden @@ -10,11 +10,9 @@ , (\x xs -> delay (force - (force - (force ifThenElse - (equalsInteger 1 x) - (delay (delay (constr 0 []))) - (delay (delay (s s xs))))))) ])) + (case + (equalsInteger 1 x) + [(delay (s s xs)), (delay (constr 0 []))]))) ])) (constr 1 [ 1 , (constr 1 diff --git a/plutus-tx-plugin/test/Budget/9.6/elemExpensive.budget.golden b/plutus-tx-plugin/test/Budget/9.6/elemExpensive.budget.golden index 524d1d54703..993ba537c95 100644 --- a/plutus-tx-plugin/test/Budget/9.6/elemExpensive.budget.golden +++ b/plutus-tx-plugin/test/Budget/9.6/elemExpensive.budget.golden @@ -1,2 +1,2 @@ -({cpu: 6147920 -| mem: 30520}) \ No newline at end of file +({cpu: 4267430 +| mem: 23510}) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/elemExpensive.pir.golden b/plutus-tx-plugin/test/Budget/9.6/elemExpensive.pir.golden index d056d7efa25..e244ebe84ed 100644 --- a/plutus-tx-plugin/test/Budget/9.6/elemExpensive.pir.golden +++ b/plutus-tx-plugin/test/Budget/9.6/elemExpensive.pir.golden @@ -19,7 +19,7 @@ letrec (\(x : integer) (xs : List integer) -> /\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 0 x) True False) + (case Bool (equalsInteger 0 x) [False, True]) {all dead. Bool} (/\dead -> True) (/\dead -> go xs) diff --git a/plutus-tx-plugin/test/Budget/9.6/elemExpensive.uplc.golden b/plutus-tx-plugin/test/Budget/9.6/elemExpensive.uplc.golden index e2053411e8d..a7f7b09f87b 100644 --- a/plutus-tx-plugin/test/Budget/9.6/elemExpensive.uplc.golden +++ b/plutus-tx-plugin/test/Budget/9.6/elemExpensive.uplc.golden @@ -10,11 +10,9 @@ , (\x xs -> delay (force - (force - (force ifThenElse - (equalsInteger 0 x) - (delay (delay (constr 0 []))) - (delay (delay (s s xs))))))) ])) + (case + (equalsInteger 0 x) + [(delay (s s xs)), (delay (constr 0 []))]))) ])) (constr 1 [ 1 , (constr 1 diff --git a/plutus-tx-plugin/test/Budget/9.6/filter.budget.golden b/plutus-tx-plugin/test/Budget/9.6/filter.budget.golden index a7ed628c2b2..07527b7813f 100644 --- a/plutus-tx-plugin/test/Budget/9.6/filter.budget.golden +++ b/plutus-tx-plugin/test/Budget/9.6/filter.budget.golden @@ -1,2 +1,2 @@ -({cpu: 8747220 -| mem: 38530}) \ No newline at end of file +({cpu: 6866730 +| mem: 31520}) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/filter.pir.golden b/plutus-tx-plugin/test/Budget/9.6/filter.pir.golden index 638425f5f85..f827f744b6a 100644 --- a/plutus-tx-plugin/test/Budget/9.6/filter.pir.golden +++ b/plutus-tx-plugin/test/Budget/9.6/filter.pir.golden @@ -22,11 +22,7 @@ letrec !xs : List integer = go xs in Bool_match - (ifThenElse - {Bool} - (equalsInteger 0 (modInteger x 2)) - True - False) + (case Bool (equalsInteger 0 (modInteger x 2)) [False, True]) {all dead. List integer} (/\dead -> Cons {integer} x xs) (/\dead -> xs) diff --git a/plutus-tx-plugin/test/Budget/9.6/filter.uplc.golden b/plutus-tx-plugin/test/Budget/9.6/filter.uplc.golden index 72304b4ad4e..62aed773fab 100644 --- a/plutus-tx-plugin/test/Budget/9.6/filter.uplc.golden +++ b/plutus-tx-plugin/test/Budget/9.6/filter.uplc.golden @@ -11,11 +11,9 @@ delay ((\xs -> force - (force - (force ifThenElse - (equalsInteger 0 (modInteger x 2)) - (delay (delay (constr 1 [x, xs]))) - (delay (delay xs))))) + (case + (equalsInteger 0 (modInteger x 2)) + [(delay xs), (delay (constr 1 [x, xs]))])) (s s xs))) ])) (constr 1 [ 1 diff --git a/plutus-tx-plugin/test/Budget/9.6/findCheap.budget.golden b/plutus-tx-plugin/test/Budget/9.6/findCheap.budget.golden index e3158b829b5..0fdba6b033b 100644 --- a/plutus-tx-plugin/test/Budget/9.6/findCheap.budget.golden +++ b/plutus-tx-plugin/test/Budget/9.6/findCheap.budget.golden @@ -1,2 +1,2 @@ -({cpu: 951986 -| mem: 5302}) \ No newline at end of file +({cpu: 763937 +| mem: 4601}) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/findCheap.pir.golden b/plutus-tx-plugin/test/Budget/9.6/findCheap.pir.golden index 4434e6d5856..a1f19cdefaa 100644 --- a/plutus-tx-plugin/test/Budget/9.6/findCheap.pir.golden +++ b/plutus-tx-plugin/test/Budget/9.6/findCheap.pir.golden @@ -22,7 +22,7 @@ letrec (\(x : integer) (xs : List integer) -> /\dead -> Bool_match - (ifThenElse {Bool} (lessThanEqualsInteger 10 x) False True) + (case Bool (lessThanEqualsInteger 10 x) [True, False]) {all dead. Maybe integer} (/\dead -> Just {integer} x) (/\dead -> go xs) diff --git a/plutus-tx-plugin/test/Budget/9.6/findCheap.uplc.golden b/plutus-tx-plugin/test/Budget/9.6/findCheap.uplc.golden index d905d620a00..1ae4b338350 100644 --- a/plutus-tx-plugin/test/Budget/9.6/findCheap.uplc.golden +++ b/plutus-tx-plugin/test/Budget/9.6/findCheap.uplc.golden @@ -10,11 +10,9 @@ , (\x xs -> delay (force - (force - (force ifThenElse - (lessThanEqualsInteger 10 x) - (delay (delay (s s xs))) - (delay (delay (constr 0 [x]))))))) ])) + (case + (lessThanEqualsInteger 10 x) + [(delay (constr 0 [x])), (delay (s s xs))]))) ])) (constr 1 [ 1 , (constr 1 diff --git a/plutus-tx-plugin/test/Budget/9.6/findEmptyList.pir.golden b/plutus-tx-plugin/test/Budget/9.6/findEmptyList.pir.golden index e56630b3ddb..d6c1031c87f 100644 --- a/plutus-tx-plugin/test/Budget/9.6/findEmptyList.pir.golden +++ b/plutus-tx-plugin/test/Budget/9.6/findEmptyList.pir.golden @@ -22,7 +22,7 @@ letrec (\(x : integer) (xs : List integer) -> /\dead -> Bool_match - (ifThenElse {Bool} (lessThanEqualsInteger 1 x) False True) + (case Bool (lessThanEqualsInteger 1 x) [True, False]) {all dead. Maybe integer} (/\dead -> Just {integer} x) (/\dead -> go xs) diff --git a/plutus-tx-plugin/test/Budget/9.6/findEmptyList.uplc.golden b/plutus-tx-plugin/test/Budget/9.6/findEmptyList.uplc.golden index eebdf7cdfb4..bd964773e0f 100644 --- a/plutus-tx-plugin/test/Budget/9.6/findEmptyList.uplc.golden +++ b/plutus-tx-plugin/test/Budget/9.6/findEmptyList.uplc.golden @@ -9,9 +9,7 @@ , (\x xs -> delay (force - (force - (force ifThenElse - (lessThanEqualsInteger 1 x) - (delay (delay (s s xs))) - (delay (delay (constr 0 [x]))))))) ])) + (case + (lessThanEqualsInteger 1 x) + [(delay (constr 0 [x])), (delay (s s xs))]))) ])) (constr 0 []))) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/findExpensive.budget.golden b/plutus-tx-plugin/test/Budget/9.6/findExpensive.budget.golden index 0fcf3e05164..19abb2b978a 100644 --- a/plutus-tx-plugin/test/Budget/9.6/findExpensive.budget.golden +++ b/plutus-tx-plugin/test/Budget/9.6/findExpensive.budget.golden @@ -1,2 +1,2 @@ -({cpu: 6062960 -| mem: 30520}) \ No newline at end of file +({cpu: 4182470 +| mem: 23510}) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/findExpensive.pir.golden b/plutus-tx-plugin/test/Budget/9.6/findExpensive.pir.golden index a94f48deade..d9b7e6cf136 100644 --- a/plutus-tx-plugin/test/Budget/9.6/findExpensive.pir.golden +++ b/plutus-tx-plugin/test/Budget/9.6/findExpensive.pir.golden @@ -22,7 +22,7 @@ letrec (\(x : integer) (xs : List integer) -> /\dead -> Bool_match - (ifThenElse {Bool} (lessThanEqualsInteger 1 x) False True) + (case Bool (lessThanEqualsInteger 1 x) [True, False]) {all dead. Maybe integer} (/\dead -> Just {integer} x) (/\dead -> go xs) diff --git a/plutus-tx-plugin/test/Budget/9.6/findExpensive.uplc.golden b/plutus-tx-plugin/test/Budget/9.6/findExpensive.uplc.golden index 1182f5d3ca5..28788be611b 100644 --- a/plutus-tx-plugin/test/Budget/9.6/findExpensive.uplc.golden +++ b/plutus-tx-plugin/test/Budget/9.6/findExpensive.uplc.golden @@ -10,11 +10,9 @@ , (\x xs -> delay (force - (force - (force ifThenElse - (lessThanEqualsInteger 1 x) - (delay (delay (s s xs))) - (delay (delay (constr 0 [x]))))))) ])) + (case + (lessThanEqualsInteger 1 x) + [(delay (constr 0 [x])), (delay (s s xs))]))) ])) (constr 1 [ 1 , (constr 1 diff --git a/plutus-tx-plugin/test/Budget/9.6/findIndexCheap.budget.golden b/plutus-tx-plugin/test/Budget/9.6/findIndexCheap.budget.golden index 8c7f896e465..3a03241cc7d 100644 --- a/plutus-tx-plugin/test/Budget/9.6/findIndexCheap.budget.golden +++ b/plutus-tx-plugin/test/Budget/9.6/findIndexCheap.budget.golden @@ -1,2 +1,2 @@ -({cpu: 999986 -| mem: 5602}) \ No newline at end of file +({cpu: 811937 +| mem: 4901}) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/findIndexCheap.pir.golden b/plutus-tx-plugin/test/Budget/9.6/findIndexCheap.pir.golden index 2dbcb61f82c..880cd5eb2ce 100644 --- a/plutus-tx-plugin/test/Budget/9.6/findIndexCheap.pir.golden +++ b/plutus-tx-plugin/test/Budget/9.6/findIndexCheap.pir.golden @@ -22,7 +22,7 @@ letrec (\(x : integer) (xs : List integer) -> /\dead -> Bool_match - (ifThenElse {Bool} (lessThanEqualsInteger 10 x) False True) + (case Bool (lessThanEqualsInteger 10 x) [True, False]) {all dead. Maybe integer} (/\dead -> Just {integer} i) (/\dead -> go (addInteger 1 i) xs) diff --git a/plutus-tx-plugin/test/Budget/9.6/findIndexCheap.uplc.golden b/plutus-tx-plugin/test/Budget/9.6/findIndexCheap.uplc.golden index 360bcd0e178..96ee66a12ce 100644 --- a/plutus-tx-plugin/test/Budget/9.6/findIndexCheap.uplc.golden +++ b/plutus-tx-plugin/test/Budget/9.6/findIndexCheap.uplc.golden @@ -10,12 +10,11 @@ , (\x xs -> delay (force - (force - (force ifThenElse - (lessThanEqualsInteger 10 x) - (delay - (delay ((\x -> s s x) (addInteger 1 i) xs))) - (delay (delay (constr 0 [i]))))))) ])) + (case + (lessThanEqualsInteger 10 x) + [ (delay (constr 0 [i])) + , (delay + ((\x -> s s x) (addInteger 1 i) xs)) ]))) ])) 0 (constr 1 [ 1 diff --git a/plutus-tx-plugin/test/Budget/9.6/findIndexEmptyList.pir.golden b/plutus-tx-plugin/test/Budget/9.6/findIndexEmptyList.pir.golden index cfdedbabc41..fa7ffec388f 100644 --- a/plutus-tx-plugin/test/Budget/9.6/findIndexEmptyList.pir.golden +++ b/plutus-tx-plugin/test/Budget/9.6/findIndexEmptyList.pir.golden @@ -22,7 +22,7 @@ letrec (\(x : integer) (xs : List integer) -> /\dead -> Bool_match - (ifThenElse {Bool} (lessThanEqualsInteger 1 x) False True) + (case Bool (lessThanEqualsInteger 1 x) [True, False]) {all dead. Maybe integer} (/\dead -> Just {integer} i) (/\dead -> go (addInteger 1 i) xs) diff --git a/plutus-tx-plugin/test/Budget/9.6/findIndexEmptyList.uplc.golden b/plutus-tx-plugin/test/Budget/9.6/findIndexEmptyList.uplc.golden index 4ab11b04206..6de8dcd3902 100644 --- a/plutus-tx-plugin/test/Budget/9.6/findIndexEmptyList.uplc.golden +++ b/plutus-tx-plugin/test/Budget/9.6/findIndexEmptyList.uplc.golden @@ -9,11 +9,10 @@ , (\x xs -> delay (force - (force - (force ifThenElse - (lessThanEqualsInteger 1 x) - (delay - (delay ((\x -> s s x) (addInteger 1 i) xs))) - (delay (delay (constr 0 [i]))))))) ])) + (case + (lessThanEqualsInteger 1 x) + [ (delay (constr 0 [i])) + , (delay + ((\x -> s s x) (addInteger 1 i) xs)) ]))) ])) 0 (constr 0 []))) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/findIndexExpensive.budget.golden b/plutus-tx-plugin/test/Budget/9.6/findIndexExpensive.budget.golden index 8372dd64ca3..2fed8f062c7 100644 --- a/plutus-tx-plugin/test/Budget/9.6/findIndexExpensive.budget.golden +++ b/plutus-tx-plugin/test/Budget/9.6/findIndexExpensive.budget.golden @@ -1,2 +1,2 @@ -({cpu: 8723040 -| mem: 40840}) \ No newline at end of file +({cpu: 6842550 +| mem: 33830}) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/findIndexExpensive.pir.golden b/plutus-tx-plugin/test/Budget/9.6/findIndexExpensive.pir.golden index 5d03400d1a3..70b42ea0c4b 100644 --- a/plutus-tx-plugin/test/Budget/9.6/findIndexExpensive.pir.golden +++ b/plutus-tx-plugin/test/Budget/9.6/findIndexExpensive.pir.golden @@ -22,7 +22,7 @@ letrec (\(x : integer) (xs : List integer) -> /\dead -> Bool_match - (ifThenElse {Bool} (lessThanEqualsInteger 1 x) False True) + (case Bool (lessThanEqualsInteger 1 x) [True, False]) {all dead. Maybe integer} (/\dead -> Just {integer} i) (/\dead -> go (addInteger 1 i) xs) diff --git a/plutus-tx-plugin/test/Budget/9.6/findIndexExpensive.uplc.golden b/plutus-tx-plugin/test/Budget/9.6/findIndexExpensive.uplc.golden index ae2f5416988..e74c07cf93f 100644 --- a/plutus-tx-plugin/test/Budget/9.6/findIndexExpensive.uplc.golden +++ b/plutus-tx-plugin/test/Budget/9.6/findIndexExpensive.uplc.golden @@ -10,12 +10,11 @@ , (\x xs -> delay (force - (force - (force ifThenElse - (lessThanEqualsInteger 1 x) - (delay - (delay ((\x -> s s x) (addInteger 1 i) xs))) - (delay (delay (constr 0 [i]))))))) ])) + (case + (lessThanEqualsInteger 1 x) + [ (delay (constr 0 [i])) + , (delay + ((\x -> s s x) (addInteger 1 i) xs)) ]))) ])) 0 (constr 1 [ 1 diff --git a/plutus-tx-plugin/test/Budget/9.6/gte0.budget.golden b/plutus-tx-plugin/test/Budget/9.6/gte0.budget.golden index bca07ab6ce2..712ce91dcb0 100644 --- a/plutus-tx-plugin/test/Budget/9.6/gte0.budget.golden +++ b/plutus-tx-plugin/test/Budget/9.6/gte0.budget.golden @@ -1,2 +1,2 @@ -({cpu: 1255160986 -| mem: 5709902}) \ No newline at end of file +({cpu: 878874937 +| mem: 4307201}) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/gte0.pir.golden b/plutus-tx-plugin/test/Budget/9.6/gte0.pir.golden index ae6fab6255b..7f4dab70c4a 100644 --- a/plutus-tx-plugin/test/Budget/9.6/gte0.pir.golden +++ b/plutus-tx-plugin/test/Budget/9.6/gte0.pir.golden @@ -19,7 +19,7 @@ letrec (\(x : integer) (xs : List integer) -> /\dead -> Bool_match - (ifThenElse {Bool} (lessThanInteger x 0) False True) + (case Bool (lessThanInteger x 0) [True, False]) {all dead. Bool} (/\dead -> go xs) (/\dead -> False) @@ -30,7 +30,7 @@ letrec !go : integer -> List integer = \(n : integer) -> Bool_match - (ifThenElse {Bool} (lessThanEqualsInteger n 0) True False) + (case Bool (lessThanEqualsInteger n 0) [False, True]) {all dead. List integer} (/\dead -> Nil {integer}) (/\dead -> Cons {integer} 0 (go (subtractInteger n 1))) diff --git a/plutus-tx-plugin/test/Budget/9.6/gte0.uplc.golden b/plutus-tx-plugin/test/Budget/9.6/gte0.uplc.golden index e545f4c2320..c7eb172dcf9 100644 --- a/plutus-tx-plugin/test/Budget/9.6/gte0.uplc.golden +++ b/plutus-tx-plugin/test/Budget/9.6/gte0.uplc.golden @@ -9,20 +9,14 @@ , (\x xs -> delay (force - (force - (force ifThenElse - (lessThanInteger x 0) - (delay (delay (constr 1 []))) - (delay (delay (s s xs))))))) ])) + (case + (lessThanInteger x 0) + [(delay (s s xs)), (delay (constr 1 []))]))) ])) ((\s -> s s) (\s n -> force - (force - (force ifThenElse - (lessThanEqualsInteger n 0) - (delay (delay (constr 0 []))) - (delay - (delay - (constr 1 - [0, ((\x -> s s x) (subtractInteger n 1))])))))) + (case + (lessThanEqualsInteger n 0) + [ (delay (constr 1 [0, ((\x -> s s x) (subtractInteger n 1))])) + , (delay (constr 0 [])) ])) 1000))) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/listIndexing.budget.golden b/plutus-tx-plugin/test/Budget/9.6/listIndexing.budget.golden index 778708b2bff..74652a22a9f 100644 --- a/plutus-tx-plugin/test/Budget/9.6/listIndexing.budget.golden +++ b/plutus-tx-plugin/test/Budget/9.6/listIndexing.budget.golden @@ -1,2 +1,2 @@ -({cpu: 5196432 -| mem: 24622}) \ No newline at end of file +({cpu: 4068138 +| mem: 20416}) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/listIndexing.pir.golden b/plutus-tx-plugin/test/Budget/9.6/listIndexing.pir.golden index 55f70cdb9a9..70bd08080d2 100644 --- a/plutus-tx-plugin/test/Budget/9.6/listIndexing.pir.golden +++ b/plutus-tx-plugin/test/Budget/9.6/listIndexing.pir.golden @@ -23,7 +23,7 @@ letrec (\(x : data) (xs : List data) -> /\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 0 ds) True False) + (case Bool (equalsInteger 0 ds) [False, True]) {all dead. data} (/\dead -> x) (/\dead -> go (subtractInteger ds 1) xs) diff --git a/plutus-tx-plugin/test/Budget/9.6/listIndexing.uplc.golden b/plutus-tx-plugin/test/Budget/9.6/listIndexing.uplc.golden index e75bdda9e2e..84506410110 100644 --- a/plutus-tx-plugin/test/Budget/9.6/listIndexing.uplc.golden +++ b/plutus-tx-plugin/test/Budget/9.6/listIndexing.uplc.golden @@ -10,12 +10,8 @@ , (\x xs -> delay (force - (force - (force ifThenElse - (equalsInteger 0 ds) - (delay (delay x)) - (delay - (delay - ((\x -> s s x) - (subtractInteger ds 1) - xs))))))) ]))))) \ No newline at end of file + (case + (equalsInteger 0 ds) + [ (delay + ((\x -> s s x) (subtractInteger ds 1) xs)) + , (delay x) ]))) ]))))) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/lte0.budget.golden b/plutus-tx-plugin/test/Budget/9.6/lte0.budget.golden index ac6244b5fed..3b57d782581 100644 --- a/plutus-tx-plugin/test/Budget/9.6/lte0.budget.golden +++ b/plutus-tx-plugin/test/Budget/9.6/lte0.budget.golden @@ -1,2 +1,2 @@ -({cpu: 1253707986 -| mem: 5709902}) \ No newline at end of file +({cpu: 877421937 +| mem: 4307201}) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/lte0.pir.golden b/plutus-tx-plugin/test/Budget/9.6/lte0.pir.golden index a4a6d6405d1..464cd1c03ee 100644 --- a/plutus-tx-plugin/test/Budget/9.6/lte0.pir.golden +++ b/plutus-tx-plugin/test/Budget/9.6/lte0.pir.golden @@ -19,7 +19,7 @@ letrec (\(x : integer) (xs : List integer) -> /\dead -> Bool_match - (ifThenElse {Bool} (lessThanEqualsInteger x 0) True False) + (case Bool (lessThanEqualsInteger x 0) [False, True]) {all dead. Bool} (/\dead -> go xs) (/\dead -> False) @@ -30,7 +30,7 @@ letrec !go : integer -> List integer = \(n : integer) -> Bool_match - (ifThenElse {Bool} (lessThanEqualsInteger n 0) True False) + (case Bool (lessThanEqualsInteger n 0) [False, True]) {all dead. List integer} (/\dead -> Nil {integer}) (/\dead -> Cons {integer} 0 (go (subtractInteger n 1))) diff --git a/plutus-tx-plugin/test/Budget/9.6/lte0.uplc.golden b/plutus-tx-plugin/test/Budget/9.6/lte0.uplc.golden index 4e375504f2c..c903be7b83b 100644 --- a/plutus-tx-plugin/test/Budget/9.6/lte0.uplc.golden +++ b/plutus-tx-plugin/test/Budget/9.6/lte0.uplc.golden @@ -9,20 +9,14 @@ , (\x xs -> delay (force - (force - (force ifThenElse - (lessThanEqualsInteger x 0) - (delay (delay (s s xs))) - (delay (delay (constr 1 []))))))) ])) + (case + (lessThanEqualsInteger x 0) + [(delay (constr 1 [])), (delay (s s xs))]))) ])) ((\s -> s s) (\s n -> force - (force - (force ifThenElse - (lessThanEqualsInteger n 0) - (delay (delay (constr 0 []))) - (delay - (delay - (constr 1 - [0, ((\x -> s s x) (subtractInteger n 1))])))))) + (case + (lessThanEqualsInteger n 0) + [ (delay (constr 1 [0, ((\x -> s s x) (subtractInteger n 1))])) + , (delay (constr 0 [])) ])) 1000))) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/map1.budget.golden b/plutus-tx-plugin/test/Budget/9.6/map1.budget.golden index ebc2fa51869..c371d2faf59 100644 --- a/plutus-tx-plugin/test/Budget/9.6/map1.budget.golden +++ b/plutus-tx-plugin/test/Budget/9.6/map1.budget.golden @@ -1,2 +1,2 @@ -({cpu: 267588667 -| mem: 714658}) \ No newline at end of file +({cpu: 248031571 +| mem: 641754}) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/map1.pir.golden b/plutus-tx-plugin/test/Budget/9.6/map1.pir.golden index 497054e561c..75611369f22 100644 --- a/plutus-tx-plugin/test/Budget/9.6/map1.pir.golden +++ b/plutus-tx-plugin/test/Budget/9.6/map1.pir.golden @@ -12,7 +12,7 @@ letrec !`$fEnumBool_$cenumFromTo` : integer -> integer -> List integer = \(x : integer) (lim : integer) -> Bool_match - (ifThenElse {Bool} (lessThanEqualsInteger x lim) False True) + (case Bool (lessThanEqualsInteger x lim) [True, False]) {all dead. List integer} (/\dead -> Nil {integer}) (/\dead -> @@ -60,11 +60,10 @@ let (Nothing {data}) (\(hd : pair data data) -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsData k (fstPair {data} {data} hd)) - True - False) + [False, True]) {all dead. list (pair data data) -> Maybe data} (/\dead -> \(ds : list (pair data data)) -> @@ -117,11 +116,10 @@ in nilCase (\(hd : pair data data) -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsData k (fstPair {data} {data} hd)) - True - False) + [False, True]) {all dead. list (pair data data) -> list (pair data data)} (/\dead -> mkCons {pair data data} (mkPairData k a)) @@ -145,11 +143,10 @@ in [] (\(hd : pair data data) -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsData k (fstPair {data} {data} hd)) - True - False) + [False, True]) {all dead. list (pair data data) -> list (pair data data)} (/\dead -> \(x : list (pair data data)) -> x) diff --git a/plutus-tx-plugin/test/Budget/9.6/map1.uplc.golden b/plutus-tx-plugin/test/Budget/9.6/map1.uplc.golden index 4bc2281015d..7a5c15a381e 100644 --- a/plutus-tx-plugin/test/Budget/9.6/map1.uplc.golden +++ b/plutus-tx-plugin/test/Budget/9.6/map1.uplc.golden @@ -12,46 +12,36 @@ , (lookup (\i -> iData i) unIData (addInteger 10 n) nt) , (lookup (\i -> iData i) unIData (addInteger 20 n) nt) , (lookup (\i -> iData i) unIData (addInteger 5 n) nt) ]) - (\`$dToData` - `$dUnsafeFromData` - ds - ds -> + (\`$dToData` `$dUnsafeFromData` ds ds -> force (case ((\k -> force - ((\s -> - s s) - (\s - arg -> + ((\s -> s s) + (\s arg -> delay (caseList' (constr 1 []) (\hd -> force - (force - (force - ifThenElse - (equalsData - k - (force (force fstPair) - hd)) - (delay - (delay - (\ds -> - constr 0 - [ (force - (force - sndPair) - hd) ]))) - (delay - (delay - (force - (s - s - (delay - (\x -> - x))))))))))) + (case + (equalsData + k + (force (force fstPair) + hd)) + [ (delay + (force + (s + s + (delay + (\x -> x))))) + , (delay + (\ds -> + constr 0 + [ (force + (force + sndPair) + hd) ])) ])))) (delay (\x -> x))) ds) (`$dToData` ds)) @@ -66,20 +56,17 @@ [] (\hd -> force - (force - (force ifThenElse - (equalsData - k - (force (force fstPair) hd)) - (delay (delay (\x -> x))) - (delay - (delay - (\eta -> - force mkCons - hd - (force - (s s (delay (\x -> x))) - eta))))))))) + (case + (equalsData + k + (force (force fstPair) hd)) + [ (delay + (\eta -> + force mkCons + hd + (force (s s (delay (\x -> x))) + eta))) + , (delay (\x -> x)) ])))) (delay (\x -> x)))) (iData (addInteger 5 n)) nt)) @@ -111,35 +98,31 @@ nilCase (\hd -> force - (force - (force - ifThenElse - (equalsData - k + (case + (equalsData + k + (force (force - (force - fstPair) - hd)) - (delay - (delay - (force - mkCons - (mkPairData - k - a)))) - (delay - (delay - (\eta -> - force - mkCons - hd - (force - (s - s - (delay - (\x -> - x))) - eta))))))))) + fstPair) + hd)) + [ (delay + (\eta -> + force + mkCons + hd + (force + (s + s + (delay + (\x -> + x))) + eta))) + , (delay + (force + mkCons + (mkPairData + k + a))) ])))) (delay (\x -> x))) ds) (force mkCons @@ -159,10 +142,9 @@ ((\s -> s s) (\s x lim -> force - (force - (force ifThenElse - (lessThanEqualsInteger x lim) - (delay - (delay - (constr 1 [x, ((\x -> s s x) (addInteger 1 x) lim)]))) - (delay (delay (constr 0 []))))))))) \ No newline at end of file + (case + (lessThanEqualsInteger x lim) + [ (delay (constr 0 [])) + , (delay + (constr 1 + [x, ((\x -> s s x) (addInteger 1 x) lim)])) ]))))) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/map2.budget.golden b/plutus-tx-plugin/test/Budget/9.6/map2.budget.golden index 42f9e8ec971..5e8ebe215a8 100644 --- a/plutus-tx-plugin/test/Budget/9.6/map2.budget.golden +++ b/plutus-tx-plugin/test/Budget/9.6/map2.budget.golden @@ -1,2 +1,2 @@ -({cpu: 126920515 -| mem: 398182}) \ No newline at end of file +({cpu: 120902947 +| mem: 375750}) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/map2.pir.golden b/plutus-tx-plugin/test/Budget/9.6/map2.pir.golden index 6712c0bfcb8..d7b446f5135 100644 --- a/plutus-tx-plugin/test/Budget/9.6/map2.pir.golden +++ b/plutus-tx-plugin/test/Budget/9.6/map2.pir.golden @@ -151,11 +151,10 @@ in (Nothing {data}) (\(hd : pair data data) -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsData k' (fstPair {data} {data} hd)) - True - False) + [False, True]) {all dead. list (pair data data) -> Maybe data} (/\dead -> \(ds : list (pair data data)) -> @@ -226,11 +225,10 @@ in False (\(hd : pair data data) -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsData k (fstPair {data} {data} hd)) - True - False) + [False, True]) {all dead. list (pair data data) -> Bool} (/\dead -> \(ds : list (pair data data)) -> True) (/\dead -> go) diff --git a/plutus-tx-plugin/test/Budget/9.6/map2.uplc.golden b/plutus-tx-plugin/test/Budget/9.6/map2.uplc.golden index 5fe2401a556..e63afb16ef4 100644 --- a/plutus-tx-plugin/test/Budget/9.6/map2.uplc.golden +++ b/plutus-tx-plugin/test/Budget/9.6/map2.uplc.golden @@ -38,28 +38,24 @@ [ ]) (\hd -> force - (force - (force - ifThenElse - (equalsData - k + (case + (equalsData + k + (force (force - (force - fstPair) - hd)) - (delay - (delay - (\ds -> - constr 0 - [ ]))) - (delay - (delay - (force - (s - s - (delay - (\x -> - x))))))))))) + fstPair) + hd)) + [ (delay + (force + (s + s + (delay + (\x -> + x))))) + , (delay + (\ds -> + constr 0 + [ ])) ])))) (delay (\x -> x))) @@ -117,31 +113,27 @@ (constr 1 []) (\hd -> force - (force - (force - ifThenElse - (equalsData - k' + (case + (equalsData + k' + (force (force - (force - fstPair) - hd)) - (delay - (delay - (\ds -> - constr 0 - [ (force - (force - sndPair) - hd) ]))) - (delay - (delay - (force - (s - s - (delay - (\x -> - x))))))))))) + fstPair) + hd)) + [ (delay + (force + (s + s + (delay + (\x -> + x))))) + , (delay + (\ds -> + constr 0 + [ (force + (force + sndPair) + hd) ])) ])))) (delay (\x -> x))) nt) [ (\r -> diff --git a/plutus-tx-plugin/test/Budget/9.6/map3.budget.golden b/plutus-tx-plugin/test/Budget/9.6/map3.budget.golden index d9d32c1fd6c..ea8b1242fff 100644 --- a/plutus-tx-plugin/test/Budget/9.6/map3.budget.golden +++ b/plutus-tx-plugin/test/Budget/9.6/map3.budget.golden @@ -1,2 +1,2 @@ -({cpu: 203202927 -| mem: 641180}) \ No newline at end of file +({cpu: 191355840 +| mem: 597017}) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/map3.pir.golden b/plutus-tx-plugin/test/Budget/9.6/map3.pir.golden index 9b7316238ca..4c48bdfb0ce 100644 --- a/plutus-tx-plugin/test/Budget/9.6/map3.pir.golden +++ b/plutus-tx-plugin/test/Budget/9.6/map3.pir.golden @@ -37,11 +37,10 @@ letrec nilCase (\(hd : pair data data) -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsData k (fstPair {data} {data} hd)) - True - False) + [False, True]) {all dead. list (pair data data) -> list (pair data data)} (/\dead -> mkCons {pair data data} (mkPairData k v)) @@ -95,11 +94,10 @@ let (Nothing {data}) (\(hd : pair data data) -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsData k (fstPair {data} {data} hd)) - True - False) + [False, True]) {all dead. list (pair data data) -> Maybe data} (/\dead -> \(ds : list (pair data data)) -> @@ -393,19 +391,19 @@ in !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. These integer integer} (/\dead -> This {integer} {integer} (unIData (headList {data} args))) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 1 index) True False) + (case Bool (equalsInteger 1 index) [False, True]) {all dead. These integer integer} (/\dead -> That {integer} {integer} (unIData (headList {data} args))) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 2 index) True False) + (case Bool (equalsInteger 2 index) [False, True]) {all dead. These integer integer} (/\dead -> These diff --git a/plutus-tx-plugin/test/Budget/9.6/map3.uplc.golden b/plutus-tx-plugin/test/Budget/9.6/map3.uplc.golden index 26b2e3f0b68..b63e6dd47f8 100644 --- a/plutus-tx-plugin/test/Budget/9.6/map3.uplc.golden +++ b/plutus-tx-plugin/test/Budget/9.6/map3.uplc.golden @@ -64,66 +64,54 @@ (\index -> (\args -> force - (force - (force - ifThenElse - (equalsInteger - 0 - index) - (delay - (delay - (constr 2 - [ (unIData - (force - headList - args)) ]))) - (delay - (delay - (force - (force - (force - ifThenElse - (equalsInteger - 1 - index) - (delay - (delay - (constr 0 - [ (unIData - (force - headList - args)) ]))) - (delay - (delay - (force - (force + (case + (equalsInteger + 0 + index) + [ (delay + (force + (case + (equalsInteger + 1 + index) + [ (delay + (force + (case + (equalsInteger + 2 + index) + [ (delay + ((\x -> + error) (force - ifThenElse - (equalsInteger - 2 - index) - (delay - (delay - (constr 1 - [ (unIData - (force - headList - args)) - , (unIData - (force - headList - (force - tailList - args))) ]))) - (delay - (delay - ((\x -> - error) - (force - trace - "PT1" - (constr 0 - [ ])))))))))))))))))) + trace + "PT1" + (constr 0 + [ ])))) + , (delay + (constr 1 + [ (unIData + (force + headList + args)) + , (unIData + (force + headList + (force + tailList + args))) ])) ]))) + , (delay + (constr 0 + [ (unIData + (force + headList + args)) ])) ]))) + , (delay + (constr 2 + [ (unIData + (force + headList + args)) ])) ])) (force (force sndPair) @@ -359,70 +347,53 @@ (constr 1 []) (\hd -> force - (force - (force ifThenElse - (equalsData k (force (force fstPair) hd)) - (delay - (delay - (\ds -> - constr 0 - [ (force (force sndPair) - hd) ]))) - (delay - (delay - (force - (s s (delay (\x -> x))))))))))) + (case + (equalsData k (force (force fstPair) hd)) + [ (delay (force (s s (delay (\x -> x))))) + , (delay + (\ds -> + constr 0 + [ (force (force sndPair) + hd) ])) ])))) (delay (\x -> x))))) - ((\s -> - s s) - (\s - xs - xs -> + ((\s -> s s) + (\s xs xs -> caseList' xs - (\hd - tl -> + (\hd tl -> (\v -> (\k -> (\eta -> (\nilCase -> force - ((\s -> - s s) - (\s - arg -> + ((\s -> s s) + (\s arg -> delay (caseList' nilCase (\hd -> force - (force - (force - ifThenElse - (equalsData - k - (force - (force fstPair) - hd)) - (delay - (delay - (force mkCons - (mkPairData - k - v)))) - (delay - (delay - (\eta -> - force - mkCons - hd - (force - (s - s - (delay - (\x -> - x))) - eta))))))))) + (case + (equalsData + k + (force (force fstPair) + hd)) + [ (delay + (\eta -> + force mkCons + hd + (force + (s + s + (delay + (\x -> + x))) + eta))) + , (delay + (force mkCons + (mkPairData + k + v))) ])))) (delay (\x -> x))) eta) (force mkCons (mkPairData k v) [])) diff --git a/plutus-tx-plugin/test/Budget/9.6/matchAsDataE.budget.golden b/plutus-tx-plugin/test/Budget/9.6/matchAsDataE.budget.golden index b9427c47577..ad8457943a8 100644 --- a/plutus-tx-plugin/test/Budget/9.6/matchAsDataE.budget.golden +++ b/plutus-tx-plugin/test/Budget/9.6/matchAsDataE.budget.golden @@ -1,2 +1,2 @@ -({cpu: 1228851 -| mem: 4562}) \ No newline at end of file +({cpu: 1040802 +| mem: 3861}) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/not-not.budget.golden b/plutus-tx-plugin/test/Budget/9.6/not-not.budget.golden index a82ae028aba..687f230ae22 100644 --- a/plutus-tx-plugin/test/Budget/9.6/not-not.budget.golden +++ b/plutus-tx-plugin/test/Budget/9.6/not-not.budget.golden @@ -1,2 +1,2 @@ -({cpu: 489439 -| mem: 2402}) \ No newline at end of file +({cpu: 301390 +| mem: 1701}) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/not-not.pir.golden b/plutus-tx-plugin/test/Budget/9.6/not-not.pir.golden index 9d9f0d13406..3c6d2da9d63 100644 --- a/plutus-tx-plugin/test/Budget/9.6/not-not.pir.golden +++ b/plutus-tx-plugin/test/Budget/9.6/not-not.pir.golden @@ -6,7 +6,7 @@ \(x : integer) -> Bool_match (Bool_match - (ifThenElse {Bool} (lessThanInteger 0 x) True False) + (case Bool (lessThanInteger 0 x) [False, True]) {all dead. Bool} (/\dead -> False) (/\dead -> True) diff --git a/plutus-tx-plugin/test/Budget/9.6/not-not.uplc.golden b/plutus-tx-plugin/test/Budget/9.6/not-not.uplc.golden index dc4df8a3ab5..b685840cffc 100644 --- a/plutus-tx-plugin/test/Budget/9.6/not-not.uplc.golden +++ b/plutus-tx-plugin/test/Budget/9.6/not-not.uplc.golden @@ -4,10 +4,8 @@ force (case (force - (force - (force ifThenElse - (lessThanInteger 0 x) - (delay (delay (constr 1 []))) - (delay (delay (constr 0 [])))))) + (case + (lessThanInteger 0 x) + [(delay (constr 0 [])), (delay (constr 1 []))])) [(delay (constr 1 [])), (delay (constr 0 []))])) 1)) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/notElemCheap.budget.golden b/plutus-tx-plugin/test/Budget/9.6/notElemCheap.budget.golden index 78391dbcf1a..a9d3f93c910 100644 --- a/plutus-tx-plugin/test/Budget/9.6/notElemCheap.budget.golden +++ b/plutus-tx-plugin/test/Budget/9.6/notElemCheap.budget.golden @@ -1,2 +1,2 @@ -({cpu: 944482 -| mem: 5202}) \ No newline at end of file +({cpu: 756433 +| mem: 4501}) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/notElemCheap.pir.golden b/plutus-tx-plugin/test/Budget/9.6/notElemCheap.pir.golden index ed2bf7f4892..d10c251ce0b 100644 --- a/plutus-tx-plugin/test/Budget/9.6/notElemCheap.pir.golden +++ b/plutus-tx-plugin/test/Budget/9.6/notElemCheap.pir.golden @@ -19,7 +19,7 @@ letrec (\(x : integer) (xs : List integer) -> /\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 1 x) True False) + (case Bool (equalsInteger 1 x) [False, True]) {all dead. Bool} (/\dead -> False) (/\dead -> go xs) diff --git a/plutus-tx-plugin/test/Budget/9.6/notElemCheap.uplc.golden b/plutus-tx-plugin/test/Budget/9.6/notElemCheap.uplc.golden index db9fda02a2b..b5c0b22f260 100644 --- a/plutus-tx-plugin/test/Budget/9.6/notElemCheap.uplc.golden +++ b/plutus-tx-plugin/test/Budget/9.6/notElemCheap.uplc.golden @@ -10,11 +10,9 @@ , (\x xs -> delay (force - (force - (force ifThenElse - (equalsInteger 1 x) - (delay (delay (constr 1 []))) - (delay (delay (s s xs))))))) ])) + (case + (equalsInteger 1 x) + [(delay (s s xs)), (delay (constr 1 []))]))) ])) (constr 1 [ 1 , (constr 1 diff --git a/plutus-tx-plugin/test/Budget/9.6/notElemExpensive.budget.golden b/plutus-tx-plugin/test/Budget/9.6/notElemExpensive.budget.golden index 524d1d54703..993ba537c95 100644 --- a/plutus-tx-plugin/test/Budget/9.6/notElemExpensive.budget.golden +++ b/plutus-tx-plugin/test/Budget/9.6/notElemExpensive.budget.golden @@ -1,2 +1,2 @@ -({cpu: 6147920 -| mem: 30520}) \ No newline at end of file +({cpu: 4267430 +| mem: 23510}) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/notElemExpensive.pir.golden b/plutus-tx-plugin/test/Budget/9.6/notElemExpensive.pir.golden index 6b8c94a91d8..87f74ef4226 100644 --- a/plutus-tx-plugin/test/Budget/9.6/notElemExpensive.pir.golden +++ b/plutus-tx-plugin/test/Budget/9.6/notElemExpensive.pir.golden @@ -19,7 +19,7 @@ letrec (\(x : integer) (xs : List integer) -> /\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 0 x) True False) + (case Bool (equalsInteger 0 x) [False, True]) {all dead. Bool} (/\dead -> False) (/\dead -> go xs) diff --git a/plutus-tx-plugin/test/Budget/9.6/notElemExpensive.uplc.golden b/plutus-tx-plugin/test/Budget/9.6/notElemExpensive.uplc.golden index 05dd8338af8..8b0e7018669 100644 --- a/plutus-tx-plugin/test/Budget/9.6/notElemExpensive.uplc.golden +++ b/plutus-tx-plugin/test/Budget/9.6/notElemExpensive.uplc.golden @@ -10,11 +10,9 @@ , (\x xs -> delay (force - (force - (force ifThenElse - (equalsInteger 0 x) - (delay (delay (constr 1 []))) - (delay (delay (s s xs))))))) ])) + (case + (equalsInteger 0 x) + [(delay (s s xs)), (delay (constr 1 []))]))) ])) (constr 1 [ 1 , (constr 1 diff --git a/plutus-tx-plugin/test/Budget/9.6/recursiveGte0.budget.golden b/plutus-tx-plugin/test/Budget/9.6/recursiveGte0.budget.golden index 88f0b3c7a62..407d9b5e293 100644 --- a/plutus-tx-plugin/test/Budget/9.6/recursiveGte0.budget.golden +++ b/plutus-tx-plugin/test/Budget/9.6/recursiveGte0.budget.golden @@ -1,2 +1,2 @@ -({cpu: 1431432986 -| mem: 6811602}) \ No newline at end of file +({cpu: 1087146937 +| mem: 5608901}) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/recursiveGte0.pir.golden b/plutus-tx-plugin/test/Budget/9.6/recursiveGte0.pir.golden index cb0947f7a1e..629dad832dc 100644 --- a/plutus-tx-plugin/test/Budget/9.6/recursiveGte0.pir.golden +++ b/plutus-tx-plugin/test/Budget/9.6/recursiveGte0.pir.golden @@ -12,7 +12,7 @@ letrec !go : integer -> List integer = \(n : integer) -> Bool_match - (ifThenElse {Bool} (lessThanEqualsInteger n 0) True False) + (case Bool (lessThanEqualsInteger n 0) [False, True]) {all dead. List integer} (/\dead -> Nil {integer}) (/\dead -> Cons {integer} 0 (go (subtractInteger n 1))) @@ -42,5 +42,5 @@ let in recursiveAll {integer} - (\(v : integer) -> ifThenElse {Bool} (lessThanInteger v 0) False True) + (\(v : integer) -> case Bool (lessThanInteger v 0) [True, False]) ls \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/recursiveGte0.uplc.golden b/plutus-tx-plugin/test/Budget/9.6/recursiveGte0.uplc.golden index 2f313d6f9ab..9402cc265b1 100644 --- a/plutus-tx-plugin/test/Budget/9.6/recursiveGte0.uplc.golden +++ b/plutus-tx-plugin/test/Budget/9.6/recursiveGte0.uplc.golden @@ -4,11 +4,7 @@ (\recursiveAll -> (\ls -> force recursiveAll - (\v -> - force ifThenElse - (lessThanInteger v 0) - (constr 1 []) - (constr 0 [])) + (\v -> case (lessThanInteger v 0) [(constr 0 []), (constr 1 [])]) ls) (go 1000)) ((\s -> s s) @@ -33,11 +29,7 @@ ((\s -> s s) (\s n -> force - (force - (force ifThenElse - (lessThanEqualsInteger n 0) - (delay (delay (constr 0 []))) - (delay - (delay - (constr 1 - [0, ((\x -> s s x) (subtractInteger n 1))]))))))))) \ No newline at end of file + (case + (lessThanEqualsInteger n 0) + [ (delay (constr 1 [0, ((\x -> s s x) (subtractInteger n 1))])) + , (delay (constr 0 [])) ]))))) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/recursiveLte0.budget.golden b/plutus-tx-plugin/test/Budget/9.6/recursiveLte0.budget.golden index 02981da6ab5..6ed3c9961d7 100644 --- a/plutus-tx-plugin/test/Budget/9.6/recursiveLte0.budget.golden +++ b/plutus-tx-plugin/test/Budget/9.6/recursiveLte0.budget.golden @@ -1,2 +1,2 @@ -({cpu: 1429979986 -| mem: 6811602}) \ No newline at end of file +({cpu: 1085693937 +| mem: 5608901}) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/recursiveLte0.pir.golden b/plutus-tx-plugin/test/Budget/9.6/recursiveLte0.pir.golden index b2e44075448..225a32d499f 100644 --- a/plutus-tx-plugin/test/Budget/9.6/recursiveLte0.pir.golden +++ b/plutus-tx-plugin/test/Budget/9.6/recursiveLte0.pir.golden @@ -12,7 +12,7 @@ letrec !go : integer -> List integer = \(n : integer) -> Bool_match - (ifThenElse {Bool} (lessThanEqualsInteger n 0) True False) + (case Bool (lessThanEqualsInteger n 0) [False, True]) {all dead. List integer} (/\dead -> Nil {integer}) (/\dead -> Cons {integer} 0 (go (subtractInteger n 1))) @@ -42,5 +42,5 @@ let in recursiveAll {integer} - (\(v : integer) -> ifThenElse {Bool} (lessThanEqualsInteger v 0) True False) + (\(v : integer) -> case Bool (lessThanEqualsInteger v 0) [False, True]) ls \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/recursiveLte0.uplc.golden b/plutus-tx-plugin/test/Budget/9.6/recursiveLte0.uplc.golden index 6f71de6e069..7c79f1831ee 100644 --- a/plutus-tx-plugin/test/Budget/9.6/recursiveLte0.uplc.golden +++ b/plutus-tx-plugin/test/Budget/9.6/recursiveLte0.uplc.golden @@ -5,10 +5,9 @@ (\ls -> force recursiveAll (\v -> - force ifThenElse + case (lessThanEqualsInteger v 0) - (constr 0 []) - (constr 1 [])) + [(constr 1 []), (constr 0 [])]) ls) (go 1000)) ((\s -> s s) @@ -33,11 +32,7 @@ ((\s -> s s) (\s n -> force - (force - (force ifThenElse - (lessThanEqualsInteger n 0) - (delay (delay (constr 0 []))) - (delay - (delay - (constr 1 - [0, ((\x -> s s x) (subtractInteger n 1))]))))))))) \ No newline at end of file + (case + (lessThanEqualsInteger n 0) + [ (delay (constr 1 [0, ((\x -> s s x) (subtractInteger n 1))])) + , (delay (constr 0 [])) ]))))) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/show.budget.golden b/plutus-tx-plugin/test/Budget/9.6/show.budget.golden index 7b96e5097a8..3b93f621425 100644 --- a/plutus-tx-plugin/test/Budget/9.6/show.budget.golden +++ b/plutus-tx-plugin/test/Budget/9.6/show.budget.golden @@ -1,2 +1,2 @@ -({cpu: 1408693555 -| mem: 6140324}) \ No newline at end of file +({cpu: 1116089311 +| mem: 5049568}) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/show.pir.golden b/plutus-tx-plugin/test/Budget/9.6/show.pir.golden index 68f53f7af40..09b96057603 100644 --- a/plutus-tx-plugin/test/Budget/9.6/show.pir.golden +++ b/plutus-tx-plugin/test/Budget/9.6/show.pir.golden @@ -15,7 +15,7 @@ letrec !x : integer = quotientInteger n 10 in Bool_match - (ifThenElse {Bool} (equalsInteger 0 x) True False) + (case Bool (equalsInteger 0 x) [False, True]) {all dead. List integer} (/\dead -> Cons {integer} (remainderInteger n 10) acc) (/\dead -> go (Cons {integer} (remainderInteger n 10) acc) x) @@ -40,88 +40,78 @@ letrec Cons {string} (Bool_match - (ifThenElse {Bool} (equalsInteger 0 x) True False) + (case Bool (equalsInteger 0 x) [False, True]) {all dead. string} (/\dead -> "0") (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 1 x) True False) + (case Bool (equalsInteger 1 x) [False, True]) {all dead. string} (/\dead -> "1") (/\dead -> Bool_match - (ifThenElse - {Bool} - (equalsInteger 2 x) - True - False) + (case Bool (equalsInteger 2 x) [False, True]) {all dead. string} (/\dead -> "2") (/\dead -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 3 x) - True - False) + [False, True]) {all dead. string} (/\dead -> "3") (/\dead -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 4 x) - True - False) + [False, True]) {all dead. string} (/\dead -> "4") (/\dead -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 5 x) - True - False) + [False, True]) {all dead. string} (/\dead -> "5") (/\dead -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 6 x) - True - False) + [False, True]) {all dead. string} (/\dead -> "6") (/\dead -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 7 x) - True - False) + [False, True]) {all dead. string} (/\dead -> "7") (/\dead -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 8 x) - True - False) + [False, True]) {all dead. string} (/\dead -> "8") (/\dead -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 9 x) - True - False) + [ False + , True ]) {string} "9" "") @@ -142,7 +132,7 @@ letrec integer -> integer -> List string -> List string = \(p : integer) (n : integer) -> Bool_match - (ifThenElse {Bool} (lessThanInteger n 0) True False) + (case Bool (lessThanInteger n 0) [False, True]) {all dead. List string -> List string} (/\dead -> \(eta : List string) -> @@ -160,52 +150,46 @@ let !toHex : integer -> List string -> List string = \(x : integer) -> Bool_match - (ifThenElse {Bool} (lessThanEqualsInteger x 9) True False) + (case Bool (lessThanEqualsInteger x 9) [False, True]) {all dead. List string -> List string} (/\dead -> `$fShowBuiltinByteString_$cshowsPrec` 0 x) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 10 x) True False) + (case Bool (equalsInteger 10 x) [False, True]) {all dead. List string -> List string} (/\dead -> \(ds : List string) -> Cons {string} "a" ds) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 11 x) True False) + (case Bool (equalsInteger 11 x) [False, True]) {all dead. List string -> List string} (/\dead -> \(ds : List string) -> Cons {string} "b" ds) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 12 x) True False) + (case Bool (equalsInteger 12 x) [False, True]) {all dead. List string -> List string} (/\dead -> \(ds : List string) -> Cons {string} "c" ds) (/\dead -> Bool_match - (ifThenElse - {Bool} - (equalsInteger 13 x) - True - False) + (case Bool (equalsInteger 13 x) [False, True]) {all dead. List string -> List string} (/\dead -> \(ds : List string) -> Cons {string} "d" ds) (/\dead -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 14 x) - True - False) + [False, True]) {all dead. List string -> List string} (/\dead -> \(ds : List string) -> Cons {string} "e" ds) (/\dead -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 15 x) - True - False) + [False, True]) {List string -> List string} (\(ds : List string) -> Cons {string} "f" ds) @@ -241,6 +225,10 @@ letrec (acc eta)) {all dead. dead} in +let + !ifThenElse : all a. bool -> a -> a -> a + = /\a -> \(b : bool) (x : a) (y : a) -> case a b [y, x] +in letrec !`$fEnumBool_$cenumFromTo` : integer -> integer -> List integer = \(x : integer) (lim : integer) -> @@ -268,7 +256,7 @@ letrec (\(y : string) (ys : List string) -> /\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 1 ds) True False) + (case Bool (equalsInteger 1 ds) [False, True]) {all dead. Tuple2 (List string) (List string)} (/\dead -> Tuple2 @@ -330,11 +318,7 @@ letrec !n : integer = divideInteger (go ds) 2 in Bool_match - (ifThenElse - {Bool} - (lessThanEqualsInteger n 0) - True - False) + (case Bool (lessThanEqualsInteger n 0) [False, True]) {all dead. Tuple2 (List string) (List string)} (/\dead -> Tuple2 {List string} {List string} (Nil {string}) ds) diff --git a/plutus-tx-plugin/test/Budget/9.6/show.uplc.golden b/plutus-tx-plugin/test/Budget/9.6/show.uplc.golden index 82881c473c4..7d8adcc03ce 100644 --- a/plutus-tx-plugin/test/Budget/9.6/show.uplc.golden +++ b/plutus-tx-plugin/test/Budget/9.6/show.uplc.golden @@ -123,13 +123,11 @@ (constr 0 []))) d)) (force trace - (force - (force ifThenElse - (lessThanEqualsInteger - c - 0) - (delay "False") - (delay "True"))) + (case + (lessThanEqualsInteger + c + 0) + ["True", "False"]) c)) (force trace (concatBuiltinStrings @@ -171,23 +169,19 @@ (case ((\n -> force - (force - (force - ifThenElse - (lessThanEqualsInteger - n - 0) - (delay - (delay - (constr 0 - [ (constr 0 - [ ]) - , ds ]))) - (delay - (delay - (go - n - ds)))))) + (case + (lessThanEqualsInteger + n + 0) + [ (delay + (go + n + ds)) + , (delay + (constr 0 + [ (constr 0 + [ ]) + , ds ])) ])) (divideInteger (go ds) 2)) @@ -204,61 +198,48 @@ case ds [0, (\ds xs -> addInteger 1 (s s xs))]))) - ((\s -> - s s) - (\s - ds - ds -> + ((\s -> s s) + (\s ds ds -> force (case ds [ (delay (constr 0 [(constr 0 []), (constr 0 [])])) - , (\y - ys -> + , (\y ys -> delay (force - (force - (force - ifThenElse - (equalsInteger 1 ds) - (delay - (delay - (constr 0 - [ (constr 1 - [ y - , (constr 0 - []) ]) - , ys ]))) - (delay - (delay - (case - ((\x -> s s x) - (subtractInteger - ds - 1) - ys) - [ (\zs - ws -> - constr 0 - [ (constr 1 - [y, zs]) - , ws ]) ]))))))) ])))) + (case + (equalsInteger 1 ds) + [ (delay + (case + ((\x -> s s x) + (subtractInteger + ds + 1) + ys) + [ (\zs ws -> + constr 0 + [ (constr 1 + [y, zs]) + , ws ]) ])) + , (delay + (constr 0 + [ (constr 1 + [y, (constr 0 [])]) + , ys ])) ]))) ])))) ((\s -> s s) (\s x lim -> force - (force - (force ifThenElse - (lessThanEqualsInteger x lim) - (delay - (delay - (constr 1 - [ x - , ((\x -> s s x) - (addInteger 1 x) - lim) ]))) - (delay (delay (constr 0 [])))))))) + (case + (lessThanEqualsInteger x lim) + [ (delay (constr 0 [])) + , (delay + (constr 1 + [ x + , ((\x -> s s x) + (addInteger 1 x) + lim) ])) ])))) ((\s -> s s) (\s @@ -283,109 +264,77 @@ (s s xs))) ])))) (\x -> force - (force - (force - ifThenElse - (lessThanEqualsInteger x 9) - (delay - (delay - (`$fShowBuiltinByteString_$cshowsPrec` 0 x))) - (delay - (delay - (force - (force - (force - ifThenElse - (equalsInteger 10 x) - (delay - (delay (\ds -> constr 1 ["a", ds]))) - (delay - (delay - (force + (case + (lessThanEqualsInteger x 9) + [ (delay + (force + (case + (equalsInteger 10 x) + [ (delay + (force + (case + (equalsInteger 11 x) + [ (delay (force - (force - ifThenElse - (equalsInteger 11 x) - (delay - (delay - (\ds -> - constr 1 - ["b", ds]))) - (delay - (delay - (force - (force - (force - ifThenElse - (equalsInteger - 12 - x) - (delay - (delay - (\ds -> - constr 1 - [ "c" - , ds ]))) - (delay - (delay - (force - (force - (force - ifThenElse + (case + (equalsInteger 12 x) + [ (delay + (force + (case + (equalsInteger + 13 + x) + [ (delay + (force + (case + (equalsInteger + 14 + x) + [ (delay + (case (equalsInteger - 13 + 15 x) - (delay - (delay - (\ds -> - constr 1 - [ "d" - , ds ]))) - (delay - (delay - (force - (force - (force - ifThenElse - (equalsInteger - 14 - x) - (delay - (delay - (\ds -> - constr 1 - [ "e" - , ds ]))) - (delay - (delay - (force - (force - ifThenElse - (equalsInteger - 15 - x) - (delay - (\ds -> - constr 1 - [ "f" - , ds ])) - (delay - (\ds -> - constr 1 - [ "" - , ds ]))))))))))))))))))))))))))))))))))) + [ (\ds -> + constr 1 + [ "" + , ds ]) + , (\ds -> + constr 1 + [ "f" + , ds ]) ])) + , (delay + (\ds -> + constr 1 + [ "e" + , ds ])) ]))) + , (delay + (\ds -> + constr 1 + [ "d" + , ds ])) ]))) + , (delay + (\ds -> + constr 1 + [ "c" + , ds ])) ]))) + , (delay + (\ds -> + constr 1 ["b", ds])) ]))) + , (delay (\ds -> constr 1 ["a", ds])) ]))) + , (delay + (`$fShowBuiltinByteString_$cshowsPrec` 0 x)) ]))) ((\s -> s s) (\s p n -> force - (force - (force ifThenElse - (lessThanInteger n 0) - (delay - (delay - (\eta -> - constr 1 - ["-", (s s p (subtractInteger 0 n) eta)]))) - (delay (delay (go (go (constr 0 []) n))))))))) + (case + (lessThanInteger n 0) + [ (delay (go (go (constr 0 []) n))) + , (delay + (\eta -> + constr 1 + [ "-" + , (s s p (subtractInteger 0 n) eta) ])) ])))) ((\s -> s s) (\s @@ -401,128 +350,88 @@ eta -> constr 1 [ (force - (force - (force - ifThenElse - (equalsInteger 0 x) - (delay (delay "0")) - (delay - (delay - (force - (force - (force - ifThenElse - (equalsInteger 1 x) - (delay (delay "1")) - (delay - (delay - (force + (case + (equalsInteger 0 x) + [ (delay + (force + (case + (equalsInteger 1 x) + [ (delay + (force + (case + (equalsInteger + 2 + x) + [ (delay (force - (force - ifThenElse + (case (equalsInteger - 2 + 3 x) - (delay - (delay - "2")) - (delay - (delay - (force - (force - (force - ifThenElse - (equalsInteger - 3 - x) - (delay - (delay - "3")) - (delay - (delay - (force - (force + [ (delay + (force + (case + (equalsInteger + 4 + x) + [ (delay + (force + (case + (equalsInteger + 5 + x) + [ (delay (force - ifThenElse - (equalsInteger - 4 - x) - (delay - (delay - "4")) - (delay - (delay - (force - (force - (force - ifThenElse - (equalsInteger - 5 - x) - (delay - (delay - "5")) - (delay - (delay - (force - (force - (force - ifThenElse - (equalsInteger - 6 - x) - (delay - (delay - "6")) - (delay - (delay - (force - (force - (force - ifThenElse - (equalsInteger - 7 - x) - (delay - (delay - "7")) - (delay - (delay - (force - (force - (force - ifThenElse - (equalsInteger - 8 - x) - (delay - (delay - "8")) - (delay - (delay - (force - (force - ifThenElse - (equalsInteger - 9 - x) - (delay - "9") - (delay - "")))))))))))))))))))))))))))))))))))))))))))))))) + (case + (equalsInteger + 6 + x) + [ (delay + (force + (case + (equalsInteger + 7 + x) + [ (delay + (force + (case + (equalsInteger + 8 + x) + [ (delay + (case + (equalsInteger + 9 + x) + [ "" + , "9" ])) + , (delay + "8") ]))) + , (delay + "7") ]))) + , (delay + "6") ]))) + , (delay + "5") ]))) + , (delay + "4") ]))) + , (delay + "3") ]))) + , (delay + "2") ]))) + , (delay "1") ]))) + , (delay "0") ])) , (acc eta) ]) (s s xs))) ])))) ((\s -> s s) (\s acc n -> (\x -> force - (force - (force ifThenElse - (equalsInteger 0 x) - (delay (delay (constr 1 [(remainderInteger n 10), acc]))) - (delay - (delay - ((\x -> s s x) - (constr 1 [(remainderInteger n 10), acc]) - x)))))) + (case + (equalsInteger 0 x) + [ (delay + ((\x -> s s x) + (constr 1 [(remainderInteger n 10), acc]) + x)) + , (delay (constr 1 [(remainderInteger n 10), acc])) ])) (quotientInteger n 10))))) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/sumAtIndices.pir.golden b/plutus-tx-plugin/test/Budget/9.6/sumAtIndices.pir.golden index 1ac6c537ec8..b96bc7e6e21 100644 --- a/plutus-tx-plugin/test/Budget/9.6/sumAtIndices.pir.golden +++ b/plutus-tx-plugin/test/Budget/9.6/sumAtIndices.pir.golden @@ -1,10 +1,10 @@ -\(d-1579 : data) -> +\(d-1586 : data) -> let - !nt-1580 : list data = tailList {data} (unListData d-1579) - !s-1581 : integer = unIData (headList {data} nt-1580) - !nt-1582 : list data - = tailList {data} (tailList {data} (tailList {data} nt-1580)) - !s-1583 : integer = unIData (headList {data} nt-1582) - !s-1584 : integer = unIData (headList {data} (tailList {data} nt-1582)) + !nt-1587 : list data = tailList {data} (unListData d-1586) + !s-1588 : integer = unIData (headList {data} nt-1587) + !nt-1589 : list data + = tailList {data} (tailList {data} (tailList {data} nt-1587)) + !s-1590 : integer = unIData (headList {data} nt-1589) + !s-1591 : integer = unIData (headList {data} (tailList {data} nt-1589)) in - addInteger (addInteger s-1581 s-1583) s-1584 \ No newline at end of file + addInteger (addInteger s-1588 s-1590) s-1591 \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/sumL.budget.golden b/plutus-tx-plugin/test/Budget/9.6/sumL.budget.golden index c5b6629db4d..ecefdb37156 100644 --- a/plutus-tx-plugin/test/Budget/9.6/sumL.budget.golden +++ b/plutus-tx-plugin/test/Budget/9.6/sumL.budget.golden @@ -1,2 +1,2 @@ -({cpu: 1203221986 -| mem: 5511102}) \ No newline at end of file +({cpu: 1014984937 +| mem: 4809401}) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/sumL.pir.golden b/plutus-tx-plugin/test/Budget/9.6/sumL.pir.golden index 277ae9b0495..c5f1956105d 100644 --- a/plutus-tx-plugin/test/Budget/9.6/sumL.pir.golden +++ b/plutus-tx-plugin/test/Budget/9.6/sumL.pir.golden @@ -24,7 +24,7 @@ letrec !`$fEnumBool_$cenumFromTo` : integer -> integer -> List integer = \(x : integer) (lim : integer) -> Bool_match - (ifThenElse {Bool} (lessThanEqualsInteger x lim) False True) + (case Bool (lessThanEqualsInteger x lim) [True, False]) {all dead. List integer} (/\dead -> Nil {integer}) (/\dead -> diff --git a/plutus-tx-plugin/test/Budget/9.6/sumL.uplc.golden b/plutus-tx-plugin/test/Budget/9.6/sumL.uplc.golden index 8150e94d342..b7d004b74d7 100644 --- a/plutus-tx-plugin/test/Budget/9.6/sumL.uplc.golden +++ b/plutus-tx-plugin/test/Budget/9.6/sumL.uplc.golden @@ -5,14 +5,12 @@ ((\s -> s s) (\s x lim -> force - (force - (force ifThenElse - (lessThanEqualsInteger x lim) - (delay - (delay - (constr 1 - [x, ((\x -> s s x) (addInteger 1 x) lim)]))) - (delay (delay (constr 0 [])))))) + (case + (lessThanEqualsInteger x lim) + [ (delay (constr 0 [])) + , (delay + (constr 1 + [x, ((\x -> s s x) (addInteger 1 x) lim)])) ])) 1 1000)) ((\s -> s s) diff --git a/plutus-tx-plugin/test/Budget/9.6/sumR.budget.golden b/plutus-tx-plugin/test/Budget/9.6/sumR.budget.golden index cb51b3a52a3..ebadae05336 100644 --- a/plutus-tx-plugin/test/Budget/9.6/sumR.budget.golden +++ b/plutus-tx-plugin/test/Budget/9.6/sumR.budget.golden @@ -1,2 +1,2 @@ -({cpu: 1107077986 -| mem: 4910202}) \ No newline at end of file +({cpu: 918840937 +| mem: 4208501}) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/sumR.pir.golden b/plutus-tx-plugin/test/Budget/9.6/sumR.pir.golden index 32f4dfa023b..e07ca7b8878 100644 --- a/plutus-tx-plugin/test/Budget/9.6/sumR.pir.golden +++ b/plutus-tx-plugin/test/Budget/9.6/sumR.pir.golden @@ -23,7 +23,7 @@ letrec !`$fEnumBool_$cenumFromTo` : integer -> integer -> List integer = \(x : integer) (lim : integer) -> Bool_match - (ifThenElse {Bool} (lessThanEqualsInteger x lim) False True) + (case Bool (lessThanEqualsInteger x lim) [True, False]) {all dead. List integer} (/\dead -> Nil {integer}) (/\dead -> diff --git a/plutus-tx-plugin/test/Budget/9.6/sumR.uplc.golden b/plutus-tx-plugin/test/Budget/9.6/sumR.uplc.golden index d9d5c14b273..80d913d7951 100644 --- a/plutus-tx-plugin/test/Budget/9.6/sumR.uplc.golden +++ b/plutus-tx-plugin/test/Budget/9.6/sumR.uplc.golden @@ -6,12 +6,10 @@ ((\s -> s s) (\s x lim -> force - (force - (force ifThenElse - (lessThanEqualsInteger x lim) - (delay - (delay - (constr 1 [x, ((\x -> s s x) (addInteger 1 x) lim)]))) - (delay (delay (constr 0 [])))))) + (case + (lessThanEqualsInteger x lim) + [ (delay (constr 0 [])) + , (delay + (constr 1 [x, ((\x -> s s x) (addInteger 1 x) lim)])) ])) 1 1000))) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/toFromData.budget.golden b/plutus-tx-plugin/test/Budget/9.6/toFromData.budget.golden index 44b3805af96..e291fe95590 100644 --- a/plutus-tx-plugin/test/Budget/9.6/toFromData.budget.golden +++ b/plutus-tx-plugin/test/Budget/9.6/toFromData.budget.golden @@ -1,2 +1,2 @@ -({cpu: 8236913 -| mem: 30040}) \ No newline at end of file +({cpu: 6732521 +| mem: 24432}) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/toFromData.pir.golden b/plutus-tx-plugin/test/Budget/9.6/toFromData.pir.golden index 6a8d4b55809..4977a507caf 100644 --- a/plutus-tx-plugin/test/Budget/9.6/toFromData.pir.golden +++ b/plutus-tx-plugin/test/Budget/9.6/toFromData.pir.golden @@ -92,12 +92,12 @@ in !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. Either integer b} (/\dead -> Left {integer} {b} (`$dUnsafeFromData` (headList {data} args))) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 1 index) True False) + (case Bool (equalsInteger 1 index) [False, True]) {all dead. Either integer b} (/\dead -> Right {integer} {b} (`$dUnsafeFromData` (headList {data} args))) @@ -115,12 +115,12 @@ in !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 1 index) True False) + (case Bool (equalsInteger 1 index) [False, True]) {all dead. Maybe a} (/\dead -> Nothing {a}) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. Maybe a} (/\dead -> Just {a} (`$dUnsafeFromData` (headList {data} args))) (/\dead -> traceError {Maybe a} "PT1") @@ -133,7 +133,7 @@ in !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. Tuple3 Bool integer Bool} (/\dead -> let @@ -150,12 +150,12 @@ in !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. Bool} (/\dead -> False) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 1 index) True False) + (case Bool (equalsInteger 1 index) [False, True]) {all dead. Bool} (/\dead -> True) (/\dead -> traceError {Bool} "PT1") @@ -169,12 +169,12 @@ in !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. Bool} (/\dead -> False) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 1 index) True False) + (case Bool (equalsInteger 1 index) [False, True]) {all dead. Bool} (/\dead -> True) (/\dead -> traceError {Bool} "PT1") diff --git a/plutus-tx-plugin/test/Budget/9.6/toFromData.uplc.golden b/plutus-tx-plugin/test/Budget/9.6/toFromData.uplc.golden index 2e9f7662ae1..6c40e235c72 100644 --- a/plutus-tx-plugin/test/Budget/9.6/toFromData.uplc.golden +++ b/plutus-tx-plugin/test/Budget/9.6/toFromData.uplc.golden @@ -5,187 +5,144 @@ (\index -> (\args -> force - (force - (force - ifThenElse - (equalsInteger 0 index) - (delay - (delay (constr 0 [(unIData (force headList args))]))) - (delay - (delay - (force - (force - (force - ifThenElse - (equalsInteger 1 index) - (delay - (delay - (constr 1 - [ ((\tup -> - (\index -> - (\args -> - force + (case + (equalsInteger 0 index) + [ (delay + (force + (case + (equalsInteger 1 index) + [ (delay (traceError "PT1")) + , (delay + (constr 1 + [ ((\tup -> + (\index -> + (\args -> + force + (case + (equalsInteger 1 index) + [ (delay (force - (force - ifThenElse + (case (equalsInteger - 1 + 0 index) - (delay - (delay - (constr 1 - [ ]))) - (delay - (delay - (force - (force - (force - ifThenElse - (equalsInteger - 0 - index) - (delay - (delay - (constr 0 - [ ((\tup -> - (\index -> - (\args -> - force - (force + [ (delay + (traceError + "PT1")) + , (delay + (constr 0 + [ ((\tup -> + (\index -> + (\args -> + force + (case + (equalsInteger + 0 + index) + [ (delay + (traceError + "PT1")) + , (delay + ((\l -> + constr 0 + [ ((\tup -> + (\index -> + (\args -> + force + (case + (equalsInteger + 0 + index) + [ (delay + (force + (case + (equalsInteger + 1 + index) + [ (delay + (traceError + "PT1")) + , (delay + (constr 0 + [ ])) ]))) + , (delay + (constr 1 + [ ])) ])) + (force + (force + sndPair) + tup)) + (force + (force + fstPair) + tup)) + (unConstrData + (force + headList + args))) + , (unIData (force - ifThenElse - (equalsInteger - 0 - index) - (delay - (delay - ((\l -> - constr 0 - [ ((\tup -> - (\index -> - (\args -> - force - (force - (force - ifThenElse - (equalsInteger - 0 - index) - (delay - (delay - (constr 1 - [ ]))) - (delay - (delay - (force - (force - (force - ifThenElse - (equalsInteger - 1 - index) - (delay - (delay - (constr 0 - [ ]))) - (delay - (delay - (traceError - "PT1"))))))))))) - (force - (force - sndPair) - tup)) - (force - (force - fstPair) - tup)) - (unConstrData - (force - headList - args))) - , (unIData - (force - headList - l)) - , ((\tup -> - (\index -> - (\args -> - force - (force - (force - ifThenElse - (equalsInteger - 0 - index) - (delay - (delay - (constr 1 - [ ]))) - (delay - (delay - (force - (force - (force - ifThenElse - (equalsInteger - 1 - index) - (delay - (delay - (constr 0 - [ ]))) - (delay - (delay - (traceError - "PT1"))))))))))) - (force - (force - sndPair) - tup)) - (force - (force - fstPair) - tup)) - (unConstrData - (force - headList - (force - tailList - l)))) ]) - (force - tailList - args)))) - (delay - (delay - (traceError - "PT1")))))) - (force - (force - sndPair) - tup)) - (force - (force - fstPair) - tup)) - (unConstrData - (force - headList - args))) ]))) - (delay - (delay - (traceError - "PT1"))))))))))) - (force - (force sndPair) - tup)) - (force (force fstPair) - tup)) - (unConstrData - (force headList - args))) ]))) - (delay - (delay (traceError "PT1"))))))))))) + headList + l)) + , ((\tup -> + (\index -> + (\args -> + force + (case + (equalsInteger + 0 + index) + [ (delay + (force + (case + (equalsInteger + 1 + index) + [ (delay + (traceError + "PT1")) + , (delay + (constr 0 + [ ])) ]))) + , (delay + (constr 1 + [ ])) ])) + (force + (force + sndPair) + tup)) + (force + (force + fstPair) + tup)) + (unConstrData + (force + headList + (force + tailList + l)))) ]) + (force + tailList + args))) ])) + (force + (force + sndPair) + tup)) + (force + (force + fstPair) + tup)) + (unConstrData + (force + headList + args))) ])) ]))) + , (delay + (constr 1 [])) ])) + (force (force sndPair) tup)) + (force (force fstPair) tup)) + (unConstrData + (force headList args))) ])) ]))) + , (delay (constr 0 [(unIData (force headList args))])) ])) (force (force sndPair) tup)) (force (force fstPair) tup)) (unConstrData diff --git a/plutus-tx-plugin/test/DataList/Budget/9.6/any.budget.golden b/plutus-tx-plugin/test/DataList/Budget/9.6/any.budget.golden index 798b25767ce..bbbf068f34c 100644 --- a/plutus-tx-plugin/test/DataList/Budget/9.6/any.budget.golden +++ b/plutus-tx-plugin/test/DataList/Budget/9.6/any.budget.golden @@ -1,2 +1,2 @@ -({cpu: 9439220 -| mem: 38140}) \ No newline at end of file +({cpu: 7934828 +| mem: 32532}) \ No newline at end of file diff --git a/plutus-tx-plugin/test/DataList/Budget/9.6/any.pir.golden b/plutus-tx-plugin/test/DataList/Budget/9.6/any.pir.golden index 36dae80421c..243d0fe62dd 100644 --- a/plutus-tx-plugin/test/DataList/Budget/9.6/any.pir.golden +++ b/plutus-tx-plugin/test/DataList/Budget/9.6/any.pir.golden @@ -17,7 +17,7 @@ letrec !eta : list data = tailList {data} ds in Bool_match - (ifThenElse {Bool} (lessThanInteger (unIData x) 8) False True) + (case Bool (lessThanInteger (unIData x) 8) [True, False]) {all dead. Bool} (/\dead -> True) (/\dead -> go eta) diff --git a/plutus-tx-plugin/test/DataList/Budget/9.6/any.uplc.golden b/plutus-tx-plugin/test/DataList/Budget/9.6/any.uplc.golden index 3e5802f5f16..c1a736730c0 100644 --- a/plutus-tx-plugin/test/DataList/Budget/9.6/any.uplc.golden +++ b/plutus-tx-plugin/test/DataList/Budget/9.6/any.uplc.golden @@ -11,10 +11,8 @@ ((\x -> (\eta -> force - (force - (force ifThenElse - (lessThanInteger (unIData x) 8) - (delay (delay (s s eta))) - (delay (delay (constr 0 [])))))) + (case + (lessThanInteger (unIData x) 8) + [(delay (constr 0 [])), (delay (s s eta))])) (force tailList ds)) (force headList ds)))))))) \ No newline at end of file diff --git a/plutus-tx-plugin/test/DataList/Budget/9.6/elem.budget.golden b/plutus-tx-plugin/test/DataList/Budget/9.6/elem.budget.golden index 97dc95fce4a..63fc3097abe 100644 --- a/plutus-tx-plugin/test/DataList/Budget/9.6/elem.budget.golden +++ b/plutus-tx-plugin/test/DataList/Budget/9.6/elem.budget.golden @@ -1,2 +1,2 @@ -({cpu: 16931292 -| mem: 36284}) \ No newline at end of file +({cpu: 15426900 +| mem: 30676}) \ No newline at end of file diff --git a/plutus-tx-plugin/test/DataList/Budget/9.6/elem.pir.golden b/plutus-tx-plugin/test/DataList/Budget/9.6/elem.pir.golden index 63a722bdf4d..2e3106846ef 100644 --- a/plutus-tx-plugin/test/DataList/Budget/9.6/elem.pir.golden +++ b/plutus-tx-plugin/test/DataList/Budget/9.6/elem.pir.golden @@ -17,7 +17,7 @@ letrec !t : list data = tailList {data} xs in Bool_match - (ifThenElse {Bool} (equalsData (I 8) h) True False) + (case Bool (equalsData (I 8) h) [False, True]) {all dead. Bool} (/\dead -> True) (/\dead -> go t) diff --git a/plutus-tx-plugin/test/DataList/Budget/9.6/elem.uplc.golden b/plutus-tx-plugin/test/DataList/Budget/9.6/elem.uplc.golden index c65c1ac3946..205ccd00eb5 100644 --- a/plutus-tx-plugin/test/DataList/Budget/9.6/elem.uplc.golden +++ b/plutus-tx-plugin/test/DataList/Budget/9.6/elem.uplc.golden @@ -11,10 +11,8 @@ ((\h -> (\t -> force - (force - (force ifThenElse - (equalsData (I 8) h) - (delay (delay (constr 0 []))) - (delay (delay (s s t)))))) + (case + (equalsData (I 8) h) + [(delay (s s t)), (delay (constr 0 []))])) (force tailList xs)) (force headList xs)))))))) \ No newline at end of file diff --git a/plutus-tx-plugin/test/DataList/Budget/9.6/filter.budget.golden b/plutus-tx-plugin/test/DataList/Budget/9.6/filter.budget.golden index bfa26f2c824..57163446e0a 100644 --- a/plutus-tx-plugin/test/DataList/Budget/9.6/filter.budget.golden +++ b/plutus-tx-plugin/test/DataList/Budget/9.6/filter.budget.golden @@ -1,2 +1,2 @@ -({cpu: 12890977 -| mem: 52224}) \ No newline at end of file +({cpu: 11010487 +| mem: 45214}) \ No newline at end of file diff --git a/plutus-tx-plugin/test/DataList/Budget/9.6/filter.pir.golden b/plutus-tx-plugin/test/DataList/Budget/9.6/filter.pir.golden index 2666b6c8386..9af6bbf9cf6 100644 --- a/plutus-tx-plugin/test/DataList/Budget/9.6/filter.pir.golden +++ b/plutus-tx-plugin/test/DataList/Budget/9.6/filter.pir.golden @@ -23,7 +23,7 @@ letrec !h : integer = unIData x in Bool_match - (ifThenElse {Bool} (lessThanInteger h 8) False True) + (case Bool (lessThanInteger h 8) [True, False]) {all dead. (\a -> list data) integer} (/\dead -> let diff --git a/plutus-tx-plugin/test/DataList/Budget/9.6/filter.uplc.golden b/plutus-tx-plugin/test/DataList/Budget/9.6/filter.uplc.golden index 7148b54f6a7..bf9cb5780f5 100644 --- a/plutus-tx-plugin/test/DataList/Budget/9.6/filter.uplc.golden +++ b/plutus-tx-plugin/test/DataList/Budget/9.6/filter.uplc.golden @@ -11,13 +11,11 @@ ((\eta -> (\h -> force - (force - (force ifThenElse - (lessThanInteger h 8) - (delay (delay (s s eta))) - (delay - (delay - ((\nt -> force mkCons (iData h) nt) - (s s eta))))))) + (case + (lessThanInteger h 8) + [ (delay + ((\nt -> force mkCons (iData h) nt) + (s s eta))) + , (delay (s s eta)) ])) (unIData (force headList ds))) (force tailList ds)))))))) \ No newline at end of file diff --git a/plutus-tx-plugin/test/DataList/Budget/9.6/partition.budget.golden b/plutus-tx-plugin/test/DataList/Budget/9.6/partition.budget.golden index 74c7427a934..81456ca9249 100644 --- a/plutus-tx-plugin/test/DataList/Budget/9.6/partition.budget.golden +++ b/plutus-tx-plugin/test/DataList/Budget/9.6/partition.budget.golden @@ -1,2 +1,2 @@ -({cpu: 15543614 -| mem: 66052}) \ No newline at end of file +({cpu: 13663124 +| mem: 59042}) \ No newline at end of file diff --git a/plutus-tx-plugin/test/DataList/Budget/9.6/partition.pir.golden b/plutus-tx-plugin/test/DataList/Budget/9.6/partition.pir.golden index 84cf50678b4..72ca7c14ca4 100644 --- a/plutus-tx-plugin/test/DataList/Budget/9.6/partition.pir.golden +++ b/plutus-tx-plugin/test/DataList/Budget/9.6/partition.pir.golden @@ -27,7 +27,7 @@ letrec {Tuple2 (list data) (list data)} (\(ipv : list data) (ipv : list data) -> Bool_match - (ifThenElse {Bool} (lessThanInteger (unIData h) 8) False True) + (case Bool (lessThanInteger (unIData h) 8) [True, False]) {all dead. Tuple2 (list data) (list data)} (/\dead -> Tuple2 {list data} {list data} (mkCons {data} h ipv) ipv) diff --git a/plutus-tx-plugin/test/DataList/Budget/9.6/partition.uplc.golden b/plutus-tx-plugin/test/DataList/Budget/9.6/partition.uplc.golden index f359a69f771..cf8e9208713 100644 --- a/plutus-tx-plugin/test/DataList/Budget/9.6/partition.uplc.golden +++ b/plutus-tx-plugin/test/DataList/Budget/9.6/partition.uplc.golden @@ -15,19 +15,17 @@ (force (s s (delay (\x -> x))) t) [ (\ipv ipv -> force - (force - (force ifThenElse - (lessThanInteger (unIData h) 8) - (delay - (delay - (constr 0 - [ ipv - , (force mkCons h ipv) ]))) - (delay - (delay - (constr 0 - [ (force mkCons h ipv) - , ipv ])))))) ]) + (case + (lessThanInteger (unIData h) 8) + [ (delay + (constr 0 + [(force mkCons h ipv), ipv])) + , (delay + (constr 0 + [ ipv + , (force mkCons + h + ipv) ])) ])) ]) (force headList xs) (force tailList xs)))))) (delay (\x -> x))))) \ No newline at end of file diff --git a/plutus-tx-plugin/test/IsData/9.6/dataToData.pir.golden b/plutus-tx-plugin/test/IsData/9.6/dataToData.pir.golden index b90353ac98c..fddfd7d5afe 100644 --- a/plutus-tx-plugin/test/IsData/9.6/dataToData.pir.golden +++ b/plutus-tx-plugin/test/IsData/9.6/dataToData.pir.golden @@ -42,7 +42,8 @@ let True : Bool False : Bool !equalsInteger : integer -> integer -> bool = equalsInteger - !ifThenElse : all a. bool -> a -> a -> a = ifThenElse + !ifThenElse : all a. bool -> a -> a -> a + = /\a -> \(b : bool) (x : a) (y : a) -> case a b [y, x] ~equalsInteger : integer -> integer -> Bool = \(x : integer) -> let diff --git a/plutus-tx-plugin/test/IsData/9.6/deconstructData.pir.golden b/plutus-tx-plugin/test/IsData/9.6/deconstructData.pir.golden index 6fcac63f242..5794f71421a 100644 --- a/plutus-tx-plugin/test/IsData/9.6/deconstructData.pir.golden +++ b/plutus-tx-plugin/test/IsData/9.6/deconstructData.pir.golden @@ -51,7 +51,8 @@ let data (Maybe :: * -> *) a | Maybe_match where Just : a -> Maybe a Nothing : Maybe a - !ifThenElse : all a. bool -> a -> a -> a = ifThenElse + !ifThenElse : all a. bool -> a -> a -> a + = /\a -> \(b : bool) (x : a) (y : a) -> case a b [y, x] ~`$fFromDataTuple2_$cfromBuiltinData` : all a b. (\a -> data -> Maybe a) a -> diff --git a/plutus-tx-plugin/test/IsData/9.6/equalityAsData.pir.golden b/plutus-tx-plugin/test/IsData/9.6/equalityAsData.pir.golden index a1c84036ed3..31bfc05fcf9 100644 --- a/plutus-tx-plugin/test/IsData/9.6/equalityAsData.pir.golden +++ b/plutus-tx-plugin/test/IsData/9.6/equalityAsData.pir.golden @@ -3,7 +3,8 @@ let True : Bool False : Bool !equalsData : data -> data -> bool = equalsData - !ifThenElse : all a. bool -> a -> a -> a = ifThenElse + !ifThenElse : all a. bool -> a -> a -> a + = /\a -> \(b : bool) (x : a) (y : a) -> case a b [y, x] ~equalsData : data -> data -> Bool = \(d : data) -> let diff --git a/plutus-tx-plugin/test/IsData/9.6/matchAsData.pir.golden b/plutus-tx-plugin/test/IsData/9.6/matchAsData.pir.golden index d8f2409168e..3114acabf5f 100644 --- a/plutus-tx-plugin/test/IsData/9.6/matchAsData.pir.golden +++ b/plutus-tx-plugin/test/IsData/9.6/matchAsData.pir.golden @@ -40,7 +40,8 @@ let True : Bool False : Bool !equalsInteger : integer -> integer -> bool = equalsInteger - !ifThenElse : all a. bool -> a -> a -> a = ifThenElse + !ifThenElse : all a. bool -> a -> a -> a + = /\a -> \(b : bool) (x : a) (y : a) -> case a b [y, x] ~equalsInteger : integer -> integer -> Bool = \(x : integer) -> let diff --git a/plutus-tx-plugin/test/IsData/9.6/unsafeDeconstructData.pir.golden b/plutus-tx-plugin/test/IsData/9.6/unsafeDeconstructData.pir.golden index 45ff17198c2..cc3012539fa 100644 --- a/plutus-tx-plugin/test/IsData/9.6/unsafeDeconstructData.pir.golden +++ b/plutus-tx-plugin/test/IsData/9.6/unsafeDeconstructData.pir.golden @@ -7,7 +7,8 @@ let !equalsInteger : integer -> integer -> bool = equalsInteger !fst : all a b. pair a b -> a = fstPair !head : all a. list a -> a = headList - !ifThenElse : all a. bool -> a -> a -> a = ifThenElse + !ifThenElse : all a. bool -> a -> a -> a + = /\a -> \(b : bool) (x : a) (y : a) -> case a b [y, x] ~reconstructCaseError : string = "PT1" !snd : all a b. pair a b -> b = sndPair data Unit | Unit_match where diff --git a/plutus-tx-plugin/test/Optimization/9.6/matchAsData.pir.golden b/plutus-tx-plugin/test/Optimization/9.6/matchAsData.pir.golden index 1fc8e656519..b786894f4d6 100644 --- a/plutus-tx-plugin/test/Optimization/9.6/matchAsData.pir.golden +++ b/plutus-tx-plugin/test/Optimization/9.6/matchAsData.pir.golden @@ -24,7 +24,7 @@ in {integer} (\(ds : integer) (ds : list data) -> Bool_match - (ifThenElse {Bool} (equalsInteger 0 ds) True False) + (case Bool (equalsInteger 0 ds) [False, True]) {all dead. integer} (/\dead -> let @@ -49,7 +49,7 @@ in {integer} (\(ds : integer) (ds : list data) -> Bool_match - (ifThenElse {Bool} (equalsInteger 1 ds) True False) + (case Bool (equalsInteger 1 ds) [False, True]) {all dead. integer} (/\dead -> 1) (/\dead -> diff --git a/plutus-tx-plugin/test/Optimization/9.6/unsafeDeconstructData.pir.golden b/plutus-tx-plugin/test/Optimization/9.6/unsafeDeconstructData.pir.golden index e91d682b329..15823de0689 100644 --- a/plutus-tx-plugin/test/Optimization/9.6/unsafeDeconstructData.pir.golden +++ b/plutus-tx-plugin/test/Optimization/9.6/unsafeDeconstructData.pir.golden @@ -24,12 +24,12 @@ in !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 1 index) True False) + (case Bool (equalsInteger 1 index) [False, True]) {all dead. Maybe a} (/\dead -> Nothing {a}) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. Maybe a} (/\dead -> Just {a} (`$dUnsafeFromData` (headList {data} args))) (/\dead -> traceError {Maybe a} "PT1") @@ -42,7 +42,7 @@ in !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. Tuple2 integer integer} (/\dead -> Tuple2 diff --git a/plutus-tx-plugin/test/Plugin/Basic/9.6/ifOpt.pir.golden b/plutus-tx-plugin/test/Plugin/Basic/9.6/ifOpt.pir.golden index 7f4a0d97bc7..5abf9a3935a 100644 --- a/plutus-tx-plugin/test/Plugin/Basic/9.6/ifOpt.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Basic/9.6/ifOpt.pir.golden @@ -10,7 +10,8 @@ let True : Bool False : Bool !equalsInteger : integer -> integer -> bool = equalsInteger - !ifThenElse : all a. bool -> a -> a -> a = ifThenElse + !ifThenElse : all a. bool -> a -> a -> a + = /\a -> \(b : bool) (x : a) (y : a) -> case a b [y, x] ~equalsInteger : integer -> integer -> Bool = \(x : integer) -> let diff --git a/plutus-tx-plugin/test/Plugin/Basic/9.6/letFun.pir.golden b/plutus-tx-plugin/test/Plugin/Basic/9.6/letFun.pir.golden index 69c5751d728..147fb87e24b 100644 --- a/plutus-tx-plugin/test/Plugin/Basic/9.6/letFun.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Basic/9.6/letFun.pir.golden @@ -3,7 +3,8 @@ let True : Bool False : Bool !equalsInteger : integer -> integer -> bool = equalsInteger - !ifThenElse : all a. bool -> a -> a -> a = ifThenElse + !ifThenElse : all a. bool -> a -> a -> a + = /\a -> \(b : bool) (x : a) (y : a) -> case a b [y, x] ~equalsInteger : integer -> integer -> Bool = \(x : integer) -> let diff --git a/plutus-tx-plugin/test/Plugin/Coverage/9.6/coverageCode.pir.golden b/plutus-tx-plugin/test/Plugin/Coverage/9.6/coverageCode.pir.golden index 59011199d3c..34079b8f0a2 100644 --- a/plutus-tx-plugin/test/Plugin/Coverage/9.6/coverageCode.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Coverage/9.6/coverageCode.pir.golden @@ -20,7 +20,8 @@ let {all dead. dead} {Bool} !equalsInteger : integer -> integer -> bool = equalsInteger - !ifThenElse : all a. bool -> a -> a -> a = ifThenElse + !ifThenElse : all a. bool -> a -> a -> a + = /\a -> \(b : bool) (x : a) (y : a) -> case a b [y, x] ~equalsInteger : integer -> integer -> Bool = \(x : integer) -> let diff --git a/plutus-tx-plugin/test/Plugin/Debug/9.6/fib.pir.golden b/plutus-tx-plugin/test/Plugin/Debug/9.6/fib.pir.golden index 45afefbea79..f58ba322248 100644 --- a/plutus-tx-plugin/test/Plugin/Debug/9.6/fib.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Debug/9.6/fib.pir.golden @@ -124,7 +124,33 @@ ) ) ) - (builtin { no-src-span } ifThenElse) + (abs + { no-src-span } + a + ({ no-src-span } type) + (lam + { no-src-span } + b + (con { no-src-span } bool) + (lam + { no-src-span } + x + { no-src-span } a + (lam + { no-src-span } + y + { no-src-span } a + (case + { no-src-span } + { no-src-span } a + { no-src-span } b + { no-src-span } y + { no-src-span } x + ) + ) + ) + ) + ) ) (termbind { no-src-span } diff --git a/plutus-tx-plugin/test/Plugin/Debug/9.6/letFun.pir.golden b/plutus-tx-plugin/test/Plugin/Debug/9.6/letFun.pir.golden index 4c61eb0073f..f40e06ff369 100644 --- a/plutus-tx-plugin/test/Plugin/Debug/9.6/letFun.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Debug/9.6/letFun.pir.golden @@ -54,7 +54,33 @@ ) ) ) - (builtin { no-src-span } ifThenElse) + (abs + { no-src-span } + a + ({ no-src-span } type) + (lam + { no-src-span } + b + (con { no-src-span } bool) + (lam + { no-src-span } + x + { no-src-span } a + (lam + { no-src-span } + y + { no-src-span } a + (case + { no-src-span } + { no-src-span } a + { no-src-span } b + { no-src-span } y + { no-src-span } x + ) + ) + ) + ) + ) ) (termbind { no-src-span } diff --git a/plutus-tx-plugin/test/Plugin/Functions/9.6/recursive/even.pir.golden b/plutus-tx-plugin/test/Plugin/Functions/9.6/recursive/even.pir.golden index d022832851d..c7f645ef4d8 100644 --- a/plutus-tx-plugin/test/Plugin/Functions/9.6/recursive/even.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Functions/9.6/recursive/even.pir.golden @@ -3,7 +3,8 @@ let True : Bool False : Bool !equalsInteger : integer -> integer -> bool = equalsInteger - !ifThenElse : all a. bool -> a -> a -> a = ifThenElse + !ifThenElse : all a. bool -> a -> a -> a + = /\a -> \(b : bool) (x : a) (y : a) -> case a b [y, x] ~equalsInteger : integer -> integer -> Bool = \(x : integer) -> let diff --git a/plutus-tx-plugin/test/Plugin/Functions/9.6/recursive/fib.pir.golden b/plutus-tx-plugin/test/Plugin/Functions/9.6/recursive/fib.pir.golden index fa8cbee97bd..867314d5ad1 100644 --- a/plutus-tx-plugin/test/Plugin/Functions/9.6/recursive/fib.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Functions/9.6/recursive/fib.pir.golden @@ -10,7 +10,8 @@ let True : Bool False : Bool !equalsInteger : integer -> integer -> bool = equalsInteger - !ifThenElse : all a. bool -> a -> a -> a = ifThenElse + !ifThenElse : all a. bool -> a -> a -> a + = /\a -> \(b : bool) (x : a) (y : a) -> case a b [y, x] ~equalsInteger : integer -> integer -> Bool = \(x : integer) -> let diff --git a/plutus-tx-plugin/test/Plugin/Functions/9.6/unfoldings/allDirect.pir.golden b/plutus-tx-plugin/test/Plugin/Functions/9.6/unfoldings/allDirect.pir.golden index 1fd6a9a57c1..8e90b16138b 100644 --- a/plutus-tx-plugin/test/Plugin/Functions/9.6/unfoldings/allDirect.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Functions/9.6/unfoldings/allDirect.pir.golden @@ -64,7 +64,8 @@ let = /\a -> \(g : all b. (a -> b -> b) -> b -> b) -> g {List a} (\(ds : a) (ds : List a) -> Cons {a} ds ds) (Nil {a}) - !ifThenElse : all a. bool -> a -> a -> a = ifThenElse + !ifThenElse : all a. bool -> a -> a -> a + = /\a -> \(b : bool) (x : a) (y : a) -> case a b [y, x] !lessThanInteger : integer -> integer -> bool = lessThanInteger ~lessThanInteger : integer -> integer -> Bool = \(x : integer) -> diff --git a/plutus-tx-plugin/test/Plugin/Functions/9.6/unfoldings/mutualRecursionUnfoldings.pir.golden b/plutus-tx-plugin/test/Plugin/Functions/9.6/unfoldings/mutualRecursionUnfoldings.pir.golden index 7ebed3c6e26..a10b34566da 100644 --- a/plutus-tx-plugin/test/Plugin/Functions/9.6/unfoldings/mutualRecursionUnfoldings.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Functions/9.6/unfoldings/mutualRecursionUnfoldings.pir.golden @@ -3,7 +3,8 @@ let True : Bool False : Bool !equalsInteger : integer -> integer -> bool = equalsInteger - !ifThenElse : all a. bool -> a -> a -> a = ifThenElse + !ifThenElse : all a. bool -> a -> a -> a + = /\a -> \(b : bool) (x : a) (y : a) -> case a b [y, x] !subtractInteger : integer -> integer -> integer = subtractInteger in letrec diff --git a/plutus-tx-plugin/test/Plugin/Primitives/9.6/ifThenElse.pir.golden b/plutus-tx-plugin/test/Plugin/Primitives/9.6/ifThenElse.pir.golden index d606dbd777b..55f8220f5f3 100644 --- a/plutus-tx-plugin/test/Plugin/Primitives/9.6/ifThenElse.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Primitives/9.6/ifThenElse.pir.golden @@ -3,7 +3,8 @@ let True : Bool False : Bool !equalsInteger : integer -> integer -> bool = equalsInteger - !ifThenElse : all a. bool -> a -> a -> a = ifThenElse + !ifThenElse : all a. bool -> a -> a -> a + = /\a -> \(b : bool) (x : a) (y : a) -> case a b [y, x] ~equalsInteger : integer -> integer -> Bool = \(x : integer) -> let diff --git a/plutus-tx-plugin/test/Plugin/Primitives/9.6/intCompare.pir.golden b/plutus-tx-plugin/test/Plugin/Primitives/9.6/intCompare.pir.golden index 012f049af58..86fd648756a 100644 --- a/plutus-tx-plugin/test/Plugin/Primitives/9.6/intCompare.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Primitives/9.6/intCompare.pir.golden @@ -2,7 +2,8 @@ let data Bool | Bool_match where True : Bool False : Bool - !ifThenElse : all a. bool -> a -> a -> a = ifThenElse + !ifThenElse : all a. bool -> a -> a -> a + = /\a -> \(b : bool) (x : a) (y : a) -> case a b [y, x] !lessThanInteger : integer -> integer -> bool = lessThanInteger ~lessThanInteger : integer -> integer -> Bool = \(x : integer) -> diff --git a/plutus-tx-plugin/test/Plugin/Primitives/9.6/intEq.pir.golden b/plutus-tx-plugin/test/Plugin/Primitives/9.6/intEq.pir.golden index 69c5751d728..147fb87e24b 100644 --- a/plutus-tx-plugin/test/Plugin/Primitives/9.6/intEq.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Primitives/9.6/intEq.pir.golden @@ -3,7 +3,8 @@ let True : Bool False : Bool !equalsInteger : integer -> integer -> bool = equalsInteger - !ifThenElse : all a. bool -> a -> a -> a = ifThenElse + !ifThenElse : all a. bool -> a -> a -> a + = /\a -> \(b : bool) (x : a) (y : a) -> case a b [y, x] ~equalsInteger : integer -> integer -> Bool = \(x : integer) -> let diff --git a/plutus-tx-plugin/test/Plugin/Primitives/9.6/verify.pir.golden b/plutus-tx-plugin/test/Plugin/Primitives/9.6/verify.pir.golden index 6c3b806161e..83bb880dc20 100644 --- a/plutus-tx-plugin/test/Plugin/Primitives/9.6/verify.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Primitives/9.6/verify.pir.golden @@ -2,7 +2,8 @@ let data Bool | Bool_match where True : Bool False : Bool - !ifThenElse : all a. bool -> a -> a -> a = ifThenElse + !ifThenElse : all a. bool -> a -> a -> a + = /\a -> \(b : bool) (x : a) (y : a) -> case a b [y, x] !verifyEd25519Signature : bytestring -> bytestring -> bytestring -> bool = verifyEd25519Signature ~verifyEd25519Signature : bytestring -> bytestring -> bytestring -> Bool diff --git a/plutus-tx-plugin/test/Plugin/Primitives/9.6/void.pir.golden b/plutus-tx-plugin/test/Plugin/Primitives/9.6/void.pir.golden index 078a8c43c43..7fcddced1ee 100644 --- a/plutus-tx-plugin/test/Plugin/Primitives/9.6/void.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Primitives/9.6/void.pir.golden @@ -4,7 +4,8 @@ let False : Bool ~fail : unit -> Bool = \(ds : unit) -> False !equalsInteger : integer -> integer -> bool = equalsInteger - !ifThenElse : all a. bool -> a -> a -> a = ifThenElse + !ifThenElse : all a. bool -> a -> a -> a + = /\a -> \(b : bool) (x : a) (y : a) -> case a b [y, x] ~equalsInteger : integer -> integer -> Bool = \(x : integer) -> let diff --git a/plutus-tx-plugin/test/Plugin/Profiling/9.6/fib.pir.golden b/plutus-tx-plugin/test/Plugin/Profiling/9.6/fib.pir.golden index fe8508177d9..10847182abb 100644 --- a/plutus-tx-plugin/test/Plugin/Profiling/9.6/fib.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Profiling/9.6/fib.pir.golden @@ -19,7 +19,8 @@ let True : Bool False : Bool !equalsInteger : integer -> integer -> bool = equalsInteger - !ifThenElse : all a. bool -> a -> a -> a = ifThenElse + !ifThenElse : all a. bool -> a -> a -> a + = /\a -> \(b : bool) (x : a) (y : a) -> case a b [y, x] ~equalsInteger : integer -> integer -> Bool = \(x : integer) -> let diff --git a/plutus-tx-plugin/test/Plugin/Strict/9.6/issue4645.pir.golden b/plutus-tx-plugin/test/Plugin/Strict/9.6/issue4645.pir.golden index 93bceee4a57..ec8c2edfbff 100644 --- a/plutus-tx-plugin/test/Plugin/Strict/9.6/issue4645.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Strict/9.6/issue4645.pir.golden @@ -19,4 +19,4 @@ Tuple2_match let !t : integer = trace {integer} "t" zz in - ifThenElse {Bool} (equalsInteger (trace {integer} "x" 0) t) True False) \ No newline at end of file + case Bool (equalsInteger (trace {integer} "x" 0) t) [False, True]) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Strict/9.6/strictITE.pir.golden b/plutus-tx-plugin/test/Plugin/Strict/9.6/strictITE.pir.golden index 4b1fdeb4cfb..927640eceb7 100644 --- a/plutus-tx-plugin/test/Plugin/Strict/9.6/strictITE.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Strict/9.6/strictITE.pir.golden @@ -1 +1 @@ -\(x : bool) (y : integer) (z : integer) -> ifThenElse {integer} x y z \ No newline at end of file +\(x : bool) (y : integer) (z : integer) -> case integer x [z, y] \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Typeclasses/9.6/compareTest.pir.golden b/plutus-tx-plugin/test/Plugin/Typeclasses/9.6/compareTest.pir.golden index 4f0ac1fb5c6..37628282b7f 100644 --- a/plutus-tx-plugin/test/Plugin/Typeclasses/9.6/compareTest.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Typeclasses/9.6/compareTest.pir.golden @@ -1,7 +1,8 @@ let !equalsInteger : integer -> integer -> bool = equalsInteger !lessThanEqualsInteger : integer -> integer -> bool = lessThanEqualsInteger - !ifThenElse : all a. bool -> a -> a -> a = ifThenElse + !ifThenElse : all a. bool -> a -> a -> a + = /\a -> \(b : bool) (x : a) (y : a) -> case a b [y, x] data Bool | Bool_match where True : Bool False : Bool diff --git a/plutus-tx-plugin/test/Plugin/Typeclasses/9.6/multiFunction.pir.golden b/plutus-tx-plugin/test/Plugin/Typeclasses/9.6/multiFunction.pir.golden index 1aec2f14641..27bf7318336 100644 --- a/plutus-tx-plugin/test/Plugin/Typeclasses/9.6/multiFunction.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Typeclasses/9.6/multiFunction.pir.golden @@ -15,7 +15,8 @@ let v {a -> integer} (\(v : a -> integer) (v : a -> Animal -> Bool) -> v) - !ifThenElse : all a. bool -> a -> a -> a = ifThenElse + !ifThenElse : all a. bool -> a -> a -> a + = /\a -> \(b : bool) (x : a) (y : a) -> case a b [y, x] !lessThanInteger : integer -> integer -> bool = lessThanInteger ~lessThanInteger : integer -> integer -> Bool = \(x : integer) -> diff --git a/plutus-tx-plugin/test/Plugin/Typeclasses/9.6/partialApplication.pir.golden b/plutus-tx-plugin/test/Plugin/Typeclasses/9.6/partialApplication.pir.golden index 34b7ddd4f9d..9248522cef1 100644 --- a/plutus-tx-plugin/test/Plugin/Typeclasses/9.6/partialApplication.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Typeclasses/9.6/partialApplication.pir.golden @@ -7,7 +7,8 @@ let GT : Ordering LT : Ordering !equalsInteger : integer -> integer -> bool = equalsInteger - !ifThenElse : all a. bool -> a -> a -> a = ifThenElse + !ifThenElse : all a. bool -> a -> a -> a + = /\a -> \(b : bool) (x : a) (y : a) -> case a b [y, x] !lessThanEqualsInteger : integer -> integer -> bool = lessThanEqualsInteger ~`$fOrdInteger_$ccompare` : integer -> integer -> Ordering = \(eta : integer) -> diff --git a/plutus-tx-plugin/test/Strictness/9.6/let-default.pir.golden b/plutus-tx-plugin/test/Strictness/9.6/let-default.pir.golden index 35e1bc55801..760f982dd6d 100644 --- a/plutus-tx-plugin/test/Strictness/9.6/let-default.pir.golden +++ b/plutus-tx-plugin/test/Strictness/9.6/let-default.pir.golden @@ -7,7 +7,7 @@ let in \(m : integer) -> Bool_match - (ifThenElse {Bool} (lessThanInteger m 0) True False) + (case Bool (lessThanInteger m 0) [False, True]) {all dead. integer} (/\dead -> addInteger (error {integer -> integer} m) (error {integer -> integer} m)) diff --git a/plutus-tx-plugin/test/Strictness/9.6/let-default.uplc.golden b/plutus-tx-plugin/test/Strictness/9.6/let-default.uplc.golden index f0cea811d66..dc30b6852a2 100644 --- a/plutus-tx-plugin/test/Strictness/9.6/let-default.uplc.golden +++ b/plutus-tx-plugin/test/Strictness/9.6/let-default.uplc.golden @@ -2,8 +2,6 @@ 1.1.0 (\m -> force - (force - (force ifThenElse - (lessThanInteger m 0) - (delay (delay ((\cse -> addInteger cse cse) (error m)))) - (delay (delay m)))))) \ No newline at end of file + (case + (lessThanInteger m 0) + [(delay m), (delay ((\cse -> addInteger cse cse) (error m)))]))) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Strictness/9.6/let-nonstrict.pir.golden b/plutus-tx-plugin/test/Strictness/9.6/let-nonstrict.pir.golden index 35e1bc55801..760f982dd6d 100644 --- a/plutus-tx-plugin/test/Strictness/9.6/let-nonstrict.pir.golden +++ b/plutus-tx-plugin/test/Strictness/9.6/let-nonstrict.pir.golden @@ -7,7 +7,7 @@ let in \(m : integer) -> Bool_match - (ifThenElse {Bool} (lessThanInteger m 0) True False) + (case Bool (lessThanInteger m 0) [False, True]) {all dead. integer} (/\dead -> addInteger (error {integer -> integer} m) (error {integer -> integer} m)) diff --git a/plutus-tx-plugin/test/Strictness/9.6/let-nonstrict.uplc.golden b/plutus-tx-plugin/test/Strictness/9.6/let-nonstrict.uplc.golden index f0cea811d66..dc30b6852a2 100644 --- a/plutus-tx-plugin/test/Strictness/9.6/let-nonstrict.uplc.golden +++ b/plutus-tx-plugin/test/Strictness/9.6/let-nonstrict.uplc.golden @@ -2,8 +2,6 @@ 1.1.0 (\m -> force - (force - (force ifThenElse - (lessThanInteger m 0) - (delay (delay ((\cse -> addInteger cse cse) (error m)))) - (delay (delay m)))))) \ No newline at end of file + (case + (lessThanInteger m 0) + [(delay m), (delay ((\cse -> addInteger cse cse) (error m)))]))) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Strictness/9.6/let-strict.pir.golden b/plutus-tx-plugin/test/Strictness/9.6/let-strict.pir.golden index 35e1bc55801..760f982dd6d 100644 --- a/plutus-tx-plugin/test/Strictness/9.6/let-strict.pir.golden +++ b/plutus-tx-plugin/test/Strictness/9.6/let-strict.pir.golden @@ -7,7 +7,7 @@ let in \(m : integer) -> Bool_match - (ifThenElse {Bool} (lessThanInteger m 0) True False) + (case Bool (lessThanInteger m 0) [False, True]) {all dead. integer} (/\dead -> addInteger (error {integer -> integer} m) (error {integer -> integer} m)) diff --git a/plutus-tx-plugin/test/Strictness/9.6/let-strict.uplc.golden b/plutus-tx-plugin/test/Strictness/9.6/let-strict.uplc.golden index f0cea811d66..dc30b6852a2 100644 --- a/plutus-tx-plugin/test/Strictness/9.6/let-strict.uplc.golden +++ b/plutus-tx-plugin/test/Strictness/9.6/let-strict.uplc.golden @@ -2,8 +2,6 @@ 1.1.0 (\m -> force - (force - (force ifThenElse - (lessThanInteger m 0) - (delay (delay ((\cse -> addInteger cse cse) (error m)))) - (delay (delay m)))))) \ No newline at end of file + (case + (lessThanInteger m 0) + [(delay m), (delay ((\cse -> addInteger cse cse) (error m)))]))) \ No newline at end of file diff --git a/plutus-tx-plugin/test/size/Golden/Rational/Additive/minus.size.golden b/plutus-tx-plugin/test/size/Golden/Rational/Additive/minus.size.golden index 9f728587959..3ca9062a117 100644 --- a/plutus-tx-plugin/test/size/Golden/Rational/Additive/minus.size.golden +++ b/plutus-tx-plugin/test/size/Golden/Rational/Additive/minus.size.golden @@ -1 +1 @@ -88 \ No newline at end of file +84 \ No newline at end of file diff --git a/plutus-tx-plugin/test/size/Golden/Rational/Additive/plus.size.golden b/plutus-tx-plugin/test/size/Golden/Rational/Additive/plus.size.golden index 9f728587959..3ca9062a117 100644 --- a/plutus-tx-plugin/test/size/Golden/Rational/Additive/plus.size.golden +++ b/plutus-tx-plugin/test/size/Golden/Rational/Additive/plus.size.golden @@ -1 +1 @@ -88 \ No newline at end of file +84 \ No newline at end of file diff --git a/plutus-tx-plugin/test/size/Golden/Rational/Construction/ratio.size.golden b/plutus-tx-plugin/test/size/Golden/Rational/Construction/ratio.size.golden index 725cdcde650..7b27b251970 100644 --- a/plutus-tx-plugin/test/size/Golden/Rational/Construction/ratio.size.golden +++ b/plutus-tx-plugin/test/size/Golden/Rational/Construction/ratio.size.golden @@ -1 +1 @@ -193 \ No newline at end of file +173 \ No newline at end of file diff --git a/plutus-tx-plugin/test/size/Golden/Rational/Construction/unsafeRatio.size.golden b/plutus-tx-plugin/test/size/Golden/Rational/Construction/unsafeRatio.size.golden index d800886d9c8..9d07aa0df55 100644 --- a/plutus-tx-plugin/test/size/Golden/Rational/Construction/unsafeRatio.size.golden +++ b/plutus-tx-plugin/test/size/Golden/Rational/Construction/unsafeRatio.size.golden @@ -1 +1 @@ -123 \ No newline at end of file +111 \ No newline at end of file diff --git a/plutus-tx-plugin/test/size/Golden/Rational/Eq/equal.size.golden b/plutus-tx-plugin/test/size/Golden/Rational/Eq/equal.size.golden index 72f523f36ed..b74e882ae37 100644 --- a/plutus-tx-plugin/test/size/Golden/Rational/Eq/equal.size.golden +++ b/plutus-tx-plugin/test/size/Golden/Rational/Eq/equal.size.golden @@ -1 +1 @@ -39 \ No newline at end of file +31 \ No newline at end of file diff --git a/plutus-tx-plugin/test/size/Golden/Rational/Eq/not-equal.size.golden b/plutus-tx-plugin/test/size/Golden/Rational/Eq/not-equal.size.golden index 7d37386284a..7c091989d01 100644 --- a/plutus-tx-plugin/test/size/Golden/Rational/Eq/not-equal.size.golden +++ b/plutus-tx-plugin/test/size/Golden/Rational/Eq/not-equal.size.golden @@ -1 +1 @@ -45 \ No newline at end of file +37 \ No newline at end of file diff --git a/plutus-tx-plugin/test/size/Golden/Rational/Multiplicative/scale.size.golden b/plutus-tx-plugin/test/size/Golden/Rational/Multiplicative/scale.size.golden index 8c0474e3239..b44fe09a7a8 100644 --- a/plutus-tx-plugin/test/size/Golden/Rational/Multiplicative/scale.size.golden +++ b/plutus-tx-plugin/test/size/Golden/Rational/Multiplicative/scale.size.golden @@ -1 +1 @@ -69 \ No newline at end of file +65 \ No newline at end of file diff --git a/plutus-tx-plugin/test/size/Golden/Rational/Multiplicative/times.size.golden b/plutus-tx-plugin/test/size/Golden/Rational/Multiplicative/times.size.golden index e3f1e9b791c..aa92725341c 100644 --- a/plutus-tx-plugin/test/size/Golden/Rational/Multiplicative/times.size.golden +++ b/plutus-tx-plugin/test/size/Golden/Rational/Multiplicative/times.size.golden @@ -1 +1 @@ -80 \ No newline at end of file +76 \ No newline at end of file diff --git a/plutus-tx-plugin/test/size/Golden/Rational/Ord/compare.size.golden b/plutus-tx-plugin/test/size/Golden/Rational/Ord/compare.size.golden index fc9afb48e03..7003e7fe1fa 100644 --- a/plutus-tx-plugin/test/size/Golden/Rational/Ord/compare.size.golden +++ b/plutus-tx-plugin/test/size/Golden/Rational/Ord/compare.size.golden @@ -1 +1 @@ -59 \ No newline at end of file +51 \ No newline at end of file diff --git a/plutus-tx-plugin/test/size/Golden/Rational/Ord/greater-than-equal.size.golden b/plutus-tx-plugin/test/size/Golden/Rational/Ord/greater-than-equal.size.golden index 8580e7b684b..978b4e8e518 100644 --- a/plutus-tx-plugin/test/size/Golden/Rational/Ord/greater-than-equal.size.golden +++ b/plutus-tx-plugin/test/size/Golden/Rational/Ord/greater-than-equal.size.golden @@ -1 +1 @@ -30 \ No newline at end of file +26 \ No newline at end of file diff --git a/plutus-tx-plugin/test/size/Golden/Rational/Ord/greater-than.size.golden b/plutus-tx-plugin/test/size/Golden/Rational/Ord/greater-than.size.golden index 8580e7b684b..978b4e8e518 100644 --- a/plutus-tx-plugin/test/size/Golden/Rational/Ord/greater-than.size.golden +++ b/plutus-tx-plugin/test/size/Golden/Rational/Ord/greater-than.size.golden @@ -1 +1 @@ -30 \ No newline at end of file +26 \ No newline at end of file diff --git a/plutus-tx-plugin/test/size/Golden/Rational/Ord/less-than-equal.size.golden b/plutus-tx-plugin/test/size/Golden/Rational/Ord/less-than-equal.size.golden index 8580e7b684b..978b4e8e518 100644 --- a/plutus-tx-plugin/test/size/Golden/Rational/Ord/less-than-equal.size.golden +++ b/plutus-tx-plugin/test/size/Golden/Rational/Ord/less-than-equal.size.golden @@ -1 +1 @@ -30 \ No newline at end of file +26 \ No newline at end of file diff --git a/plutus-tx-plugin/test/size/Golden/Rational/Ord/less-than.size.golden b/plutus-tx-plugin/test/size/Golden/Rational/Ord/less-than.size.golden index 8580e7b684b..978b4e8e518 100644 --- a/plutus-tx-plugin/test/size/Golden/Rational/Ord/less-than.size.golden +++ b/plutus-tx-plugin/test/size/Golden/Rational/Ord/less-than.size.golden @@ -1 +1 @@ -30 \ No newline at end of file +26 \ No newline at end of file diff --git a/plutus-tx-plugin/test/size/Golden/Rational/Ord/max.size.golden b/plutus-tx-plugin/test/size/Golden/Rational/Ord/max.size.golden index dce6588ca14..1758dddccea 100644 --- a/plutus-tx-plugin/test/size/Golden/Rational/Ord/max.size.golden +++ b/plutus-tx-plugin/test/size/Golden/Rational/Ord/max.size.golden @@ -1 +1 @@ -36 \ No newline at end of file +32 \ No newline at end of file diff --git a/plutus-tx-plugin/test/size/Golden/Rational/Ord/min.size.golden b/plutus-tx-plugin/test/size/Golden/Rational/Ord/min.size.golden index dce6588ca14..1758dddccea 100644 --- a/plutus-tx-plugin/test/size/Golden/Rational/Ord/min.size.golden +++ b/plutus-tx-plugin/test/size/Golden/Rational/Ord/min.size.golden @@ -1 +1 @@ -36 \ No newline at end of file +32 \ No newline at end of file diff --git a/plutus-tx-plugin/test/size/Golden/Rational/Other/abs-specialized.size.golden b/plutus-tx-plugin/test/size/Golden/Rational/Other/abs-specialized.size.golden index d99e90eb967..410b14d2ce6 100644 --- a/plutus-tx-plugin/test/size/Golden/Rational/Other/abs-specialized.size.golden +++ b/plutus-tx-plugin/test/size/Golden/Rational/Other/abs-specialized.size.golden @@ -1 +1 @@ -29 \ No newline at end of file +25 \ No newline at end of file diff --git a/plutus-tx-plugin/test/size/Golden/Rational/Other/recip.size.golden b/plutus-tx-plugin/test/size/Golden/Rational/Other/recip.size.golden index 2b82dfea308..61395542108 100644 --- a/plutus-tx-plugin/test/size/Golden/Rational/Other/recip.size.golden +++ b/plutus-tx-plugin/test/size/Golden/Rational/Other/recip.size.golden @@ -1 +1 @@ -60 \ No newline at end of file +52 \ No newline at end of file diff --git a/plutus-tx-plugin/test/size/Golden/Rational/Other/round.size.golden b/plutus-tx-plugin/test/size/Golden/Rational/Other/round.size.golden index 27b4d6e6bac..680cc9c31b9 100644 --- a/plutus-tx-plugin/test/size/Golden/Rational/Other/round.size.golden +++ b/plutus-tx-plugin/test/size/Golden/Rational/Other/round.size.golden @@ -1 +1 @@ -287 \ No newline at end of file +263 \ No newline at end of file diff --git a/plutus-tx-plugin/test/size/Golden/Rational/Serialization/fromBuiltinData.size.golden b/plutus-tx-plugin/test/size/Golden/Rational/Serialization/fromBuiltinData.size.golden index 2a9c18ad50e..ef491079a37 100644 --- a/plutus-tx-plugin/test/size/Golden/Rational/Serialization/fromBuiltinData.size.golden +++ b/plutus-tx-plugin/test/size/Golden/Rational/Serialization/fromBuiltinData.size.golden @@ -1 +1 @@ -357 \ No newline at end of file +337 \ No newline at end of file diff --git a/plutus-tx-plugin/test/size/Golden/Rational/Serialization/unsafeFromBuiltinData.size.golden b/plutus-tx-plugin/test/size/Golden/Rational/Serialization/unsafeFromBuiltinData.size.golden index 4be28fd89c2..6fc1e6e18c4 100644 --- a/plutus-tx-plugin/test/size/Golden/Rational/Serialization/unsafeFromBuiltinData.size.golden +++ b/plutus-tx-plugin/test/size/Golden/Rational/Serialization/unsafeFromBuiltinData.size.golden @@ -1 +1 @@ -194 \ No newline at end of file +178 \ No newline at end of file diff --git a/plutus-tx/src/PlutusTx/Lift.hs b/plutus-tx/src/PlutusTx/Lift.hs index 2da3d16665c..33794eeaa7e 100644 --- a/plutus-tx/src/PlutusTx/Lift.hs +++ b/plutus-tx/src/PlutusTx/Lift.hs @@ -81,6 +81,8 @@ safeLiftWith , MonadError e m , MonadQuote m , PLC.Typecheckable uni fun + , PLC.CaseBuiltin (PIR.Term TyName Name uni fun (Provenance ())) uni + , PLC.CaseBuiltin (UPLC.Term Name uni fun (Provenance ())) uni , PrettyUni uni , Pretty fun , Default (PLC.CostingPart uni fun) @@ -127,6 +129,8 @@ safeLift , MonadError e m , MonadQuote m , PLC.Typecheckable uni fun + , PLC.CaseBuiltin (PIR.Term TyName Name uni fun (Provenance ())) uni + , PLC.CaseBuiltin (UPLC.Term Name uni fun (Provenance ())) uni , PrettyUni uni , Pretty fun , Default (PLC.CostingPart uni fun) @@ -152,6 +156,8 @@ safeLiftUnopt , MonadError e m , MonadQuote m , PLC.Typecheckable uni fun + , PLC.CaseBuiltin (UPLC.Term Name uni fun (Provenance ())) uni + , PLC.CaseBuiltin (PIR.Term TyName Name uni fun (Provenance ())) uni , PrettyUni uni , Pretty fun , Default (PLC.CostingPart uni fun) @@ -178,6 +184,8 @@ safeLiftProgram , PLC.AsFreeVariableError e , AsError e uni fun (Provenance ()), MonadError e m, MonadQuote m , PLC.Typecheckable uni fun + , PLC.CaseBuiltin (PIR.Term TyName Name uni fun (Provenance ())) uni + , PLC.CaseBuiltin (UPLC.Term Name uni fun (Provenance ())) uni , PrettyUni uni, Pretty fun , Default (PLC.CostingPart uni fun) , Default (PIR.BuiltinsInfo uni fun) @@ -196,6 +204,8 @@ safeLiftProgramUnopt , PLC.AsFreeVariableError e , AsError e uni fun (Provenance ()), MonadError e m, MonadQuote m , PLC.Typecheckable uni fun + , PLC.CaseBuiltin (PIR.Term TyName Name uni fun (Provenance ())) uni + , PLC.CaseBuiltin (UPLC.Term Name uni fun (Provenance ())) uni , PrettyUni uni, Pretty fun , Default (PLC.CostingPart uni fun) , Default (PIR.BuiltinsInfo uni fun) @@ -212,6 +222,8 @@ safeLiftCode , PLC.AsFreeVariableError e , AsError e uni fun (Provenance ()), MonadError e m, MonadQuote m , PLC.Typecheckable uni fun + , PLC.CaseBuiltin (PIR.Term TyName Name uni fun (Provenance ())) uni + , PLC.CaseBuiltin (UPLC.Term Name uni fun (Provenance ())) uni , PrettyUni uni, Pretty fun , Default (PLC.CostingPart uni fun) , Default (PIR.BuiltinsInfo uni fun) @@ -235,6 +247,8 @@ safeLiftCodeUnopt , PLC.AsFreeVariableError e , AsError e uni fun (Provenance ()), MonadError e m, MonadQuote m , PLC.Typecheckable uni fun + , PLC.CaseBuiltin (PIR.Term TyName Name uni fun (Provenance ())) uni + , PLC.CaseBuiltin (UPLC.Term Name uni fun (Provenance ())) uni , PrettyUni uni, Pretty fun , Default (PLC.CostingPart uni fun) , Default (PIR.BuiltinsInfo uni fun) @@ -263,6 +277,8 @@ unsafely ma = runQuote $ do -- are applied. lift :: ( Lift.Lift uni a, ThrowableBuiltins uni fun, PLC.Typecheckable uni fun, PLC.GEq uni + , PLC.CaseBuiltin (PIR.Term TyName Name uni fun (Provenance ())) uni + , PLC.CaseBuiltin (UPLC.Term Name uni fun (Provenance ())) uni , Default (PLC.CostingPart uni fun) , Default (PIR.BuiltinsInfo uni fun) , Default (PIR.RewriteRules uni fun) @@ -275,6 +291,8 @@ lift v a = unsafely $ safeLift v a -- where lifting speed is more important than optimal code. liftUnopt :: ( Lift.Lift uni a, ThrowableBuiltins uni fun, PLC.Typecheckable uni fun, PLC.GEq uni + , PLC.CaseBuiltin (PIR.Term TyName Name uni fun (Provenance ())) uni + , PLC.CaseBuiltin (UPLC.Term Name uni fun (Provenance ())) uni , Default (PLC.CostingPart uni fun) , Default (PIR.BuiltinsInfo uni fun) , Default (PIR.RewriteRules uni fun) @@ -286,6 +304,8 @@ liftUnopt v a = unsafely $ safeLiftUnopt v a -- | Get a Plutus Core program corresponding to the given value, throwing any errors that occur as exceptions and ignoring fresh names. liftProgram :: ( Lift.Lift uni a, ThrowableBuiltins uni fun, PLC.Typecheckable uni fun, PLC.GEq uni + , PLC.CaseBuiltin (PIR.Term TyName Name uni fun (Provenance ())) uni + , PLC.CaseBuiltin (UPLC.Term Name uni fun (Provenance ())) uni , Default (PLC.CostingPart uni fun) , Default (PIR.BuiltinsInfo uni fun) , Default (PIR.RewriteRules uni fun) @@ -298,6 +318,8 @@ liftProgram v x = unsafely $ safeLiftProgram v x -- where lifting speed is more important than optimal code. liftProgramUnopt :: ( Lift.Lift uni a, ThrowableBuiltins uni fun, PLC.Typecheckable uni fun, PLC.GEq uni + , PLC.CaseBuiltin (PIR.Term TyName Name uni fun (Provenance ())) uni + , PLC.CaseBuiltin (UPLC.Term Name uni fun (Provenance ())) uni , Default (PLC.CostingPart uni fun) , Default (PIR.BuiltinsInfo uni fun) , Default (PIR.RewriteRules uni fun) @@ -322,6 +344,8 @@ liftProgramDefUnopt = liftProgramUnopt PLC.latestVersion -- | Get a Plutus Core program corresponding to the given value as a 'CompiledCodeIn', throwing any errors that occur as exceptions and ignoring fresh names. liftCode :: ( Lift.Lift uni a, PLC.GEq uni, ThrowableBuiltins uni fun, PLC.Typecheckable uni fun + , PLC.CaseBuiltin (PIR.Term TyName Name uni fun (Provenance ())) uni + , PLC.CaseBuiltin (UPLC.Term Name uni fun (Provenance ())) uni , Default (PLC.CostingPart uni fun) , Default (PIR.BuiltinsInfo uni fun) , Default (PIR.RewriteRules uni fun) @@ -334,6 +358,8 @@ liftCode v x = unsafely $ safeLiftCode v x -- where lifting speed is more important than optimal code. liftCodeUnopt :: ( Lift.Lift uni a, PLC.GEq uni, ThrowableBuiltins uni fun, PLC.Typecheckable uni fun + , PLC.CaseBuiltin (PIR.Term TyName Name uni fun (Provenance ())) uni + , PLC.CaseBuiltin (UPLC.Term Name uni fun (Provenance ())) uni , Default (PLC.CostingPart uni fun) , Default (PIR.BuiltinsInfo uni fun) , Default (PIR.RewriteRules uni fun) @@ -345,6 +371,8 @@ liftCodeUnopt v x = unsafely $ safeLiftCodeUnopt v x -- | Get a Plutus Core program with the default version, corresponding to the given value as a 'CompiledCodeIn', throwing any errors that occur as exceptions and ignoring fresh names. liftCodeDef :: ( Lift.Lift uni a, PLC.GEq uni, ThrowableBuiltins uni fun, PLC.Typecheckable uni fun + , PLC.CaseBuiltin (PIR.Term TyName Name uni fun (Provenance ())) uni + , PLC.CaseBuiltin (UPLC.Term Name uni fun (Provenance ())) uni , Default (PLC.CostingPart uni fun) , Default (PIR.BuiltinsInfo uni fun) , Default (PIR.RewriteRules uni fun) @@ -357,6 +385,8 @@ liftCodeDef = liftCode PLC.latestVersion -- where lifting speed is more important than optimal code. liftCodeDefUnopt :: ( Lift.Lift uni a, PLC.GEq uni, ThrowableBuiltins uni fun, PLC.Typecheckable uni fun + , PLC.CaseBuiltin (PIR.Term TyName Name uni fun (Provenance ())) uni + , PLC.CaseBuiltin (UPLC.Term Name uni fun (Provenance ())) uni , Default (PLC.CostingPart uni fun) , Default (PIR.BuiltinsInfo uni fun) , Default (PIR.RewriteRules uni fun) @@ -387,6 +417,7 @@ typeCheckAgainst , MonadError e m, MonadQuote m , PLC.GEq uni , PLC.Typecheckable uni fun + , PLC.CaseBuiltin (PIR.Term TyName Name uni fun (Provenance ())) uni , PrettyUni uni, Pretty fun , Default (PLC.CostingPart uni fun) , Default (PIR.BuiltinsInfo uni fun) @@ -431,6 +462,8 @@ typeCode , MonadError e m, MonadQuote m , PLC.GEq uni , PLC.Typecheckable uni fun + , PLC.CaseBuiltin (PIR.Term TyName Name uni fun (Provenance ())) uni + , PLC.CaseBuiltin (UPLC.Term Name uni fun ()) uni , PrettyUni uni, Pretty fun , Default (PLC.CostingPart uni fun) , Default (PIR.BuiltinsInfo uni fun) diff --git a/plutus-tx/testlib/PlutusTx/Test.hs b/plutus-tx/testlib/PlutusTx/Test.hs index f5fef4fa090..bb14e156060 100644 --- a/plutus-tx/testlib/PlutusTx/Test.hs +++ b/plutus-tx/testlib/PlutusTx/Test.hs @@ -52,7 +52,9 @@ import PlutusCore.Evaluation.Machine.ExBudgetingDefaults qualified as PLC import PlutusCore.Pretty import PlutusCore.Pretty qualified as PLC import PlutusCore.Test +import PlutusIR qualified as PIR import PlutusIR.Analysis.Builtins as PIR +import PlutusIR.Compiler.Provenance qualified as PIR import PlutusIR.Core.Type (progTerm) import PlutusIR.Test () import PlutusIR.Transform.RewriteRules as PIR @@ -194,6 +196,7 @@ instance ( PLC.PrettyParens (PLC.SomeTypeIn uni) , PLC.GEq uni , PLC.Typecheckable uni fun + , PLC.CaseBuiltin (PIR.Term UPLC.TyName UPLC.Name uni fun (PIR.Provenance PLC.SrcSpans)) uni , PLC.Closed uni , uni `PLC.Everywhere` PrettyConst , Pretty fun From 89f9909f0339ebcc2f4fe54dcc9fb1629763fe97 Mon Sep 17 00:00:00 2001 From: effectfully Date: Sat, 19 Apr 2025 03:54:12 +0200 Subject: [PATCH 02/25] Restore the original case-of-case --- .../UntypedPlutusCore/Transform/CaseOfCase.hs | 17 ++++++++++++++++- .../test/Transform/CaseOfCase/1.uplc.golden | 12 ++++++++---- .../test/Transform/CaseOfCase/3.uplc.golden | 12 ++++++++---- .../Transform/CaseOfCase/withError.uplc.golden | 12 ++++++++---- 4 files changed, 40 insertions(+), 13 deletions(-) diff --git a/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Transform/CaseOfCase.hs b/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Transform/CaseOfCase.hs index fdc200fb325..17c666c4a85 100644 --- a/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Transform/CaseOfCase.hs +++ b/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Transform/CaseOfCase.hs @@ -26,6 +26,7 @@ import PlutusPrelude import PlutusCore qualified as PLC import PlutusCore.Builtin (CaseBuiltin (..)) +import PlutusCore.MkPlc (mkIterApp) import UntypedPlutusCore.Core import UntypedPlutusCore.Transform.CaseReduce qualified as CaseReduce import UntypedPlutusCore.Transform.Simplifier (SimplifierStage (CaseOfCase), SimplifierT, @@ -43,8 +44,22 @@ caseOfCase term = do recordSimplification term CaseOfCase result return result -processTerm :: CaseBuiltin (Term name uni fun a) uni => Term name uni fun a -> Term name uni fun a +processTerm + :: fun ~ PLC.DefaultFun + => CaseBuiltin (Term name uni fun a) uni => Term name uni fun a -> Term name uni fun a processTerm = \case + Case ann scrut alts + | ( ite@(Force a (Builtin _ PLC.IfThenElse)) + , [cond, (trueAnn, true@Constr{}), (falseAnn, false@Constr{})] + ) <- + splitApplication scrut -> + Force a $ + mkIterApp + ite + [ cond + , (trueAnn, Delay trueAnn (Case ann true alts)) + , (falseAnn, Delay falseAnn (Case ann false alts)) + ] original@(Case annOuter (Case annInner scrut altsInner) altsOuter) -> maybe original diff --git a/plutus-core/untyped-plutus-core/test/Transform/CaseOfCase/1.uplc.golden b/plutus-core/untyped-plutus-core/test/Transform/CaseOfCase/1.uplc.golden index 7622ec1cb45..9cf88689c14 100644 --- a/plutus-core/untyped-plutus-core/test/Transform/CaseOfCase/1.uplc.golden +++ b/plutus-core/untyped-plutus-core/test/Transform/CaseOfCase/1.uplc.golden @@ -1,5 +1,9 @@ -(case - [ [ [ (force (builtin ifThenElse)) b ] (constr 0) ] (constr 1) ] - (con integer 1) - (con integer 2) +(force + [ + [ + [ (force (builtin ifThenElse)) b ] + (delay (case (constr 0) (con integer 1) (con integer 2))) + ] + (delay (case (constr 1) (con integer 1) (con integer 2))) + ] ) \ No newline at end of file diff --git a/plutus-core/untyped-plutus-core/test/Transform/CaseOfCase/3.uplc.golden b/plutus-core/untyped-plutus-core/test/Transform/CaseOfCase/3.uplc.golden index 8d6ae17569b..9e7f8874321 100644 --- a/plutus-core/untyped-plutus-core/test/Transform/CaseOfCase/3.uplc.golden +++ b/plutus-core/untyped-plutus-core/test/Transform/CaseOfCase/3.uplc.golden @@ -1,5 +1,9 @@ -(case - [ [ [ (force (builtin ifThenElse)) b ] (constr 0 x xs) ] (constr 1) ] - f - (con integer 2) +(force + [ + [ + [ (force (builtin ifThenElse)) b ] + (delay (case (constr 0 x xs) f (con integer 2))) + ] + (delay (case (constr 1) f (con integer 2))) + ] ) \ No newline at end of file diff --git a/plutus-core/untyped-plutus-core/test/Transform/CaseOfCase/withError.uplc.golden b/plutus-core/untyped-plutus-core/test/Transform/CaseOfCase/withError.uplc.golden index 926050fd444..7cdbc9b7363 100644 --- a/plutus-core/untyped-plutus-core/test/Transform/CaseOfCase/withError.uplc.golden +++ b/plutus-core/untyped-plutus-core/test/Transform/CaseOfCase/withError.uplc.golden @@ -1,5 +1,9 @@ -(case - [ [ [ (force (builtin ifThenElse)) (con bool True) ] (constr 0) ] (constr 1) ] - (con unit ()) - (error) +(force + [ + [ + [ (force (builtin ifThenElse)) (con bool True) ] + (delay (case (constr 0) (con unit ()) (error))) + ] + (delay (case (constr 1) (con unit ()) (error))) + ] ) \ No newline at end of file From 9e65c92f11cdfd37cd99c10f5dd2686cb541161b Mon Sep 17 00:00:00 2001 From: effectfully Date: Tue, 29 Apr 2025 02:02:56 +0100 Subject: [PATCH 03/25] Proper error messages, support for old 'IfThenElse' --- .../src/PlutusCore/Builtin/Case.hs | 5 +-- .../src/PlutusCore/Default/Universe.hs | 20 +++++++++--- .../plutus-core/src/PlutusCore/Error.hs | 6 ++++ .../Evaluation/Machine/Exception.hs | 7 ++++ .../src/PlutusCore/TypeCheck/Internal.hs | 4 +-- .../src/PlutusIR/TypeCheck/Internal.hs | 2 +- .../Evaluation/Machine/Cek/Internal.hs | 2 +- .../Machine/SteppableCek/Internal.hs | 2 +- .../UntypedPlutusCore/Transform/CaseOfCase.hs | 19 +++++++++-- .../Evaluation/Golden/caseNonTag.uplc.golden | 3 +- .../test/Transform/CaseOfCase/1.uplc.golden | 7 ++-- .../test/Transform/CaseOfCase/3.uplc.golden | 7 ++-- .../CaseOfCase/withError.uplc.golden | 7 ++-- .../src/PlutusTx/Compiler/Builtins.hs | 32 ++++++++++++------- .../src/PlutusTx/Compiler/Types.hs | 10 +++--- plutus-tx-plugin/src/PlutusTx/Plugin.hs | 9 ++++-- 16 files changed, 94 insertions(+), 48 deletions(-) diff --git a/plutus-core/plutus-core/src/PlutusCore/Builtin/Case.hs b/plutus-core/plutus-core/src/PlutusCore/Builtin/Case.hs index 430420bd4c9..68afc101984 100644 --- a/plutus-core/plutus-core/src/PlutusCore/Builtin/Case.hs +++ b/plutus-core/plutus-core/src/PlutusCore/Builtin/Case.hs @@ -6,6 +6,7 @@ module PlutusCore.Builtin.Case where import PlutusCore.Core.Type (Type, UniOf) import PlutusCore.Name.Unique +import Data.Text (Text) import Data.Vector (Vector) import Universe @@ -14,7 +15,7 @@ class AnnotateCaseBuiltin uni where :: UniOf term ~ uni => SomeTypeIn uni -> [term] - -> Either () [(term, [Type TyName uni ann])] + -> Either Text [(term, [Type TyName uni ann])] class UniOf term ~ uni => CaseBuiltin term uni where - caseBuiltin :: Some (ValueOf uni) -> Vector term -> Either () term + caseBuiltin :: Some (ValueOf uni) -> Vector term -> Either Text term diff --git a/plutus-core/plutus-core/src/PlutusCore/Default/Universe.hs b/plutus-core/plutus-core/src/PlutusCore/Default/Universe.hs index d13ab81bf77..66f4a4bb828 100644 --- a/plutus-core/plutus-core/src/PlutusCore/Default/Universe.hs +++ b/plutus-core/plutus-core/src/PlutusCore/Default/Universe.hs @@ -538,20 +538,32 @@ instance KnownBuiltinTypeIn DefaultUni term Integer => ReadKnownIn DefaultUni te instance UniOf term ~ DefaultUni => CaseBuiltin term DefaultUni where caseBuiltin (Some (ValueOf uni x)) branches = case uni of + -- TODO: It feels like we should support having only one branch to verify that a condition + -- is true and fail otherwise, but that requires changing the order of branches, which on + -- the one hand is weird and on the other hand matches the order for if-then-else, which is + -- nice. DefaultUniBool | Vector.length branches == 2 -> Right $ branches Vector.! fromEnum x - | otherwise -> Left () + | otherwise -> Left $ fold + [ "'case' on a 'Bool' must have exactly two branches, but were given " + , showText $ Vector.length branches + ] DefaultUniInteger | 0 <= x && x < fromIntegral (Vector.length branches) -> Right $ branches Vector.! fromIntegral x - | otherwise -> Left () - _ -> Left () + | otherwise -> Left $ fold + [ "'case " + , showText x + , "' is out of bounds for the given number of branches: " + , showText $ Vector.length branches + ] + _ -> Left $ display uni <> " isn't supported in 'case'" instance AnnotateCaseBuiltin DefaultUni where annotateCaseBuiltin (SomeTypeIn uni) branches = case uni of DefaultUniBool -> Right $ map (, []) branches DefaultUniInteger -> Right $ map (, []) branches - _ -> Left () + _ -> Left $ display uni <> " isn't supported in 'case'" {- Note [Stable encoding of tags] 'encodeUni' and 'decodeUni' are used for serialisation and deserialisation of types from the diff --git a/plutus-core/plutus-core/src/PlutusCore/Error.hs b/plutus-core/plutus-core/src/PlutusCore/Error.hs index 7ec30398602..a7ac65a6548 100644 --- a/plutus-core/plutus-core/src/PlutusCore/Error.hs +++ b/plutus-core/plutus-core/src/PlutusCore/Error.hs @@ -130,6 +130,7 @@ data TypeError term uni fun ann | FreeTypeVariableE !ann !TyName | FreeVariableE !ann !Name | UnknownBuiltinFunctionE !ann !fun + | UnsupportedCaseBuiltin !ann !T.Text deriving stock (Show, Eq, Generic, Functor) deriving anyclass (NFData) @@ -275,6 +276,11 @@ instance (Pretty term, PrettyUni uni, Pretty fun, Pretty ann) => , pretty $ name1 ^. theUnique , "is attempted to be referenced" ] + prettyBy _ (UnsupportedCaseBuiltin ann err) = hsep + [ "Unsupported 'case' of a value of a built-in type at" + , pretty ann <> ":" + , pretty err + ] instance (PrettyUni uni, Pretty fun, Pretty ann) => PrettyBy PrettyConfigPlc (Error uni fun ann) where diff --git a/plutus-core/plutus-core/src/PlutusCore/Evaluation/Machine/Exception.hs b/plutus-core/plutus-core/src/PlutusCore/Evaluation/Machine/Exception.hs index 3e3e1c09777..608aecbdc46 100644 --- a/plutus-core/plutus-core/src/PlutusCore/Evaluation/Machine/Exception.hs +++ b/plutus-core/plutus-core/src/PlutusCore/Evaluation/Machine/Exception.hs @@ -41,6 +41,7 @@ import PlutusCore.Pretty import Control.Lens import Data.Either.Extras +import Data.Text (Text) import Data.Word (Word64) import Prettyprinter @@ -66,6 +67,8 @@ data MachineError fun -- ^ An attempt to go into a non-existent case branch. | PanicMachineError String -- ^ A GHC exception was thrown. + | CaseBuiltinError Text + -- ^ 'Case' over a value of a built-in type failed. deriving stock (Show, Eq, Functor, Generic) deriving anyclass (NFData) @@ -141,3 +144,7 @@ instance (HasPrettyDefaults config ~ 'True, Pretty fun) => [ "Panic: a GHC exception was thrown, please report this as a bug." , "The error: " <+> pretty err ] + prettyBy _ (CaseBuiltinError err) = vcat + [ "'case' over a value of a built-in type failed with" + , pretty err + ] diff --git a/plutus-core/plutus-core/src/PlutusCore/TypeCheck/Internal.hs b/plutus-core/plutus-core/src/PlutusCore/TypeCheck/Internal.hs index f4e9738ed3c..73c8b9d4ea1 100644 --- a/plutus-core/plutus-core/src/PlutusCore/TypeCheck/Internal.hs +++ b/plutus-core/plutus-core/src/PlutusCore/TypeCheck/Internal.hs @@ -21,7 +21,7 @@ module PlutusCore.TypeCheck.Internal import PlutusCore.Builtin import PlutusCore.Core.Type (Kind (..), Normalized (..), Term (..), Type (..), toPatFuncKind) import PlutusCore.Error (AsTypeError (_TypeError), ExpectedShapeOr (ExpectedExact, ExpectedShape), - TypeError (FreeTypeVariableE, FreeVariableE, KindMismatch, NameMismatch, TyNameMismatch, TypeMismatch, UnknownBuiltinFunctionE)) + TypeError (..)) import PlutusCore.MkPlc (mkIterTyAppNoAnn, mkIterTyFun, mkTyBuiltinOf) import PlutusCore.Name.Unique (HasText (theText), Name (Name), Named (Named), TermUnique, TyName (TyName), TypeUnique, theUnique) @@ -577,7 +577,7 @@ inferTypeM (Case ann resTy scrut branches) = do Right branchesAndArgTypes -> for_ branchesAndArgTypes $ \(c, argTypes) -> -- made of sub-parts of a normalized type, so normalized checkTypeM ann c (Normalized $ mkIterTyFun () argTypes (unNormalized vResTy)) - Left () -> undefined + Left err -> throwing _TypeError $ UnsupportedCaseBuiltin ann err -- scrutinee does not have a SOP type at all _ -> throwing _TypeError (TypeMismatch ann (void scrut) expectedSop vScrutTy) diff --git a/plutus-core/plutus-ir/src/PlutusIR/TypeCheck/Internal.hs b/plutus-core/plutus-ir/src/PlutusIR/TypeCheck/Internal.hs index 2c588fecf5b..2caad36c387 100644 --- a/plutus-core/plutus-ir/src/PlutusIR/TypeCheck/Internal.hs +++ b/plutus-core/plutus-ir/src/PlutusIR/TypeCheck/Internal.hs @@ -292,7 +292,7 @@ inferTypeM (Case ann resTy scrut branches) = do Right branchesAndArgTypes -> for_ branchesAndArgTypes $ \(c, argTypes) -> -- made of sub-parts of a normalized type, so normalized checkTypeM ann c (Normalized $ mkIterTyFun () argTypes (unNormalized vResTy)) - Left () -> undefined + Left err -> throwing _TypeError $ UnsupportedCaseBuiltin ann err -- scrutinee does not have a SOP type at all _ -> throwing _TypeError (TypeMismatch ann (void scrut) expectedSop vScrutTy) diff --git a/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Evaluation/Machine/Cek/Internal.hs b/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Evaluation/Machine/Cek/Internal.hs index 6fb862fabbe..ee36f0a1b31 100644 --- a/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Evaluation/Machine/Cek/Internal.hs +++ b/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Evaluation/Machine/Cek/Internal.hs @@ -786,7 +786,7 @@ enterComputeCek = computeCek Just t -> computeCek (transferArgStack args ctx) env t Nothing -> throwingDischarged _MachineError (MissingCaseBranchMachineError i) e VCon val -> case caseBuiltin val cs of - Left () -> throwingDischarged _MachineError undefined e + Left err -> throwingDischarged _MachineError (CaseBuiltinError err) e Right res -> computeCek ctx env res _ -> throwingDischarged _MachineError NonConstrScrutinizedMachineError e diff --git a/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Evaluation/Machine/SteppableCek/Internal.hs b/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Evaluation/Machine/SteppableCek/Internal.hs index b6da81525e3..5d28549c865 100644 --- a/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Evaluation/Machine/SteppableCek/Internal.hs +++ b/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Evaluation/Machine/SteppableCek/Internal.hs @@ -212,7 +212,7 @@ returnCek (FrameCases ann env cs ctx) e = case e of in computeCek ctx' env t Nothing -> throwingDischarged _MachineError (MissingCaseBranchMachineError i) e VCon val -> case caseBuiltin val cs of - Left () -> throwingDischarged _MachineError undefined e + Left err -> throwingDischarged _MachineError (CaseBuiltinError err) e Right res -> pure $ Computing ctx env res _ -> throwingDischarged _MachineError NonConstrScrutinizedMachineError e diff --git a/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Transform/CaseOfCase.hs b/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Transform/CaseOfCase.hs index 17c666c4a85..331dccfe190 100644 --- a/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Transform/CaseOfCase.hs +++ b/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Transform/CaseOfCase.hs @@ -19,6 +19,21 @@ Example: C1 a -> case x of { D1 -> w; D2 -> z; } C2 b -> case y of { D1 -> w; D2 -> z; } @ + +We also transform + +@ + case ((force ifThenElse) b (constr t) (constr f)) alts +@ + +into + +@ + force (force ifThenElse b (delay (case (constr t) alts)) (delay (case (constr f) alts))) +@ + +This is always an improvement. + -} module UntypedPlutusCore.Transform.CaseOfCase (caseOfCase) where @@ -57,8 +72,8 @@ processTerm = \case mkIterApp ite [ cond - , (trueAnn, Delay trueAnn (Case ann true alts)) - , (falseAnn, Delay falseAnn (Case ann false alts)) + , (trueAnn, Delay trueAnn . CaseReduce.processTerm $ Case ann true alts) + , (falseAnn, Delay falseAnn . CaseReduce.processTerm $ Case ann false alts) ] original@(Case annOuter (Case annInner scrut altsInner) altsOuter) -> maybe diff --git a/plutus-core/untyped-plutus-core/test/Evaluation/Golden/caseNonTag.uplc.golden b/plutus-core/untyped-plutus-core/test/Evaluation/Golden/caseNonTag.uplc.golden index 1bd7d1fbdda..315273b1b83 100644 --- a/plutus-core/untyped-plutus-core/test/Evaluation/Golden/caseNonTag.uplc.golden +++ b/plutus-core/untyped-plutus-core/test/Evaluation/Golden/caseNonTag.uplc.golden @@ -1,3 +1,4 @@ (Left An error has occurred: -A non-constructor value was scrutinized in a case expression +'case' over a value of a built-in type failed with +'case 1' is out of bounds for the given number of branches: 0 Caused by: (con integer 1)) \ No newline at end of file diff --git a/plutus-core/untyped-plutus-core/test/Transform/CaseOfCase/1.uplc.golden b/plutus-core/untyped-plutus-core/test/Transform/CaseOfCase/1.uplc.golden index 9cf88689c14..b9ae07de867 100644 --- a/plutus-core/untyped-plutus-core/test/Transform/CaseOfCase/1.uplc.golden +++ b/plutus-core/untyped-plutus-core/test/Transform/CaseOfCase/1.uplc.golden @@ -1,9 +1,6 @@ (force [ - [ - [ (force (builtin ifThenElse)) b ] - (delay (case (constr 0) (con integer 1) (con integer 2))) - ] - (delay (case (constr 1) (con integer 1) (con integer 2))) + [ [ (force (builtin ifThenElse)) b ] (delay (con integer 1)) ] + (delay (con integer 2)) ] ) \ No newline at end of file diff --git a/plutus-core/untyped-plutus-core/test/Transform/CaseOfCase/3.uplc.golden b/plutus-core/untyped-plutus-core/test/Transform/CaseOfCase/3.uplc.golden index 9e7f8874321..8ca609adaf5 100644 --- a/plutus-core/untyped-plutus-core/test/Transform/CaseOfCase/3.uplc.golden +++ b/plutus-core/untyped-plutus-core/test/Transform/CaseOfCase/3.uplc.golden @@ -1,9 +1,6 @@ (force [ - [ - [ (force (builtin ifThenElse)) b ] - (delay (case (constr 0 x xs) f (con integer 2))) - ] - (delay (case (constr 1) f (con integer 2))) + [ [ (force (builtin ifThenElse)) b ] (delay [ [ f x ] xs ]) ] + (delay (con integer 2)) ] ) \ No newline at end of file diff --git a/plutus-core/untyped-plutus-core/test/Transform/CaseOfCase/withError.uplc.golden b/plutus-core/untyped-plutus-core/test/Transform/CaseOfCase/withError.uplc.golden index 7cdbc9b7363..f0fa02f8286 100644 --- a/plutus-core/untyped-plutus-core/test/Transform/CaseOfCase/withError.uplc.golden +++ b/plutus-core/untyped-plutus-core/test/Transform/CaseOfCase/withError.uplc.golden @@ -1,9 +1,6 @@ (force [ - [ - [ (force (builtin ifThenElse)) (con bool True) ] - (delay (case (constr 0) (con unit ()) (error))) - ] - (delay (case (constr 1) (con unit ()) (error))) + [ [ (force (builtin ifThenElse)) (con bool True) ] (delay (con unit ())) ] + (delay (error)) ] ) \ No newline at end of file diff --git a/plutus-tx-plugin/src/PlutusTx/Compiler/Builtins.hs b/plutus-tx-plugin/src/PlutusTx/Compiler/Builtins.hs index 4dc4a261139..a0ced8216bf 100644 --- a/plutus-tx-plugin/src/PlutusTx/Compiler/Builtins.hs +++ b/plutus-tx-plugin/src/PlutusTx/Compiler/Builtins.hs @@ -30,6 +30,7 @@ import PlutusTx.PIRTypes import PlutusIR qualified as PIR import PlutusIR.Compiler.Definitions qualified as PIR import PlutusIR.Compiler.Names +import PlutusIR.Compiler.Types qualified as PIR import PlutusIR.MkPir qualified as PIR import PlutusIR.Purity qualified as PIR @@ -329,6 +330,8 @@ defineBuiltinType name ty = do -- | Add definitions for all the builtin terms to the environment. defineBuiltinTerms :: CompilingDefault uni fun m ann => m () defineBuiltinTerms = do + datatypeStyle <- asks $ coDatatypeStyle . ccOpts + -- Error -- See Note [Delaying error] func <- delayedErrorFunc @@ -364,18 +367,23 @@ defineBuiltinTerms = do for_ enumerate $ \fun -> let defineBuiltinInl impl = defineBuiltinTerm annMayInline impl $ mkBuiltin fun in case fun of - PLC.IfThenElse -> defineBuiltinTerm annMayInline 'Builtins.ifThenElse $ - fmap (const annMayInline) . runQuote $ do - a <- freshTyName "a" - b <- freshName "b" - x <- freshName "x" - y <- freshName "y" - return - . PIR.tyAbs () a (PLC.Type ()) - . PIR.lamAbs () b (PLC.mkTyBuiltin @_ @Bool ()) - . PIR.lamAbs () x (PLC.TyVar () a) - . PIR.lamAbs () y (PLC.TyVar () a) - $ PIR.kase () (PLC.TyVar () a) (PIR.Var () b) [PIR.Var () y, PIR.Var () x] + PLC.IfThenElse -> case datatypeStyle of + PIR.ScottEncoding -> defineBuiltinInl 'Builtins.ifThenElse + PIR.SumsOfProducts -> defineBuiltinTerm annMayInline 'Builtins.ifThenElse $ + fmap (const annMayInline) . runQuote $ do + a <- freshTyName "a" + b <- freshName "b" + x <- freshName "x" + y <- freshName "y" + return + . PIR.tyAbs () a (PLC.Type ()) + . PIR.lamAbs () b (PLC.mkTyBuiltin @_ @Bool ()) + . PIR.lamAbs () x (PLC.TyVar () a) + . PIR.lamAbs () y (PLC.TyVar () a) + $ PIR.kase () + (PLC.TyVar () a) + (PIR.Var () b) + [PIR.Var () y, PIR.Var () x] PLC.ChooseUnit -> defineBuiltinInl 'Builtins.chooseUnit -- Bytestrings diff --git a/plutus-tx-plugin/src/PlutusTx/Compiler/Types.hs b/plutus-tx-plugin/src/PlutusTx/Compiler/Types.hs index cd762e39525..f95ed5fd966 100644 --- a/plutus-tx-plugin/src/PlutusTx/Compiler/Types.hs +++ b/plutus-tx-plugin/src/PlutusTx/Compiler/Types.hs @@ -19,6 +19,7 @@ import PlutusTx.PLCTypes import PlutusIR.Analysis.Builtins qualified as PIR import PlutusIR.Compiler.Definitions +import PlutusIR.Compiler.Types qualified as PIR import PlutusIR.Transform.RewriteRules qualified as PIR import PlutusCore.Annotation @@ -46,10 +47,11 @@ type NameInfo = Map.Map TH.Name GHC.TyThing -- | Compilation options. data CompileOptions = CompileOptions { - coProfile :: ProfileOpts - , coCoverage :: CoverageOpts - , coRemoveTrace :: Bool - , coInlineFix :: Bool + coProfile :: ProfileOpts + , coCoverage :: CoverageOpts + , coDatatypeStyle :: PIR.DatatypeStyle + , coRemoveTrace :: Bool + , coInlineFix :: Bool } data CompileContext uni fun = CompileContext { diff --git a/plutus-tx-plugin/src/PlutusTx/Plugin.hs b/plutus-tx-plugin/src/PlutusTx/Plugin.hs index ffbb5ef7450..1adf52b7bb1 100644 --- a/plutus-tx-plugin/src/PlutusTx/Plugin.hs +++ b/plutus-tx-plugin/src/PlutusTx/Plugin.hs @@ -398,6 +398,10 @@ compileMarkedExpr locStr codeTy origE = do ccOpts = CompileOptions { coProfile=_posProfile opts ,coCoverage=coverage + ,coDatatypeStyle = + if _posPlcTargetVersion opts < PLC.plcVersion110 + then PIR.ScottEncoding + else PIR.SumsOfProducts ,coRemoveTrace=_posRemoveTrace opts ,coInlineFix=_posInlineFix opts}, ccFlags = flags, @@ -456,6 +460,7 @@ runCompiler :: runCompiler moduleName opts expr = do -- Plc configuration plcTcConfig <- PLC.getDefTypeCheckConfig PIR.noProvenance + datatypeStyle <- asks $ coDatatypeStyle . ccOpts let plcVersion = opts ^. posPlcTargetVersion let hints = UPLC.InlineHints $ \ann _ -> case ann of @@ -514,9 +519,7 @@ runCompiler moduleName opts expr = do -- 1. The only other choice you can make is new version + Scott encoding, and -- there's really no reason to pick that -- 2. This is consistent with what we do in Lift - & set (PIR.ccOpts . PIR.coDatatypes . PIR.dcoStyle) - (if plcVersion < PLC.plcVersion110 - then PIR.ScottEncoding else PIR.SumsOfProducts) + & set (PIR.ccOpts . PIR.coDatatypes . PIR.dcoStyle) datatypeStyle -- TODO: ensure the same as the one used in the plugin & set PIR.ccBuiltinsInfo def & set PIR.ccBuiltinCostModel def From 50689dc0fcd53812e5a3642ac62ad70e325942ee Mon Sep 17 00:00:00 2001 From: effectfully Date: Fri, 16 May 2025 17:05:37 +0100 Subject: [PATCH 04/25] Make the default branch correspond to 'False' --- .../src/PlutusCore/Default/Universe.hs | 35 +++++++++---------- 1 file changed, 17 insertions(+), 18 deletions(-) diff --git a/plutus-core/plutus-core/src/PlutusCore/Default/Universe.hs b/plutus-core/plutus-core/src/PlutusCore/Default/Universe.hs index fa4b2e68541..a0c3a3da212 100644 --- a/plutus-core/plutus-core/src/PlutusCore/Default/Universe.hs +++ b/plutus-core/plutus-core/src/PlutusCore/Default/Universe.hs @@ -6,6 +6,7 @@ -- to test that some constraints are solvable {-# OPTIONS -Wno-redundant-constraints #-} +{-# LANGUAGE BangPatterns #-} {-# LANGUAGE BlockArguments #-} {-# LANGUAGE CPP #-} {-# LANGUAGE ConstraintKinds #-} @@ -520,28 +521,26 @@ instance KnownBuiltinTypeIn DefaultUni term Integer => ReadKnownIn DefaultUni te ] {-# INLINE readKnown #-} +outOfBoundsErr :: Pretty a => a -> Vector.Vector term -> Text +outOfBoundsErr x branches = fold + [ "'case " + , display x + , "' is out of bounds for the given number of branches: " + , display $ Vector.length branches + ] + instance UniOf term ~ DefaultUni => CaseBuiltin term DefaultUni where caseBuiltin (Some (ValueOf uni x)) branches = case uni of - -- TODO: It feels like we should support having only one branch to verify that a condition - -- is true and fail otherwise, but that requires changing the order of branches, which on - -- the one hand is weird and on the other hand matches the order for if-then-else, which is - -- nice. - DefaultUniBool - | Vector.length branches == 2 -> Right $ branches Vector.! fromEnum x - | otherwise -> Left $ fold - [ "'case' on a 'Bool' must have exactly two branches, but were given " - , showText $ Vector.length branches - ] + DefaultUniBool -> case x of + False | len == 1 || len == 2 -> Right $ branches Vector.! 0 + True | len == 2 -> Right $ branches Vector.! 1 + _ -> Left $ outOfBoundsErr x branches DefaultUniInteger - | 0 <= x && x < fromIntegral (Vector.length branches) -> - Right $ branches Vector.! fromIntegral x - | otherwise -> Left $ fold - [ "'case " - , showText x - , "' is out of bounds for the given number of branches: " - , showText $ Vector.length branches - ] + | 0 <= x && x < fromIntegral len -> Right $ branches Vector.! fromIntegral x + | otherwise -> Left $ outOfBoundsErr x branches _ -> Left $ display uni <> " isn't supported in 'case'" + where + !len = Vector.length branches instance AnnotateCaseBuiltin DefaultUni where annotateCaseBuiltin (SomeTypeIn uni) branches = case uni of From 43789e2368283f8db57d026ed7a704ffce4b1922 Mon Sep 17 00:00:00 2001 From: effectfully Date: Mon, 19 May 2025 12:26:59 +0100 Subject: [PATCH 05/25] Fix conformance tests --- .../evaluation/term/case/case-5/case-5.uplc.budget.expected | 3 ++- .../uplc/evaluation/term/case/case-5/case-5.uplc.expected | 2 +- 2 files changed, 3 insertions(+), 2 deletions(-) diff --git a/plutus-conformance/test-cases/uplc/evaluation/term/case/case-5/case-5.uplc.budget.expected b/plutus-conformance/test-cases/uplc/evaluation/term/case/case-5/case-5.uplc.budget.expected index ccc477ffed6..f736fb48118 100644 --- a/plutus-conformance/test-cases/uplc/evaluation/term/case/case-5/case-5.uplc.budget.expected +++ b/plutus-conformance/test-cases/uplc/evaluation/term/case/case-5/case-5.uplc.budget.expected @@ -1 +1,2 @@ -evaluation failure \ No newline at end of file +({cpu: 48100 +| mem: 400}) \ No newline at end of file diff --git a/plutus-conformance/test-cases/uplc/evaluation/term/case/case-5/case-5.uplc.expected b/plutus-conformance/test-cases/uplc/evaluation/term/case/case-5/case-5.uplc.expected index ccc477ffed6..e5829cd8efc 100644 --- a/plutus-conformance/test-cases/uplc/evaluation/term/case/case-5/case-5.uplc.expected +++ b/plutus-conformance/test-cases/uplc/evaluation/term/case/case-5/case-5.uplc.expected @@ -1 +1 @@ -evaluation failure \ No newline at end of file +(program 1.1.0 (lam x-0 x-0)) \ No newline at end of file From 15f15b9cfae35ffe5f59c79eaa46508793ffd303 Mon Sep 17 00:00:00 2001 From: effectfully Date: Thu, 22 May 2025 17:09:54 +0100 Subject: [PATCH 06/25] Add 'Case on constants' tests --- .../Evaluation/Machine/Exception.hs | 7 --- .../Evaluation/Machine/Cek/ExBudgetMode.hs | 3 +- .../Evaluation/Machine/Cek/Internal.hs | 9 +++- .../Machine/SteppableCek/Internal.hs | 2 +- .../testlib/Evaluation/Builtins/Definition.hs | 51 +++++++++++++++++++ 5 files changed, 60 insertions(+), 12 deletions(-) diff --git a/plutus-core/plutus-core/src/PlutusCore/Evaluation/Machine/Exception.hs b/plutus-core/plutus-core/src/PlutusCore/Evaluation/Machine/Exception.hs index def3b0879a1..d77b7bc458a 100644 --- a/plutus-core/plutus-core/src/PlutusCore/Evaluation/Machine/Exception.hs +++ b/plutus-core/plutus-core/src/PlutusCore/Evaluation/Machine/Exception.hs @@ -41,7 +41,6 @@ import PlutusCore.Pretty import Control.Lens import Data.Either.Extras -import Data.Text (Text) import Data.Word (Word64) import Prettyprinter @@ -67,8 +66,6 @@ data MachineError fun -- ^ An attempt to go into a non-existent case branch. | PanicMachineError String -- ^ A GHC exception was thrown. - | CaseBuiltinError Text - -- ^ 'Case' over a value of a built-in type failed. deriving stock (Show, Eq, Functor, Generic) deriving anyclass (NFData) @@ -139,7 +136,3 @@ instance (HasPrettyDefaults config ~ 'True, Pretty fun) => [ "Panic: a GHC exception was thrown, please report this as a bug." , "The error: " <+> pretty err ] - prettyBy _ (CaseBuiltinError err) = vcat - [ "'case' over a value of a built-in type failed with" - , pretty err - ] diff --git a/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Evaluation/Machine/Cek/ExBudgetMode.hs b/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Evaluation/Machine/Cek/ExBudgetMode.hs index ff678e053c1..28f8f65b8e8 100644 --- a/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Evaluation/Machine/Cek/ExBudgetMode.hs +++ b/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Evaluation/Machine/Cek/ExBudgetMode.hs @@ -149,8 +149,7 @@ restricting (ExRestrictingBudget initB@(ExBudget cpuInit memInit)) = ExBudgetMod -- @spend@ without this bang. Bangs on @cpuLeft'@ and @memLeft'@ don't help -- either as those are forced by 'writeCpu' and 'writeMem' anyway. Go figure. !budgetLeft = ExBudget cpuLeft' memLeft' - throwing _OperationalError - (CekOutOfExError $ ExRestrictingBudget budgetLeft) + throwing _OperationalError . CekOutOfExError $ ExRestrictingBudget budgetLeft spender = CekBudgetSpender spend remaining = ExBudget <$> readCpu <*> readMem cumulative = do diff --git a/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Evaluation/Machine/Cek/Internal.hs b/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Evaluation/Machine/Cek/Internal.hs index 7dded762686..e59bfa85d31 100644 --- a/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Evaluation/Machine/Cek/Internal.hs +++ b/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Evaluation/Machine/Cek/Internal.hs @@ -408,7 +408,8 @@ type GivenCekCosts = (?cekCosts :: CekMachineCosts) type GivenCekReqs uni fun ann s = (GivenCekRuntime uni fun ann, GivenCekEmitter uni fun s, GivenCekSpender uni fun s, GivenCekSlippage, GivenCekStepCounter s, GivenCekCosts) data CekUserError - = CekOutOfExError !ExRestrictingBudget -- ^ The final overspent (i.e. negative) budget. + = CaseBuiltinError Text -- ^ 'Case' over a value of a built-in type failed. + | CekOutOfExError !ExRestrictingBudget -- ^ The final overspent (i.e. negative) budget. | CekEvaluationFailure -- ^ Error has been called or a builtin application has failed deriving stock (Show, Eq, Generic) deriving anyclass (NFData) @@ -511,6 +512,10 @@ instance AsUnliftingError CekUserError where _UnliftingError = _UnliftingErrorVia CekEvaluationFailure instance Pretty CekUserError where + pretty (CaseBuiltinError err) = vcat + [ "'case' over a value of a built-in type failed with" + , pretty err + ] pretty (CekOutOfExError (ExRestrictingBudget res)) = cat [ "The machine terminated part way through evaluation due to overspending the budget." @@ -786,7 +791,7 @@ enterComputeCek = computeCek Just t -> computeCek (transferArgStack args ctx) env t Nothing -> throwingDischarged _StructuralError (MissingCaseBranchMachineError i) e VCon val -> case caseBuiltin val cs of - Left err -> throwingDischarged _StructuralError (CaseBuiltinError err) e + Left err -> throwingDischarged _OperationalError (CaseBuiltinError err) e Right res -> computeCek ctx env res _ -> throwingDischarged _StructuralError NonConstrScrutinizedMachineError e diff --git a/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Evaluation/Machine/SteppableCek/Internal.hs b/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Evaluation/Machine/SteppableCek/Internal.hs index c42c8b1d552..7a34330890c 100644 --- a/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Evaluation/Machine/SteppableCek/Internal.hs +++ b/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Evaluation/Machine/SteppableCek/Internal.hs @@ -212,7 +212,7 @@ returnCek (FrameCases ann env cs ctx) e = case e of in computeCek ctx' env t Nothing -> throwingDischarged _StructuralError (MissingCaseBranchMachineError i) e VCon val -> case caseBuiltin val cs of - Left err -> throwingDischarged _StructuralError (CaseBuiltinError err) e + Left err -> throwingDischarged _OperationalError (CaseBuiltinError err) e Right res -> pure $ Computing ctx env res _ -> throwingDischarged _StructuralError NonConstrScrutinizedMachineError e diff --git a/plutus-core/untyped-plutus-core/testlib/Evaluation/Builtins/Definition.hs b/plutus-core/untyped-plutus-core/testlib/Evaluation/Builtins/Definition.hs index 691c57a9dcd..d22b615f039 100644 --- a/plutus-core/untyped-plutus-core/testlib/Evaluation/Builtins/Definition.hs +++ b/plutus-core/untyped-plutus-core/testlib/Evaluation/Builtins/Definition.hs @@ -1215,6 +1215,56 @@ test_Bitwise_CIP0123 = ] ] +test_Case :: TestTree +test_Case = + testGroup "Case on constants" + [ QC.testProperty "Bool success" . QC.withMaxSuccess 99 $ + \(scrut :: Bool) (i :: Integer) (j :: Integer) -> + let term :: TermLike term tyname name DefaultUni DefaultFun => term () + term = + kase () + (mkTyBuiltin @_ @Integer ()) + (mkConstant () scrut) + [mkConstant () i, mkConstant () j] + in Right (EvaluationSuccess . mkConstant () $ if not scrut then i else j) QC.=== + typecheckEvaluateCekNoEmit def defaultBuiltinCostModelForTesting term + , QC.testProperty "Bool any" . QC.withMaxSuccess 99 $ + \(scrut :: Bool) (is :: [Integer]) -> + let term :: TermLike term tyname name DefaultUni DefaultFun => term () + term = + kase () + (mkTyBuiltin @_ @Integer ()) + (mkConstant () scrut) + (map (mkConstant ()) is) + in case typecheckEvaluateCekNoEmit def defaultBuiltinCostModelForTesting term of + Left _ -> False + Right EvaluationFailure -> length is /= 2 && (scrut || length is /= 1) + Right (EvaluationSuccess res) -> res == mkConstant () (is !! fromEnum scrut) + , QC.testProperty "Integer success" . QC.withMaxSuccess 99 $ + \(QC.NonEmpty is :: QC.NonEmptyList Integer) -> + QC.forAll (QC.chooseInt (0, length is - 1)) $ \scrut -> + let term :: TermLike term tyname name DefaultUni DefaultFun => term () + term = + kase () + (mkTyBuiltin @_ @Integer ()) + (mkConstant () $ toInteger scrut) + (map (mkConstant ()) is) + in Right (EvaluationSuccess . mkConstant () $ is !! scrut) QC.=== + typecheckEvaluateCekNoEmit def defaultBuiltinCostModelForTesting term + , QC.testProperty "Integer any" . QC.withMaxSuccess 99 $ + \(scrut :: Integer) (is :: [Integer]) -> + let term :: TermLike term tyname name DefaultUni DefaultFun => term () + term = + kase () + (mkTyBuiltin @_ @Integer ()) + (mkConstant () scrut) + (map (mkConstant ()) is) + in case typecheckEvaluateCekNoEmit def defaultBuiltinCostModelForTesting term of + Left _ -> False + Right EvaluationFailure -> 0 > scrut || scrut >= fromIntegral (length is) + Right (EvaluationSuccess res) -> res == mkConstant () (is !! fromIntegral scrut) + ] + test_definition :: TestTree test_definition = testGroup "definition" @@ -1258,4 +1308,5 @@ test_definition = , test_Conversion , test_Bitwise_CIP0122 , test_Bitwise_CIP0123 + , test_Case ] From eaf8284b90cd9b6a3af17d1687faf638b70b0410 Mon Sep 17 00:00:00 2001 From: effectfully Date: Thu, 22 May 2025 22:19:27 +0100 Subject: [PATCH 07/25] Docs --- plutus-core/plutus-core/src/PlutusCore/Builtin/Case.hs | 5 +++++ plutus-core/plutus-core/src/PlutusCore/Default/Universe.hs | 7 +++++-- .../plutus-core/src/PlutusCore/TypeCheck/Internal.hs | 5 +++-- plutus-core/plutus-ir/src/PlutusIR/TypeCheck/Internal.hs | 5 +++-- .../src/UntypedPlutusCore/Transform/CaseOfCase.hs | 1 - 5 files changed, 16 insertions(+), 7 deletions(-) diff --git a/plutus-core/plutus-core/src/PlutusCore/Builtin/Case.hs b/plutus-core/plutus-core/src/PlutusCore/Builtin/Case.hs index 68afc101984..50710c0a71c 100644 --- a/plutus-core/plutus-core/src/PlutusCore/Builtin/Case.hs +++ b/plutus-core/plutus-core/src/PlutusCore/Builtin/Case.hs @@ -11,6 +11,8 @@ import Data.Vector (Vector) import Universe class AnnotateCaseBuiltin uni where + -- | Given a tag for a built-in type and a list of branches, annotate each of the branches with + -- its expected type or fail if casing on values of the built-in type isn't supported. annotateCaseBuiltin :: UniOf term ~ uni => SomeTypeIn uni @@ -18,4 +20,7 @@ class AnnotateCaseBuiltin uni where -> Either Text [(term, [Type TyName uni ann])] class UniOf term ~ uni => CaseBuiltin term uni where + -- | Given a constant with its type tag and a vector of branches, choose the appropriate branch + -- or fail if the constant doesn't correspond to any of the branches (or casing on constants of + -- this type isn't supported at all). caseBuiltin :: Some (ValueOf uni) -> Vector term -> Either Text term diff --git a/plutus-core/plutus-core/src/PlutusCore/Default/Universe.hs b/plutus-core/plutus-core/src/PlutusCore/Default/Universe.hs index 9ee4501e404..489802f3fd6 100644 --- a/plutus-core/plutus-core/src/PlutusCore/Default/Universe.hs +++ b/plutus-core/plutus-core/src/PlutusCore/Default/Universe.hs @@ -532,12 +532,15 @@ outOfBoundsErr x branches = fold instance UniOf term ~ DefaultUni => CaseBuiltin term DefaultUni where caseBuiltin (Some (ValueOf uni x)) branches = case uni of DefaultUniBool -> case x of + -- We allow there to be only one branch as long as the scrutinee is 'False'. + -- This is strictly to save size by not having the 'True' branch if it was gonna be + -- 'Error' anyway. False | len == 1 || len == 2 -> Right $ branches Vector.! 0 True | len == 2 -> Right $ branches Vector.! 1 _ -> Left $ outOfBoundsErr x branches DefaultUniInteger - | 0 <= x && x < fromIntegral len -> Right $ branches Vector.! fromIntegral x - | otherwise -> Left $ outOfBoundsErr x branches + | 0 <= x && x < toInteger len -> Right $ branches Vector.! fromInteger x + | otherwise -> Left $ outOfBoundsErr x branches _ -> Left $ display uni <> " isn't supported in 'case'" where !len = Vector.length branches diff --git a/plutus-core/plutus-core/src/PlutusCore/TypeCheck/Internal.hs b/plutus-core/plutus-core/src/PlutusCore/TypeCheck/Internal.hs index 73c8b9d4ea1..f7690c5d8dc 100644 --- a/plutus-core/plutus-core/src/PlutusCore/TypeCheck/Internal.hs +++ b/plutus-core/plutus-core/src/PlutusCore/TypeCheck/Internal.hs @@ -574,9 +574,10 @@ inferTypeM (Case ann resTy scrut branches) = do -- for the number of branches Nothing -> throwing _TypeError (TypeMismatch ann (void scrut) expectedSop vScrutTy) TyBuiltin _ someUni -> case annotateCaseBuiltin someUni branches of - Right branchesAndArgTypes -> for_ branchesAndArgTypes $ \(c, argTypes) -> + Right branchesAndArgTypes -> for_ branchesAndArgTypes $ \(c, argTypes) -> do + vArgTypes <- traverse (fmap unNormalized . normalizeTypeM) argTypes -- made of sub-parts of a normalized type, so normalized - checkTypeM ann c (Normalized $ mkIterTyFun () argTypes (unNormalized vResTy)) + checkTypeM ann c (Normalized $ mkIterTyFun () vArgTypes (unNormalized vResTy)) Left err -> throwing _TypeError $ UnsupportedCaseBuiltin ann err -- scrutinee does not have a SOP type at all _ -> throwing _TypeError (TypeMismatch ann (void scrut) expectedSop vScrutTy) diff --git a/plutus-core/plutus-ir/src/PlutusIR/TypeCheck/Internal.hs b/plutus-core/plutus-ir/src/PlutusIR/TypeCheck/Internal.hs index 2caad36c387..03bd7bbfa6c 100644 --- a/plutus-core/plutus-ir/src/PlutusIR/TypeCheck/Internal.hs +++ b/plutus-core/plutus-ir/src/PlutusIR/TypeCheck/Internal.hs @@ -289,9 +289,10 @@ inferTypeM (Case ann resTy scrut branches) = do -- for the number of branches Nothing -> throwing _TypeError (TypeMismatch ann (void scrut) expectedSop vScrutTy) TyBuiltin _ someUni -> case annotateCaseBuiltin someUni branches of - Right branchesAndArgTypes -> for_ branchesAndArgTypes $ \(c, argTypes) -> + Right branchesAndArgTypes -> for_ branchesAndArgTypes $ \(c, argTypes) -> do + vArgTypes <- traverse (fmap unNormalized . normalizeTypeM) argTypes -- made of sub-parts of a normalized type, so normalized - checkTypeM ann c (Normalized $ mkIterTyFun () argTypes (unNormalized vResTy)) + checkTypeM ann c (Normalized $ mkIterTyFun () vArgTypes (unNormalized vResTy)) Left err -> throwing _TypeError $ UnsupportedCaseBuiltin ann err -- scrutinee does not have a SOP type at all _ -> throwing _TypeError (TypeMismatch ann (void scrut) expectedSop vScrutTy) diff --git a/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Transform/CaseOfCase.hs b/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Transform/CaseOfCase.hs index 331dccfe190..20ba218fc5c 100644 --- a/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Transform/CaseOfCase.hs +++ b/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Transform/CaseOfCase.hs @@ -33,7 +33,6 @@ into @ This is always an improvement. - -} module UntypedPlutusCore.Transform.CaseOfCase (caseOfCase) where From 7c5387eb3fffba4b2a8c3b759cfe0acd02f09f8e Mon Sep 17 00:00:00 2001 From: effectfully Date: Thu, 22 May 2025 22:21:22 +0100 Subject: [PATCH 08/25] Cosmetics --- .../plutus-core/src/PlutusCore/Default/Universe.hs | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/plutus-core/plutus-core/src/PlutusCore/Default/Universe.hs b/plutus-core/plutus-core/src/PlutusCore/Default/Universe.hs index 489802f3fd6..2c7fe7b8462 100644 --- a/plutus-core/plutus-core/src/PlutusCore/Default/Universe.hs +++ b/plutus-core/plutus-core/src/PlutusCore/Default/Universe.hs @@ -529,6 +529,12 @@ outOfBoundsErr x branches = fold , display $ Vector.length branches ] +instance AnnotateCaseBuiltin DefaultUni where + annotateCaseBuiltin (SomeTypeIn uni) branches = case uni of + DefaultUniBool -> Right $ map (, []) branches + DefaultUniInteger -> Right $ map (, []) branches + _ -> Left $ display uni <> " isn't supported in 'case'" + instance UniOf term ~ DefaultUni => CaseBuiltin term DefaultUni where caseBuiltin (Some (ValueOf uni x)) branches = case uni of DefaultUniBool -> case x of @@ -545,12 +551,6 @@ instance UniOf term ~ DefaultUni => CaseBuiltin term DefaultUni where where !len = Vector.length branches -instance AnnotateCaseBuiltin DefaultUni where - annotateCaseBuiltin (SomeTypeIn uni) branches = case uni of - DefaultUniBool -> Right $ map (, []) branches - DefaultUniInteger -> Right $ map (, []) branches - _ -> Left $ display uni <> " isn't supported in 'case'" - {- Note [Stable encoding of tags] 'encodeUni' and 'decodeUni' are used for serialisation and deserialisation of types from the universe and we need serialised things to be extremely stable, hence the definitions of 'encodeUni' From b63ff2f0ce50c5db0c02a7714beccc6c70b885ea Mon Sep 17 00:00:00 2001 From: effectfully Date: Fri, 23 May 2025 14:06:09 +0100 Subject: [PATCH 09/25] Fix a test --- .../test-cases/uplc/evaluation/term/case/case-5/case-5.uplc | 2 +- .../evaluation/term/case/case-5/case-5.uplc.budget.expected | 3 +-- .../uplc/evaluation/term/case/case-5/case-5.uplc.expected | 2 +- 3 files changed, 3 insertions(+), 4 deletions(-) diff --git a/plutus-conformance/test-cases/uplc/evaluation/term/case/case-5/case-5.uplc b/plutus-conformance/test-cases/uplc/evaluation/term/case/case-5/case-5.uplc index 5478b91829b..886cca67826 100644 --- a/plutus-conformance/test-cases/uplc/evaluation/term/case/case-5/case-5.uplc +++ b/plutus-conformance/test-cases/uplc/evaluation/term/case/case-5/case-5.uplc @@ -1,4 +1,4 @@ -- case of non-constr (program 1.1.0 - (case (con integer 1) (lam x x) (lam x x)) + (case (lam x x) (lam x x) (lam x x)) ) diff --git a/plutus-conformance/test-cases/uplc/evaluation/term/case/case-5/case-5.uplc.budget.expected b/plutus-conformance/test-cases/uplc/evaluation/term/case/case-5/case-5.uplc.budget.expected index f736fb48118..ccc477ffed6 100644 --- a/plutus-conformance/test-cases/uplc/evaluation/term/case/case-5/case-5.uplc.budget.expected +++ b/plutus-conformance/test-cases/uplc/evaluation/term/case/case-5/case-5.uplc.budget.expected @@ -1,2 +1 @@ -({cpu: 48100 -| mem: 400}) \ No newline at end of file +evaluation failure \ No newline at end of file diff --git a/plutus-conformance/test-cases/uplc/evaluation/term/case/case-5/case-5.uplc.expected b/plutus-conformance/test-cases/uplc/evaluation/term/case/case-5/case-5.uplc.expected index e5829cd8efc..ccc477ffed6 100644 --- a/plutus-conformance/test-cases/uplc/evaluation/term/case/case-5/case-5.uplc.expected +++ b/plutus-conformance/test-cases/uplc/evaluation/term/case/case-5/case-5.uplc.expected @@ -1 +1 @@ -(program 1.1.0 (lam x-0 x-0)) \ No newline at end of file +evaluation failure \ No newline at end of file From 35c61d85243e4a063c4965eb6124a26782f5a655 Mon Sep 17 00:00:00 2001 From: effectfully Date: Fri, 23 May 2025 23:26:37 +0100 Subject: [PATCH 10/25] Apply 'fourmolu' to 'plutus-tx' --- plutus-tx/src/Data/Aeson/Extra.hs | 16 +- plutus-tx/src/PlutusTx.hs | 55 +- plutus-tx/src/PlutusTx/Applicative.hs | 79 +- plutus-tx/src/PlutusTx/AsData/Internal.hs | 7 +- plutus-tx/src/PlutusTx/AssocMap.hs | 260 ++-- plutus-tx/src/PlutusTx/Base.hs | 41 +- plutus-tx/src/PlutusTx/Blueprint/Class.hs | 14 +- plutus-tx/src/PlutusTx/Blueprint/Contract.hs | 26 +- .../src/PlutusTx/Blueprint/Definition.hs | 12 +- .../PlutusTx/Blueprint/Definition/Derive.hs | 2 +- .../src/PlutusTx/Blueprint/Definition/Id.hs | 22 +- .../PlutusTx/Blueprint/Definition/Internal.hs | 2 +- .../PlutusTx/Blueprint/Definition/Unroll.hs | 6 +- plutus-tx/src/PlutusTx/Blueprint/Parameter.hs | 2 +- .../src/PlutusTx/Blueprint/PlutusVersion.hs | 2 +- plutus-tx/src/PlutusTx/Blueprint/Preamble.hs | 5 +- plutus-tx/src/PlutusTx/Blueprint/Purpose.hs | 8 +- plutus-tx/src/PlutusTx/Blueprint/Schema.hs | 12 +- .../PlutusTx/Blueprint/Schema/Annotation.hs | 6 +- plutus-tx/src/PlutusTx/Blueprint/TH.hs | 45 +- plutus-tx/src/PlutusTx/Blueprint/Validator.hs | 18 +- plutus-tx/src/PlutusTx/Bool.hs | 36 +- plutus-tx/src/PlutusTx/Builtins.hs | 1053 +++++++++-------- plutus-tx/src/PlutusTx/Builtins/HasBuiltin.hs | 132 ++- plutus-tx/src/PlutusTx/Builtins/HasOpaque.hs | 1 - plutus-tx/src/PlutusTx/Builtins/Internal.hs | 549 +++++---- plutus-tx/src/PlutusTx/Code.hs | 133 ++- plutus-tx/src/PlutusTx/Coverage.hs | 186 +-- plutus-tx/src/PlutusTx/Data/AssocMap.hs | 720 +++++------ plutus-tx/src/PlutusTx/Data/List.hs | 891 +++++++------- plutus-tx/src/PlutusTx/Data/List/TH.hs | 40 +- plutus-tx/src/PlutusTx/Either.hs | 10 +- plutus-tx/src/PlutusTx/Enum.hs | 122 +- plutus-tx/src/PlutusTx/Eq.hs | 92 +- plutus-tx/src/PlutusTx/ErrorCodes.hs | 90 +- plutus-tx/src/PlutusTx/Foldable.hs | 90 +- plutus-tx/src/PlutusTx/Functor.hs | 63 +- plutus-tx/src/PlutusTx/IsData/Class.hs | 252 ++-- plutus-tx/src/PlutusTx/IsData/TH.hs | 263 ++-- plutus-tx/src/PlutusTx/Lattice.hs | 117 +- plutus-tx/src/PlutusTx/Lift.hs | 595 ++++++---- plutus-tx/src/PlutusTx/Lift/Class.hs | 207 ++-- plutus-tx/src/PlutusTx/Lift/Instances.hs | 3 +- plutus-tx/src/PlutusTx/Lift/TH.hs | 562 ++++----- plutus-tx/src/PlutusTx/Lift/THUtils.hs | 56 +- plutus-tx/src/PlutusTx/Lift/TestInstances.hs | 43 +- plutus-tx/src/PlutusTx/List.hs | 585 ++++----- plutus-tx/src/PlutusTx/Maybe.hs | 79 +- plutus-tx/src/PlutusTx/Monoid.hs | 70 +- plutus-tx/src/PlutusTx/Numeric.hs | 130 +- plutus-tx/src/PlutusTx/Optimize/Inline.hs | 9 +- plutus-tx/src/PlutusTx/Ord.hs | 218 ++-- plutus-tx/src/PlutusTx/Plugin/Utils.hs | 4 +- plutus-tx/src/PlutusTx/Prelude.hs | 345 +++--- plutus-tx/src/PlutusTx/Ratio.hs | 348 +++--- plutus-tx/src/PlutusTx/Semigroup.hs | 84 +- plutus-tx/src/PlutusTx/Show.hs | 168 +-- plutus-tx/src/PlutusTx/Show/TH.hs | 425 +++---- plutus-tx/src/PlutusTx/Sqrt.hs | 89 +- plutus-tx/src/PlutusTx/TH.hs | 26 +- plutus-tx/src/PlutusTx/These.hs | 2 +- plutus-tx/src/PlutusTx/Trace.hs | 18 +- plutus-tx/src/PlutusTx/Traversable.hs | 57 +- plutus-tx/src/PlutusTx/Utils.hs | 6 +- plutus-tx/test/Blueprint/Spec.hs | 10 +- plutus-tx/test/List/Spec.hs | 148 +-- plutus-tx/test/Rational/Laws.hs | 24 +- plutus-tx/test/Rational/Laws/Additive.hs | 12 +- plutus-tx/test/Rational/Laws/Construction.hs | 63 +- plutus-tx/test/Rational/Laws/Eq.hs | 21 +- plutus-tx/test/Rational/Laws/Helpers.hs | 88 +- plutus-tx/test/Rational/Laws/Module.hs | 10 +- .../test/Rational/Laws/Multiplicative.hs | 8 +- plutus-tx/test/Rational/Laws/Ord.hs | 31 +- plutus-tx/test/Rational/Laws/Other.hs | 134 ++- plutus-tx/test/Rational/Laws/Ring.hs | 12 +- plutus-tx/test/Rational/Laws/Serialization.hs | 8 +- plutus-tx/test/Show/Spec.hs | 66 +- plutus-tx/test/Spec.hs | 336 +++--- plutus-tx/testlib/Hedgehog/Laws/Common.hs | 1 + plutus-tx/testlib/Hedgehog/Laws/Eq.hs | 13 +- plutus-tx/testlib/Hedgehog/Laws/Lattice.hs | 69 +- plutus-tx/testlib/Hedgehog/Laws/Ord.hs | 24 +- plutus-tx/testlib/PlutusTx/Test.hs | 79 +- 84 files changed, 5680 insertions(+), 5086 deletions(-) diff --git a/plutus-tx/src/Data/Aeson/Extra.hs b/plutus-tx/src/Data/Aeson/Extra.hs index 07f0f0ebccb..c638c916ae2 100644 --- a/plutus-tx/src/Data/Aeson/Extra.hs +++ b/plutus-tx/src/Data/Aeson/Extra.hs @@ -14,7 +14,7 @@ import Data.Aeson qualified as Aeson import Data.Aeson.KeyMap qualified as KeyMap import Data.Char qualified as Char -{- | Build a JSON object omitting optional keys if a corresponding value is 'Nothing'. +{-| Build a JSON object omitting optional keys if a corresponding value is 'Nothing'. Example: @ @@ -43,16 +43,16 @@ optionalField = maybe id . requiredField requiredField :: (ToJSON a) => Aeson.Key -> a -> Aeson.Object -> Aeson.Object requiredField key value = KeyMap.insert key (toJSON value) -{- | A field label modifier that strips a prefix from the camelCased field name; +{-| A field label modifier that strips a prefix from the camelCased field name; >>> stripPrefix "preamble" "preambleTitle" "title" -} -stripPrefix :: - -- | Field prefix to strip - String -> - -- | Field name - String -> - String +stripPrefix + :: String + -- ^ Field prefix to strip + -> String + -- ^ Field name + -> String stripPrefix prefix field = go (prefix, field) where go = \case diff --git a/plutus-tx/src/PlutusTx.hs b/plutus-tx/src/PlutusTx.hs index 3eaab51052e..00196fb23fb 100644 --- a/plutus-tx/src/PlutusTx.hs +++ b/plutus-tx/src/PlutusTx.hs @@ -1,31 +1,32 @@ module PlutusTx ( - module Export, - CompiledCode, - CompiledCodeIn, - getPlc, - getPlcNoAnn, - getPir, - getPirNoAnn, - applyCode, - unsafeApplyCode, - BuiltinData, - Data (..), - ToData (..), - FromData (..), - UnsafeFromData (..), - toData, - fromData, - builtinDataToData, - dataToBuiltinData, - unstableMakeIsData, - makeIsDataIndexed, - makeIsDataSchemaIndexed, - Lift, - Typeable, - makeLift, - safeLiftCode, - liftCode, - liftCodeDef) where + module Export, + CompiledCode, + CompiledCodeIn, + getPlc, + getPlcNoAnn, + getPir, + getPirNoAnn, + applyCode, + unsafeApplyCode, + BuiltinData, + Data (..), + ToData (..), + FromData (..), + UnsafeFromData (..), + toData, + fromData, + builtinDataToData, + dataToBuiltinData, + unstableMakeIsData, + makeIsDataIndexed, + makeIsDataSchemaIndexed, + Lift, + Typeable, + makeLift, + safeLiftCode, + liftCode, + liftCodeDef, +) where import PlutusCore.Data (Data (..)) import PlutusTx.Blueprint.TH (makeIsDataSchemaIndexed) diff --git a/plutus-tx/src/PlutusTx/Applicative.hs b/plutus-tx/src/PlutusTx/Applicative.hs index eb8f792cb0c..b85624456cb 100644 --- a/plutus-tx/src/PlutusTx/Applicative.hs +++ b/plutus-tx/src/PlutusTx/Applicative.hs @@ -18,64 +18,65 @@ import PlutusTx.Monoid (Monoid (..), mappend) infixl 4 <*>, <*, *> -- | Plutus Tx version of 'Control.Applicative.Applicative'. -class Functor f => Applicative f where - {-# MINIMAL pure, (<*>) #-} - -- | Plutus Tx version of 'Control.Applicative.pure'. - pure :: a -> f a +class (Functor f) => Applicative f where + {-# MINIMAL pure, (<*>) #-} - -- | Plutus Tx version of '(Control.Applicative.<*>)'. - (<*>) :: f (a -> b) -> f a -> f b + -- | Plutus Tx version of 'Control.Applicative.pure'. + pure :: a -> f a + + -- | Plutus Tx version of '(Control.Applicative.<*>)'. + (<*>) :: f (a -> b) -> f a -> f b -- | Plutus Tx version of 'Control.Applicative.liftA2'. -liftA2 :: Applicative f => (a -> b -> c) -> f a -> f b -> f c +liftA2 :: (Applicative f) => (a -> b -> c) -> f a -> f b -> f c liftA2 f x = (<*>) (fmap f x) -{-# INLINABLE liftA2 #-} +{-# INLINEABLE liftA2 #-} -- | Plutus Tx version of '(Control.Applicative.*>)'. -(*>) :: Applicative f => f a -> f b -> f b +(*>) :: (Applicative f) => f a -> f b -> f b a1 *> a2 = (id <$ a1) <*> a2 -{-# INLINABLE (*>) #-} +{-# INLINEABLE (*>) #-} -- | Plutus Tx version of '(Control.Applicative.<*)'. -(<*) :: Applicative f => f a -> f b -> f a +(<*) :: (Applicative f) => f a -> f b -> f a (<*) = liftA2 const -{-# INLINABLE (<*) #-} +{-# INLINEABLE (<*) #-} -- | Plutus Tx version of 'Control.Monad.unless'. unless :: (Applicative f) => Bool -> f () -> f () unless p s = if p then pure () else s -{-# INLINABLE unless #-} +{-# INLINEABLE unless #-} instance Applicative Maybe where - {-# INLINABLE pure #-} - pure = Just - {-# INLINABLE (<*>) #-} - Nothing <*> _ = Nothing - _ <*> Nothing = Nothing - Just f <*> Just x = Just (f x) + {-# INLINEABLE pure #-} + pure = Just + {-# INLINEABLE (<*>) #-} + Nothing <*> _ = Nothing + _ <*> Nothing = Nothing + Just f <*> Just x = Just (f x) instance Applicative (Either a) where - {-# INLINABLE pure #-} - pure = Right - {-# INLINABLE (<*>) #-} - Left e <*> _ = Left e - Right f <*> r = fmap f r + {-# INLINEABLE pure #-} + pure = Right + {-# INLINEABLE (<*>) #-} + Left e <*> _ = Left e + Right f <*> r = fmap f r instance Applicative [] where - {-# INLINABLE pure #-} - pure x = [x] - {-# INLINABLE (<*>) #-} - fs <*> xs = List.concatMap (\f -> List.map f xs) fs + {-# INLINEABLE pure #-} + pure x = [x] + {-# INLINEABLE (<*>) #-} + fs <*> xs = List.concatMap (\f -> List.map f xs) fs instance Applicative Identity where - {-# INLINABLE pure #-} - pure = Identity - {-# INLINABLE (<*>) #-} - (<*>) :: forall a b. Identity (a -> b) -> Identity a -> Identity b - (<*>) = coerce (id :: (a -> b) -> a -> b) - -instance Monoid m => Applicative (Const m) where - {-# INLINABLE pure #-} - pure _ = Const mempty - {-# INLINABLE (<*>) #-} - (<*>) = coerce (mappend :: m -> m -> m) + {-# INLINEABLE pure #-} + pure = Identity + {-# INLINEABLE (<*>) #-} + (<*>) :: forall a b. Identity (a -> b) -> Identity a -> Identity b + (<*>) = coerce (id :: (a -> b) -> a -> b) + +instance (Monoid m) => Applicative (Const m) where + {-# INLINEABLE pure #-} + pure _ = Const mempty + {-# INLINEABLE (<*>) #-} + (<*>) = coerce (mappend :: m -> m -> m) diff --git a/plutus-tx/src/PlutusTx/AsData/Internal.hs b/plutus-tx/src/PlutusTx/AsData/Internal.hs index 320888e38fe..db7e724d8cd 100644 --- a/plutus-tx/src/PlutusTx/AsData/Internal.hs +++ b/plutus-tx/src/PlutusTx/AsData/Internal.hs @@ -1,15 +1,16 @@ {-# LANGUAGE Strict #-} {-# OPTIONS_GHC -fexpose-all-unfoldings #-} --- | Functions in this module are for internal compiler use only, and should not --- be used elsewhere. +{-| Functions in this module are for internal compiler use only, and should not +be used elsewhere. +-} module PlutusTx.AsData.Internal where import PlutusTx.Builtins.Internal as BI -- See Note [Compiling AsData Matchers and Their Invocations] -wrapUnsafeDataAsConstr:: BuiltinData -> BuiltinPair BuiltinInteger (BuiltinList BuiltinData) +wrapUnsafeDataAsConstr :: BuiltinData -> BuiltinPair BuiltinInteger (BuiltinList BuiltinData) wrapUnsafeDataAsConstr = BI.unsafeDataAsConstr {-# OPAQUE wrapUnsafeDataAsConstr #-} diff --git a/plutus-tx/src/PlutusTx/AssocMap.hs b/plutus-tx/src/PlutusTx/AssocMap.hs index ac54cadefda..a298e04fa7f 100644 --- a/plutus-tx/src/PlutusTx/AssocMap.hs +++ b/plutus-tx/src/PlutusTx/AssocMap.hs @@ -68,21 +68,23 @@ import PlutusTx.Blueprint.Schema.Annotation (emptySchemaInfo) import Prettyprinter (Pretty (..)) -- See Note [Optimising Value]. --- | A 'Map' of key-value pairs. --- A 'Map' is considered well-defined if there are no key collisions, meaning that each value --- is uniquely identified by a key. --- --- Use 'safeFromList' to create well-defined 'Map's from arbitrary lists of pairs. --- --- If cost minimisation is required, then you can use 'unsafeFromList' but you must --- be certain that the list you are converting to a 'Map' abides by the well-definedness condition. --- --- Most operations on 'Map's are definedness-preserving, meaning that for the resulting 'Map' to be --- well-defined then the input 'Map'(s) have to also be well-defined. This is not checked explicitly --- unless mentioned in the documentation. --- --- Take care when using 'fromBuiltinData' and 'unsafeFromBuiltinData', as neither function performs --- deduplication of the input collection and may create invalid 'Map's! + +{-| A 'Map' of key-value pairs. +A 'Map' is considered well-defined if there are no key collisions, meaning that each value +is uniquely identified by a key. + +Use 'safeFromList' to create well-defined 'Map's from arbitrary lists of pairs. + +If cost minimisation is required, then you can use 'unsafeFromList' but you must +be certain that the list you are converting to a 'Map' abides by the well-definedness condition. + +Most operations on 'Map's are definedness-preserving, meaning that for the resulting 'Map' to be +well-defined then the input 'Map'(s) have to also be well-defined. This is not checked explicitly +unless mentioned in the documentation. + +Take care when using 'fromBuiltinData' and 'unsafeFromBuiltinData', as neither function performs +deduplication of the input collection and may create invalid 'Map's! +-} newtype Map k v = Map {unMap :: [(k, v)]} deriving stock (Generic, Haskell.Show, Data, TH.Lift) deriving newtype (NFData) @@ -95,24 +97,26 @@ instance (Haskell.Ord k, Haskell.Ord v) => Haskell.Ord (Map k v) where Map l <= Map r = on (Haskell.<=) HMap.fromList l r --- | Hand-written instances to use the underlying 'Map' type in 'Data', and --- to be reasonably efficient. +{-| Hand-written instances to use the underlying 'Map' type in 'Data', and +to be reasonably efficient. +-} instance (ToData k, ToData v) => ToData (Map k v) where toBuiltinData (Map es) = BI.mkMap (mapToBuiltin es) - where - {-# INLINE mapToBuiltin #-} - mapToBuiltin :: [(k, v)] -> BuiltinList (BuiltinPair BI.BuiltinData BI.BuiltinData) - mapToBuiltin = go - where - go :: [(k, v)] -> BuiltinList (BuiltinPair BI.BuiltinData BI.BuiltinData) - go [] = P.mkNil - go ((k, v) : xs) = BI.mkCons (BI.mkPairData (toBuiltinData k) (toBuiltinData v)) (go xs) - --- | A hand-written transformation from 'Data' to 'Map'. Compared to 'unsafeFromBuiltinData', --- it is safe to call when it is unknown if the 'Data' is built with 'Data's 'Map' constructor. --- Note that it is, however, unsafe in the sense that it assumes that any map --- encoded in the 'Data' is well-formed, i.e. 'fromBuiltinData' does not perform any --- deduplication of keys or of key-value pairs! + where + {-# INLINE mapToBuiltin #-} + mapToBuiltin :: [(k, v)] -> BuiltinList (BuiltinPair BI.BuiltinData BI.BuiltinData) + mapToBuiltin = go + where + go :: [(k, v)] -> BuiltinList (BuiltinPair BI.BuiltinData BI.BuiltinData) + go [] = P.mkNil + go ((k, v) : xs) = BI.mkCons (BI.mkPairData (toBuiltinData k) (toBuiltinData v)) (go xs) + +{-| A hand-written transformation from 'Data' to 'Map'. Compared to 'unsafeFromBuiltinData', +it is safe to call when it is unknown if the 'Data' is built with 'Data's 'Map' constructor. +Note that it is, however, unsafe in the sense that it assumes that any map +encoded in the 'Data' is well-formed, i.e. 'fromBuiltinData' does not perform any +deduplication of keys or of key-value pairs! +-} instance (FromData k, FromData v) => FromData (Map k v) where fromBuiltinData = P.caseData' @@ -121,49 +125,50 @@ instance (FromData k, FromData v) => FromData (Map k v) where (const Nothing) (const Nothing) (const Nothing) - where - {-# INLINE traverseFromBuiltin #-} - traverseFromBuiltin :: - BuiltinList (BuiltinPair BI.BuiltinData BI.BuiltinData) -> - Maybe [(k, v)] - traverseFromBuiltin = go - where - go :: BuiltinList (BuiltinPair BI.BuiltinData BI.BuiltinData) -> Maybe [(k, v)] - go = - P.caseList' - (pure []) - ( \tup tups -> - liftA2 - (:) - (liftA2 (,) (fromBuiltinData $ BI.fst tup) (fromBuiltinData $ BI.snd tup)) - (go tups) - ) - --- | A hand-written transformation from 'Data' to 'Map'. It is unsafe because the --- caller must provide the guarantee that the 'Data' is constructed using the 'Data's --- 'Map' constructor. --- Note that it assumes, like the 'fromBuiltinData' transformation, that the map --- encoded in the 'Data' is well-formed, i.e. 'unsafeFromBuiltinData' does not perform --- any deduplication of keys or of key-value pairs! + where + {-# INLINE traverseFromBuiltin #-} + traverseFromBuiltin + :: BuiltinList (BuiltinPair BI.BuiltinData BI.BuiltinData) + -> Maybe [(k, v)] + traverseFromBuiltin = go + where + go :: BuiltinList (BuiltinPair BI.BuiltinData BI.BuiltinData) -> Maybe [(k, v)] + go = + P.caseList' + (pure []) + ( \tup tups -> + liftA2 + (:) + (liftA2 (,) (fromBuiltinData $ BI.fst tup) (fromBuiltinData $ BI.snd tup)) + (go tups) + ) + +{-| A hand-written transformation from 'Data' to 'Map'. It is unsafe because the +caller must provide the guarantee that the 'Data' is constructed using the 'Data's +'Map' constructor. +Note that it assumes, like the 'fromBuiltinData' transformation, that the map +encoded in the 'Data' is well-formed, i.e. 'unsafeFromBuiltinData' does not perform +any deduplication of keys or of key-value pairs! +-} instance (UnsafeFromData k, UnsafeFromData v) => UnsafeFromData (Map k v) where -- The `~` here enables `BI.unsafeDataAsMap d` to be inlined, which reduces costs slightly. -- Without the `~`, the inliner would consider it not effect safe to inline. -- We can remove the `~` once we make the inliner smart enough to inline them. -- See https://github.com/IntersectMBO/plutus/pull/5371#discussion_r1297833685 unsafeFromBuiltinData d = let ~es = BI.unsafeDataAsMap d in Map $ mapFromBuiltin es - where - {-# INLINE mapFromBuiltin #-} - mapFromBuiltin :: BuiltinList (BuiltinPair BI.BuiltinData BI.BuiltinData) -> [(k, v)] - mapFromBuiltin = go - where - go :: BuiltinList (BuiltinPair BI.BuiltinData BI.BuiltinData) -> [(k, v)] - go = - P.caseList' - [] - ( \tup tups -> - (unsafeFromBuiltinData $ BI.fst tup, unsafeFromBuiltinData $ BI.snd tup) - : go tups - ) + where + {-# INLINE mapFromBuiltin #-} + mapFromBuiltin :: BuiltinList (BuiltinPair BI.BuiltinData BI.BuiltinData) -> [(k, v)] + mapFromBuiltin = go + where + go :: BuiltinList (BuiltinPair BI.BuiltinData BI.BuiltinData) -> [(k, v)] + go = + P.caseList' + [] + ( \tup tups -> + (unsafeFromBuiltinData $ BI.fst tup, unsafeFromBuiltinData $ BI.snd tup) + : go tups + ) instance (HasBlueprintDefinition k, HasBlueprintDefinition v) @@ -178,15 +183,18 @@ instance instance ( HasBlueprintSchema k referencedTypes , HasBlueprintSchema v referencedTypes - ) => - HasBlueprintSchema (Map k v) referencedTypes where - schema = SchemaMap emptySchemaInfo MkMapSchema - { keySchema = schema @k - , valueSchema = schema @v - , minItems = Nothing - , maxItems = Nothing - } - + ) + => HasBlueprintSchema (Map k v) referencedTypes + where + schema = + SchemaMap + emptySchemaInfo + MkMapSchema + { keySchema = schema @k + , valueSchema = schema @v + , minItems = Nothing + , maxItems = Nothing + } instance Functor (Map k) where {-# INLINEABLE fmap #-} @@ -212,17 +220,19 @@ instance (Eq k, Semigroup v) => Monoid (Map k v) where instance (Pretty k, Pretty v) => Pretty (Map k v) where pretty (Map mp) = pretty mp --- | Unsafely create a 'Map' from a list of pairs. This should _only_ be applied to lists which --- have been checked to not contain duplicate keys, otherwise the resulting 'Map' will contain --- conflicting entries (two entries sharing the same key). --- As usual, the "keys" are considered to be the first element of the pair. +{-| Unsafely create a 'Map' from a list of pairs. This should _only_ be applied to lists which +have been checked to not contain duplicate keys, otherwise the resulting 'Map' will contain +conflicting entries (two entries sharing the same key). +As usual, the "keys" are considered to be the first element of the pair. +-} unsafeFromList :: [(k, v)] -> Map k v unsafeFromList = Map {-# INLINEABLE unsafeFromList #-} --- | In case of duplicates, this function will keep only one entry (the one that precedes). --- In other words, this function de-duplicates the input list. -safeFromList :: Eq k => [(k, v)] -> Map k v +{-| In case of duplicates, this function will keep only one entry (the one that precedes). +In other words, this function de-duplicates the input list. +-} +safeFromList :: (Eq k) => [(k, v)] -> Map k v safeFromList = List.foldr (uncurry insert) empty {-# INLINEABLE safeFromList #-} @@ -230,8 +240,9 @@ toList :: Map k v -> [(k, v)] toList (Map l) = l {-# INLINEABLE toList #-} --- | Find an entry in a 'Map'. If the 'Map' is not well-formed (it contains duplicate keys) --- then this will return the value of the left-most pair in the underlying list of pairs. +{-| Find an entry in a 'Map'. If the 'Map' is not well-formed (it contains duplicate keys) +then this will return the value of the left-most pair in the underlying list of pairs. +-} lookup :: forall k v. (Eq k) => k -> Map k v -> Maybe v lookup c (Map xs) = let @@ -250,35 +261,38 @@ member k m = isJust (lookup k m) -- | If a key already exists in the map, its entry will be replaced with the new value. insert :: forall k v. (Eq k) => k -> v -> Map k v -> Map k v insert k v (Map xs) = Map (go xs) - where - go [] = [(k, v)] - go ((k', v') : rest) = if k == k' then (k, v) : rest else (k', v') : go rest + where + go [] = [(k, v)] + go ((k', v') : rest) = if k == k' then (k, v) : rest else (k', v') : go rest {-# INLINEABLE insert #-} --- | Delete an entry from the 'Map'. Assumes that the 'Map' is well-formed, i.e. if the --- underlying list of pairs contains pairs with duplicate keys then only the left-most --- pair will be removed. +{-| Delete an entry from the 'Map'. Assumes that the 'Map' is well-formed, i.e. if the +underlying list of pairs contains pairs with duplicate keys then only the left-most +pair will be removed. +-} delete :: forall k v. (Eq k) => k -> Map k v -> Map k v delete key (Map ls) = Map (go ls) - where - go [] = [] - go ((k, v) : rest) - | k == key = rest - | otherwise = (k, v) : go rest + where + go [] = [] + go ((k, v) : rest) + | k == key = rest + | otherwise = (k, v) : go rest {-# INLINEABLE delete #-} --- | The keys of a 'Map'. Semantically, the resulting list is only a set if the 'Map' --- didn't contain duplicate keys. +{-| The keys of a 'Map'. Semantically, the resulting list is only a set if the 'Map' +didn't contain duplicate keys. +-} keys :: Map k v -> [k] keys (Map xs) = P.fmap (\(k, _ :: v) -> k) xs {-# INLINEABLE keys #-} --- | Combine two 'Map's. Keeps both values on key collisions. --- Note that well-formedness is only preserved if the two input maps --- are also well-formed. --- Also, as an implementation detail, in the case that the right map contains --- duplicate keys, and there exists a collision between the two maps, --- then only the left-most value of the right map will be kept. +{-| Combine two 'Map's. Keeps both values on key collisions. +Note that well-formedness is only preserved if the two input maps +are also well-formed. +Also, as an implementation detail, in the case that the right map contains +duplicate keys, and there exists a collision between the two maps, +then only the left-most value of the right map will be kept. +-} union :: forall k v r. (Eq k) => Map k v -> Map k r -> Map k (These v r) union (Map ls) (Map rs) = let @@ -299,12 +313,13 @@ union (Map ls) (Map rs) = in Map (ls' List.++ rs'') --- | Combine two 'Map's with the given combination function. --- Note that well-formedness of the resulting map depends on the two input maps --- being well-formed. --- Also, as an implementation detail, in the case that the right map contains --- duplicate keys, and there exists a collision between the two maps, --- then only the left-most value of the right map will be kept. +{-| Combine two 'Map's with the given combination function. +Note that well-formedness of the resulting map depends on the two input maps +being well-formed. +Also, as an implementation detail, in the case that the right map contains +duplicate keys, and there exists a collision between the two maps, +then only the left-most value of the right map will be kept. +-} unionWith :: forall k a. (Eq k) => (a -> a -> a) -> Map k a -> Map k a -> Map k a unionWith merge (Map ls) (Map rs) = let @@ -325,20 +340,19 @@ unionWith merge (Map ls) (Map rs) = -- | A version of 'Data.Map.Lazy.mapEither' that works with 'These'. mapThese :: (v -> These a b) -> Map k v -> (Map k a, Map k b) mapThese f mps = (Map mpl, Map mpr) - where - (mpl, mpr) = List.foldr f' ([], []) mps' - Map mps' = fmap f mps - f' (k, v) (as, bs) = case v of - This a -> ((k, a) : as, bs) - That b -> (as, (k, b) : bs) - These a b -> ((k, a) : as, (k, b) : bs) + where + (mpl, mpr) = List.foldr f' ([], []) mps' + Map mps' = fmap f mps + f' (k, v) (as, bs) = case v of + This a -> ((k, a) : as, bs) + That b -> (as, (k, b) : bs) + These a b -> ((k, a) : as, (k, b) : bs) {-# INLINEABLE mapThese #-} -- | A singleton map. singleton :: k -> v -> Map k v singleton c i = Map [(c, i)] - -- | An empty 'Map'. empty :: Map k v empty = Map ([] :: [(k, v)]) @@ -377,10 +391,10 @@ mapMaybeWithKey f (Map xs) = Map $ P.mapMaybe (\(k, v) -> (k,) <$> f k v) xs -- | Determines whether all elements in the map satisfy the predicate. all :: (a -> Bool) -> Map k a -> Bool all f (Map m) = go m - where - go = \case - [] -> True - (_, x) : xs -> if f x then go xs else False + where + go = \case + [] -> True + (_, x) : xs -> if f x then go xs else False {-# INLINEABLE all #-} ---------------------------------------------------------------------------------------------------- diff --git a/plutus-tx/src/PlutusTx/Base.hs b/plutus-tx/src/PlutusTx/Base.hs index 1265eaf0f5a..8fc0a9e2159 100644 --- a/plutus-tx/src/PlutusTx/Base.hs +++ b/plutus-tx/src/PlutusTx/Base.hs @@ -6,54 +6,57 @@ import PlutusTx.Bool -- | Plutus Tx version of 'Data.Tuple.fst' fst :: (a, b) -> a fst (a, _) = a -{-# INLINABLE fst #-} +{-# INLINEABLE fst #-} -- | Plutus Tx version of 'Data.Tuple.snd' snd :: (a, b) -> b snd (_, b) = b -{-# INLINABLE snd #-} +{-# INLINEABLE snd #-} curry :: ((a, b) -> c) -> a -> b -> c curry f a b = f (a, b) -{-# INLINABLE curry #-} +{-# INLINEABLE curry #-} uncurry :: (a -> b -> c) -> (a, b) -> c uncurry f (a, b) = f a b -{-# INLINABLE uncurry #-} +{-# INLINEABLE uncurry #-} infixr 0 $ + -- Normal $ is levity-polymorphic, which we can't handle. + -- | Plutus Tx version of 'Data.Function.($)'. ($) :: (a -> b) -> a -> b f $ a = f a -{-# INLINABLE ($) #-} +{-# INLINEABLE ($) #-} -- | Plutus Tx version of 'Prelude.flip'. -flip :: (a -> b -> c) -> b -> a -> c -flip f x y = f y x -{-# INLINABLE flip #-} +flip :: (a -> b -> c) -> b -> a -> c +flip f x y = f y x +{-# INLINEABLE flip #-} -- | Plutus Tx version of 'Prelude.until'. -until :: (a -> Bool) -> (a -> a) -> a -> a +until :: (a -> Bool) -> (a -> a) -> a -> a until p f = go - where - go x | p x = x - | otherwise = go (f x) -{-# INLINABLE until #-} + where + go x + | p x = x + | otherwise = go (f x) +{-# INLINEABLE until #-} infixr 9 . + -- | Plutus Tx version of 'Prelude.(.)'. -(.) :: (b -> c) -> (a -> b) -> a -> c +(.) :: (b -> c) -> (a -> b) -> a -> c (.) f g = \x -> f (g x) -{-# INLINABLE (.) #-} - +{-# INLINEABLE (.) #-} -- | Plutus Tx version of 'Prelude.const'. const :: a -> b -> a -const x _ = x -{-# INLINABLE const #-} +const x _ = x +{-# INLINEABLE const #-} -- | Plutus Tx version of 'Prelude.id'. id :: a -> a id x = x -{-# INLINABLE id #-} +{-# INLINEABLE id #-} diff --git a/plutus-tx/src/PlutusTx/Blueprint/Class.hs b/plutus-tx/src/PlutusTx/Blueprint/Class.hs index 1bfd1f5ae0b..7e2f716c5ac 100644 --- a/plutus-tx/src/PlutusTx/Blueprint/Class.hs +++ b/plutus-tx/src/PlutusTx/Blueprint/Class.hs @@ -21,7 +21,7 @@ import PlutusTx.Blueprint.Schema.Annotation (emptySchemaInfo) import PlutusTx.Builtins (BuiltinByteString, BuiltinData, BuiltinString) import PlutusTx.Builtins.Internal (BuiltinBool, BuiltinList, BuiltinPair, BuiltinUnit) -{- | +{-| A class of types that have a Blueprint schema definition and can reference other schema definitions of other types. -} @@ -53,8 +53,8 @@ instance HasBlueprintSchema ByteString referencedTypes where schema = SchemaBytes emptySchemaInfo emptyBytesSchema instance - (HasBlueprintSchema a referencedTypes) => - HasBlueprintSchema [a] referencedTypes + (HasBlueprintSchema a referencedTypes) + => HasBlueprintSchema [a] referencedTypes where schema = SchemaList @@ -68,15 +68,15 @@ instance ) instance - (HasBlueprintSchema a referencedTypes) => - HasBlueprintSchema (BuiltinList a) referencedTypes + (HasBlueprintSchema a referencedTypes) + => HasBlueprintSchema (BuiltinList a) referencedTypes where schema = SchemaBuiltInList emptySchemaInfo (schema @a) instance ( HasBlueprintSchema a referencedTypes , HasBlueprintSchema b referencedTypes - ) => - HasBlueprintSchema (BuiltinPair a b) referencedTypes + ) + => HasBlueprintSchema (BuiltinPair a b) referencedTypes where schema = SchemaBuiltInPair emptySchemaInfo (MkPairSchema (schema @a) (schema @b)) diff --git a/plutus-tx/src/PlutusTx/Blueprint/Contract.hs b/plutus-tx/src/PlutusTx/Blueprint/Contract.hs index 2b55d8651bb..3af5e9450df 100644 --- a/plutus-tx/src/PlutusTx/Blueprint/Contract.hs +++ b/plutus-tx/src/PlutusTx/Blueprint/Contract.hs @@ -22,25 +22,25 @@ import PlutusTx.Blueprint.Definition (DefinitionId, Definitions, definitionsToMa import PlutusTx.Blueprint.Preamble (Preamble) import PlutusTx.Blueprint.Validator (ValidatorBlueprint) -{- | A blueprint of a smart contract, as defined by the CIP-0057 +{-| A blueprint of a smart contract, as defined by the CIP-0057 The 'referencedTypes' type variable is used to track the types used in the contract making sure their schemas are included in the blueprint and that they are referenced in a type-safe way. See Note ["Unrolling" types] for more details. -} data ContractBlueprint where - MkContractBlueprint :: - forall referencedTypes. - { contractId :: Maybe Text - -- ^ An optional identifier for the contract. - , contractPreamble :: Preamble - -- ^ An object with meta-information about the contract. - , contractValidators :: Set (ValidatorBlueprint referencedTypes) - -- ^ A set of validator blueprints that are part of the contract. - , contractDefinitions :: Definitions referencedTypes - -- ^ A registry of schema definitions used across the blueprint. - } -> - ContractBlueprint + MkContractBlueprint + :: forall referencedTypes + . { contractId :: Maybe Text + -- ^ An optional identifier for the contract. + , contractPreamble :: Preamble + -- ^ An object with meta-information about the contract. + , contractValidators :: Set (ValidatorBlueprint referencedTypes) + -- ^ A set of validator blueprints that are part of the contract. + , contractDefinitions :: Definitions referencedTypes + -- ^ A registry of schema definitions used across the blueprint. + } + -> ContractBlueprint instance ToJSON ContractBlueprint where toJSON MkContractBlueprint{..} = diff --git a/plutus-tx/src/PlutusTx/Blueprint/Definition.hs b/plutus-tx/src/PlutusTx/Blueprint/Definition.hs index 0154f47ff77..e4507302cba 100644 --- a/plutus-tx/src/PlutusTx/Blueprint/Definition.hs +++ b/plutus-tx/src/PlutusTx/Blueprint/Definition.hs @@ -1,10 +1,10 @@ -- | This module provides a functionality to derive and reference schema definitions. -module PlutusTx.Blueprint.Definition - ( module DefinitionId - , module Unroll - , module Internal - , module Derive - ) where +module PlutusTx.Blueprint.Definition ( + module DefinitionId, + module Unroll, + module Internal, + module Derive, +) where import PlutusTx.Blueprint.Definition.Derive as Derive import PlutusTx.Blueprint.Definition.Id as DefinitionId diff --git a/plutus-tx/src/PlutusTx/Blueprint/Definition/Derive.hs b/plutus-tx/src/PlutusTx/Blueprint/Definition/Derive.hs index f756c2dec4a..86d2b914b78 100644 --- a/plutus-tx/src/PlutusTx/Blueprint/Definition/Derive.hs +++ b/plutus-tx/src/PlutusTx/Blueprint/Definition/Derive.hs @@ -23,7 +23,7 @@ deriveDefinitions = definitionsFor @(UnrollAll ts) definitionRef :: forall t ts. (HasBlueprintDefinition t) => Schema ts definitionRef = SchemaDefinitionRef (definitionId @t) -{- | This class and its two instances are used internally to derive 'Definitions' +{-| This class and its two instances are used internally to derive 'Definitions' for a given list of types. -} type DefinitionsFor ts = DefinitionsFor' ts ts diff --git a/plutus-tx/src/PlutusTx/Blueprint/Definition/Id.hs b/plutus-tx/src/PlutusTx/Blueprint/Definition/Id.hs index 40fc4240e52..5443fe213c1 100644 --- a/plutus-tx/src/PlutusTx/Blueprint/Definition/Id.hs +++ b/plutus-tx/src/PlutusTx/Blueprint/Definition/Id.hs @@ -5,16 +5,16 @@ {-# LANGUAGE PolyKinds #-} {-# LANGUAGE TypeApplications #-} -module PlutusTx.Blueprint.Definition.Id - ( DefinitionId - , definitionIdFromType - , definitionIdFromTypeK - , definitionIdToText - , definitionIdUnit - , definitionIdList - , definitionIdTuple2 - , definitionIdTuple3 - ) where +module PlutusTx.Blueprint.Definition.Id ( + DefinitionId, + definitionIdFromType, + definitionIdFromTypeK, + definitionIdToText, + definitionIdUnit, + definitionIdList, + definitionIdTuple2, + definitionIdTuple3, +) where import Prelude @@ -38,7 +38,7 @@ instance Semigroup DefinitionId where definitionIdFromType :: forall (t :: Type). (Typeable t) => DefinitionId definitionIdFromType = MkDefinitionId . pack . show . typeRep $ Proxy @t -{- | Creates a 'DefinitionId' from a type with a kind other than 'Type'. +{-| Creates a 'DefinitionId' from a type with a kind other than 'Type'. Example: > definitionIdFromTypeK @(Type -> Type) @Maybe -} diff --git a/plutus-tx/src/PlutusTx/Blueprint/Definition/Internal.hs b/plutus-tx/src/PlutusTx/Blueprint/Definition/Internal.hs index e4f53f5cb53..d2ecc8d06c0 100644 --- a/plutus-tx/src/PlutusTx/Blueprint/Definition/Internal.hs +++ b/plutus-tx/src/PlutusTx/Blueprint/Definition/Internal.hs @@ -48,7 +48,7 @@ definitionsToMap NoDefinitions _k = Map.empty definitionsToMap (AddDefinition (MkDefinition defId v) s) k = Map.insert defId (k v) (definitionsToMap s k) -{- | +{-| A constraint that checks if a schema definition is present in a list of schema definitions. Gives a user-friendly error message if the schema definition is not found. -} diff --git a/plutus-tx/src/PlutusTx/Blueprint/Definition/Unroll.hs b/plutus-tx/src/PlutusTx/Blueprint/Definition/Unroll.hs index f5214da5d40..f274b0490fd 100644 --- a/plutus-tx/src/PlutusTx/Blueprint/Definition/Unroll.hs +++ b/plutus-tx/src/PlutusTx/Blueprint/Definition/Unroll.hs @@ -74,7 +74,7 @@ type family will take care of discovering all the nested types: -} -{- | Designates a class of types that could be used as a Blueprint Definition. +{-| Designates a class of types that could be used as a Blueprint Definition. Each such type: - could be unrolled to a list of all nested types (including the type itself). - has a unique 'DefinitionId'. @@ -150,14 +150,14 @@ instance type Unroll (a, b, c) = Insert (a, b, c) (Unrolled a ++ Unrolled b ++ Unrolled c) definitionId = definitionIdTuple3 <> definitionId @a <> definitionId @b <> definitionId @c -{- | Compile-time error that happens when a type couldn't be unrolled +{-| Compile-time error that happens when a type couldn't be unrolled ('Unroll' TF is "stuck") -} type family UnrollIsStuckError x where UnrollIsStuckError x = GHC.TypeError (GHC.Text "No instance: " GHC.:<>: GHC.ShowType (HasBlueprintDefinition x)) -{- | Compile-time error that happens when type's generic representation is not defined +{-| Compile-time error that happens when type's generic representation is not defined ('Rep' TF is "stuck") -} type family RepIsStuckError x where diff --git a/plutus-tx/src/PlutusTx/Blueprint/Parameter.hs b/plutus-tx/src/PlutusTx/Blueprint/Parameter.hs index b8377e180ed..f4bc0d911de 100644 --- a/plutus-tx/src/PlutusTx/Blueprint/Parameter.hs +++ b/plutus-tx/src/PlutusTx/Blueprint/Parameter.hs @@ -18,7 +18,7 @@ import Data.Text (Text) import PlutusTx.Blueprint.Purpose (Purpose) import PlutusTx.Blueprint.Schema (Schema) -{- | Blueprint that defines validator's compile-time parameter. +{-| Blueprint that defines validator's compile-time parameter. The 'referencedTypes' phantom type parameter is used to track the types used in the contract making sure their schemas are included in the blueprint and that they are referenced diff --git a/plutus-tx/src/PlutusTx/Blueprint/PlutusVersion.hs b/plutus-tx/src/PlutusTx/Blueprint/PlutusVersion.hs index 1c02807a21f..cb25c530796 100644 --- a/plutus-tx/src/PlutusTx/Blueprint/PlutusVersion.hs +++ b/plutus-tx/src/PlutusTx/Blueprint/PlutusVersion.hs @@ -8,7 +8,7 @@ import Prelude import Data.Aeson (ToJSON (..)) -{- | A "Plutus Version", as defined by the CIP-0057 +{-| A "Plutus Version", as defined by the CIP-0057 | | This version corresponds to the "Plutus Ledger Language Version" | defined by the plutus-tx-plugin. diff --git a/plutus-tx/src/PlutusTx/Blueprint/Preamble.hs b/plutus-tx/src/PlutusTx/Blueprint/Preamble.hs index 6b6ee55a92d..c71ecdb00d3 100644 --- a/plutus-tx/src/PlutusTx/Blueprint/Preamble.hs +++ b/plutus-tx/src/PlutusTx/Blueprint/Preamble.hs @@ -24,8 +24,9 @@ data Preamble = MkPreamble , preamblePlutusVersion :: PlutusVersion -- ^ The Plutus version assumed for all validators , preambleLicense :: Maybe Text - -- ^ A license under which the specification - -- and contract code is distributed + {- ^ A license under which the specification + and contract code is distributed + -} } deriving stock (Show, Generic) diff --git a/plutus-tx/src/PlutusTx/Blueprint/Purpose.hs b/plutus-tx/src/PlutusTx/Blueprint/Purpose.hs index d066370311a..d207a4e64f9 100644 --- a/plutus-tx/src/PlutusTx/Blueprint/Purpose.hs +++ b/plutus-tx/src/PlutusTx/Blueprint/Purpose.hs @@ -11,7 +11,7 @@ import Data.Aeson qualified as Json import Data.Text (Text) import Language.Haskell.TH.Syntax (Lift) -{- | +{-| As per CIP-57, a validator arguments (redeemer, datum) and validator parameters all must specify a purpose that indicates in which context they are used. -} @@ -23,7 +23,7 @@ instance ToJSON Purpose where purposeToText :: Purpose -> Text purposeToText = \case - Spend -> "spend" - Mint -> "mint" + Spend -> "spend" + Mint -> "mint" Withdraw -> "withdraw" - Publish -> "publish" + Publish -> "publish" diff --git a/plutus-tx/src/PlutusTx/Blueprint/Schema.hs b/plutus-tx/src/PlutusTx/Blueprint/Schema.hs index 897e88b4661..f4b8a5e8eb5 100644 --- a/plutus-tx/src/PlutusTx/Blueprint/Schema.hs +++ b/plutus-tx/src/PlutusTx/Blueprint/Schema.hs @@ -33,7 +33,7 @@ import PlutusTx.Blueprint.Definition.Id (DefinitionId, definitionIdToText) import PlutusTx.Blueprint.Schema.Annotation (SchemaInfo, comment, description, title) import Prelude hiding (max, maximum, min, minimum) -{- | Blueprint schema definition, as defined by the CIP-0057: +{-| Blueprint schema definition, as defined by the CIP-0057: https://github.com/cardano-foundation/CIPs/tree/master/CIP-0057#core-vocabulary The 'referencedTypes' phantom type parameter is used to track the types used in the contract @@ -190,8 +190,9 @@ emptyIntegerSchema = data BytesSchema = MkBytesSchema { enum :: [ByteString] - -- ^ An instance validates successfully if once hex-encoded, - -- its value matches one of the specified values. + {- ^ An instance validates successfully if once hex-encoded, + its value matches one of the specified values. + -} , minLength :: Maybe Natural -- ^ An instance is valid if its length is greater than, or equal to, this value. , maxLength :: Maybe Natural @@ -210,8 +211,9 @@ data ListSchema (referencedTypes :: [Type]) = MkListSchema , maxItems :: Maybe Natural -- ^ An array instance is valid if its size is less than, or equal to, this value. , uniqueItems :: Maybe Bool - -- ^ If this value is false, the instance validates successfully. - -- If it is set to True, the instance validates successfully if all of its elements are unique. + {- ^ If this value is false, the instance validates successfully. + If it is set to True, the instance validates successfully if all of its elements are unique. + -} } deriving stock (Eq, Ord, Show, Generic, Data) diff --git a/plutus-tx/src/PlutusTx/Blueprint/Schema/Annotation.hs b/plutus-tx/src/PlutusTx/Blueprint/Schema/Annotation.hs index 1f47497f36f..84406c9d668 100644 --- a/plutus-tx/src/PlutusTx/Blueprint/Schema/Annotation.hs +++ b/plutus-tx/src/PlutusTx/Blueprint/Schema/Annotation.hs @@ -60,7 +60,7 @@ data SchemaAnn | MkSchemaAnnComment SchemaComment deriving stock (Eq, Ord, Show, Generic, Data, Lift) -{- | An annotation for the "title" schema attribute. +{-| An annotation for the "title" schema attribute. This annotation could be attached to a type or constructor: @ @@ -73,7 +73,7 @@ newtype SchemaTitle = SchemaTitle {schemaTitleToString :: String} deriving newtype (Eq, Ord, Show, ToJSON) deriving stock (Data, Lift) -{- | An annotation for the "description" schema attribute. +{-| An annotation for the "description" schema attribute. This annotation could be attached to a type or constructor: @ @@ -86,7 +86,7 @@ newtype SchemaDescription = SchemaDescription {schemaDescriptionToString :: Stri deriving newtype (Eq, Ord, Show, ToJSON) deriving stock (Data, Lift) -{- | An annotation for the "$comment" schema attribute. +{-| An annotation for the "$comment" schema attribute. This annotation could be attached to a type or constructor: @ diff --git a/plutus-tx/src/PlutusTx/Blueprint/TH.hs b/plutus-tx/src/PlutusTx/Blueprint/TH.hs index e8ff70ce54f..fc0ead65a2c 100644 --- a/plutus-tx/src/PlutusTx/Blueprint/TH.hs +++ b/plutus-tx/src/PlutusTx/Blueprint/TH.hs @@ -34,7 +34,7 @@ import PlutusTx.Blueprint.Schema.Annotation (SchemaAnn (..), SchemaComment, Sche schemaDescriptionToString, schemaTitleToString) import PlutusTx.IsData.TH (makeIsDataIndexed) -{- | +{-| Generate a 'ToData', 'FromData', 'UnsafeFromData', 'HasBlueprintSchema' instances for a type, using an explicit mapping of constructor names to indices. Use this for types where you need to keep the representation stable. @@ -48,7 +48,7 @@ makeIsDataSchemaIndexed dataTypeName indices = do unstableMakeIsDataSchema :: TH.Name -> TH.Q [TH.Dec] unstableMakeIsDataSchema name = do info <- TH.reifyDatatype name - let defaultIndex = zip (TH.constructorName <$> TH.datatypeCons info) [0..] + let defaultIndex = zip (TH.constructorName <$> TH.datatypeCons info) [0 ..] makeIsDataSchemaIndexed name defaultIndex makeHasSchemaInstance :: TH.Name -> [(TH.Name, Natural)] -> TH.Q [TH.InstanceDec] @@ -75,9 +75,10 @@ makeHasSchemaInstance dataTypeName indices = do nub . join $ -- Every type in the constructor fields must have a schema definition. [ ( case fieldType of - TH.VarT {} -> (TH.classPred ''HasBlueprintDefinition [fieldType] :) - _ -> id - ) [ TH.classPred ''HasSchemaDefinition [fieldType, referencedTypes] ] + TH.VarT{} -> (TH.classPred ''HasBlueprintDefinition [fieldType] :) + _ -> id + ) + [TH.classPred ''HasSchemaDefinition [fieldType, referencedTypes]] | (TH.ConstructorInfo{constructorFields}, _info, _index) <- indexedCons , fieldType <- constructorFields ] @@ -92,9 +93,9 @@ makeHasSchemaInstance dataTypeName indices = do -- {-# INLINE schema #-} -- schema = ... [ nonOverlapInstance - constraints - (TH.classPred ''HasBlueprintSchema [appliedType, referencedTypes]) - [schemaPrag, schemaDecl] + constraints + (TH.classPred ''HasBlueprintSchema [appliedType, referencedTypes]) + [schemaPrag, schemaDecl] ] where -- Lookup all annotations (SchemaTitle, SchemdDescription, SchemaComment) attached to a name. @@ -105,18 +106,18 @@ makeHasSchemaInstance dataTypeName indices = do comment <- MkSchemaAnnComment <<$>> lookupAnn @SchemaComment name pure $ title ++ description ++ comment - -- | Make SchemaInfo from a list of schema annotations, failing in case of ambiguity. + -- \| Make SchemaInfo from a list of schema annotations, failing in case of ambiguity. schemaInfoFromAnns :: [SchemaAnn] -> TH.Q SchemaInfo schemaInfoFromAnns = either fail pure . annotationsToSchemaInfo -- | Make a clause for the 'schema' function. -mkSchemaClause :: - -- | The type for the 'HasBlueprintSchema' instance. - TH.Type -> - -- | The constructors of the type with their schema infos and indices. - [(TH.ConstructorInfo, SchemaInfo, Natural)] -> - -- | The clause for the 'schema' function. - TH.ClauseQ +mkSchemaClause + :: TH.Type + -- ^ The type for the 'HasBlueprintSchema' instance. + -> [(TH.ConstructorInfo, SchemaInfo, Natural)] + -- ^ The constructors of the type with their schema infos and indices. + -> TH.ClauseQ + -- ^ The clause for the 'schema' function. mkSchemaClause ts ctorIndexes = case ctorIndexes of [] -> fail "At least one constructor index must be specified." @@ -138,7 +139,8 @@ deriveParameterBlueprint :: TH.Name -> Set Purpose -> TH.ExpQ deriveParameterBlueprint tyName purpose = do title <- Text.pack . schemaTitleToString <<$>> lookupSchemaTitle tyName description <- Text.pack . schemaDescriptionToString <<$>> lookupSchemaDescription tyName - [| MkParameterBlueprint + [| + MkParameterBlueprint { parameterTitle = title , parameterDescription = description , parameterPurpose = purpose @@ -150,7 +152,8 @@ deriveArgumentBlueprint :: TH.Name -> Set Purpose -> TH.ExpQ deriveArgumentBlueprint tyName purpose = do title <- Text.pack . schemaTitleToString <<$>> lookupSchemaTitle tyName description <- Text.pack . schemaDescriptionToString <<$>> lookupSchemaDescription tyName - [| MkArgumentBlueprint + [| + MkArgumentBlueprint { argumentTitle = title , argumentDescription = description , argumentPurpose = purpose @@ -165,13 +168,15 @@ lookupAnn :: (Data a) => TH.Name -> TH.Q [a] lookupAnn = TH.reifyAnnotations . TH.AnnLookupName lookupSchemaTitle :: TH.Name -> TH.Q (Maybe SchemaTitle) -lookupSchemaTitle tyName = lookupAnn @SchemaTitle tyName <&> \case +lookupSchemaTitle tyName = + lookupAnn @SchemaTitle tyName <&> \case [x] -> Just x [] -> Nothing _ -> fail $ "Multiple SchemTitle annotations found for " <> show tyName lookupSchemaDescription :: TH.Name -> TH.Q (Maybe SchemaDescription) -lookupSchemaDescription tyName = lookupAnn @SchemaDescription tyName <&> \case +lookupSchemaDescription tyName = + lookupAnn @SchemaDescription tyName <&> \case [x] -> Just x [] -> Nothing _ -> fail $ "Multiple SchemaDescription annotations found for " <> show tyName diff --git a/plutus-tx/src/PlutusTx/Blueprint/Validator.hs b/plutus-tx/src/PlutusTx/Blueprint/Validator.hs index 096fb6a0f28..24e42017c97 100644 --- a/plutus-tx/src/PlutusTx/Blueprint/Validator.hs +++ b/plutus-tx/src/PlutusTx/Blueprint/Validator.hs @@ -23,7 +23,7 @@ import PlutusTx.Blueprint.Argument (ArgumentBlueprint) import PlutusTx.Blueprint.Parameter (ParameterBlueprint) import PlutusTx.Blueprint.PlutusVersion (PlutusVersion (..)) -{- | A blueprint of a validator, as defined by the CIP-0057 +{-| A blueprint of a validator, as defined by the CIP-0057 The 'referencedTypes' phantom type parameter is used to track the types used in the contract making sure their schemas are included in the blueprint and that they are referenced @@ -58,11 +58,11 @@ compiledValidator version code = , compiledValidatorHash = blake2b_224 (BS.singleton (versionTag version) <> code) } - where - versionTag = \case - PlutusV1 -> 0x1 - PlutusV2 -> 0x2 - PlutusV3 -> 0x3 + where + versionTag = \case + PlutusV1 -> 0x1 + PlutusV2 -> 0x2 + PlutusV3 -> 0x3 instance ToJSON (ValidatorBlueprint referencedTypes) where toJSON MkValidatorBlueprint{..} = @@ -74,6 +74,6 @@ instance ToJSON (ValidatorBlueprint referencedTypes) where . optionalField "parameters" (NE.nonEmpty validatorParameters) . optionalField "compiledCode" (toHex . compiledValidatorCode <$> validatorCompiled) . optionalField "hash" (toHex . compiledValidatorHash <$> validatorCompiled) - where - toHex :: ByteString -> Text - toHex = Text.decodeUtf8 . Base16.encode + where + toHex :: ByteString -> Text + toHex = Text.decodeUtf8 . Base16.encode diff --git a/plutus-tx/src/PlutusTx/Bool.hs b/plutus-tx/src/PlutusTx/Bool.hs index d2b98fe7bd4..33a04c5d403 100644 --- a/plutus-tx/src/PlutusTx/Bool.hs +++ b/plutus-tx/src/PlutusTx/Bool.hs @@ -1,4 +1,4 @@ -module PlutusTx.Bool (Bool(..), (&&), (||), not, otherwise) where +module PlutusTx.Bool (Bool (..), (&&), (||), not, otherwise) where {- We export off-chain Haskell's Bool type as on-chain Plutus's Bool type since they are the same. @@ -11,31 +11,33 @@ import Prelude (Bool (..), otherwise) -- `(&&)` and `(||)` are handled specially in the plugin to make sure they can short-circuit. -- See Note [Lazy boolean operators] in the plugin. --- | Logical AND. Short-circuits if the first argument evaluates to `False`. --- --- >>> True && False --- False --- +{-| Logical AND. Short-circuits if the first argument evaluates to `False`. + + >>> True && False + False +-} infixr 3 && + (&&) :: Bool -> Bool -> Bool (&&) l r = if l then r else False {-# OPAQUE (&&) #-} --- | Logical OR. Short-circuits if the first argument evaluates to `True`. --- --- >>> True || False --- True --- +{-| Logical OR. Short-circuits if the first argument evaluates to `True`. + + >>> True || False + True +-} infixr 2 || + (||) :: Bool -> Bool -> Bool (||) l r = if l then True else r {-# OPAQUE (||) #-} --- | Logical negation --- --- >>> not True --- False --- +{-| Logical negation + + >>> not True + False +-} not :: Bool -> Bool not a = if a then False else True -{-# INLINABLE not #-} +{-# INLINEABLE not #-} diff --git a/plutus-tx/src/PlutusTx/Builtins.hs b/plutus-tx/src/PlutusTx/Builtins.hs index 3d916e0b107..3914701f173 100644 --- a/plutus-tx/src/PlutusTx/Builtins.hs +++ b/plutus-tx/src/PlutusTx/Builtins.hs @@ -2,148 +2,160 @@ -- | Primitive names and functions for working with Plutus Core builtins. module PlutusTx.Builtins ( - -- * Bytestring builtins - BuiltinByteString - , appendByteString - , consByteString - , sliceByteString - , lengthOfByteString - , indexByteString - , emptyByteString - , equalsByteString - , lessThanByteString - , lessThanEqualsByteString - , greaterThanByteString - , greaterThanEqualsByteString - , sha2_256 - , sha3_256 - , blake2b_224 - , blake2b_256 - , keccak_256 - , ripemd_160 - , verifyEd25519Signature - , verifyEcdsaSecp256k1Signature - , verifySchnorrSecp256k1Signature - , decodeUtf8 - , BuiltinByteStringHex (..) - , BuiltinByteStringUtf8 (..) - -- * Integer builtins - , Integer - , addInteger - , subtractInteger - , multiplyInteger - , divideInteger - , modInteger - , quotientInteger - , remainderInteger - , greaterThanInteger - , greaterThanEqualsInteger - , lessThanInteger - , lessThanEqualsInteger - , equalsInteger - , expModInteger - -- * Error - , error - -- * Data - , BuiltinData - , chooseData - , BI.caseData' - , caseData - , matchData - , matchData' - , equalsData - , serialiseData - , mkConstr - , mkMap - , mkList - , mkI - , mkB - , unsafeDataAsConstr - , unsafeDataAsMap - , unsafeDataAsList - , unsafeDataAsI - , unsafeDataAsB - , BI.builtinDataToData - , BI.dataToBuiltinData - -- * Strings - , BuiltinString - , appendString - , emptyString - , equalsString - , encodeUtf8 - -- * Pairs - , pairToPair - -- * Lists - , mkNil - , mkNilOpaque - , null - , BI.caseList' - , caseList - , matchList - , matchList' - , headMaybe - , BI.head - , BI.tail - , BI.drop - , uncons - , unsafeUncons - -- * Arrays - , BI.BuiltinArray - , BI.listToArray - , sopListToArray - , BI.lengthOfArray - , BI.indexArray - -- * Tracing - , trace - -- * BLS12_381 - , BuiltinBLS12_381_G1_Element - , bls12_381_G1_equals - , bls12_381_G1_add - , bls12_381_G1_scalarMul - , bls12_381_G1_neg - , bls12_381_G1_compress - , bls12_381_G1_uncompress - , bls12_381_G1_hashToGroup - , bls12_381_G1_compressed_zero - , bls12_381_G1_compressed_generator - , BuiltinBLS12_381_G2_Element - , bls12_381_G2_equals - , bls12_381_G2_add - , bls12_381_G2_scalarMul - , bls12_381_G2_neg - , bls12_381_G2_compress - , bls12_381_G2_uncompress - , bls12_381_G2_hashToGroup - , bls12_381_G2_compressed_zero - , bls12_381_G2_compressed_generator - , BuiltinBLS12_381_MlResult - , bls12_381_millerLoop - , bls12_381_mulMlResult - , bls12_381_finalVerify - -- * Conversions - , fromOpaque - , toOpaque - , useToOpaque - , useFromOpaque - , fromBuiltin - , toBuiltin - -- * Logical - , ByteOrder (..) - , integerToByteString - , byteStringToInteger - , andByteString - , orByteString - , xorByteString - , complementByteString - , readBit - , writeBits - , replicateByte - -- * Bitwise - , shiftByteString - , rotateByteString - , countSetBits - , findFirstSetBit - ) where + -- * Bytestring builtins + BuiltinByteString, + appendByteString, + consByteString, + sliceByteString, + lengthOfByteString, + indexByteString, + emptyByteString, + equalsByteString, + lessThanByteString, + lessThanEqualsByteString, + greaterThanByteString, + greaterThanEqualsByteString, + sha2_256, + sha3_256, + blake2b_224, + blake2b_256, + keccak_256, + ripemd_160, + verifyEd25519Signature, + verifyEcdsaSecp256k1Signature, + verifySchnorrSecp256k1Signature, + decodeUtf8, + BuiltinByteStringHex (..), + BuiltinByteStringUtf8 (..), + + -- * Integer builtins + Integer, + addInteger, + subtractInteger, + multiplyInteger, + divideInteger, + modInteger, + quotientInteger, + remainderInteger, + greaterThanInteger, + greaterThanEqualsInteger, + lessThanInteger, + lessThanEqualsInteger, + equalsInteger, + expModInteger, + + -- * Error + error, + + -- * Data + BuiltinData, + chooseData, + BI.caseData', + caseData, + matchData, + matchData', + equalsData, + serialiseData, + mkConstr, + mkMap, + mkList, + mkI, + mkB, + unsafeDataAsConstr, + unsafeDataAsMap, + unsafeDataAsList, + unsafeDataAsI, + unsafeDataAsB, + BI.builtinDataToData, + BI.dataToBuiltinData, + + -- * Strings + BuiltinString, + appendString, + emptyString, + equalsString, + encodeUtf8, + + -- * Pairs + pairToPair, + + -- * Lists + mkNil, + mkNilOpaque, + null, + BI.caseList', + caseList, + matchList, + matchList', + headMaybe, + BI.head, + BI.tail, + BI.drop, + uncons, + unsafeUncons, + + -- * Arrays + BI.BuiltinArray, + BI.listToArray, + sopListToArray, + BI.lengthOfArray, + BI.indexArray, + + -- * Tracing + trace, + + -- * BLS12_381 + BuiltinBLS12_381_G1_Element, + bls12_381_G1_equals, + bls12_381_G1_add, + bls12_381_G1_scalarMul, + bls12_381_G1_neg, + bls12_381_G1_compress, + bls12_381_G1_uncompress, + bls12_381_G1_hashToGroup, + bls12_381_G1_compressed_zero, + bls12_381_G1_compressed_generator, + BuiltinBLS12_381_G2_Element, + bls12_381_G2_equals, + bls12_381_G2_add, + bls12_381_G2_scalarMul, + bls12_381_G2_neg, + bls12_381_G2_compress, + bls12_381_G2_uncompress, + bls12_381_G2_hashToGroup, + bls12_381_G2_compressed_zero, + bls12_381_G2_compressed_generator, + BuiltinBLS12_381_MlResult, + bls12_381_millerLoop, + bls12_381_mulMlResult, + bls12_381_finalVerify, + + -- * Conversions + fromOpaque, + toOpaque, + useToOpaque, + useFromOpaque, + fromBuiltin, + toBuiltin, + + -- * Logical + ByteOrder (..), + integerToByteString, + byteStringToInteger, + andByteString, + orByteString, + xorByteString, + complementByteString, + readBit, + writeBits, + replicateByte, + + -- * Bitwise + shiftByteString, + rotateByteString, + countSetBits, + findFirstSetBit, +) where import Data.Maybe import PlutusTx.Bool (Bool (..)) @@ -160,177 +172,189 @@ import GHC.ByteOrder (ByteOrder (BigEndian, LittleEndian)) -- | Concatenates two 'ByteString's. appendByteString :: BuiltinByteString -> BuiltinByteString -> BuiltinByteString appendByteString = BI.appendByteString -{-# INLINABLE appendByteString #-} +{-# INLINEABLE appendByteString #-} -- | Adds a byte to the front of a 'ByteString'. consByteString :: Integer -> BuiltinByteString -> BuiltinByteString consByteString n bs = BI.consByteString (toOpaque n) bs -{-# INLINABLE consByteString #-} +{-# INLINEABLE consByteString #-} -- | Returns the substring of a 'ByteString' from index 'start' of length 'n'. sliceByteString :: Integer -> Integer -> BuiltinByteString -> BuiltinByteString sliceByteString start n bs = BI.sliceByteString (toOpaque start) (toOpaque n) bs -{-# INLINABLE sliceByteString #-} +{-# INLINEABLE sliceByteString #-} -- | Returns the length of a 'ByteString'. lengthOfByteString :: BuiltinByteString -> Integer lengthOfByteString = BI.lengthOfByteString -{-# INLINABLE lengthOfByteString #-} +{-# INLINEABLE lengthOfByteString #-} -- | Returns the byte of a 'ByteString' at index. indexByteString :: BuiltinByteString -> Integer -> Integer indexByteString b n = BI.indexByteString b (toOpaque n) -{-# INLINABLE indexByteString #-} +{-# INLINEABLE indexByteString #-} -- | An empty 'ByteString'. emptyByteString :: BuiltinByteString emptyByteString = BI.emptyByteString -{-# INLINABLE emptyByteString #-} +{-# INLINEABLE emptyByteString #-} -- | The SHA2-256 hash of a 'ByteString' sha2_256 :: BuiltinByteString -> BuiltinByteString sha2_256 = BI.sha2_256 -{-# INLINABLE sha2_256 #-} +{-# INLINEABLE sha2_256 #-} -- | The SHA3-256 hash of a 'ByteString' sha3_256 :: BuiltinByteString -> BuiltinByteString sha3_256 = BI.sha3_256 -{-# INLINABLE sha3_256 #-} +{-# INLINEABLE sha3_256 #-} -- | The BLAKE2B-224 hash of a 'ByteString' blake2b_224 :: BuiltinByteString -> BuiltinByteString blake2b_224 = BI.blake2b_224 -{-# INLINABLE blake2b_224 #-} +{-# INLINEABLE blake2b_224 #-} -- | The BLAKE2B-256 hash of a 'ByteString' blake2b_256 :: BuiltinByteString -> BuiltinByteString blake2b_256 = BI.blake2b_256 -{-# INLINABLE blake2b_256 #-} +{-# INLINEABLE blake2b_256 #-} -- | The KECCAK-256 hash of a 'ByteString' keccak_256 :: BuiltinByteString -> BuiltinByteString keccak_256 = BI.keccak_256 -{-# INLINABLE keccak_256 #-} +{-# INLINEABLE keccak_256 #-} -- | The RIPEMD-160 hash of a 'ByteString' ripemd_160 :: BuiltinByteString -> BuiltinByteString ripemd_160 = BI.ripemd_160 -{-# INLINABLE ripemd_160 #-} +{-# INLINEABLE ripemd_160 #-} --- | Ed25519 signature verification. Verify that the signature is a signature of --- the message by the public key. This will fail if key or the signature are not --- of the expected length. +{-| Ed25519 signature verification. Verify that the signature is a signature of +the message by the public key. This will fail if key or the signature are not +of the expected length. +-} verifyEd25519Signature - :: BuiltinByteString -- ^ Public Key (32 bytes) - -> BuiltinByteString -- ^ Message (arbirtary length) - -> BuiltinByteString -- ^ Signature (64 bytes) - -> Bool + :: BuiltinByteString + -- ^ Public Key (32 bytes) + -> BuiltinByteString + -- ^ Message (arbirtary length) + -> BuiltinByteString + -- ^ Signature (64 bytes) + -> Bool verifyEd25519Signature pubKey message signature = - fromOpaque (BI.verifyEd25519Signature pubKey message signature) -{-# INLINABLE verifyEd25519Signature #-} + fromOpaque (BI.verifyEd25519Signature pubKey message signature) +{-# INLINEABLE verifyEd25519Signature #-} -- | Check if two 'ByteString's are equal. equalsByteString :: BuiltinByteString -> BuiltinByteString -> Bool equalsByteString x y = fromOpaque (BI.equalsByteString x y) -{-# INLINABLE equalsByteString #-} +{-# INLINEABLE equalsByteString #-} -- | Check if one 'ByteString' is less than another. lessThanByteString :: BuiltinByteString -> BuiltinByteString -> Bool lessThanByteString x y = fromOpaque (BI.lessThanByteString x y) -{-# INLINABLE lessThanByteString #-} +{-# INLINEABLE lessThanByteString #-} -- | Check if one 'ByteString' is less than or equal to another. lessThanEqualsByteString :: BuiltinByteString -> BuiltinByteString -> Bool lessThanEqualsByteString x y = fromOpaque (BI.lessThanEqualsByteString x y) -{-# INLINABLE lessThanEqualsByteString #-} +{-# INLINEABLE lessThanEqualsByteString #-} -- | Check if one 'ByteString' is greater than another. greaterThanByteString :: BuiltinByteString -> BuiltinByteString -> Bool greaterThanByteString x y = BI.ifThenElse (BI.lessThanEqualsByteString x y) False True -{-# INLINABLE greaterThanByteString #-} +{-# INLINEABLE greaterThanByteString #-} -- | Check if one 'ByteString' is greater than another. greaterThanEqualsByteString :: BuiltinByteString -> BuiltinByteString -> Bool greaterThanEqualsByteString x y = BI.ifThenElse (BI.lessThanByteString x y) False True -{-# INLINABLE greaterThanEqualsByteString #-} +{-# INLINEABLE greaterThanEqualsByteString #-} -- | Converts a ByteString to a String. decodeUtf8 :: BuiltinByteString -> BuiltinString decodeUtf8 = BI.decodeUtf8 -{-# INLINABLE decodeUtf8 #-} - --- | Given an ECDSA SECP256k1 verification key, an ECDSA SECP256k1 signature, --- and an ECDSA SECP256k1 message hash (all as 'BuiltinByteString's), verify the --- hash with that key and signature. --- --- = Note --- --- There are additional well-formation requirements for the arguments beyond --- their length: --- --- * The first byte of the public key must correspond to the sign of the /y/ --- coordinate: this is @0x02@ if /y/ is even, and @0x03@ otherwise. --- * The remaining bytes of the public key must correspond to the /x/ --- coordinate, as a big-endian integer. --- * The first 32 bytes of the signature must correspond to the big-endian --- integer representation of _r_. --- * The last 32 bytes of the signature must correspond to the big-endian --- integer representation of _s_. --- --- While this primitive /accepts/ a hash, any caller should only pass it hashes --- that they computed themselves: specifically, they should receive the --- /message/ from a sender and hash it, rather than receiving the /hash/ from --- said sender. Failure to do so can be --- [dangerous](https://bitcoin.stackexchange.com/a/81116/35586). Other than --- length, we make no requirements of what hash gets used. --- --- = See also --- --- * --- [@secp256k1_ec_pubkey_serialize@](https://github.com/bitcoin-core/secp256k1/blob/master/include/secp256k1.h#L394); --- this implements the format for the verification key that we accept, given a --- length argument of 33 and the @SECP256K1_EC_COMPRESSED@ flag. --- * --- [@secp256k1_ecdsa_serialize_compact@](https://github.com/bitcoin-core/secp256k1/blob/master/include/secp256k1.h#L487); --- this implements the format for the signature that we accept. +{-# INLINEABLE decodeUtf8 #-} + +{-| Given an ECDSA SECP256k1 verification key, an ECDSA SECP256k1 signature, +and an ECDSA SECP256k1 message hash (all as 'BuiltinByteString's), verify the +hash with that key and signature. + += Note + +There are additional well-formation requirements for the arguments beyond +their length: + +* The first byte of the public key must correspond to the sign of the /y/ +coordinate: this is @0x02@ if /y/ is even, and @0x03@ otherwise. +* The remaining bytes of the public key must correspond to the /x/ +coordinate, as a big-endian integer. +* The first 32 bytes of the signature must correspond to the big-endian +integer representation of _r_. +* The last 32 bytes of the signature must correspond to the big-endian +integer representation of _s_. + +While this primitive /accepts/ a hash, any caller should only pass it hashes +that they computed themselves: specifically, they should receive the +/message/ from a sender and hash it, rather than receiving the /hash/ from +said sender. Failure to do so can be +[dangerous](https://bitcoin.stackexchange.com/a/81116/35586). Other than +length, we make no requirements of what hash gets used. + += See also + +* +[@secp256k1_ec_pubkey_serialize@](https://github.com/bitcoin-core/secp256k1/blob/master/include/secp256k1.h#L394); +this implements the format for the verification key that we accept, given a +length argument of 33 and the @SECP256K1_EC_COMPRESSED@ flag. +* +[@secp256k1_ecdsa_serialize_compact@](https://github.com/bitcoin-core/secp256k1/blob/master/include/secp256k1.h#L487); +this implements the format for the signature that we accept. +-} verifyEcdsaSecp256k1Signature - :: BuiltinByteString -- ^ Verification key (33 bytes) - -> BuiltinByteString -- ^ Message hash (32 bytes) - -> BuiltinByteString -- ^ Signature (64 bytes) + :: BuiltinByteString + -- ^ Verification key (33 bytes) + -> BuiltinByteString + -- ^ Message hash (32 bytes) + -> BuiltinByteString + -- ^ Signature (64 bytes) -> Bool verifyEcdsaSecp256k1Signature vk msg sig = fromOpaque (BI.verifyEcdsaSecp256k1Signature vk msg sig) {-# INLINEABLE verifyEcdsaSecp256k1Signature #-} --- | Given a Schnorr SECP256k1 verification key, a Schnorr SECP256k1 signature, --- and a message (all as 'BuiltinByteString's), verify the message with that key --- and signature. --- --- = Note --- --- There are additional well-formation requirements for the arguments beyond --- their length. Throughout, we refer to co-ordinates of the point @R@. --- --- * The bytes of the public key must correspond to the /x/ coordinate, as a --- big-endian integer, as specified in BIP-340. --- * The first 32 bytes of the signature must correspond to the /x/ coordinate, --- as a big-endian integer, as specified in BIP-340. --- * The last 32 bytes of the signature must correspond to the bytes of /s/, as --- a big-endian integer, as specified in BIP-340. --- --- = See also --- --- * [BIP-340](https://github.com/bitcoin/bips/blob/master/bip-0340.mediawiki) --- * --- [@secp256k1_xonly_pubkey_serialize@](https://github.com/bitcoin-core/secp256k1/blob/master/include/secp256k1_extrakeys.h#L61); --- this implements the format for the verification key that we accept. --- * --- [@secp256k1_schnorrsig_sign@](https://github.com/bitcoin-core/secp256k1/blob/master/include/secp256k1_schnorrsig.h#L129); --- this implements the signing logic for signatures this builtin can verify. +{-| Given a Schnorr SECP256k1 verification key, a Schnorr SECP256k1 signature, +and a message (all as 'BuiltinByteString's), verify the message with that key +and signature. + += Note + +There are additional well-formation requirements for the arguments beyond +their length. Throughout, we refer to co-ordinates of the point @R@. + +* The bytes of the public key must correspond to the /x/ coordinate, as a +big-endian integer, as specified in BIP-340. +* The first 32 bytes of the signature must correspond to the /x/ coordinate, +as a big-endian integer, as specified in BIP-340. +* The last 32 bytes of the signature must correspond to the bytes of /s/, as +a big-endian integer, as specified in BIP-340. + += See also + +* [BIP-340](https://github.com/bitcoin/bips/blob/master/bip-0340.mediawiki) +* +[@secp256k1_xonly_pubkey_serialize@](https://github.com/bitcoin-core/secp256k1/blob/master/include/secp256k1_extrakeys.h#L61); +this implements the format for the verification key that we accept. +* +[@secp256k1_schnorrsig_sign@](https://github.com/bitcoin-core/secp256k1/blob/master/include/secp256k1_schnorrsig.h#L129); +this implements the signing logic for signatures this builtin can verify. +-} verifySchnorrSecp256k1Signature - :: BuiltinByteString -- ^ Verification key (32 bytes) - -> BuiltinByteString -- ^ Message (arbitrary length) - -> BuiltinByteString -- ^ Signature (64 bytes) + :: BuiltinByteString + -- ^ Verification key (32 bytes) + -> BuiltinByteString + -- ^ Message (arbitrary length) + -> BuiltinByteString + -- ^ Signature (64 bytes) -> Bool verifySchnorrSecp256k1Signature vk msg sig = fromOpaque (BI.verifySchnorrSecp256k1Signature vk msg sig) @@ -339,108 +363,108 @@ verifySchnorrSecp256k1Signature vk msg sig = -- | Add two 'Integer's. addInteger :: Integer -> Integer -> Integer addInteger x y = fromOpaque (BI.addInteger (toOpaque x) (toOpaque y)) -{-# INLINABLE addInteger #-} +{-# INLINEABLE addInteger #-} -- | Subtract two 'Integer's. subtractInteger :: Integer -> Integer -> Integer subtractInteger x y = fromOpaque (BI.subtractInteger (toOpaque x) (toOpaque y)) -{-# INLINABLE subtractInteger #-} +{-# INLINEABLE subtractInteger #-} -- | Multiply two 'Integer's. multiplyInteger :: Integer -> Integer -> Integer multiplyInteger x y = fromOpaque (BI.multiplyInteger (toOpaque x) (toOpaque y)) -{-# INLINABLE multiplyInteger #-} +{-# INLINEABLE multiplyInteger #-} -- | Divide two integers. divideInteger :: Integer -> Integer -> Integer divideInteger x y = fromOpaque (BI.divideInteger (toOpaque x) (toOpaque y)) -{-# INLINABLE divideInteger #-} +{-# INLINEABLE divideInteger #-} -- | Integer modulo operation. modInteger :: Integer -> Integer -> Integer modInteger x y = fromOpaque (BI.modInteger (toOpaque x) (toOpaque y)) -{-# INLINABLE modInteger #-} +{-# INLINEABLE modInteger #-} -- | Quotient of two integers. quotientInteger :: Integer -> Integer -> Integer quotientInteger x y = fromOpaque (BI.quotientInteger (toOpaque x) (toOpaque y)) -{-# INLINABLE quotientInteger #-} +{-# INLINEABLE quotientInteger #-} -- | Take the remainder of dividing two 'Integer's. remainderInteger :: Integer -> Integer -> Integer remainderInteger x y = fromOpaque (BI.remainderInteger (toOpaque x) (toOpaque y)) -{-# INLINABLE remainderInteger #-} +{-# INLINEABLE remainderInteger #-} -- | Check whether one 'Integer' is greater than another. greaterThanInteger :: Integer -> Integer -> Bool greaterThanInteger x y = BI.ifThenElse (BI.lessThanEqualsInteger x y) False True -{-# INLINABLE greaterThanInteger #-} +{-# INLINEABLE greaterThanInteger #-} -- | Check whether one 'Integer' is greater than or equal to another. greaterThanEqualsInteger :: Integer -> Integer -> Bool greaterThanEqualsInteger x y = BI.ifThenElse (BI.lessThanInteger x y) False True -{-# INLINABLE greaterThanEqualsInteger #-} +{-# INLINEABLE greaterThanEqualsInteger #-} -- | Check whether one 'Integer' is less than another. lessThanInteger :: Integer -> Integer -> Bool lessThanInteger x y = fromOpaque (BI.lessThanInteger (toOpaque x) (toOpaque y)) -{-# INLINABLE lessThanInteger #-} +{-# INLINEABLE lessThanInteger #-} -- | Check whether one 'Integer' is less than or equal to another. lessThanEqualsInteger :: Integer -> Integer -> Bool lessThanEqualsInteger x y = fromOpaque (BI.lessThanEqualsInteger (toOpaque x) (toOpaque y)) -{-# INLINABLE lessThanEqualsInteger #-} +{-# INLINEABLE lessThanEqualsInteger #-} -- | Check if two 'Integer's are equal. equalsInteger :: Integer -> Integer -> Bool equalsInteger x y = fromOpaque (BI.equalsInteger (toOpaque x) (toOpaque y)) -{-# INLINABLE equalsInteger #-} +{-# INLINEABLE equalsInteger #-} -- | Aborts evaluation with an error. error :: () -> a error x = BI.error (toOpaque x) -{-# INLINABLE error #-} +{-# INLINEABLE error #-} -- | Append two 'String's. appendString :: BuiltinString -> BuiltinString -> BuiltinString appendString = BI.appendString -{-# INLINABLE appendString #-} +{-# INLINEABLE appendString #-} -- | An empty 'String'. emptyString :: BuiltinString emptyString = BI.emptyString -{-# INLINABLE emptyString #-} +{-# INLINEABLE emptyString #-} -- | Check if two strings are equal equalsString :: BuiltinString -> BuiltinString -> Bool equalsString x y = fromOpaque (BI.equalsString x y) -{-# INLINABLE equalsString #-} +{-# INLINEABLE equalsString #-} -- | Emit the given string as a trace message before evaluating the argument. trace :: BuiltinString -> a -> a trace = BI.trace -{-# INLINABLE trace #-} +{-# INLINEABLE trace #-} -- | Convert a String into a ByteString. encodeUtf8 :: BuiltinString -> BuiltinByteString encodeUtf8 = BI.encodeUtf8 -{-# INLINABLE encodeUtf8 #-} +{-# INLINEABLE encodeUtf8 #-} null :: forall a. BI.BuiltinList a -> Bool null l = fromOpaque (BI.null l) -{-# INLINABLE null #-} +{-# INLINEABLE null #-} -caseList :: forall a r . (() -> r) -> (a -> BI.BuiltinList a -> r) -> BI.BuiltinList a -> r +caseList :: forall a r. (() -> r) -> (a -> BI.BuiltinList a -> r) -> BI.BuiltinList a -> r caseList nilCase consCase l = BI.caseList' nilCase (\x xs _ -> consCase x xs) l () -{-# INLINABLE caseList #-} +{-# INLINEABLE caseList #-} -matchList :: forall a r . BI.BuiltinList a -> (() -> r) -> (a -> BI.BuiltinList a -> r) -> r +matchList :: forall a r. BI.BuiltinList a -> (() -> r) -> (a -> BI.BuiltinList a -> r) -> r matchList l nilCase consCase = caseList nilCase consCase l -{-# INLINABLE matchList #-} +{-# INLINEABLE matchList #-} -matchList' :: forall a r . BI.BuiltinList a -> r -> (a -> BI.BuiltinList a -> r) -> r +matchList' :: forall a r. BI.BuiltinList a -> r -> (a -> BI.BuiltinList a -> r) -> r matchList' l nilCase consCase = BI.caseList' nilCase consCase l -{-# INLINABLE matchList' #-} +{-# INLINEABLE matchList' #-} headMaybe :: BI.BuiltinList a -> Maybe a headMaybe = BI.caseList' Nothing (\h _ -> Just h) @@ -461,205 +485,211 @@ pairToPair :: BI.BuiltinPair a b -> (a, b) pairToPair tup = (BI.fst tup, BI.snd tup) {-# INLINE pairToPair #-} -sopListToArray :: (HasToOpaque a arep, MkNil arep) => [a] -> BI.BuiltinArray arep +sopListToArray :: (HasToOpaque a arep, MkNil arep) => [a] -> BI.BuiltinArray arep sopListToArray l = BI.listToArray (toOpaque l) -{-# INLINABLE sopListToArray #-} +{-# INLINEABLE sopListToArray #-} --- | Given five values for the five different constructors of 'BuiltinData', selects --- one depending on which corresponds to the actual constructor of the given value. -chooseData :: forall a . BuiltinData -> a -> a -> a -> a -> a -> a +{-| Given five values for the five different constructors of 'BuiltinData', selects +one depending on which corresponds to the actual constructor of the given value. +-} +chooseData :: forall a. BuiltinData -> a -> a -> a -> a -> a -> a chooseData = BI.chooseData -{-# INLINABLE chooseData #-} +{-# INLINEABLE chooseData #-} -- | Convert a String into a ByteString. serialiseData :: BuiltinData -> BuiltinByteString serialiseData = BI.serialiseData -{-# INLINABLE serialiseData #-} +{-# INLINEABLE serialiseData #-} -- | Constructs a 'BuiltinData' value with the @Constr@ constructor. mkConstr :: Integer -> [BuiltinData] -> BuiltinData mkConstr i args = BI.mkConstr (toOpaque i) (toOpaque args) -{-# INLINABLE mkConstr #-} +{-# INLINEABLE mkConstr #-} -- | Constructs a 'BuiltinData' value with the @Map@ constructor. mkMap :: [(BuiltinData, BuiltinData)] -> BuiltinData mkMap es = BI.mkMap (toOpaque es) -{-# INLINABLE mkMap #-} +{-# INLINEABLE mkMap #-} -- | Constructs a 'BuiltinData' value with the @List@ constructor. mkList :: [BuiltinData] -> BuiltinData mkList l = BI.mkList (toOpaque l) -{-# INLINABLE mkList #-} +{-# INLINEABLE mkList #-} -- | Constructs a 'BuiltinData' value with the @I@ constructor. mkI :: Integer -> BuiltinData mkI = BI.mkI -{-# INLINABLE mkI #-} +{-# INLINEABLE mkI #-} -- | Constructs a 'BuiltinData' value with the @B@ constructor. mkB :: BuiltinByteString -> BuiltinData mkB = BI.mkB -{-# INLINABLE mkB #-} +{-# INLINEABLE mkB #-} -- | Deconstructs a 'BuiltinData' as a @Constr@, or fails if it is not one. unsafeDataAsConstr :: BuiltinData -> (Integer, [BuiltinData]) unsafeDataAsConstr d = fromOpaque (BI.unsafeDataAsConstr d) -{-# INLINABLE unsafeDataAsConstr #-} +{-# INLINEABLE unsafeDataAsConstr #-} -- | Deconstructs a 'BuiltinData' as a @Map@, or fails if it is not one. unsafeDataAsMap :: BuiltinData -> [(BuiltinData, BuiltinData)] unsafeDataAsMap d = fromOpaque (BI.unsafeDataAsMap d) -{-# INLINABLE unsafeDataAsMap #-} +{-# INLINEABLE unsafeDataAsMap #-} -- | Deconstructs a 'BuiltinData' as a @List@, or fails if it is not one. unsafeDataAsList :: BuiltinData -> [BuiltinData] unsafeDataAsList d = fromOpaque (BI.unsafeDataAsList d) -{-# INLINABLE unsafeDataAsList #-} +{-# INLINEABLE unsafeDataAsList #-} -- | Deconstructs a 'BuiltinData' as an @I@, or fails if it is not one. unsafeDataAsI :: BuiltinData -> Integer unsafeDataAsI d = fromOpaque (BI.unsafeDataAsI d) -{-# INLINABLE unsafeDataAsI #-} +{-# INLINEABLE unsafeDataAsI #-} -- | Deconstructs a 'BuiltinData' as a @B@, or fails if it is not one. unsafeDataAsB :: BuiltinData -> BuiltinByteString unsafeDataAsB = BI.unsafeDataAsB -{-# INLINABLE unsafeDataAsB #-} +{-# INLINEABLE unsafeDataAsB #-} -- | Check if two 'BuiltinData's are equal. equalsData :: BuiltinData -> BuiltinData -> Bool equalsData d1 d2 = fromOpaque (BI.equalsData d1 d2) -{-# INLINABLE equalsData #-} +{-# INLINEABLE equalsData #-} caseData - :: (Integer -> [BuiltinData] -> r) - -> ([(BuiltinData, BuiltinData)] -> r) - -> ([BuiltinData] -> r) - -> (Integer -> r) - -> (BuiltinByteString -> r) - -> BuiltinData - -> r + :: (Integer -> [BuiltinData] -> r) + -> ([(BuiltinData, BuiltinData)] -> r) + -> ([BuiltinData] -> r) + -> (Integer -> r) + -> (BuiltinByteString -> r) + -> BuiltinData + -> r caseData constrCase mapCase listCase iCase bCase = - BI.caseData' - (\i ds -> constrCase i (fromOpaque ds)) - (\ps -> mapCase (fromOpaque ps)) - (\ds -> listCase (fromOpaque ds)) - iCase - bCase -{-# INLINABLE caseData #-} + BI.caseData' + (\i ds -> constrCase i (fromOpaque ds)) + (\ps -> mapCase (fromOpaque ps)) + (\ds -> listCase (fromOpaque ds)) + iCase + bCase +{-# INLINEABLE caseData #-} matchData' - :: BuiltinData - -> (Integer -> BI.BuiltinList BuiltinData -> r) - -> (BI.BuiltinList (BI.BuiltinPair BuiltinData BuiltinData) -> r) - -> (BI.BuiltinList BuiltinData -> r) - -> (Integer -> r) - -> (BuiltinByteString -> r) - -> r + :: BuiltinData + -> (Integer -> BI.BuiltinList BuiltinData -> r) + -> (BI.BuiltinList (BI.BuiltinPair BuiltinData BuiltinData) -> r) + -> (BI.BuiltinList BuiltinData -> r) + -> (Integer -> r) + -> (BuiltinByteString -> r) + -> r matchData' d constrCase mapCase listCase iCase bCase = - BI.caseData' constrCase mapCase listCase iCase bCase d -{-# INLINABLE matchData' #-} + BI.caseData' constrCase mapCase listCase iCase bCase d +{-# INLINEABLE matchData' #-} --- | Given a 'BuiltinData' value and matching functions for the five constructors, --- applies the appropriate matcher to the arguments of the constructor and returns the result. +{-| Given a 'BuiltinData' value and matching functions for the five constructors, +applies the appropriate matcher to the arguments of the constructor and returns the result. +-} matchData - :: BuiltinData - -> (Integer -> [BuiltinData] -> r) - -> ([(BuiltinData, BuiltinData)] -> r) - -> ([BuiltinData] -> r) - -> (Integer -> r) - -> (BuiltinByteString -> r) - -> r + :: BuiltinData + -> (Integer -> [BuiltinData] -> r) + -> ([(BuiltinData, BuiltinData)] -> r) + -> ([BuiltinData] -> r) + -> (Integer -> r) + -> (BuiltinByteString -> r) + -> r matchData d constrCase mapCase listCase iCase bCase = - caseData constrCase mapCase listCase iCase bCase d -{-# INLINABLE matchData #-} + caseData constrCase mapCase listCase iCase bCase d +{-# INLINEABLE matchData #-} -- G1 -- bls12_381_G1_equals :: BuiltinBLS12_381_G1_Element -> BuiltinBLS12_381_G1_Element -> Bool bls12_381_G1_equals a b = fromOpaque (BI.bls12_381_G1_equals a b) -{-# INLINABLE bls12_381_G1_equals #-} +{-# INLINEABLE bls12_381_G1_equals #-} -bls12_381_G1_add :: BuiltinBLS12_381_G1_Element -> BuiltinBLS12_381_G1_Element -> BuiltinBLS12_381_G1_Element +bls12_381_G1_add + :: BuiltinBLS12_381_G1_Element -> BuiltinBLS12_381_G1_Element -> BuiltinBLS12_381_G1_Element bls12_381_G1_add = BI.bls12_381_G1_add -{-# INLINABLE bls12_381_G1_add #-} +{-# INLINEABLE bls12_381_G1_add #-} bls12_381_G1_scalarMul :: Integer -> BuiltinBLS12_381_G1_Element -> BuiltinBLS12_381_G1_Element bls12_381_G1_scalarMul = BI.bls12_381_G1_scalarMul -{-# INLINABLE bls12_381_G1_scalarMul #-} +{-# INLINEABLE bls12_381_G1_scalarMul #-} bls12_381_G1_neg :: BuiltinBLS12_381_G1_Element -> BuiltinBLS12_381_G1_Element bls12_381_G1_neg = BI.bls12_381_G1_neg -{-# INLINABLE bls12_381_G1_neg #-} +{-# INLINEABLE bls12_381_G1_neg #-} bls12_381_G1_compress :: BuiltinBLS12_381_G1_Element -> BuiltinByteString bls12_381_G1_compress = BI.bls12_381_G1_compress -{-# INLINABLE bls12_381_G1_compress #-} +{-# INLINEABLE bls12_381_G1_compress #-} bls12_381_G1_uncompress :: BuiltinByteString -> BuiltinBLS12_381_G1_Element bls12_381_G1_uncompress = BI.bls12_381_G1_uncompress -{-# INLINABLE bls12_381_G1_uncompress #-} +{-# INLINEABLE bls12_381_G1_uncompress #-} bls12_381_G1_hashToGroup :: BuiltinByteString -> BuiltinByteString -> BuiltinBLS12_381_G1_Element bls12_381_G1_hashToGroup = BI.bls12_381_G1_hashToGroup -{-# INLINABLE bls12_381_G1_hashToGroup #-} +{-# INLINEABLE bls12_381_G1_hashToGroup #-} bls12_381_G1_compressed_zero :: BuiltinByteString bls12_381_G1_compressed_zero = BI.bls12_381_G1_compressed_zero -{-# INLINABLE bls12_381_G1_compressed_zero #-} +{-# INLINEABLE bls12_381_G1_compressed_zero #-} bls12_381_G1_compressed_generator :: BuiltinByteString bls12_381_G1_compressed_generator = BI.bls12_381_G1_compressed_generator -{-# INLINABLE bls12_381_G1_compressed_generator #-} +{-# INLINEABLE bls12_381_G1_compressed_generator #-} -- G2 -- bls12_381_G2_equals :: BuiltinBLS12_381_G2_Element -> BuiltinBLS12_381_G2_Element -> Bool bls12_381_G2_equals a b = fromOpaque (BI.bls12_381_G2_equals a b) -{-# INLINABLE bls12_381_G2_equals #-} +{-# INLINEABLE bls12_381_G2_equals #-} -bls12_381_G2_add :: BuiltinBLS12_381_G2_Element -> BuiltinBLS12_381_G2_Element -> BuiltinBLS12_381_G2_Element +bls12_381_G2_add + :: BuiltinBLS12_381_G2_Element -> BuiltinBLS12_381_G2_Element -> BuiltinBLS12_381_G2_Element bls12_381_G2_add = BI.bls12_381_G2_add -{-# INLINABLE bls12_381_G2_add #-} +{-# INLINEABLE bls12_381_G2_add #-} bls12_381_G2_scalarMul :: Integer -> BuiltinBLS12_381_G2_Element -> BuiltinBLS12_381_G2_Element bls12_381_G2_scalarMul = BI.bls12_381_G2_scalarMul -{-# INLINABLE bls12_381_G2_scalarMul #-} +{-# INLINEABLE bls12_381_G2_scalarMul #-} bls12_381_G2_neg :: BuiltinBLS12_381_G2_Element -> BuiltinBLS12_381_G2_Element bls12_381_G2_neg = BI.bls12_381_G2_neg -{-# INLINABLE bls12_381_G2_neg #-} +{-# INLINEABLE bls12_381_G2_neg #-} bls12_381_G2_compress :: BuiltinBLS12_381_G2_Element -> BuiltinByteString bls12_381_G2_compress = BI.bls12_381_G2_compress -{-# INLINABLE bls12_381_G2_compress #-} +{-# INLINEABLE bls12_381_G2_compress #-} bls12_381_G2_uncompress :: BuiltinByteString -> BuiltinBLS12_381_G2_Element bls12_381_G2_uncompress = BI.bls12_381_G2_uncompress -{-# INLINABLE bls12_381_G2_uncompress #-} +{-# INLINEABLE bls12_381_G2_uncompress #-} bls12_381_G2_hashToGroup :: BuiltinByteString -> BuiltinByteString -> BuiltinBLS12_381_G2_Element bls12_381_G2_hashToGroup = BI.bls12_381_G2_hashToGroup -{-# INLINABLE bls12_381_G2_hashToGroup #-} +{-# INLINEABLE bls12_381_G2_hashToGroup #-} bls12_381_G2_compressed_zero :: BuiltinByteString bls12_381_G2_compressed_zero = BI.bls12_381_G2_compressed_zero -{-# INLINABLE bls12_381_G2_compressed_zero #-} +{-# INLINEABLE bls12_381_G2_compressed_zero #-} bls12_381_G2_compressed_generator :: BuiltinByteString bls12_381_G2_compressed_generator = BI.bls12_381_G2_compressed_generator -{-# INLINABLE bls12_381_G2_compressed_generator #-} +{-# INLINEABLE bls12_381_G2_compressed_generator #-} -- Pairing -- -bls12_381_millerLoop :: BuiltinBLS12_381_G1_Element -> BuiltinBLS12_381_G2_Element -> BuiltinBLS12_381_MlResult +bls12_381_millerLoop + :: BuiltinBLS12_381_G1_Element -> BuiltinBLS12_381_G2_Element -> BuiltinBLS12_381_MlResult bls12_381_millerLoop = BI.bls12_381_millerLoop -{-# INLINABLE bls12_381_millerLoop #-} +{-# INLINEABLE bls12_381_millerLoop #-} -bls12_381_mulMlResult :: BuiltinBLS12_381_MlResult -> BuiltinBLS12_381_MlResult -> BuiltinBLS12_381_MlResult +bls12_381_mulMlResult + :: BuiltinBLS12_381_MlResult -> BuiltinBLS12_381_MlResult -> BuiltinBLS12_381_MlResult bls12_381_mulMlResult = BI.bls12_381_mulMlResult -{-# INLINABLE bls12_381_mulMlResult #-} +{-# INLINEABLE bls12_381_mulMlResult #-} bls12_381_finalVerify :: BuiltinBLS12_381_MlResult -> BuiltinBLS12_381_MlResult -> Bool bls12_381_finalVerify a b = fromOpaque (BI.bls12_381_finalVerify a b) -{-# INLINABLE bls12_381_finalVerify #-} +{-# INLINEABLE bls12_381_finalVerify #-} -- Bitwise conversions @@ -668,221 +698,234 @@ bls12_381_finalVerify a b = fromOpaque (BI.bls12_381_finalVerify a b) byteOrderToBool :: ByteOrder -> Bool byteOrderToBool BigEndian = True byteOrderToBool LittleEndian = False -{-# INLINABLE byteOrderToBool #-} - --- | Convert a 'BuiltinInteger' into a 'BuiltinByteString', as described in --- [CIP-121](https://github.com/cardano-foundation/CIPs/tree/master/CIP-0121). --- The first argument indicates the endianness of the conversion and the third --- argument is the integer to be converted, which must be non-negative. The --- second argument must also be non-negative and it indicates the required width --- of the output. If the width is zero then the output is the smallest --- bytestring which can contain the converted input (and in this case, the --- integer 0 encodes to the empty bytestring). If the width is nonzero then the --- output bytestring will be padded to the required width with 0x00 bytes (on --- the left for big-endian conversions and on the right for little-endian --- conversions); if the input integer is too big to fit into a bytestring of the --- specified width then the conversion will fail. Conversion will also fail if --- the specified width is greater than 8192 or the input integer is too big to --- fit into a bytestring of length 8192. +{-# INLINEABLE byteOrderToBool #-} + +{-| Convert a 'BuiltinInteger' into a 'BuiltinByteString', as described in +[CIP-121](https://github.com/cardano-foundation/CIPs/tree/master/CIP-0121). +The first argument indicates the endianness of the conversion and the third +argument is the integer to be converted, which must be non-negative. The +second argument must also be non-negative and it indicates the required width +of the output. If the width is zero then the output is the smallest +bytestring which can contain the converted input (and in this case, the +integer 0 encodes to the empty bytestring). If the width is nonzero then the +output bytestring will be padded to the required width with 0x00 bytes (on +the left for big-endian conversions and on the right for little-endian +conversions); if the input integer is too big to fit into a bytestring of the +specified width then the conversion will fail. Conversion will also fail if +the specified width is greater than 8192 or the input integer is too big to +fit into a bytestring of length 8192. +-} integerToByteString :: ByteOrder -> Integer -> Integer -> BuiltinByteString integerToByteString endianness = BI.integerToByteString (toOpaque (byteOrderToBool endianness)) -{-# INLINABLE integerToByteString #-} - --- | Convert a 'BuiltinByteString' to a 'BuiltinInteger', as described in --- [CIP-121](https://github.com/cardano-foundation/CIPs/tree/master/CIP-0121). --- The first argument indicates the endianness of the conversion and the second --- is the bytestring to be converted. There is no limitation on the size of --- the bytestring. The empty bytestring is converted to the integer 0. +{-# INLINEABLE integerToByteString #-} + +{-| Convert a 'BuiltinByteString' to a 'BuiltinInteger', as described in +[CIP-121](https://github.com/cardano-foundation/CIPs/tree/master/CIP-0121). +The first argument indicates the endianness of the conversion and the second +is the bytestring to be converted. There is no limitation on the size of +the bytestring. The empty bytestring is converted to the integer 0. +-} byteStringToInteger :: ByteOrder -> BuiltinByteString -> Integer byteStringToInteger endianness = BI.byteStringToInteger (toOpaque (byteOrderToBool endianness)) -{-# INLINABLE byteStringToInteger #-} +{-# INLINEABLE byteStringToInteger #-} -- Bitwise operations --- | Shift a 'BuiltinByteString', as per --- [CIP-123](https://github.com/cardano-foundation/CIPs/tree/master/CIP-0123). +{-| Shift a 'BuiltinByteString', as per +[CIP-123](https://github.com/cardano-foundation/CIPs/tree/master/CIP-0123). +-} shiftByteString :: BuiltinByteString -> Integer -> BuiltinByteString shiftByteString = BI.shiftByteString {-# INLINEABLE shiftByteString #-} --- | Rotate a 'BuiltinByteString', as per --- [CIP-123](https://github.com/cardano-foundation/CIPs/tree/master/CIP-0123). +{-| Rotate a 'BuiltinByteString', as per +[CIP-123](https://github.com/cardano-foundation/CIPs/tree/master/CIP-0123). +-} rotateByteString :: BuiltinByteString -> Integer -> BuiltinByteString rotateByteString = BI.rotateByteString {-# INLINEABLE rotateByteString #-} --- | Count the set bits in a 'BuiltinByteString', as per --- [CIP-123](https://github.com/cardano-foundation/CIPs/tree/master/CIP-0123). +{-| Count the set bits in a 'BuiltinByteString', as per +[CIP-123](https://github.com/cardano-foundation/CIPs/tree/master/CIP-0123). +-} countSetBits :: BuiltinByteString -> Integer countSetBits = BI.countSetBits {-# INLINEABLE countSetBits #-} --- | Find the lowest index of a set bit in a 'BuiltinByteString', as per --- [CIP-123](https://github.com/cardano-foundation/CIPs/tree/master/CIP-0123). --- --- If given a 'BuiltinByteString' which consists only of zero bytes (including the empty --- 'BuiltinByteString', this returns @-1@. +{-| Find the lowest index of a set bit in a 'BuiltinByteString', as per +[CIP-123](https://github.com/cardano-foundation/CIPs/tree/master/CIP-0123). + +If given a 'BuiltinByteString' which consists only of zero bytes (including the empty +'BuiltinByteString', this returns @-1@. +-} findFirstSetBit :: BuiltinByteString -> Integer findFirstSetBit = BI.findFirstSetBit {-# INLINEABLE findFirstSetBit #-} -- Logical operations --- | Perform logical AND on two 'BuiltinByteString' arguments, as described in --- [CIP-122](https://github.com/cardano-foundation/CIPs/tree/master/CIP-0122#bitwiselogicaland). --- --- The first argument indicates whether padding semantics should be used or not; --- if 'False', truncation semantics will be used instead. --- --- = See also --- --- * [Padding and truncation --- semantics](https://github.com/cardano-foundation/CIPs/tree/master/CIP-0122#padding-versus-truncation-semantics) --- * [Bit indexing --- scheme](https://github.com/cardano-foundation/CIPs/tree/master/CIP-0122#bit-indexing-scheme) -andByteString :: - Bool -> - BuiltinByteString -> - BuiltinByteString -> - BuiltinByteString +{-| Perform logical AND on two 'BuiltinByteString' arguments, as described in +[CIP-122](https://github.com/cardano-foundation/CIPs/tree/master/CIP-0122#bitwiselogicaland). + +The first argument indicates whether padding semantics should be used or not; +if 'False', truncation semantics will be used instead. + += See also + +* [Padding and truncation +semantics](https://github.com/cardano-foundation/CIPs/tree/master/CIP-0122#padding-versus-truncation-semantics) +* [Bit indexing +scheme](https://github.com/cardano-foundation/CIPs/tree/master/CIP-0122#bit-indexing-scheme) +-} +andByteString + :: Bool + -> BuiltinByteString + -> BuiltinByteString + -> BuiltinByteString andByteString b = BI.andByteString (toOpaque b) {-# INLINEABLE andByteString #-} --- | Perform logical OR on two 'BuiltinByteString' arguments, as described --- [here](https://github.com/cardano-foundation/CIPs/tree/master/CIP-0122#bitwiselogicalor). --- --- The first argument indicates whether padding semantics should be used or not; --- if 'False', truncation semantics will be used instead. --- --- = See also --- --- * [Padding and truncation --- semantics](https://github.com/cardano-foundation/CIPs/tree/master/CIP-0122#padding-versus-truncation-semantics) --- * [Bit indexing --- scheme](https://github.com/cardano-foundation/CIPs/tree/master/CIP-0122#bit-indexing-scheme) -orByteString :: - Bool -> - BuiltinByteString -> - BuiltinByteString -> - BuiltinByteString +{-| Perform logical OR on two 'BuiltinByteString' arguments, as described +[here](https://github.com/cardano-foundation/CIPs/tree/master/CIP-0122#bitwiselogicalor). + +The first argument indicates whether padding semantics should be used or not; +if 'False', truncation semantics will be used instead. + += See also + +* [Padding and truncation +semantics](https://github.com/cardano-foundation/CIPs/tree/master/CIP-0122#padding-versus-truncation-semantics) +* [Bit indexing +scheme](https://github.com/cardano-foundation/CIPs/tree/master/CIP-0122#bit-indexing-scheme) +-} +orByteString + :: Bool + -> BuiltinByteString + -> BuiltinByteString + -> BuiltinByteString orByteString b = BI.orByteString (toOpaque b) {-# INLINEABLE orByteString #-} --- | Perform logical XOR on two 'BuiltinByteString' arguments, as described --- [here](https://github.com/cardano-foundation/CIPs/tree/master/CIP-0122#bitwiselogicalxor). --- --- The first argument indicates whether padding semantics should be used or not; --- if 'False', truncation semantics will be used instead. --- --- = See also --- --- * [Padding and truncation --- semantics](https://github.com/cardano-foundation/CIPs/tree/master/CIP-0122#padding-versus-truncation-semantics) --- * [Bit indexing --- scheme](https://github.com/cardano-foundation/CIPs/tree/master/CIP-0122#bit-indexing-scheme) -xorByteString :: - Bool -> - BuiltinByteString -> - BuiltinByteString -> - BuiltinByteString +{-| Perform logical XOR on two 'BuiltinByteString' arguments, as described +[here](https://github.com/cardano-foundation/CIPs/tree/master/CIP-0122#bitwiselogicalxor). + +The first argument indicates whether padding semantics should be used or not; +if 'False', truncation semantics will be used instead. + += See also + +* [Padding and truncation +semantics](https://github.com/cardano-foundation/CIPs/tree/master/CIP-0122#padding-versus-truncation-semantics) +* [Bit indexing +scheme](https://github.com/cardano-foundation/CIPs/tree/master/CIP-0122#bit-indexing-scheme) +-} +xorByteString + :: Bool + -> BuiltinByteString + -> BuiltinByteString + -> BuiltinByteString xorByteString b = BI.xorByteString (toOpaque b) {-# INLINEABLE xorByteString #-} --- | Perform logical complement on a 'BuiltinByteString', as described --- [here](https://github.com/cardano-foundation/CIPs/tree/master/CIP-0122#bitwiselogicalcomplement). --- --- = See also --- --- * [Bit indexing --- scheme](https://github.com/cardano-foundation/CIPs/tree/master/CIP-0122#bit-indexing-scheme) -complementByteString :: - BuiltinByteString -> - BuiltinByteString +{-| Perform logical complement on a 'BuiltinByteString', as described +[here](https://github.com/cardano-foundation/CIPs/tree/master/CIP-0122#bitwiselogicalcomplement). + += See also + +* [Bit indexing +scheme](https://github.com/cardano-foundation/CIPs/tree/master/CIP-0122#bit-indexing-scheme) +-} +complementByteString + :: BuiltinByteString + -> BuiltinByteString complementByteString = BI.complementByteString {-# INLINEABLE complementByteString #-} --- | Read a bit at the _bit_ index given by the 'Integer' argument in the --- 'BuiltinByteString' argument. The result will be 'True' if the corresponding bit is set, and --- 'False' if it is clear. Will error if given an out-of-bounds index argument; that is, if the --- index is either negative, or equal to or greater than the total number of bits in the --- 'BuiltinByteString' argument. --- --- = See also --- --- * [Bit indexing --- scheme](https://github.com/cardano-foundation/CIPs/tree/master/CIP-0122#bit-indexing-scheme) --- * [Operation --- description](https://github.com/cardano-foundation/CIPs/tree/master/CIP-0122#readbit) -readBit :: - BuiltinByteString -> - Integer -> - Bool +{-| Read a bit at the _bit_ index given by the 'Integer' argument in the +'BuiltinByteString' argument. The result will be 'True' if the corresponding bit is set, and +'False' if it is clear. Will error if given an out-of-bounds index argument; that is, if the +index is either negative, or equal to or greater than the total number of bits in the +'BuiltinByteString' argument. + += See also + +* [Bit indexing +scheme](https://github.com/cardano-foundation/CIPs/tree/master/CIP-0122#bit-indexing-scheme) +* [Operation +description](https://github.com/cardano-foundation/CIPs/tree/master/CIP-0122#readbit) +-} +readBit + :: BuiltinByteString + -> Integer + -> Bool readBit bs i = fromOpaque (BI.readBit bs i) {-# INLINEABLE readBit #-} --- | Given a 'BuiltinByteString', a list of indexes to change, and a boolean --- value 'b' to change those indexes to, set the /bit/ at each of the specified --- index as follows: --- --- * If 'b' is 'True', set that bit; --- * Otherwise, clear that bit. --- --- Will error if any of the indexes are out-of-bounds: that is, if the index is either negative, or --- equal to or greater than the total number of bits in the 'BuiltinByteString' argument. --- --- = Note --- --- This differs slightly from the description of the [corresponding operation in --- CIP-122](https://github.com/cardano-foundation/CIPs/tree/master/CIP-0122#writebits); --- instead of a single changelist argument comprised of pairs, we instead pass a --- single list of indexes to change, and a single boolean value to change those --- indexes to. The original proposal allowed one to set and clear bits in a --- single operation, but constructing the list of boolean values for the updates --- was somewhat expensive. If it's really necessary to set some bits and clear --- others then it is easier to call the function twice, once to set bits and --- and once to clear them. --- --- = See also --- --- * [Bit indexing --- scheme](https://github.com/cardano-foundation/CIPs/tree/master/CIP-0122#bit-indexing-scheme) --- * [Operation --- description](https://github.com/cardano-foundation/CIPs/tree/master/CIP-0122#writebits) -writeBits :: - BuiltinByteString -> - [Integer] -> - Bool -> - BuiltinByteString +{-| Given a 'BuiltinByteString', a list of indexes to change, and a boolean +value 'b' to change those indexes to, set the /bit/ at each of the specified +index as follows: + +* If 'b' is 'True', set that bit; +* Otherwise, clear that bit. + +Will error if any of the indexes are out-of-bounds: that is, if the index is either negative, or +equal to or greater than the total number of bits in the 'BuiltinByteString' argument. + += Note + +This differs slightly from the description of the [corresponding operation in +CIP-122](https://github.com/cardano-foundation/CIPs/tree/master/CIP-0122#writebits); +instead of a single changelist argument comprised of pairs, we instead pass a +single list of indexes to change, and a single boolean value to change those +indexes to. The original proposal allowed one to set and clear bits in a +single operation, but constructing the list of boolean values for the updates +was somewhat expensive. If it's really necessary to set some bits and clear +others then it is easier to call the function twice, once to set bits and +and once to clear them. + += See also + +* [Bit indexing +scheme](https://github.com/cardano-foundation/CIPs/tree/master/CIP-0122#bit-indexing-scheme) +* [Operation +description](https://github.com/cardano-foundation/CIPs/tree/master/CIP-0122#writebits) +-} +writeBits + :: BuiltinByteString + -> [Integer] + -> Bool + -> BuiltinByteString writeBits bs ixes bit = BI.writeBits bs (toOpaque ixes) (toOpaque bit) {-# INLINEABLE writeBits #-} --- | Given a length (first argument) and a byte (second argument), produce a 'BuiltinByteString' of --- that length, with that byte in every position. Will error if given a negative length, or a second --- argument that isn't a byte (less than 0, greater than 255). --- --- = See also --- --- * [Operation --- description](https://github.com/cardano-foundation/CIPs/tree/master/CIP-0122#replicateByteString) -replicateByte :: - Integer -> - Integer -> - BuiltinByteString +{-| Given a length (first argument) and a byte (second argument), produce a 'BuiltinByteString' of +that length, with that byte in every position. Will error if given a negative length, or a second +argument that isn't a byte (less than 0, greater than 255). + += See also + +* [Operation +description](https://github.com/cardano-foundation/CIPs/tree/master/CIP-0122#replicateByteString) +-} +replicateByte + :: Integer + -> Integer + -> BuiltinByteString replicateByte = BI.replicateByte {-# INLINEABLE replicateByte #-} +{-| FIXME + += See also --- | FIXME --- --- = See also --- --- * [Operation --- description](https://github.com/cardano-foundation/CIPs/tree/master/CIP-0109) -expModInteger :: - Integer -> - Integer -> - Integer -> - Integer +* [Operation +description](https://github.com/cardano-foundation/CIPs/tree/master/CIP-0109) +-} +expModInteger + :: Integer + -> Integer + -> Integer + -> Integer expModInteger = BI.expModInteger {-# INLINEABLE expModInteger #-} diff --git a/plutus-tx/src/PlutusTx/Builtins/HasBuiltin.hs b/plutus-tx/src/PlutusTx/Builtins/HasBuiltin.hs index ab2b22097c8..013da0e9dc9 100644 --- a/plutus-tx/src/PlutusTx/Builtins/HasBuiltin.hs +++ b/plutus-tx/src/PlutusTx/Builtins/HasBuiltin.hs @@ -35,101 +35,105 @@ useFromOpaque x = x {-# OPAQUE useFromOpaque #-} -- Also see Note [Built-in types and their Haskell counterparts]. --- | A class for converting values of Haskell-defined built-in types to their Plutus Tx --- counterparts. + +{-| A class for converting values of Haskell-defined built-in types to their Plutus Tx +counterparts. +-} type HasToBuiltin :: GHC.Type -> GHC.Constraint -class PLC.DefaultUni `PLC.Contains` a => HasToBuiltin a where - type ToBuiltin a - toBuiltin :: a -> ToBuiltin a +class (PLC.DefaultUni `PLC.Contains` a) => HasToBuiltin a where + type ToBuiltin a + toBuiltin :: a -> ToBuiltin a -- Also see Note [Built-in types and their Haskell counterparts]. --- | A class for converting values of Plutus Tx built-in types to their Haskell-defined --- counterparts. + +{-| A class for converting values of Plutus Tx built-in types to their Haskell-defined +counterparts. +-} type HasFromBuiltin :: GHC.Type -> GHC.Constraint -class HasToBuiltin (FromBuiltin arep) => HasFromBuiltin arep where - type FromBuiltin arep - fromBuiltin :: arep -> FromBuiltin arep +class (HasToBuiltin (FromBuiltin arep)) => HasFromBuiltin arep where + type FromBuiltin arep + fromBuiltin :: arep -> FromBuiltin arep instance HasToBuiltin Integer where - type ToBuiltin Integer = BuiltinInteger - toBuiltin = useToOpaque id + type ToBuiltin Integer = BuiltinInteger + toBuiltin = useToOpaque id instance HasFromBuiltin BuiltinInteger where - type FromBuiltin BuiltinInteger = Integer - fromBuiltin = useFromOpaque id + type FromBuiltin BuiltinInteger = Integer + fromBuiltin = useFromOpaque id instance HasToBuiltin ByteString where - type ToBuiltin ByteString = BuiltinByteString - toBuiltin = useToOpaque BuiltinByteString + type ToBuiltin ByteString = BuiltinByteString + toBuiltin = useToOpaque BuiltinByteString instance HasFromBuiltin BuiltinByteString where - type FromBuiltin BuiltinByteString = ByteString - fromBuiltin = useFromOpaque $ \(BuiltinByteString b) -> b + type FromBuiltin BuiltinByteString = ByteString + fromBuiltin = useFromOpaque $ \(BuiltinByteString b) -> b instance HasToBuiltin Text where - type ToBuiltin Text = BuiltinString - toBuiltin = useToOpaque BuiltinString + type ToBuiltin Text = BuiltinString + toBuiltin = useToOpaque BuiltinString instance HasFromBuiltin BuiltinString where - type FromBuiltin BuiltinString = Text - fromBuiltin (BuiltinString t) = t + type FromBuiltin BuiltinString = Text + fromBuiltin (BuiltinString t) = t instance HasToBuiltin () where - type ToBuiltin () = BuiltinUnit - toBuiltin = useToOpaque BuiltinUnit + type ToBuiltin () = BuiltinUnit + toBuiltin = useToOpaque BuiltinUnit instance HasFromBuiltin BuiltinUnit where - type FromBuiltin BuiltinUnit = () - fromBuiltin (BuiltinUnit u) = u + type FromBuiltin BuiltinUnit = () + fromBuiltin (BuiltinUnit u) = u instance HasToBuiltin Bool where - type ToBuiltin Bool = BuiltinBool - toBuiltin = useToOpaque BuiltinBool + type ToBuiltin Bool = BuiltinBool + toBuiltin = useToOpaque BuiltinBool instance HasFromBuiltin BuiltinBool where - type FromBuiltin BuiltinBool = Bool - fromBuiltin (BuiltinBool b) = b - -instance HasToBuiltin a => HasToBuiltin [a] where - type ToBuiltin [a] = BuiltinList (ToBuiltin a) - toBuiltin = useToOpaque BuiltinList . map toBuiltin -instance HasFromBuiltin a => HasFromBuiltin (BuiltinList a) where - type FromBuiltin (BuiltinList a) = [FromBuiltin a] - fromBuiltin (BuiltinList xs) = map fromBuiltin xs - -instance HasToBuiltin a => HasToBuiltin (Strict.Vector a) where - type ToBuiltin (Strict.Vector a) = BuiltinArray (ToBuiltin a) - toBuiltin = useToOpaque (BuiltinArray . fmap toBuiltin) -instance HasFromBuiltin a => HasFromBuiltin (BuiltinArray a) where - type FromBuiltin (BuiltinArray a) = Strict.Vector (FromBuiltin a) - fromBuiltin (BuiltinArray xs) = fmap fromBuiltin xs + type FromBuiltin BuiltinBool = Bool + fromBuiltin (BuiltinBool b) = b + +instance (HasToBuiltin a) => HasToBuiltin [a] where + type ToBuiltin [a] = BuiltinList (ToBuiltin a) + toBuiltin = useToOpaque BuiltinList . map toBuiltin +instance (HasFromBuiltin a) => HasFromBuiltin (BuiltinList a) where + type FromBuiltin (BuiltinList a) = [FromBuiltin a] + fromBuiltin (BuiltinList xs) = map fromBuiltin xs + +instance (HasToBuiltin a) => HasToBuiltin (Strict.Vector a) where + type ToBuiltin (Strict.Vector a) = BuiltinArray (ToBuiltin a) + toBuiltin = useToOpaque (BuiltinArray . fmap toBuiltin) +instance (HasFromBuiltin a) => HasFromBuiltin (BuiltinArray a) where + type FromBuiltin (BuiltinArray a) = Strict.Vector (FromBuiltin a) + fromBuiltin (BuiltinArray xs) = fmap fromBuiltin xs instance (HasToBuiltin a, HasToBuiltin b) => HasToBuiltin (a, b) where - type ToBuiltin (a, b) = BuiltinPair (ToBuiltin a) (ToBuiltin b) - toBuiltin (x, y) = BuiltinPair (toBuiltin x, toBuiltin y) + type ToBuiltin (a, b) = BuiltinPair (ToBuiltin a) (ToBuiltin b) + toBuiltin (x, y) = BuiltinPair (toBuiltin x, toBuiltin y) instance (HasFromBuiltin a, HasFromBuiltin b) => HasFromBuiltin (BuiltinPair a b) where - type FromBuiltin (BuiltinPair a b) = (FromBuiltin a, FromBuiltin b) - fromBuiltin (BuiltinPair (x, y)) = (fromBuiltin x, fromBuiltin y) + type FromBuiltin (BuiltinPair a b) = (FromBuiltin a, FromBuiltin b) + fromBuiltin (BuiltinPair (x, y)) = (fromBuiltin x, fromBuiltin y) instance HasToBuiltin Data where - type ToBuiltin Data = BuiltinData - toBuiltin = useToOpaque BuiltinData + type ToBuiltin Data = BuiltinData + toBuiltin = useToOpaque BuiltinData instance HasFromBuiltin BuiltinData where - type FromBuiltin BuiltinData = Data - fromBuiltin (BuiltinData t) = t + type FromBuiltin BuiltinData = Data + fromBuiltin (BuiltinData t) = t instance HasToBuiltin BLS12_381.G1.Element where - type ToBuiltin BLS12_381.G1.Element = BuiltinBLS12_381_G1_Element - toBuiltin = useToOpaque BuiltinBLS12_381_G1_Element + type ToBuiltin BLS12_381.G1.Element = BuiltinBLS12_381_G1_Element + toBuiltin = useToOpaque BuiltinBLS12_381_G1_Element instance HasFromBuiltin BuiltinBLS12_381_G1_Element where - type FromBuiltin BuiltinBLS12_381_G1_Element = BLS12_381.G1.Element - fromBuiltin (BuiltinBLS12_381_G1_Element a) = a + type FromBuiltin BuiltinBLS12_381_G1_Element = BLS12_381.G1.Element + fromBuiltin (BuiltinBLS12_381_G1_Element a) = a instance HasToBuiltin BLS12_381.G2.Element where - type ToBuiltin BLS12_381.G2.Element = BuiltinBLS12_381_G2_Element - toBuiltin = useToOpaque BuiltinBLS12_381_G2_Element + type ToBuiltin BLS12_381.G2.Element = BuiltinBLS12_381_G2_Element + toBuiltin = useToOpaque BuiltinBLS12_381_G2_Element instance HasFromBuiltin BuiltinBLS12_381_G2_Element where - type FromBuiltin BuiltinBLS12_381_G2_Element = BLS12_381.G2.Element - fromBuiltin (BuiltinBLS12_381_G2_Element a) = a + type FromBuiltin BuiltinBLS12_381_G2_Element = BLS12_381.G2.Element + fromBuiltin (BuiltinBLS12_381_G2_Element a) = a instance HasToBuiltin BLS12_381.Pairing.MlResult where - type ToBuiltin BLS12_381.Pairing.MlResult = BuiltinBLS12_381_MlResult - toBuiltin = useToOpaque BuiltinBLS12_381_MlResult + type ToBuiltin BLS12_381.Pairing.MlResult = BuiltinBLS12_381_MlResult + toBuiltin = useToOpaque BuiltinBLS12_381_MlResult instance HasFromBuiltin BuiltinBLS12_381_MlResult where - type FromBuiltin BuiltinBLS12_381_MlResult = BLS12_381.Pairing.MlResult - fromBuiltin (BuiltinBLS12_381_MlResult a) = a + type FromBuiltin BuiltinBLS12_381_MlResult = BLS12_381.Pairing.MlResult + fromBuiltin (BuiltinBLS12_381_MlResult a) = a diff --git a/plutus-tx/src/PlutusTx/Builtins/HasOpaque.hs b/plutus-tx/src/PlutusTx/Builtins/HasOpaque.hs index aa45ad57926..4e03115610f 100644 --- a/plutus-tx/src/PlutusTx/Builtins/HasOpaque.hs +++ b/plutus-tx/src/PlutusTx/Builtins/HasOpaque.hs @@ -7,7 +7,6 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} - {-# OPTIONS_GHC -Wno-orphans #-} {-# OPTIONS_GHC -fno-omit-interface-pragmas #-} {-# OPTIONS_GHC -fno-specialise #-} diff --git a/plutus-tx/src/PlutusTx/Builtins/Internal.hs b/plutus-tx/src/PlutusTx/Builtins/Internal.hs index cd5d60fb8c8..f203d94f203 100644 --- a/plutus-tx/src/PlutusTx/Builtins/Internal.hs +++ b/plutus-tx/src/PlutusTx/Builtins/Internal.hs @@ -4,16 +4,16 @@ {-# LANGUAGE KindSignatures #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeApplications #-} - -- This ensures that we don't put *anything* about these functions into the interface -- file, otherwise GHC can be clever about the ones that are always error, even though -- they're OPAQUE! {-# OPTIONS_GHC -O0 #-} - {-# OPTIONS_GHC -Wno-unrecognised-pragmas #-} -{-# HLINT ignore "Use newtype instead of data" #-} -- See Note [Opaque builtin types] -{- | This module contains the special Haskell names that are used to map to builtin types or functions +{-# HLINT ignore "Use newtype instead of data" #-} +-- See Note [Opaque builtin types] + +{-| This module contains the special Haskell names that are used to map to builtin types or functions in Plutus Core. Most users should not use this module directly, but rather use 'PlutusTx.Builtins'. @@ -161,9 +161,10 @@ multiplyInteger :: BuiltinInteger -> BuiltinInteger -> BuiltinInteger multiplyInteger = coerce ((*) @Integer) {-# OPAQUE multiplyInteger #-} --- | Finds the quotient of two integers and fails when the second argument, the divisor, is zero. --- See Note [Integer division operations] for explanation on 'divideInteger', 'modInteger', --- 'quotientInteger', and 'remainderInteger'. +{-| Finds the quotient of two integers and fails when the second argument, the divisor, is zero. +See Note [Integer division operations] for explanation on 'divideInteger', 'modInteger', +'quotientInteger', and 'remainderInteger'. +-} divideInteger :: BuiltinInteger -> BuiltinInteger -> BuiltinInteger divideInteger = coerce (div @Integer) {-# OPAQUE divideInteger #-} @@ -183,14 +184,16 @@ remainderInteger :: BuiltinInteger -> BuiltinInteger -> BuiltinInteger remainderInteger = coerce (rem @Integer) {-# OPAQUE remainderInteger #-} --- | Compares two integers and returns true when the first argument is less than the second --- | argument. +{-| Compares two integers and returns true when the first argument is less than the second +| argument. +-} lessThanInteger :: BuiltinInteger -> BuiltinInteger -> BuiltinBool -lessThanInteger x y = BuiltinBool $ coerce ((<) @Integer) x y +lessThanInteger x y = BuiltinBool $ coerce ((<) @Integer) x y {-# OPAQUE lessThanInteger #-} --- | Compares two integers and returns true when the first argument is less or equal to than the --- | second argument. +{-| Compares two integers and returns true when the first argument is less or equal to than the +| second argument. +-} lessThanEqualsInteger :: BuiltinInteger -> BuiltinInteger -> BuiltinBool lessThanEqualsInteger x y = BuiltinBool $ coerce ((<=) @Integer) x y {-# OPAQUE lessThanEqualsInteger #-} @@ -205,41 +208,42 @@ BYTESTRING -} -- See Note [Opaque builtin types] + -- | An opaque type representing Plutus Core ByteStrings. data BuiltinByteString = BuiltinByteString ~BS.ByteString deriving stock Data instance Haskell.Show BuiltinByteString where - show (BuiltinByteString bs) = show bs + show (BuiltinByteString bs) = show bs instance Haskell.Eq BuiltinByteString where - (==) (BuiltinByteString bs) (BuiltinByteString bs') = (==) bs bs' + (==) (BuiltinByteString bs) (BuiltinByteString bs') = (==) bs bs' instance Haskell.Ord BuiltinByteString where - compare (BuiltinByteString bs) (BuiltinByteString bs') = compare bs bs' + compare (BuiltinByteString bs) (BuiltinByteString bs') = compare bs bs' instance Haskell.Semigroup BuiltinByteString where - (<>) (BuiltinByteString bs) (BuiltinByteString bs') = BuiltinByteString $ (<>) bs bs' + (<>) (BuiltinByteString bs) (BuiltinByteString bs') = BuiltinByteString $ (<>) bs bs' instance Haskell.Monoid BuiltinByteString where - mempty = BuiltinByteString mempty + mempty = BuiltinByteString mempty instance Hashable BuiltinByteString where - hashWithSalt s (BuiltinByteString bs )= hashWithSalt s bs + hashWithSalt s (BuiltinByteString bs) = hashWithSalt s bs instance Serialise BuiltinByteString where - encode (BuiltinByteString bs) = encode bs - decode = BuiltinByteString <$> decode + encode (BuiltinByteString bs) = encode bs + decode = BuiltinByteString <$> decode instance NFData BuiltinByteString where - rnf (BuiltinByteString bs) = rnf bs + rnf (BuiltinByteString bs) = rnf bs instance BA.ByteArrayAccess BuiltinByteString where - length (BuiltinByteString bs) = BA.length bs - withByteArray (BuiltinByteString bs) = BA.withByteArray bs + length (BuiltinByteString bs) = BA.length bs + withByteArray (BuiltinByteString bs) = BA.withByteArray bs instance BA.ByteArray BuiltinByteString where - allocRet i p = fmap (fmap BuiltinByteString) $ BA.allocRet i p + allocRet i p = fmap (fmap BuiltinByteString) $ BA.allocRet i p instance Pretty BuiltinByteString where - pretty = viaShow + pretty = viaShow -- | Appends a bytestring to another and never fails. appendByteString :: BuiltinByteString -> BuiltinByteString -> BuiltinByteString appendByteString (BuiltinByteString b1) (BuiltinByteString b2) = BuiltinByteString $ BS.append b1 b2 {-# OPAQUE appendByteString #-} -{- | Appends a byte to the given bytestring. +{-| Appends a byte to the given bytestring. The semantics of this function differ based on [Builtin semantics variants]. - For builtin semantics variant A and B, that is for PlutusV1 and PlutusV2, this reduces the first argument modulo 256 and will never fail. @@ -250,7 +254,7 @@ consByteString :: BuiltinInteger -> BuiltinByteString -> BuiltinByteString consByteString n (BuiltinByteString b) = BuiltinByteString $ BS.cons (fromIntegral n) b {-# OPAQUE consByteString #-} -{- | Slices the given bytestring and never fails. The first integer marks the beginning index and the +{-| Slices the given bytestring and never fails. The first integer marks the beginning index and the second marks the end. Indices are expected to be 0-indexed, and when the first integer is greater than the second, it returns an empty bytestring. -} @@ -263,7 +267,7 @@ lengthOfByteString :: BuiltinByteString -> BuiltinInteger lengthOfByteString (BuiltinByteString b) = toInteger $ BS.length b {-# OPAQUE lengthOfByteString #-} -{- | Returns the n-th byte from the bytestring. Fails if the given index is not in the range @[0..j)@, +{-| Returns the n-th byte from the bytestring. Fails if the given index is not in the range @[0..j)@, where @j@ is the length of the bytestring. -} indexByteString :: BuiltinByteString -> BuiltinInteger -> BuiltinInteger @@ -305,56 +309,60 @@ ripemd_160 :: BuiltinByteString -> BuiltinByteString ripemd_160 (BuiltinByteString b) = BuiltinByteString $ Hash.ripemd_160 b {-# OPAQUE ripemd_160 #-} -{- | Ed25519 signature verification. The first bytestring is the public key (32 bytes), followed +{-| Ed25519 signature verification. The first bytestring is the public key (32 bytes), followed by an arbitrary-size message and the signature (64 bytes). The sizes of the public key and signature are enforced, and it fails when given bytestrings of incorrect size. -} verifyEd25519Signature :: BuiltinByteString -> BuiltinByteString -> BuiltinByteString -> BuiltinBool verifyEd25519Signature (BuiltinByteString vk) (BuiltinByteString msg) (BuiltinByteString sig) = case PlutusCore.Crypto.Ed25519.verifyEd25519Signature vk msg sig of - BuiltinSuccess b -> BuiltinBool b + BuiltinSuccess b -> BuiltinBool b BuiltinSuccessWithLogs logs b -> traceAll logs $ BuiltinBool b - BuiltinFailure logs err -> traceAll (logs <> pure (display err)) $ + BuiltinFailure logs err -> + traceAll (logs <> pure (display err)) $ Haskell.error "Ed25519 signature verification errored." {-# OPAQUE verifyEd25519Signature #-} -{- | ECDSA signature verification on the SECP256k1 curve. The first bytestring is the public key (32 bytes), +{-| ECDSA signature verification on the SECP256k1 curve. The first bytestring is the public key (32 bytes), followed by the message hash (32 bytes) and the signature (64 bytes). The sizes of the public key and signature are enforced, and it fails when given bytestrings of incorrect size. -} -verifyEcdsaSecp256k1Signature :: - BuiltinByteString -> - BuiltinByteString -> - BuiltinByteString -> - BuiltinBool +verifyEcdsaSecp256k1Signature + :: BuiltinByteString + -> BuiltinByteString + -> BuiltinByteString + -> BuiltinBool verifyEcdsaSecp256k1Signature (BuiltinByteString vk) (BuiltinByteString msg) (BuiltinByteString sig) = case PlutusCore.Crypto.Secp256k1.verifyEcdsaSecp256k1Signature vk msg sig of - BuiltinSuccess b -> BuiltinBool b + BuiltinSuccess b -> BuiltinBool b BuiltinSuccessWithLogs logs b -> traceAll logs $ BuiltinBool b - BuiltinFailure logs err -> traceAll (logs <> pure (display err)) $ + BuiltinFailure logs err -> + traceAll (logs <> pure (display err)) $ Haskell.error "ECDSA SECP256k1 signature verification errored." {-# OPAQUE verifyEcdsaSecp256k1Signature #-} -{- | Schnorr signature verification on the SECP256k1 curve. The first bytestring is the public key (32 bytes), +{-| Schnorr signature verification on the SECP256k1 curve. The first bytestring is the public key (32 bytes), followed by an arbitrary-length message and the signature (64 bytes). The sizes of the public key and signature are enforced, and it fails when given bytestrings of incorrect size. -} -verifySchnorrSecp256k1Signature :: - BuiltinByteString -> - BuiltinByteString -> - BuiltinByteString -> - BuiltinBool +verifySchnorrSecp256k1Signature + :: BuiltinByteString + -> BuiltinByteString + -> BuiltinByteString + -> BuiltinBool verifySchnorrSecp256k1Signature (BuiltinByteString vk) (BuiltinByteString msg) (BuiltinByteString sig) = case PlutusCore.Crypto.Secp256k1.verifySchnorrSecp256k1Signature vk msg sig of - BuiltinSuccess b -> BuiltinBool b + BuiltinSuccess b -> BuiltinBool b BuiltinSuccessWithLogs logs b -> traceAll logs $ BuiltinBool b - BuiltinFailure logs err -> traceAll (logs <> pure (display err)) $ + BuiltinFailure logs err -> + traceAll (logs <> pure (display err)) $ Haskell.error "Schnorr SECP256k1 signature verification errored." {-# OPAQUE verifySchnorrSecp256k1Signature #-} -- | Runs trace for each element in a foldable structure. -traceAll :: forall (a :: Type) (f :: Type -> Type) . - (Foldable f) => f Text -> a -> a +traceAll + :: forall (a :: Type) (f :: Type -> Type) + . (Foldable f) => f Text -> a -> a traceAll logs x = Foldable.foldl' (\acc t -> trace (BuiltinString t) acc) x logs -- | Checks the equality of two bytestrings and never fails @@ -362,7 +370,7 @@ equalsByteString :: BuiltinByteString -> BuiltinByteString -> BuiltinBool equalsByteString (BuiltinByteString b1) (BuiltinByteString b2) = BuiltinBool $ b1 == b2 {-# OPAQUE equalsByteString #-} -{- | Checks if the first bytestring is less than the second bytestring and never fails. Comparison of the +{-| Checks if the first bytestring is less than the second bytestring and never fails. Comparison of the bytestrings will behave identically to the 'compare' implementation in 'ByteString.Ord'. It will compare two bytestrings byte by byte—lexicographical ordering. -} @@ -388,11 +396,11 @@ STRING data BuiltinString = BuiltinString ~Text deriving stock Data instance Haskell.Show BuiltinString where - show (BuiltinString t) = show t + show (BuiltinString t) = show t instance Haskell.Eq BuiltinString where - (==) (BuiltinString t) (BuiltinString t') = (==) t t' + (==) (BuiltinString t) (BuiltinString t') = (==) t t' instance Haskell.Ord BuiltinString where - compare (BuiltinString t) (BuiltinString t') = compare t t' + compare (BuiltinString t) (BuiltinString t') = compare t t' -- | Appends a string to another and never fails. appendString :: BuiltinString -> BuiltinString -> BuiltinString @@ -427,11 +435,11 @@ PAIR data BuiltinPair a b = BuiltinPair ~(a, b) deriving stock Data instance (Haskell.Show a, Haskell.Show b) => Haskell.Show (BuiltinPair a b) where - show (BuiltinPair p) = show p + show (BuiltinPair p) = show p instance (Haskell.Eq a, Haskell.Eq b) => Haskell.Eq (BuiltinPair a b) where - (==) (BuiltinPair p) (BuiltinPair p') = (==) p p' + (==) (BuiltinPair p) (BuiltinPair p') = (==) p p' instance (Haskell.Ord a, Haskell.Ord b) => Haskell.Ord (BuiltinPair a b) where - compare (BuiltinPair p) (BuiltinPair p') = compare p p' + compare (BuiltinPair p) (BuiltinPair p') = compare p p' -- | Takes first value from the tuple and never fails. fst :: BuiltinPair a b -> a @@ -455,43 +463,43 @@ LIST -- See Note [Opaque builtin types] data BuiltinList a = BuiltinList ~[a] deriving stock Data -instance Haskell.Show a => Haskell.Show (BuiltinList a) where - show (BuiltinList l) = show l -instance Haskell.Eq a => Haskell.Eq (BuiltinList a) where - (==) (BuiltinList l) (BuiltinList l') = (==) l l' -instance Haskell.Ord a => Haskell.Ord (BuiltinList a) where - compare (BuiltinList l) (BuiltinList l') = compare l l' +instance (Haskell.Show a) => Haskell.Show (BuiltinList a) where + show (BuiltinList l) = show l +instance (Haskell.Eq a) => Haskell.Eq (BuiltinList a) where + (==) (BuiltinList l) (BuiltinList l') = (==) l l' +instance (Haskell.Ord a) => Haskell.Ord (BuiltinList a) where + compare (BuiltinList l) (BuiltinList l') = compare l l' -- | Checks if the given list is empty. null :: BuiltinList a -> BuiltinBool -null (BuiltinList (_:_)) = BuiltinBool False -null (BuiltinList []) = BuiltinBool True +null (BuiltinList (_ : _)) = BuiltinBool False +null (BuiltinList []) = BuiltinBool True {-# OPAQUE null #-} -- | Takes the first element of the list and fails if given list is empty. head :: BuiltinList a -> a -head (BuiltinList (x:_)) = x -head (BuiltinList []) = Haskell.error "empty list" +head (BuiltinList (x : _)) = x +head (BuiltinList []) = Haskell.error "empty list" {-# OPAQUE head #-} -- | Takes the last element of the list and fails if given list is empty. tail :: BuiltinList a -> BuiltinList a -tail (BuiltinList (_:xs)) = BuiltinList xs -tail (BuiltinList []) = Haskell.error "empty list" +tail (BuiltinList (_ : xs)) = BuiltinList xs +tail (BuiltinList []) = Haskell.error "empty list" {-# OPAQUE tail #-} -{- | Branches out depending on the structure of given list and never fails. If given list is empty, +{-| Branches out depending on the structure of given list and never fails. If given list is empty, it will take the first branch and if not it will take the second branch. -} chooseList :: BuiltinList a -> b -> b -> b -chooseList (BuiltinList []) b1 _ = b1 -chooseList (BuiltinList (_:_)) _ b2 = b2 +chooseList (BuiltinList []) b1 _ = b1 +chooseList (BuiltinList (_ : _)) _ b2 = b2 {-# OPAQUE chooseList #-} -- | Similar to 'chooseList' but deconstructs the list in case provided list is not empty. -caseList' :: forall a r . r -> (a -> BuiltinList a -> r) -> BuiltinList a -> r -caseList' nilCase _ (BuiltinList []) = nilCase -caseList' _ consCase (BuiltinList (x : xs)) = consCase x (BuiltinList xs) +caseList' :: forall a r. r -> (a -> BuiltinList a -> r) -> BuiltinList a -> r +caseList' nilCase _ (BuiltinList []) = nilCase +caseList' _ consCase (BuiltinList (x : xs)) = consCase x (BuiltinList xs) {-# OPAQUE caseList' #-} -- | Drops first n elements from the given list and never fails. @@ -499,21 +507,23 @@ drop :: Integer -> BuiltinList a -> BuiltinList a drop i (BuiltinList xs) = BuiltinList (Haskell.genericDrop i xs) {-# OPAQUE drop #-} --- | Creates an empty data list and never fails. Prefer using constant. --- See Note [Constants vs built-in functions] +{-| Creates an empty data list and never fails. Prefer using constant. +See Note [Constants vs built-in functions] +-} mkNilData :: BuiltinUnit -> BuiltinList BuiltinData mkNilData _ = BuiltinList [] {-# OPAQUE mkNilData #-} --- | Creates an empty data pair list and never fails. Prefer using constant. --- See Note [Constants vs built-in functions] +{-| Creates an empty data pair list and never fails. Prefer using constant. +See Note [Constants vs built-in functions] +-} mkNilPairData :: BuiltinUnit -> BuiltinList (BuiltinPair BuiltinData BuiltinData) mkNilPairData _ = BuiltinList [] {-# OPAQUE mkNilPairData #-} -- | Appends a new element to the given list and never fails. mkCons :: a -> BuiltinList a -> BuiltinList a -mkCons a (BuiltinList as) = BuiltinList (a:as) +mkCons a (BuiltinList as) = BuiltinList (a : as) {-# OPAQUE mkCons #-} {- @@ -533,58 +543,60 @@ For off-chain usage, there are conversion functions 'builtinDataToData' and 'dataToBuiltinData', but note that these will not work on-chain. -} data BuiltinData = BuiltinData ~PLC.Data - deriving stock (Data, Generic) + deriving stock (Data, Generic) instance Haskell.Show BuiltinData where - show (BuiltinData d) = show d + show (BuiltinData d) = show d instance Haskell.Eq BuiltinData where - (==) (BuiltinData d) (BuiltinData d') = (==) d d' + (==) (BuiltinData d) (BuiltinData d') = (==) d d' instance Haskell.Ord BuiltinData where - compare (BuiltinData d) (BuiltinData d') = compare d d' + compare (BuiltinData d) (BuiltinData d') = compare d d' instance NFData BuiltinData where - rnf (BuiltinData d) = rnf d + rnf (BuiltinData d) = rnf d instance Pretty BuiltinData where - pretty (BuiltinData d) = pretty d + pretty (BuiltinData d) = pretty d -- NOT a builtin, only safe off-chain, hence the OPAQUE + -- | NOT a builtin. Converts a 'BuiltinData' into a 'PLC.Data'. Only works off-chain. builtinDataToData :: BuiltinData -> PLC.Data builtinDataToData (BuiltinData d) = d {-# OPAQUE builtinDataToData #-} -- NOT a builtin, only safe off-chain, hence the OPAQUE + -- | NOT a builtin. Converts a 'PLC.Data' into a 'BuiltinData'. Only works off-chain. dataToBuiltinData :: PLC.Data -> BuiltinData dataToBuiltinData = BuiltinData {-# OPAQUE dataToBuiltinData #-} -- | Branches out depending on the structure of given data and never fails. -chooseData :: forall a . BuiltinData -> a -> a -> a -> a -> a -> a +chooseData :: forall a. BuiltinData -> a -> a -> a -> a -> a -> a chooseData (BuiltinData d) constrCase mapCase listCase iCase bCase = case d of - PLC.Constr{} -> constrCase - PLC.Map{} -> mapCase - PLC.List{} -> listCase - PLC.I{} -> iCase - PLC.B{} -> bCase + PLC.Constr{} -> constrCase + PLC.Map{} -> mapCase + PLC.List{} -> listCase + PLC.I{} -> iCase + PLC.B{} -> bCase {-# OPAQUE chooseData #-} -- | Similar to 'chooseData' but deconstructs the data on each cases. Never fails. caseData' - :: (Integer -> BuiltinList BuiltinData -> r) - -> (BuiltinList (BuiltinPair BuiltinData BuiltinData) -> r) - -> (BuiltinList BuiltinData -> r) - -> (Integer -> r) - -> (BuiltinByteString -> r) - -> BuiltinData - -> r + :: (Integer -> BuiltinList BuiltinData -> r) + -> (BuiltinList (BuiltinPair BuiltinData BuiltinData) -> r) + -> (BuiltinList BuiltinData -> r) + -> (Integer -> r) + -> (BuiltinByteString -> r) + -> BuiltinData + -> r caseData' constrCase mapCase listCase iCase bCase (BuiltinData d) = case d of - PLC.Constr i ds -> constrCase i (BuiltinList (fmap dataToBuiltinData ds)) - PLC.Map ps -> mapCase (BuiltinList (fmap p2p ps)) - PLC.List ds -> listCase (BuiltinList (fmap dataToBuiltinData ds)) - PLC.I i -> iCase i - PLC.B b -> bCase (BuiltinByteString b) - where - p2p (d1, d2) = BuiltinPair (dataToBuiltinData d1, dataToBuiltinData d2) + PLC.Constr i ds -> constrCase i (BuiltinList (fmap dataToBuiltinData ds)) + PLC.Map ps -> mapCase (BuiltinList (fmap p2p ps)) + PLC.List ds -> listCase (BuiltinList (fmap dataToBuiltinData ds)) + PLC.I i -> iCase i + PLC.B b -> bCase (BuiltinByteString b) + where + p2p (d1, d2) = BuiltinPair (dataToBuiltinData d1, dataToBuiltinData d2) {-# OPAQUE caseData' #-} -- | Creates 'Constr' data value with the given index and elements; never fails. @@ -595,8 +607,8 @@ mkConstr i (BuiltinList args) = BuiltinData (PLC.Constr i (fmap builtinDataToDat -- | Creates 'Map' data value with the given list of pairs and never fails. mkMap :: BuiltinList (BuiltinPair BuiltinData BuiltinData) -> BuiltinData mkMap (BuiltinList es) = BuiltinData (PLC.Map (fmap p2p es)) - where - p2p (BuiltinPair (d, d')) = (builtinDataToData d, builtinDataToData d') + where + p2p (BuiltinPair (d, d')) = (builtinDataToData d, builtinDataToData d') {-# OPAQUE mkMap #-} -- | Creates 'List' data value with the given list and never fails. @@ -617,15 +629,15 @@ mkB (BuiltinByteString b) = BuiltinData (PLC.B b) -- | Deconstructs the given data as a 'Constr', failing if it is not a 'Constr'. unsafeDataAsConstr :: BuiltinData -> BuiltinPair BuiltinInteger (BuiltinList BuiltinData) unsafeDataAsConstr (BuiltinData (PLC.Constr i args)) = BuiltinPair (i, BuiltinList $ fmap dataToBuiltinData args) -unsafeDataAsConstr _ = Haskell.error "not a Constr" +unsafeDataAsConstr _ = Haskell.error "not a Constr" {-# OPAQUE unsafeDataAsConstr #-} -- | Deconstructs the given data as a 'Map', failing if it is not a 'Map'. unsafeDataAsMap :: BuiltinData -> BuiltinList (BuiltinPair BuiltinData BuiltinData) unsafeDataAsMap (BuiltinData (PLC.Map m)) = BuiltinList (fmap p2p m) - where - p2p (d, d') = BuiltinPair (dataToBuiltinData d, dataToBuiltinData d') -unsafeDataAsMap _ = Haskell.error "not a Map" + where + p2p (d, d') = BuiltinPair (dataToBuiltinData d, dataToBuiltinData d') +unsafeDataAsMap _ = Haskell.error "not a Map" {-# OPAQUE unsafeDataAsMap #-} -- | Deconstructs the given data as a 'List', failing if it is not a 'List'. @@ -651,8 +663,9 @@ equalsData :: BuiltinData -> BuiltinData -> BuiltinBool equalsData (BuiltinData b1) (BuiltinData b2) = BuiltinBool $ b1 Haskell.== b2 {-# OPAQUE equalsData #-} --- | Serialize the given data into CBOR bytestring. See 'PlutusCore.Data' for exact encoder as 'Data' --- does not uses Generic version. +{-| Serialize the given data into CBOR bytestring. See 'PlutusCore.Data' for exact encoder as 'Data' +does not uses Generic version. +-} serialiseData :: BuiltinData -> BuiltinByteString serialiseData (BuiltinData b) = BuiltinByteString $ BSL.toStrict $ serialise b {-# OPAQUE serialiseData #-} @@ -663,12 +676,12 @@ ARRAY data BuiltinArray a = BuiltinArray ~(Vector a) deriving stock (Data) -instance Haskell.Show a => Haskell.Show (BuiltinArray a) where - show (BuiltinArray v) = show v -instance Haskell.Eq a => Haskell.Eq (BuiltinArray a) where - (==) (BuiltinArray v1) (BuiltinArray v2) = (==) v1 v2 -instance Haskell.Ord a => Haskell.Ord (BuiltinArray a) where - compare (BuiltinArray v1) (BuiltinArray v2) = compare v1 v2 +instance (Haskell.Show a) => Haskell.Show (BuiltinArray a) where + show (BuiltinArray v) = show v +instance (Haskell.Eq a) => Haskell.Eq (BuiltinArray a) where + (==) (BuiltinArray v1) (BuiltinArray v2) = (==) v1 v2 +instance (Haskell.Ord a) => Haskell.Ord (BuiltinArray a) where + compare (BuiltinArray v1) (BuiltinArray v2) = compare v1 v2 -- | Returns the length of the provided array and never fails lengthOfArray :: BuiltinArray a -> BuiltinInteger @@ -680,7 +693,7 @@ listToArray :: BuiltinList a -> BuiltinArray a listToArray (BuiltinList l) = BuiltinArray (Vector.fromList l) {-# OPAQUE listToArray #-} -{- | Returns the n-th element from the array. Fails if the given index is not in the range @[0..j)@, +{-| Returns the n-th element from the array. Fails if the given index is not in the range @[0..j)@, where @j@ is the length of the array. -} indexArray :: BuiltinArray a -> BuiltinInteger -> a @@ -711,13 +724,13 @@ here rather than in the Plutus Core code. data BuiltinBLS12_381_G1_Element = BuiltinBLS12_381_G1_Element ~BLS12_381.G1.Element instance Haskell.Show BuiltinBLS12_381_G1_Element where - show (BuiltinBLS12_381_G1_Element a) = show a + show (BuiltinBLS12_381_G1_Element a) = show a instance Haskell.Eq BuiltinBLS12_381_G1_Element where - (==) (BuiltinBLS12_381_G1_Element a) (BuiltinBLS12_381_G1_Element b) = (==) a b + (==) (BuiltinBLS12_381_G1_Element a) (BuiltinBLS12_381_G1_Element b) = (==) a b instance NFData BuiltinBLS12_381_G1_Element where - rnf (BuiltinBLS12_381_G1_Element d) = rnf d + rnf (BuiltinBLS12_381_G1_Element d) = rnf d instance Pretty BuiltinBLS12_381_G1_Element where - pretty (BuiltinBLS12_381_G1_Element a) = pretty a + pretty (BuiltinBLS12_381_G1_Element a) = pretty a -- | Checks equality of two G1 elements and never fails. bls12_381_G1_equals :: BuiltinBLS12_381_G1_Element -> BuiltinBLS12_381_G1_Element -> BuiltinBool @@ -725,7 +738,8 @@ bls12_381_G1_equals a b = BuiltinBool $ coerce ((==) @BuiltinBLS12_381_G1_Elemen {-# OPAQUE bls12_381_G1_equals #-} -- | Adds two G1 elements and never fails. -bls12_381_G1_add :: BuiltinBLS12_381_G1_Element -> BuiltinBLS12_381_G1_Element -> BuiltinBLS12_381_G1_Element +bls12_381_G1_add + :: BuiltinBLS12_381_G1_Element -> BuiltinBLS12_381_G1_Element -> BuiltinBLS12_381_G1_Element bls12_381_G1_add (BuiltinBLS12_381_G1_Element a) (BuiltinBLS12_381_G1_Element b) = BuiltinBLS12_381_G1_Element (BLS12_381.G1.add a b) {-# OPAQUE bls12_381_G1_add #-} @@ -735,7 +749,8 @@ bls12_381_G1_neg (BuiltinBLS12_381_G1_Element a) = BuiltinBLS12_381_G1_Element ( {-# OPAQUE bls12_381_G1_neg #-} -- | Multiplies a G1 element by a scalar and never fails. -bls12_381_G1_scalarMul :: BuiltinInteger -> BuiltinBLS12_381_G1_Element -> BuiltinBLS12_381_G1_Element +bls12_381_G1_scalarMul + :: BuiltinInteger -> BuiltinBLS12_381_G1_Element -> BuiltinBLS12_381_G1_Element bls12_381_G1_scalarMul n (BuiltinBLS12_381_G1_Element a) = BuiltinBLS12_381_G1_Element (BLS12_381.G1.scalarMul n a) {-# OPAQUE bls12_381_G1_scalarMul #-} @@ -747,18 +762,19 @@ bls12_381_G1_compress (BuiltinBLS12_381_G1_Element a) = BuiltinByteString (BLS12 -- | Uncompresses a bytestring to a G1 element, failing if the bytestring is not a valid compressed G1 element. bls12_381_G1_uncompress :: BuiltinByteString -> BuiltinBLS12_381_G1_Element bls12_381_G1_uncompress (BuiltinByteString b) = - case BLS12_381.G1.uncompress b of - Left err -> Haskell.error $ "BSL12_381 G1 uncompression error: " ++ show err - Right a -> BuiltinBLS12_381_G1_Element a + case BLS12_381.G1.uncompress b of + Left err -> Haskell.error $ "BSL12_381 G1 uncompression error: " ++ show err + Right a -> BuiltinBLS12_381_G1_Element a {-# OPAQUE bls12_381_G1_uncompress #-} --- | Hashes an arbitrary bytestring message to a G1 element using the given domain separation tag (DST), --- failing if length of the DST is bigger than 255 bytes. -bls12_381_G1_hashToGroup :: BuiltinByteString -> BuiltinByteString -> BuiltinBLS12_381_G1_Element +{-| Hashes an arbitrary bytestring message to a G1 element using the given domain separation tag (DST), +failing if length of the DST is bigger than 255 bytes. +-} +bls12_381_G1_hashToGroup :: BuiltinByteString -> BuiltinByteString -> BuiltinBLS12_381_G1_Element bls12_381_G1_hashToGroup (BuiltinByteString msg) (BuiltinByteString dst) = - case BLS12_381.G1.hashToGroup msg dst of - Left err -> Haskell.error $ show err - Right p -> BuiltinBLS12_381_G1_Element p + case BLS12_381.G1.hashToGroup msg dst of + Left err -> Haskell.error $ show err + Right p -> BuiltinBLS12_381_G1_Element p {-# OPAQUE bls12_381_G1_hashToGroup #-} -- | The compressed form of the G1 identity element. @@ -776,13 +792,13 @@ bls12_381_G1_compressed_generator = BuiltinByteString BLS12_381.G1.compressed_ge data BuiltinBLS12_381_G2_Element = BuiltinBLS12_381_G2_Element ~BLS12_381.G2.Element instance Haskell.Show BuiltinBLS12_381_G2_Element where - show (BuiltinBLS12_381_G2_Element a) = show a + show (BuiltinBLS12_381_G2_Element a) = show a instance Haskell.Eq BuiltinBLS12_381_G2_Element where - (==) (BuiltinBLS12_381_G2_Element a) (BuiltinBLS12_381_G2_Element b) = (==) a b + (==) (BuiltinBLS12_381_G2_Element a) (BuiltinBLS12_381_G2_Element b) = (==) a b instance NFData BuiltinBLS12_381_G2_Element where - rnf (BuiltinBLS12_381_G2_Element d) = rnf d + rnf (BuiltinBLS12_381_G2_Element d) = rnf d instance Pretty BuiltinBLS12_381_G2_Element where - pretty (BuiltinBLS12_381_G2_Element a) = pretty a + pretty (BuiltinBLS12_381_G2_Element a) = pretty a -- | Checks equality of two G2 elements and never fails. bls12_381_G2_equals :: BuiltinBLS12_381_G2_Element -> BuiltinBLS12_381_G2_Element -> BuiltinBool @@ -790,7 +806,8 @@ bls12_381_G2_equals a b = BuiltinBool $ coerce ((==) @BuiltinBLS12_381_G2_Elemen {-# OPAQUE bls12_381_G2_equals #-} -- | Adds two G2 elements and never fails. -bls12_381_G2_add :: BuiltinBLS12_381_G2_Element -> BuiltinBLS12_381_G2_Element -> BuiltinBLS12_381_G2_Element +bls12_381_G2_add + :: BuiltinBLS12_381_G2_Element -> BuiltinBLS12_381_G2_Element -> BuiltinBLS12_381_G2_Element bls12_381_G2_add (BuiltinBLS12_381_G2_Element a) (BuiltinBLS12_381_G2_Element b) = BuiltinBLS12_381_G2_Element (BLS12_381.G2.add a b) {-# OPAQUE bls12_381_G2_add #-} @@ -800,7 +817,8 @@ bls12_381_G2_neg (BuiltinBLS12_381_G2_Element a) = BuiltinBLS12_381_G2_Element ( {-# OPAQUE bls12_381_G2_neg #-} -- | Multiplies a G2 element by a scalar and never fails. -bls12_381_G2_scalarMul :: BuiltinInteger -> BuiltinBLS12_381_G2_Element -> BuiltinBLS12_381_G2_Element +bls12_381_G2_scalarMul + :: BuiltinInteger -> BuiltinBLS12_381_G2_Element -> BuiltinBLS12_381_G2_Element bls12_381_G2_scalarMul n (BuiltinBLS12_381_G2_Element a) = BuiltinBLS12_381_G2_Element (BLS12_381.G2.scalarMul n a) {-# OPAQUE bls12_381_G2_scalarMul #-} @@ -812,18 +830,19 @@ bls12_381_G2_compress (BuiltinBLS12_381_G2_Element a) = BuiltinByteString (BLS12 -- | Uncompresses a bytestring to a G2 element, failing if the bytestring is not a valid compressed G2 element. bls12_381_G2_uncompress :: BuiltinByteString -> BuiltinBLS12_381_G2_Element bls12_381_G2_uncompress (BuiltinByteString b) = - case BLS12_381.G2.uncompress b of - Left err -> Haskell.error $ "BSL12_381 G2 uncompression error: " ++ show err - Right a -> BuiltinBLS12_381_G2_Element a + case BLS12_381.G2.uncompress b of + Left err -> Haskell.error $ "BSL12_381 G2 uncompression error: " ++ show err + Right a -> BuiltinBLS12_381_G2_Element a {-# OPAQUE bls12_381_G2_uncompress #-} --- | Hashes an arbitrary bytestring message to a G2 element using the given domain separation tag (DST), --- failing if length of the DST is bigger than 255 bytes. -bls12_381_G2_hashToGroup :: BuiltinByteString -> BuiltinByteString -> BuiltinBLS12_381_G2_Element +{-| Hashes an arbitrary bytestring message to a G2 element using the given domain separation tag (DST), +failing if length of the DST is bigger than 255 bytes. +-} +bls12_381_G2_hashToGroup :: BuiltinByteString -> BuiltinByteString -> BuiltinBLS12_381_G2_Element bls12_381_G2_hashToGroup (BuiltinByteString msg) (BuiltinByteString dst) = - case BLS12_381.G2.hashToGroup msg dst of - Left err -> Haskell.error $ show err - Right p -> BuiltinBLS12_381_G2_Element p + case BLS12_381.G2.hashToGroup msg dst of + Left err -> Haskell.error $ show err + Right p -> BuiltinBLS12_381_G2_Element p {-# OPAQUE bls12_381_G2_hashToGroup #-} -- | The compressed form of the G2 identity element (also known as zero or point at infinity). @@ -836,65 +855,70 @@ bls12_381_G2_compressed_generator :: BuiltinByteString bls12_381_G2_compressed_generator = BuiltinByteString BLS12_381.G2.compressed_generator {-# OPAQUE bls12_381_G2_compressed_generator #-} - ---------------- Pairing ---------------- data BuiltinBLS12_381_MlResult = BuiltinBLS12_381_MlResult ~BLS12_381.Pairing.MlResult instance Haskell.Show BuiltinBLS12_381_MlResult where - show (BuiltinBLS12_381_MlResult a) = show a + show (BuiltinBLS12_381_MlResult a) = show a instance Haskell.Eq BuiltinBLS12_381_MlResult where - (==) (BuiltinBLS12_381_MlResult a) (BuiltinBLS12_381_MlResult b) = (==) a b + (==) (BuiltinBLS12_381_MlResult a) (BuiltinBLS12_381_MlResult b) = (==) a b instance NFData BuiltinBLS12_381_MlResult where - rnf (BuiltinBLS12_381_MlResult a) = rnf a + rnf (BuiltinBLS12_381_MlResult a) = rnf a instance Pretty BuiltinBLS12_381_MlResult where - pretty (BuiltinBLS12_381_MlResult a) = pretty a + pretty (BuiltinBLS12_381_MlResult a) = pretty a -- | Computes the Miller loop between a G1 element and a G2 element and never fails. -bls12_381_millerLoop :: BuiltinBLS12_381_G1_Element -> BuiltinBLS12_381_G2_Element -> BuiltinBLS12_381_MlResult +bls12_381_millerLoop + :: BuiltinBLS12_381_G1_Element -> BuiltinBLS12_381_G2_Element -> BuiltinBLS12_381_MlResult bls12_381_millerLoop (BuiltinBLS12_381_G1_Element a) (BuiltinBLS12_381_G2_Element b) = - BuiltinBLS12_381_MlResult $ BLS12_381.Pairing.millerLoop a b + BuiltinBLS12_381_MlResult $ BLS12_381.Pairing.millerLoop a b {-# OPAQUE bls12_381_millerLoop #-} -- | Multiplies two Miller loop results and never fails. -bls12_381_mulMlResult :: BuiltinBLS12_381_MlResult -> BuiltinBLS12_381_MlResult -> BuiltinBLS12_381_MlResult -bls12_381_mulMlResult (BuiltinBLS12_381_MlResult a) (BuiltinBLS12_381_MlResult b) - = BuiltinBLS12_381_MlResult $ BLS12_381.Pairing.mulMlResult a b +bls12_381_mulMlResult + :: BuiltinBLS12_381_MlResult -> BuiltinBLS12_381_MlResult -> BuiltinBLS12_381_MlResult +bls12_381_mulMlResult (BuiltinBLS12_381_MlResult a) (BuiltinBLS12_381_MlResult b) = + BuiltinBLS12_381_MlResult $ BLS12_381.Pairing.mulMlResult a b {-# OPAQUE bls12_381_mulMlResult #-} --- | Performs the final verification step of a pairing check. Returns true if e(P,Q) == e(R,S) for --- the given Miller loop results, and never fails. -bls12_381_finalVerify :: BuiltinBLS12_381_MlResult -> BuiltinBLS12_381_MlResult -> BuiltinBool -bls12_381_finalVerify (BuiltinBLS12_381_MlResult a) (BuiltinBLS12_381_MlResult b) - = BuiltinBool $ BLS12_381.Pairing.finalVerify a b +{-| Performs the final verification step of a pairing check. Returns true if e(P,Q) == e(R,S) for +the given Miller loop results, and never fails. +-} +bls12_381_finalVerify :: BuiltinBLS12_381_MlResult -> BuiltinBLS12_381_MlResult -> BuiltinBool +bls12_381_finalVerify (BuiltinBLS12_381_MlResult a) (BuiltinBLS12_381_MlResult b) = + BuiltinBool $ BLS12_381.Pairing.finalVerify a b {-# OPAQUE bls12_381_finalVerify #-} {- CONVERSION -} --- | Converts the given integer to a bytestring. The first argument specifies --- endianness (True for big-endian), followed by the target length of the resulting bytestring --- and the integer itself. See 'PlutusCore.Bitwise.integerToByteString' for its invariances. +{-| Converts the given integer to a bytestring. The first argument specifies +endianness (True for big-endian), followed by the target length of the resulting bytestring +and the integer itself. See 'PlutusCore.Bitwise.integerToByteString' for its invariances. +-} integerToByteString - :: BuiltinBool - -> BuiltinInteger - -> BuiltinInteger - -> BuiltinByteString + :: BuiltinBool + -> BuiltinInteger + -> BuiltinInteger + -> BuiltinByteString integerToByteString (BuiltinBool endiannessArg) paddingArg input = case Bitwise.integerToByteString endiannessArg paddingArg input of - BuiltinSuccess bs -> BuiltinByteString bs + BuiltinSuccess bs -> BuiltinByteString bs BuiltinSuccessWithLogs logs bs -> traceAll logs $ BuiltinByteString bs - BuiltinFailure logs err -> traceAll (logs <> pure (display err)) $ + BuiltinFailure logs err -> + traceAll (logs <> pure (display err)) $ Haskell.error "Integer to ByteString conversion errored." {-# OPAQUE integerToByteString #-} --- | Converts the given bytestring to the integer and never fails. The first argument specifies --- endianness (True for big-endian), followed by the bytestring. +{-| Converts the given bytestring to the integer and never fails. The first argument specifies +endianness (True for big-endian), followed by the bytestring. +-} byteStringToInteger - :: BuiltinBool - -> BuiltinByteString - -> BuiltinInteger + :: BuiltinBool + -> BuiltinByteString + -> BuiltinInteger byteStringToInteger (BuiltinBool statedEndianness) (BuiltinByteString input) = Bitwise.byteStringToInteger statedEndianness input {-# OPAQUE byteStringToInteger #-} @@ -903,39 +927,42 @@ byteStringToInteger (BuiltinBool statedEndianness) (BuiltinByteString input) = BITWISE -} --- | Shifts the bytestring to the left if the second argument is positive, and to the right otherwise. --- Right-shifts fill with 0s from the left (logical shift); left-shifts fill with 0s from the right. --- Never fails. -shiftByteString :: - BuiltinByteString -> - BuiltinInteger -> - BuiltinByteString +{-| Shifts the bytestring to the left if the second argument is positive, and to the right otherwise. +Right-shifts fill with 0s from the left (logical shift); left-shifts fill with 0s from the right. +Never fails. +-} +shiftByteString + :: BuiltinByteString + -> BuiltinInteger + -> BuiltinByteString shiftByteString (BuiltinByteString bs) = BuiltinByteString . Bitwise.shiftByteString bs {-# OPAQUE shiftByteString #-} --- | Rotates the bytestring to the left if the second argument is positive, and to the right otherwise. --- Never fails. -rotateByteString :: - BuiltinByteString -> - BuiltinInteger -> - BuiltinByteString +{-| Rotates the bytestring to the left if the second argument is positive, and to the right otherwise. +Never fails. +-} +rotateByteString + :: BuiltinByteString + -> BuiltinInteger + -> BuiltinByteString rotateByteString (BuiltinByteString bs) = BuiltinByteString . Bitwise.rotateByteString bs {-# OPAQUE rotateByteString #-} -- | Counts the number of bits set to 1 in the bytestring and never fails. -countSetBits :: - BuiltinByteString -> - BuiltinInteger +countSetBits + :: BuiltinByteString + -> BuiltinInteger countSetBits (BuiltinByteString bs) = fromIntegral . Bitwise.countSetBits $ bs {-# OPAQUE countSetBits #-} --- | Finds the index of the first bit set to 1 in the bytestring. If the bytestring consists only of --- 0s, it returns the length of the bytestring in bits. Never fails. -findFirstSetBit :: - BuiltinByteString -> - BuiltinInteger +{-| Finds the index of the first bit set to 1 in the bytestring. If the bytestring consists only of +0s, it returns the length of the bytestring in bits. Never fails. +-} +findFirstSetBit + :: BuiltinByteString + -> BuiltinInteger findFirstSetBit (BuiltinByteString bs) = fromIntegral . Bitwise.findFirstSetBit $ bs {-# OPAQUE findFirstSetBit #-} @@ -944,101 +971,111 @@ findFirstSetBit (BuiltinByteString bs) = LOGICAL -} --- | Performs a bitwise AND on two bytestrings. The first boolean argument indicates whether to use --- padding (True) or truncation (False) if the bytestrings have different lengths. Never fails. -andByteString :: - BuiltinBool -> - BuiltinByteString -> - BuiltinByteString -> - BuiltinByteString +{-| Performs a bitwise AND on two bytestrings. The first boolean argument indicates whether to use +padding (True) or truncation (False) if the bytestrings have different lengths. Never fails. +-} +andByteString + :: BuiltinBool + -> BuiltinByteString + -> BuiltinByteString + -> BuiltinByteString andByteString (BuiltinBool isPaddingSemantics) (BuiltinByteString data1) (BuiltinByteString data2) = BuiltinByteString . Bitwise.andByteString isPaddingSemantics data1 $ data2 {-# OPAQUE andByteString #-} --- | Performs a bitwise OR on two bytestrings. The first boolean argument indicates whether to use --- padding (True) or truncation (False) if the bytestrings have different lengths. Never fails. -orByteString :: - BuiltinBool -> - BuiltinByteString -> - BuiltinByteString -> - BuiltinByteString +{-| Performs a bitwise OR on two bytestrings. The first boolean argument indicates whether to use +padding (True) or truncation (False) if the bytestrings have different lengths. Never fails. +-} +orByteString + :: BuiltinBool + -> BuiltinByteString + -> BuiltinByteString + -> BuiltinByteString orByteString (BuiltinBool isPaddingSemantics) (BuiltinByteString data1) (BuiltinByteString data2) = BuiltinByteString . Bitwise.orByteString isPaddingSemantics data1 $ data2 {-# OPAQUE orByteString #-} --- | Performs a bitwise XOR on two bytestrings. The first boolean argument indicates whether to use --- padding (True) or truncation (False) if the bytestrings have different lengths. Never fails. -xorByteString :: - BuiltinBool -> - BuiltinByteString -> - BuiltinByteString -> - BuiltinByteString +{-| Performs a bitwise XOR on two bytestrings. The first boolean argument indicates whether to use +padding (True) or truncation (False) if the bytestrings have different lengths. Never fails. +-} +xorByteString + :: BuiltinBool + -> BuiltinByteString + -> BuiltinByteString + -> BuiltinByteString xorByteString (BuiltinBool isPaddingSemantics) (BuiltinByteString data1) (BuiltinByteString data2) = BuiltinByteString . Bitwise.xorByteString isPaddingSemantics data1 $ data2 {-# OPAQUE xorByteString #-} -- | Performs a bitwise complement on the bytestring and never fails. -complementByteString :: - BuiltinByteString -> - BuiltinByteString +complementByteString + :: BuiltinByteString + -> BuiltinByteString complementByteString (BuiltinByteString bs) = BuiltinByteString . Bitwise.complementByteString $ bs {-# OPAQUE complementByteString #-} -- | Reads the bit at the given index in the bytestring. Fails if the index is out of bounds. -readBit :: - BuiltinByteString -> - BuiltinInteger -> - BuiltinBool +readBit + :: BuiltinByteString + -> BuiltinInteger + -> BuiltinBool readBit (BuiltinByteString bs) i = case Bitwise.readBit bs (fromIntegral i) of - BuiltinFailure logs err -> traceAll (logs <> pure (display err)) $ - Haskell.error "readBit errored." + BuiltinFailure logs err -> + traceAll (logs <> pure (display err)) $ + Haskell.error "readBit errored." BuiltinSuccess b -> BuiltinBool b BuiltinSuccessWithLogs logs b -> traceAll logs $ BuiltinBool b {-# OPAQUE readBit #-} --- | Writes the given bit (third argument, True for 1, False for 0) at the specified indices (second argument) in the bytestring. --- Fails if any index is out of bounds. -writeBits :: - BuiltinByteString -> - BuiltinList BuiltinInteger -> - BuiltinBool -> - BuiltinByteString +{-| Writes the given bit (third argument, True for 1, False for 0) at the specified indices (second argument) in the bytestring. +Fails if any index is out of bounds. +-} +writeBits + :: BuiltinByteString + -> BuiltinList BuiltinInteger + -> BuiltinBool + -> BuiltinByteString writeBits (BuiltinByteString bs) (BuiltinList ixes) (BuiltinBool bit) = case Bitwise.writeBits bs ixes bit of - BuiltinFailure logs err -> traceAll (logs <> pure (display err)) $ - Haskell.error "writeBits errored." + BuiltinFailure logs err -> + traceAll (logs <> pure (display err)) $ + Haskell.error "writeBits errored." BuiltinSuccess bs' -> BuiltinByteString bs' BuiltinSuccessWithLogs logs bs' -> traceAll logs $ BuiltinByteString bs' {-# OPAQUE writeBits #-} --- | Creates a bytestring of a given length by repeating the given byte. --- Fails if the byte, second argument, is not in range @[0,255]@ or the length is negative. -replicateByte :: - BuiltinInteger -> - BuiltinInteger -> - BuiltinByteString +{-| Creates a bytestring of a given length by repeating the given byte. +Fails if the byte, second argument, is not in range @[0,255]@ or the length is negative. +-} +replicateByte + :: BuiltinInteger + -> BuiltinInteger + -> BuiltinByteString replicateByte n w8 = case Bitwise.replicateByte n (fromIntegral w8) of - BuiltinFailure logs err -> traceAll (logs <> pure (display err)) $ - Haskell.error "byteStringReplicate errored." + BuiltinFailure logs err -> + traceAll (logs <> pure (display err)) $ + Haskell.error "byteStringReplicate errored." BuiltinSuccess bs -> BuiltinByteString bs BuiltinSuccessWithLogs logs bs -> traceAll logs $ BuiltinByteString bs {-# OPAQUE replicateByte #-} --- | Computes modular exponentiation (base^exponent mod modulus). Fails if the modulus is zero or negative, --- or if the exponent is negative and the modular inverse does not exist. -expModInteger :: - BuiltinInteger -> - BuiltinInteger -> - BuiltinInteger -> - BuiltinInteger +{-| Computes modular exponentiation (base^exponent mod modulus). Fails if the modulus is zero or negative, +or if the exponent is negative and the modular inverse does not exist. +-} +expModInteger + :: BuiltinInteger + -> BuiltinInteger + -> BuiltinInteger + -> BuiltinInteger expModInteger b e m = -- (fromInteger @Natural) correctly throws an underflow exception upon negative integer case ExpMod.expMod b e (fromInteger m) of - BuiltinFailure logs err -> traceAll (logs <> pure (display err)) $ - Haskell.error "expModInteger errored." + BuiltinFailure logs err -> + traceAll (logs <> pure (display err)) $ + Haskell.error "expModInteger errored." BuiltinSuccess bs -> toInteger bs BuiltinSuccessWithLogs logs bs -> traceAll logs $ toInteger bs {-# OPAQUE expModInteger #-} diff --git a/plutus-tx/src/PlutusTx/Code.hs b/plutus-tx/src/PlutusTx/Code.hs index a7187aedf0e..4f6d369e568 100644 --- a/plutus-tx/src/PlutusTx/Code.hs +++ b/plutus-tx/src/PlutusTx/Code.hs @@ -10,6 +10,7 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} + module PlutusTx.Code where import Control.Exception @@ -24,6 +25,7 @@ import PlutusIR qualified as PIR import PlutusTx.Coverage import PlutusTx.Lift.Instances () import UntypedPlutusCore qualified as UPLC + -- We do not use qualified import because the whole module contains off-chain code import PlutusPrelude import Prelude as Haskell @@ -34,38 +36,42 @@ import Prelude as Haskell -- we compile newtypes the same as their underlying types, but people probably just -- shouldn't coerce the final parameter regardless, so we play it safe with a nominal role. type role CompiledCodeIn representational representational nominal + -- NOTE: any changes to this type must be paralleled by changes -- in the plugin code that generates values of this type. That is -- done by code generation so it's not typechecked normally. --- | A compiled Plutus Tx program. The last type parameter indicates --- the type of the Haskell expression that was compiled, and --- hence the type of the compiled code. --- --- Note: the compiled PLC program does *not* have normalized types, --- if you want to put it on the chain you must normalize the types first. -data CompiledCodeIn uni fun a = - -- | Serialized UPLC code and possibly serialized PIR code with metadata used for program coverage. + +{-| A compiled Plutus Tx program. The last type parameter indicates +the type of the Haskell expression that was compiled, and +hence the type of the compiled code. + +Note: the compiled PLC program does *not* have normalized types, +if you want to put it on the chain you must normalize the types first. +-} +data CompiledCodeIn uni fun a + = -- | Serialized UPLC code and possibly serialized PIR code with metadata used for program coverage. SerializedCode BS.ByteString (Maybe BS.ByteString) CoverageIndex - -- | Deserialized UPLC program, and possibly deserialized PIR program with metadata used for program coverage. - | DeserializedCode - (UPLC.Program UPLC.NamedDeBruijn uni fun SrcSpans) - (Maybe (PIR.Program PLC.TyName PLC.Name uni fun SrcSpans)) - CoverageIndex + | -- | Deserialized UPLC program, and possibly deserialized PIR program with metadata used for program coverage. + DeserializedCode + (UPLC.Program UPLC.NamedDeBruijn uni fun SrcSpans) + (Maybe (PIR.Program PLC.TyName PLC.Name uni fun SrcSpans)) + CoverageIndex -- | 'CompiledCodeIn' instantiated with default built-in types and functions. type CompiledCode = CompiledCodeIn PLC.DefaultUni PLC.DefaultFun -- | Apply a compiled function to a compiled argument. Will fail if the versions don't match. applyCode - :: (PLC.Closed uni - , uni `PLC.Everywhere` Flat - , Flat fun - , Pretty fun - , PLC.Everywhere uni PrettyConst - , PrettyBy RenderContext (PLC.SomeTypeIn uni)) - => CompiledCodeIn uni fun (a -> b) - -> CompiledCodeIn uni fun a - -> Either String (CompiledCodeIn uni fun b) + :: ( PLC.Closed uni + , uni `PLC.Everywhere` Flat + , Flat fun + , Pretty fun + , PLC.Everywhere uni PrettyConst + , PrettyBy RenderContext (PLC.SomeTypeIn uni) + ) + => CompiledCodeIn uni fun (a -> b) + -> CompiledCodeIn uni fun a + -> Either String (CompiledCodeIn uni fun b) applyCode fun arg = do let uplc = unsafeFromRight $ UPLC.applyProgram (getPlc fun) (getPlc arg) -- Probably this could be done with more appropriate combinators, but the @@ -73,38 +79,43 @@ applyCode fun arg = do -- wrong first!), so I wrote it painfully explicitly. pir <- case (getPir fun, getPir arg) of (Just funPir, Just argPir) -> case PIR.applyProgram funPir argPir of - Right appliedPir -> pure (Just appliedPir) - -- Had PIR for both, but failed to apply them, this should fail - Left err -> Left $ show err + Right appliedPir -> pure (Just appliedPir) + -- Had PIR for both, but failed to apply them, this should fail + Left err -> Left $ show err -- Missing PIR for one or both, this succeeds but has no PIR (Just funPir, Nothing) -> - Left $ "Missing PIR for the argument." - <> "Got PIR for the function program \n" - <> display funPir + Left $ + "Missing PIR for the argument." + <> "Got PIR for the function program \n" + <> display funPir (Nothing, Just argPir) -> - Left $ "Missing PIR for the function program." - <> "Got PIR for the argument \n" - <> display argPir + Left $ + "Missing PIR for the function program." + <> "Got PIR for the argument \n" + <> display argPir (Nothing, Nothing) -> Left "Missing PIR for both the function program and the argument." pure $ DeserializedCode uplc pir (getCovIdx fun <> getCovIdx arg) --- | Apply a compiled function to a compiled argument. Will throw if the versions don't match, --- should only be used in non-production code. +{-| Apply a compiled function to a compiled argument. Will throw if the versions don't match, +should only be used in non-production code. +-} unsafeApplyCode - :: (PLC.Closed uni - , uni `PLC.Everywhere` Flat - , Flat fun - , Pretty fun - , PLC.Everywhere uni PrettyConst - , PrettyBy RenderContext (PLC.SomeTypeIn uni)) - => CompiledCodeIn uni fun (a -> b) -> CompiledCodeIn uni fun a -> CompiledCodeIn uni fun b + :: ( PLC.Closed uni + , uni `PLC.Everywhere` Flat + , Flat fun + , Pretty fun + , PLC.Everywhere uni PrettyConst + , PrettyBy RenderContext (PLC.SomeTypeIn uni) + ) + => CompiledCodeIn uni fun (a -> b) -> CompiledCodeIn uni fun a -> CompiledCodeIn uni fun b unsafeApplyCode fun arg = case applyCode fun arg of Right c -> c Left err -> error err -- | The size of a 'CompiledCodeIn', in AST nodes. -sizePlc :: (PLC.Closed uni, uni `PLC.Everywhere` Flat, Flat fun) => CompiledCodeIn uni fun a -> Integer +sizePlc + :: (PLC.Closed uni, uni `PLC.Everywhere` Flat, Flat fun) => CompiledCodeIn uni fun a -> Integer sizePlc = UPLC.unSize . UPLC.programSize . getPlc {- Note [Deserializing the AST] @@ -113,40 +124,40 @@ However, we just did it ourselves, so this should be impossible, and we signal t exception. -} newtype ImpossibleDeserialisationFailure = ImpossibleDeserialisationFailure DecodeException - deriving anyclass (Exception) + deriving anyclass (Exception) instance Show ImpossibleDeserialisationFailure where - show (ImpossibleDeserialisationFailure e) = "Failed to deserialise our own program! This is a bug, please report it. Caused by: " ++ show e + show (ImpossibleDeserialisationFailure e) = "Failed to deserialise our own program! This is a bug, please report it. Caused by: " ++ show e -- | Get the actual Plutus Core program out of a 'CompiledCodeIn'. getPlc - :: (PLC.Closed uni, uni `PLC.Everywhere` Flat, Flat fun) - => CompiledCodeIn uni fun a -> UPLC.Program UPLC.NamedDeBruijn uni fun SrcSpans + :: (PLC.Closed uni, uni `PLC.Everywhere` Flat, Flat fun) + => CompiledCodeIn uni fun a -> UPLC.Program UPLC.NamedDeBruijn uni fun SrcSpans getPlc wrapper = case wrapper of - SerializedCode plc _ _ -> case unflat (BSL.fromStrict plc) of - Left e -> throw $ ImpossibleDeserialisationFailure e - Right (UPLC.UnrestrictedProgram p) -> p - DeserializedCode plc _ _ -> plc + SerializedCode plc _ _ -> case unflat (BSL.fromStrict plc) of + Left e -> throw $ ImpossibleDeserialisationFailure e + Right (UPLC.UnrestrictedProgram p) -> p + DeserializedCode plc _ _ -> plc getPlcNoAnn - :: (PLC.Closed uni, uni `PLC.Everywhere` Flat, Flat fun) - => CompiledCodeIn uni fun a -> UPLC.Program UPLC.NamedDeBruijn uni fun () + :: (PLC.Closed uni, uni `PLC.Everywhere` Flat, Flat fun) + => CompiledCodeIn uni fun a -> UPLC.Program UPLC.NamedDeBruijn uni fun () getPlcNoAnn = void . getPlc -- | Get the Plutus IR program, if there is one, out of a 'CompiledCodeIn'. getPir - :: (PLC.Closed uni, uni `PLC.Everywhere` Flat, Flat fun) - => CompiledCodeIn uni fun a -> Maybe (PIR.Program PIR.TyName PIR.Name uni fun SrcSpans) + :: (PLC.Closed uni, uni `PLC.Everywhere` Flat, Flat fun) + => CompiledCodeIn uni fun a -> Maybe (PIR.Program PIR.TyName PIR.Name uni fun SrcSpans) getPir wrapper = case wrapper of - SerializedCode _ pir _ -> case pir of - Just bs -> case unflat (BSL.fromStrict bs) of - Left e -> throw $ ImpossibleDeserialisationFailure e - Right p -> Just p - Nothing -> Nothing - DeserializedCode _ pir _ -> pir + SerializedCode _ pir _ -> case pir of + Just bs -> case unflat (BSL.fromStrict bs) of + Left e -> throw $ ImpossibleDeserialisationFailure e + Right p -> Just p + Nothing -> Nothing + DeserializedCode _ pir _ -> pir getPirNoAnn - :: (PLC.Closed uni, uni `PLC.Everywhere` Flat, Flat fun) - => CompiledCodeIn uni fun a -> Maybe (PIR.Program PIR.TyName PIR.Name uni fun ()) + :: (PLC.Closed uni, uni `PLC.Everywhere` Flat, Flat fun) + => CompiledCodeIn uni fun a -> Maybe (PIR.Program PIR.TyName PIR.Name uni fun ()) getPirNoAnn = fmap void . getPir getCovIdx :: CompiledCodeIn uni fun a -> CoverageIndex diff --git a/plutus-tx/src/PlutusTx/Coverage.hs b/plutus-tx/src/PlutusTx/Coverage.hs index dc6984bdf3b..58db725b5d4 100644 --- a/plutus-tx/src/PlutusTx/Coverage.hs +++ b/plutus-tx/src/PlutusTx/Coverage.hs @@ -5,28 +5,30 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -fno-warn-name-shadowing #-} -module PlutusTx.Coverage ( CoverageAnnotation(..) - , CoverageIndex(..) - , CoverageMetadata(..) - , Metadata(..) - , CoverageData(..) - , CoverageReport(..) - , CovLoc(..) - , covLocFile - , covLocStartLine - , covLocEndLine - , covLocStartCol - , covLocEndCol - , metadataSet - , coverageAnnotations - , ignoredAnnotations - , coverageMetadata - , coveredAnnotations - , addCoverageMetadata - , addLocationToCoverageIndex - , addBoolCaseToCoverageIndex - , coverageDataFromLogMsg - ) where + +module PlutusTx.Coverage ( + CoverageAnnotation (..), + CoverageIndex (..), + CoverageMetadata (..), + Metadata (..), + CoverageData (..), + CoverageReport (..), + CovLoc (..), + covLocFile, + covLocStartLine, + covLocEndLine, + covLocStartCol, + covLocEndCol, + metadataSet, + coverageAnnotations, + ignoredAnnotations, + coverageMetadata, + coveredAnnotations, + addCoverageMetadata, + addLocationToCoverageIndex, + addBoolCaseToCoverageIndex, + coverageDataFromLogMsg, +) where import Control.Lens @@ -69,11 +71,13 @@ import Prelude -} -- | A source location for coverage -data CovLoc = CovLoc { _covLocFile :: String - , _covLocStartLine :: Int - , _covLocEndLine :: Int - , _covLocStartCol :: Int - , _covLocEndCol :: Int } +data CovLoc = CovLoc + { _covLocFile :: String + , _covLocStartLine :: Int + , _covLocEndLine :: Int + , _covLocStartCol :: Int + , _covLocEndCol :: Int + } deriving stock (Ord, Eq, Show, Read, Generic) deriving anyclass (Serialise) deriving Flat via (FlatViaSerialise CovLoc) @@ -83,50 +87,54 @@ makeLenses ''CovLoc instance Pretty CovLoc where pretty (CovLoc file l1 l2 c1 c2) = - mconcat [ pretty file, ":", pretty l1, ",", pretty c1, "-", pretty l2, ",", pretty c2] + mconcat [pretty file, ":", pretty l1, ",", pretty c1, "-", pretty l2, ",", pretty c2] -data CoverageAnnotation = CoverLocation CovLoc - | CoverBool CovLoc Bool - deriving stock (Ord, Eq, Show, Read, Generic) - deriving anyclass (Serialise) - deriving Flat via (FlatViaSerialise CoverageAnnotation) - deriving anyclass (NFData, ToJSON, FromJSON, ToJSONKey, FromJSONKey) +data CoverageAnnotation + = CoverLocation CovLoc + | CoverBool CovLoc Bool + deriving stock (Ord, Eq, Show, Read, Generic) + deriving anyclass (Serialise) + deriving Flat via (FlatViaSerialise CoverageAnnotation) + deriving anyclass (NFData, ToJSON, FromJSON, ToJSONKey, FromJSONKey) instance Pretty CoverageAnnotation where pretty (CoverLocation loc) = pretty loc pretty (CoverBool loc b) = pretty loc <+> "=" <+> pretty b -data Metadata = ApplicationHeadSymbol String - | IgnoredAnnotation - -- ^ Location that is not interesting to cover. This is not generated by the - -- compiler, but can be added later using `addCoverageMetadata`. - deriving stock (Ord, Eq, Show, Generic) - deriving anyclass (Serialise) - deriving Flat via (FlatViaSerialise Metadata) - deriving anyclass (NFData, ToJSON, FromJSON) +data Metadata + = ApplicationHeadSymbol String + | {-| Location that is not interesting to cover. This is not generated by the + compiler, but can be added later using `addCoverageMetadata`. + -} + IgnoredAnnotation + deriving stock (Ord, Eq, Show, Generic) + deriving anyclass (Serialise) + deriving Flat via (FlatViaSerialise Metadata) + deriving anyclass (NFData, ToJSON, FromJSON) instance Pretty Metadata where pretty = viaShow -newtype CoverageMetadata = CoverageMetadata { _metadataSet :: Set Metadata } - deriving stock (Ord, Eq, Show, Generic) - deriving anyclass (Serialise, NFData, ToJSON, FromJSON) - deriving newtype (Semigroup, Monoid) - deriving Flat via (FlatViaSerialise CoverageMetadata) +newtype CoverageMetadata = CoverageMetadata {_metadataSet :: Set Metadata} + deriving stock (Ord, Eq, Show, Generic) + deriving anyclass (Serialise, NFData, ToJSON, FromJSON) + deriving newtype (Semigroup, Monoid) + deriving Flat via (FlatViaSerialise CoverageMetadata) makeLenses ''CoverageMetadata instance Pretty CoverageMetadata where pretty (CoverageMetadata s) = vsep . map pretty . Set.toList $ s --- | This type keeps track of all coverage annotations and where they have been inserted / what --- annotations are expected to be found when executing a piece of code. +{-| This type keeps track of all coverage annotations and where they have been inserted / what +annotations are expected to be found when executing a piece of code. +-} newtype CoverageIndex = CoverageIndex - { _coverageMetadata :: Map CoverageAnnotation CoverageMetadata } - deriving stock (Ord, Eq, Show, Generic) - deriving anyclass (Serialise) - deriving Flat via (FlatViaSerialise CoverageIndex) - deriving anyclass (NFData, ToJSON, FromJSON) + {_coverageMetadata :: Map CoverageAnnotation CoverageMetadata} + deriving stock (Ord, Eq, Show, Generic) + deriving anyclass (Serialise) + deriving Flat via (FlatViaSerialise CoverageIndex) + deriving anyclass (NFData, ToJSON, FromJSON) makeLenses ''CoverageIndex @@ -134,8 +142,9 @@ coverageAnnotations :: Getter CoverageIndex (Set CoverageAnnotation) coverageAnnotations = coverageMetadata . to Map.keysSet ignoredAnnotations :: Getter CoverageIndex (Set CoverageAnnotation) -ignoredAnnotations = coverageMetadata - . to (Map.keysSet . Map.filter (Set.member IgnoredAnnotation . _metadataSet)) +ignoredAnnotations = + coverageMetadata + . to (Map.keysSet . Map.filter (Set.member IgnoredAnnotation . _metadataSet)) instance Semigroup CoverageIndex where ci <> ci' = CoverageIndex (Map.unionWith (<>) (_coverageMetadata ci) (_coverageMetadata ci')) @@ -144,15 +153,16 @@ instance Monoid CoverageIndex where mempty = CoverageIndex Map.empty -- | Include a location coverage annotation in the index -addLocationToCoverageIndex :: MonadWriter CoverageIndex m => CovLoc -> m CoverageAnnotation +addLocationToCoverageIndex :: (MonadWriter CoverageIndex m) => CovLoc -> m CoverageAnnotation addLocationToCoverageIndex src = do let ann = CoverLocation src tell $ CoverageIndex $ Map.singleton ann mempty pure ann -- | Include a boolean coverage annotation in the index -addBoolCaseToCoverageIndex :: MonadWriter CoverageIndex m - => CovLoc -> Bool -> CoverageMetadata -> m CoverageAnnotation +addBoolCaseToCoverageIndex + :: (MonadWriter CoverageIndex m) + => CovLoc -> Bool -> CoverageMetadata -> m CoverageAnnotation addBoolCaseToCoverageIndex src b meta = do let ann = CoverBool src b tell $ CoverageIndex (Map.singleton ann meta) @@ -160,22 +170,25 @@ addBoolCaseToCoverageIndex src b meta = do -- | Add metadata to a coverage annotation. Does nothing if the annotation is not in the index. addCoverageMetadata :: CoverageAnnotation -> Metadata -> CoverageIndex -> CoverageIndex -addCoverageMetadata ann meta idx = idx - & coverageMetadata - . at ann - . _Just - . metadataSet - %~ Set.insert meta - -newtype CoverageData = CoverageData { _coveredAnnotations :: Set CoverageAnnotation } +addCoverageMetadata ann meta idx = + idx + & coverageMetadata + . at ann + . _Just + . metadataSet + %~ Set.insert meta + +newtype CoverageData = CoverageData {_coveredAnnotations :: Set CoverageAnnotation} deriving stock (Ord, Eq, Show, Generic) deriving newtype (Semigroup, Monoid) deriving anyclass (NFData, ToJSON, FromJSON) makeLenses ''CoverageData -data CoverageReport = CoverageReport { _coverageIndex :: CoverageIndex - , _coverageData :: CoverageData } +data CoverageReport = CoverageReport + { _coverageIndex :: CoverageIndex + , _coverageData :: CoverageData + } deriving stock (Ord, Eq, Show, Generic) deriving anyclass (NFData, ToJSON, FromJSON) @@ -185,26 +198,27 @@ instance Semigroup CoverageReport where CoverageReport i1 d1 <> CoverageReport i2 d2 = CoverageReport (i1 <> i2) (d1 <> d2) instance Monoid CoverageReport where - mempty = CoverageReport mempty mempty + mempty = CoverageReport mempty mempty mappend = (<>) coverageDataFromLogMsg :: String -> CoverageData coverageDataFromLogMsg = foldMap (CoverageData . Set.singleton) . readMaybe instance Pretty CoverageReport where - pretty report = vsep $ - ["=========[COVERED]=========="] ++ - [ nest 4 $ vsep (pretty ann : (map pretty . Set.toList . foldMap _metadataSet $ metadata ann)) - | ann <- Set.toList $ allAnns `Set.intersection` coveredAnns ] ++ - ["========[UNCOVERED]========="] ++ - (map pretty . Set.toList $ uncoveredAnns) ++ - ["=========[IGNORED]=========="] ++ - (map pretty . Set.toList $ ignoredAnns Set.\\ coveredAnns) - where - allAnns = report ^. coverageIndex . coverageAnnotations - coveredAnns = report ^. coverageData . coveredAnnotations - ignoredAnns = report ^. coverageIndex . ignoredAnnotations - uncoveredAnns = allAnns Set.\\ (coveredAnns <> ignoredAnns) - - metadata ann = Map.lookup ann (report ^. coverageIndex . coverageMetadata) - + pretty report = + vsep $ + ["=========[COVERED]=========="] + ++ [ nest 4 $ vsep (pretty ann : (map pretty . Set.toList . foldMap _metadataSet $ metadata ann)) + | ann <- Set.toList $ allAnns `Set.intersection` coveredAnns + ] + ++ ["========[UNCOVERED]========="] + ++ (map pretty . Set.toList $ uncoveredAnns) + ++ ["=========[IGNORED]=========="] + ++ (map pretty . Set.toList $ ignoredAnns Set.\\ coveredAnns) + where + allAnns = report ^. coverageIndex . coverageAnnotations + coveredAnns = report ^. coverageData . coveredAnnotations + ignoredAnns = report ^. coverageIndex . ignoredAnnotations + uncoveredAnns = allAnns Set.\\ (coveredAnns <> ignoredAnns) + + metadata ann = Map.lookup ann (report ^. coverageIndex . coverageMetadata) diff --git a/plutus-tx/src/PlutusTx/Data/AssocMap.hs b/plutus-tx/src/PlutusTx/Data/AssocMap.hs index dfc83966334..ab9c2403f82 100644 --- a/plutus-tx/src/PlutusTx/Data/AssocMap.hs +++ b/plutus-tx/src/PlutusTx/Data/AssocMap.hs @@ -35,7 +35,7 @@ module PlutusTx.Data.AssocMap ( mapWithKey, mapMaybe, mapMaybeWithKey, - ) where +) where import Data.Coerce (coerce) import PlutusTx.Builtins qualified as P @@ -51,7 +51,7 @@ import Prettyprinter (Pretty (..)) import Prelude qualified as Haskell -{- | A map associating keys and values backed by `P.BuiltinData`. +{-| A map associating keys and values backed by `P.BuiltinData`. This implementation has the following characteristics: @@ -78,11 +78,11 @@ instance P.ToData (Map k a) where {-# INLINEABLE toBuiltinData #-} toBuiltinData (Map d) = BI.mkMap d instance P.FromData (Map k a) where - {-# INLINABLE fromBuiltinData #-} + {-# INLINEABLE fromBuiltinData #-} fromBuiltinData = Just . Map . BI.unsafeDataAsMap instance P.UnsafeFromData (Map k a) where - {-# INLINABLE unsafeFromBuiltinData #-} + {-# INLINEABLE unsafeFromBuiltinData #-} unsafeFromBuiltinData = Map . BI.unsafeDataAsMap instance @@ -90,13 +90,16 @@ instance , Pretty a , P.UnsafeFromData k , P.UnsafeFromData a - ) => Pretty (Map k a) where + ) + => Pretty (Map k a) + where pretty = pretty . toSOPList --- | Look up the value corresponding to the key. --- If the `Map` is not well-defined, the result is the value associated with --- the left-most occurrence of the key in the list. --- This operation is O(n). +{-| Look up the value corresponding to the key. +If the `Map` is not well-defined, the result is the value associated with +the left-most occurrence of the key in the list. +This operation is O(n). +-} lookup :: forall k a. (P.ToData k, P.UnsafeFromData a) => k -> Map k a -> Maybe a lookup (P.toBuiltinData -> k) (Map m) = P.unsafeFromBuiltinData <$> lookup' k m {-# INLINEABLE lookup #-} @@ -106,16 +109,16 @@ lookup' -> BuiltinList (BuiltinPair BuiltinData BuiltinData) -> Maybe BuiltinData lookup' k m = go m - where - go = - P.caseList' - Nothing - ( \hd -> - let k' = BI.fst hd - in if P.equalsData k k' - then \_ -> Just (BI.snd hd) - else go - ) + where + go = + P.caseList' + Nothing + ( \hd -> + let k' = BI.fst hd + in if P.equalsData k k' + then \_ -> Just (BI.snd hd) + else go + ) -- | Check if the key is in the `Map`. member :: forall k a. (P.ToData k) => k -> Map k a -> Bool @@ -124,20 +127,21 @@ member (P.toBuiltinData -> k) (Map m) = member' k m member' :: BuiltinData -> BuiltinList (BuiltinPair BuiltinData BuiltinData) -> Bool member' k = go - where - go :: BuiltinList (BuiltinPair BuiltinData BuiltinData) -> Bool - go = - P.caseList' - False - ( \hd -> - let k' = BI.fst hd - in if P.equalsData k k' - then \_ -> True - else go - ) - --- | Insert a key-value pair into the `Map`. If the key is already present, --- the value is updated. + where + go :: BuiltinList (BuiltinPair BuiltinData BuiltinData) -> Bool + go = + P.caseList' + False + ( \hd -> + let k' = BI.fst hd + in if P.equalsData k k' + then \_ -> True + else go + ) + +{-| Insert a key-value pair into the `Map`. If the key is already present, +the value is updated. +-} insert :: forall k a. (P.ToData k, P.ToData a) => k -> a -> Map k a -> Map k a insert (P.toBuiltinData -> k) (P.toBuiltinData -> a) (Map m) = Map $ insert' k a m {-# INLINEABLE insert #-} @@ -148,44 +152,45 @@ insert' -> BuiltinList (BuiltinPair BuiltinData BuiltinData) -> BuiltinList (BuiltinPair BuiltinData BuiltinData) insert' k a = go - where - nilCase = BI.mkCons (BI.mkPairData k a) nil - go :: - BuiltinList (BuiltinPair BuiltinData BuiltinData) -> - BuiltinList (BuiltinPair BuiltinData BuiltinData) - go = - P.caseList' - nilCase - ( \hd -> - if P.equalsData k (BI.fst hd) - then BI.mkCons (BI.mkPairData k a) - else BI.mkCons hd . go - ) - --- | Delete a key value pair from the `Map`. --- If the `Map` is not well-defined, it deletes the pair associated with the --- left-most occurrence of the key in the list. + where + nilCase = BI.mkCons (BI.mkPairData k a) nil + go + :: BuiltinList (BuiltinPair BuiltinData BuiltinData) + -> BuiltinList (BuiltinPair BuiltinData BuiltinData) + go = + P.caseList' + nilCase + ( \hd -> + if P.equalsData k (BI.fst hd) + then BI.mkCons (BI.mkPairData k a) + else BI.mkCons hd . go + ) + +{-| Delete a key value pair from the `Map`. +If the `Map` is not well-defined, it deletes the pair associated with the +left-most occurrence of the key in the list. +-} delete :: forall k a. (P.ToData k) => k -> Map k a -> Map k a delete (P.toBuiltinData -> k) = coerce $ delete' k {-# INLINEABLE delete #-} -delete' :: - BuiltinData -> - BuiltinList (BuiltinPair BuiltinData BuiltinData) -> - BuiltinList (BuiltinPair BuiltinData BuiltinData) +delete' + :: BuiltinData + -> BuiltinList (BuiltinPair BuiltinData BuiltinData) + -> BuiltinList (BuiltinPair BuiltinData BuiltinData) delete' k = go - where - go :: - BuiltinList (BuiltinPair BuiltinData BuiltinData) -> - BuiltinList (BuiltinPair BuiltinData BuiltinData) - go = - P.caseList' - nil - ( \hd -> - if P.equalsData k (BI.fst hd) - then id - else BI.mkCons hd . go - ) + where + go + :: BuiltinList (BuiltinPair BuiltinData BuiltinData) + -> BuiltinList (BuiltinPair BuiltinData BuiltinData) + go = + P.caseList' + nil + ( \hd -> + if P.equalsData k (BI.fst hd) + then id + else BI.mkCons hd . go + ) -- | Create an `Map` with a single key-value pair. singleton :: forall k a. (P.ToData k, P.ToData a) => k -> a -> Map k a @@ -206,32 +211,34 @@ null = P.null {-# INLINEABLE null #-} --- | Create an `Map` from a sums of products list of key-value pairs. --- In case of duplicates, this function will keep only one entry (the one that precedes). --- In other words, this function de-duplicates the input list. --- Warning: this function is very slow. If you know that the input list does not contain --- duplicate keys, use one of the unsafe functions instead. -safeFromSOPList :: forall k a . (P.ToData k, P.ToData a) => [(k, a)] -> Map k a +{-| Create an `Map` from a sums of products list of key-value pairs. +In case of duplicates, this function will keep only one entry (the one that precedes). +In other words, this function de-duplicates the input list. +Warning: this function is very slow. If you know that the input list does not contain +duplicate keys, use one of the unsafe functions instead. +-} +safeFromSOPList :: forall k a. (P.ToData k, P.ToData a) => [(k, a)] -> Map k a safeFromSOPList = Map . toOpaque . SOP.List.foldr (uncurry go) [] - where - go :: k -> a -> [(BuiltinData, BuiltinData)] -> [(BuiltinData, BuiltinData)] - go k v [] = [(P.toBuiltinData k, P.toBuiltinData v)] - go k v ((k', v') : rest) = - if P.toBuiltinData k == k' - then (P.toBuiltinData k, P.toBuiltinData v) : go k v rest - else (k', v') : go k v rest + where + go :: k -> a -> [(BuiltinData, BuiltinData)] -> [(BuiltinData, BuiltinData)] + go k v [] = [(P.toBuiltinData k, P.toBuiltinData v)] + go k v ((k', v') : rest) = + if P.toBuiltinData k == k' + then (P.toBuiltinData k, P.toBuiltinData v) : go k v rest + else (k', v') : go k v rest {-# INLINEABLE safeFromSOPList #-} --- | Unsafely create an 'Map' from a sums of products list of pairs. --- This should _only_ be applied to lists which have been checked to not --- contain duplicate keys, otherwise the resulting 'Map' will contain --- conflicting entries (two entries sharing the same key), and therefore be ill-defined. --- Warning: this requires traversing the list and encoding the keys and values, so it --- should be avoided in favor of 'unsafeFromBuiltinList' if the input is already in --- 'BuiltinData' form. +{-| Unsafely create an 'Map' from a sums of products list of pairs. +This should _only_ be applied to lists which have been checked to not +contain duplicate keys, otherwise the resulting 'Map' will contain +conflicting entries (two entries sharing the same key), and therefore be ill-defined. +Warning: this requires traversing the list and encoding the keys and values, so it +should be avoided in favor of 'unsafeFromBuiltinList' if the input is already in +'BuiltinData' form. +-} unsafeFromSOPList :: (P.ToData k, P.ToData a) => [(k, a)] -> Map k a unsafeFromSOPList = Map @@ -239,48 +246,51 @@ unsafeFromSOPList = . SOP.List.map (\(k, a) -> (P.toBuiltinData k, P.toBuiltinData a)) {-# INLINEABLE unsafeFromSOPList #-} --- | Unsafely create an 'Map' from a `P.BuiltinList` of key-value pairs. This operation --- is O(1). --- This function is unsafe because it assumes that the elements of the list can be safely --- decoded from their 'BuiltinData' representation. It also does not deduplicate the keys. -unsafeFromBuiltinList :: - forall k a. - BuiltinList (BuiltinPair BuiltinData BuiltinData) -> - Map k a +{-| Unsafely create an 'Map' from a `P.BuiltinList` of key-value pairs. This operation +is O(1). +This function is unsafe because it assumes that the elements of the list can be safely +decoded from their 'BuiltinData' representation. It also does not deduplicate the keys. +-} +unsafeFromBuiltinList + :: forall k a + . BuiltinList (BuiltinPair BuiltinData BuiltinData) + -> Map k a unsafeFromBuiltinList = coerce {-# INLINEABLE unsafeFromBuiltinList #-} --- | Unsafely create an 'Map' from a `List` of key-value pairs. --- This function is unsafe because it assumes that the elements of the list can be safely --- decoded from their 'BuiltinData' representation. It also does not deduplicate the keys. +{-| Unsafely create an 'Map' from a `List` of key-value pairs. +This function is unsafe because it assumes that the elements of the list can be safely +decoded from their 'BuiltinData' representation. It also does not deduplicate the keys. +-} unsafeFromDataList :: List (a, k) -> Map k a unsafeFromDataList = coerce . go . Data.List.toBuiltinList - where - go - :: BuiltinList BuiltinData - -> BuiltinList (BuiltinPair BuiltinData BuiltinData) - go = - P.caseList' - nil - ( \hd tl -> - let (a, b) = P.unsafeFromBuiltinData hd - in BI.mkCons (BI.mkPairData a b) (go tl) - ) + where + go + :: BuiltinList BuiltinData + -> BuiltinList (BuiltinPair BuiltinData BuiltinData) + go = + P.caseList' + nil + ( \hd tl -> + let (a, b) = P.unsafeFromBuiltinData hd + in BI.mkCons (BI.mkPairData a b) (go tl) + ) {-# INLINEABLE unsafeFromDataList #-} --- | Convert the `Map` to a list of key-value pairs. This operation is O(n). --- See 'toBuiltinList' for a more efficient alternative. +{-| Convert the `Map` to a list of key-value pairs. This operation is O(n). +See 'toBuiltinList' for a more efficient alternative. +-} toSOPList :: (P.UnsafeFromData k, P.UnsafeFromData a) => Map k a -> [(k, a)] toSOPList d = go (toBuiltinList d) - where - go = - P.caseList' - [] - ( \hd tl -> - (P.unsafeFromBuiltinData (BI.fst hd), P.unsafeFromBuiltinData (BI.snd hd)) - : go tl - ) + where + go = + P.caseList' + [] + ( \hd tl -> + (P.unsafeFromBuiltinData (BI.fst hd), P.unsafeFromBuiltinData (BI.snd hd)) + : go tl + ) {-# INLINEABLE toSOPList #-} -- | Convert the `Map` to a `P.BuiltinList` of key-value pairs. This operation is O(1). @@ -291,155 +301,155 @@ toBuiltinList = coerce -- | Check if the `Map` is well-defined. Warning: this operation is O(n^2). noDuplicateKeys :: forall k a. Map k a -> Bool noDuplicateKeys (Map m) = go m - where - go :: BuiltinList (BuiltinPair BuiltinData BuiltinData) -> Bool - go = - P.caseList' - True - ( \hd tl -> - if member' (BI.fst hd) tl then False else go tl - ) + where + go :: BuiltinList (BuiltinPair BuiltinData BuiltinData) -> Bool + go = + P.caseList' + True + ( \hd tl -> + if member' (BI.fst hd) tl then False else go tl + ) {-# INLINEABLE noDuplicateKeys #-} --- | Check if all values in the `Map` satisfy the predicate. all :: forall k a. (P.UnsafeFromData a) => (a -> Bool) -> Map k a -> Bool all p = coerce go - where - go :: BuiltinList (BuiltinPair BuiltinData BuiltinData) -> Bool - go = - P.caseList' - True - ( \hd -> - if p (P.unsafeFromBuiltinData (BI.snd hd)) - then go - else \_ -> False - ) + where + go :: BuiltinList (BuiltinPair BuiltinData BuiltinData) -> Bool + go = + P.caseList' + True + ( \hd -> + if p (P.unsafeFromBuiltinData (BI.snd hd)) + then go + else \_ -> False + ) {-# INLINEABLE all #-} -- | Check if any value in the `Map` satisfies the predicate. any :: forall k a. (P.UnsafeFromData a) => (a -> Bool) -> Map k a -> Bool any p = coerce go - where - go :: BuiltinList (BuiltinPair BuiltinData BuiltinData) -> Bool - go = - P.caseList' - False - ( \hd -> - if p (P.unsafeFromBuiltinData (BI.snd hd)) - then \_ -> True - else go - ) + where + go :: BuiltinList (BuiltinPair BuiltinData BuiltinData) -> Bool + go = + P.caseList' + False + ( \hd -> + if p (P.unsafeFromBuiltinData (BI.snd hd)) + then \_ -> True + else go + ) {-# INLINEABLE any #-} -- | Combine two 'Map's into one. It saves both values if the key is present in both maps. -union :: - forall k a b. - (P.UnsafeFromData a, P.UnsafeFromData b, P.ToData a, P.ToData b) => - Map k a -> - Map k b -> - Map k (These a b) +union + :: forall k a b + . (P.UnsafeFromData a, P.UnsafeFromData b, P.ToData a, P.ToData b) + => Map k a + -> Map k b + -> Map k (These a b) union (Map ls) (Map rs) = Map res - where - goLeft = - P.caseList' - nil - ( \hd tl -> - let k = BI.fst hd - v = BI.snd hd - v' = case lookup' k rs of - Just r -> - P.toBuiltinData - ( These - (P.unsafeFromBuiltinData v) - (P.unsafeFromBuiltinData r) + where + goLeft = + P.caseList' + nil + ( \hd tl -> + let k = BI.fst hd + v = BI.snd hd + v' = case lookup' k rs of + Just r -> + P.toBuiltinData + ( These + (P.unsafeFromBuiltinData v) + (P.unsafeFromBuiltinData r) :: These a b - ) - Nothing -> - P.toBuiltinData (This (P.unsafeFromBuiltinData v) :: These a b) - in BI.mkCons (BI.mkPairData k v') (goLeft tl) - ) + ) + Nothing -> + P.toBuiltinData (This (P.unsafeFromBuiltinData v) :: These a b) + in BI.mkCons (BI.mkPairData k v') (goLeft tl) + ) + + goRight = + P.caseList' + nil + ( \hd tl -> + let k = BI.fst hd + v = BI.snd hd + v' = case lookup' k ls of + Just r -> + P.toBuiltinData + ( These + (P.unsafeFromBuiltinData v) + (P.unsafeFromBuiltinData r) + :: These a b + ) + Nothing -> + P.toBuiltinData (That (P.unsafeFromBuiltinData v) :: These a b) + in BI.mkCons (BI.mkPairData k v') (goRight tl) + ) + + res = goLeft ls `safeAppend` goRight rs + + safeAppend xs1 xs2 = + P.matchList' + xs1 + xs2 + ( \hd tl -> + let k = BI.fst hd + v = BI.snd hd + in insert' k v (safeAppend tl xs2) + ) +{-# INLINEABLE union #-} - goRight = +-- | Combine two 'Map's with the given combination function. +unionWith + :: forall k a + . (P.UnsafeFromData a, P.ToData a) + => (a -> a -> a) + -> Map k a + -> Map k a + -> Map k a +unionWith f (Map ls) (Map rs) = + Map res + where + ls' :: BuiltinList (BuiltinPair BuiltinData BuiltinData) + ls' = go ls + where + go = P.caseList' nil ( \hd tl -> - let k = BI.fst hd - v = BI.snd hd - v' = case lookup' k ls of + let k' = BI.fst hd + v' = BI.snd hd + v'' = case lookup' k' rs of Just r -> P.toBuiltinData - ( These - (P.unsafeFromBuiltinData v) - (P.unsafeFromBuiltinData r) - :: These a b - ) - Nothing -> - P.toBuiltinData (That (P.unsafeFromBuiltinData v) :: These a b) - in BI.mkCons (BI.mkPairData k v') (goRight tl) + (f (P.unsafeFromBuiltinData v') (P.unsafeFromBuiltinData r)) + Nothing -> v' + in BI.mkCons (BI.mkPairData k' v'') (go tl) ) - res = goLeft ls `safeAppend` goRight rs - - safeAppend xs1 xs2 = - P.matchList' - xs1 - xs2 + rs' :: BuiltinList (BuiltinPair BuiltinData BuiltinData) + rs' = go rs + where + go = + P.caseList' + nil ( \hd tl -> - let k = BI.fst hd - v = BI.snd hd - in insert' k v (safeAppend tl xs2) + let k' = BI.fst hd + tl' = go tl + in if member' k' ls + then tl' + else BI.mkCons hd tl' ) -{-# INLINEABLE union #-} --- | Combine two 'Map's with the given combination function. -unionWith :: - forall k a. - (P.UnsafeFromData a, P.ToData a) => - (a -> a -> a) -> - Map k a -> - Map k a -> - Map k a -unionWith f (Map ls) (Map rs) = - Map res - where - ls' :: BuiltinList (BuiltinPair BuiltinData BuiltinData) - ls' = go ls - where - go = - P.caseList' - nil - ( \hd tl -> - let k' = BI.fst hd - v' = BI.snd hd - v'' = case lookup' k' rs of - Just r -> - P.toBuiltinData - (f (P.unsafeFromBuiltinData v') (P.unsafeFromBuiltinData r)) - Nothing -> v' - in BI.mkCons (BI.mkPairData k' v'') (go tl) - ) - - rs' :: BuiltinList (BuiltinPair BuiltinData BuiltinData) - rs' = go rs - where - go = - P.caseList' - nil - ( \hd tl -> - let k' = BI.fst hd - tl' = go tl - in if member' k' ls - then tl' - else BI.mkCons hd tl' - ) - - res :: BuiltinList (BuiltinPair BuiltinData BuiltinData) - res = go rs' ls' - where - go acc = - P.caseList' - acc - (\hd -> go (BI.mkCons hd acc)) + res :: BuiltinList (BuiltinPair BuiltinData BuiltinData) + res = go rs' ls' + where + go acc = + P.caseList' + acc + (\hd -> go (BI.mkCons hd acc)) {-# INLINEABLE unionWith #-} -- | An empty `P.BuiltinList` of key-value pairs. @@ -451,174 +461,172 @@ keys' :: BuiltinList (BuiltinPair BuiltinData BuiltinData) -> BuiltinList BuiltinData keys' = go - where - go = - P.caseList' - P.mkNil - ( \hd -> - BI.mkCons (BI.fst hd) . go - ) + where + go = + P.caseList' + P.mkNil + ( \hd -> + BI.mkCons (BI.fst hd) . go + ) keys :: forall k a. Map k a -> List k keys = Data.List.fromBuiltinList . keys' . coerce {-# INLINEABLE keys #-} -elems :: forall k a . Map k a -> List a +elems :: forall k a. Map k a -> List a elems = Data.List.fromBuiltinList . go . coerce - where - go - :: BuiltinList (BuiltinPair BuiltinData BuiltinData) - -> BuiltinList BuiltinData - go = - P.caseList' - P.mkNil - ( \hd -> - BI.mkCons (BI.snd hd) . go - ) + where + go + :: BuiltinList (BuiltinPair BuiltinData BuiltinData) + -> BuiltinList BuiltinData + go = + P.caseList' + P.mkNil + ( \hd -> + BI.mkCons (BI.snd hd) . go + ) {-# INLINEABLE elems #-} mapThese :: forall v k a b - . ( P.ToData a, P.ToData b, P.UnsafeFromData v) + . (P.ToData a, P.ToData b, P.UnsafeFromData v) => (v -> These a b) -> Map k v -> (Map k a, Map k b) mapThese f (Map m) = (Map ls, Map rs) - where - nilCase = (nil, nil) - (ls, rs) = go m - go - :: BuiltinList (BuiltinPair BuiltinData BuiltinData) - -> - ( BuiltinList (BuiltinPair BuiltinData BuiltinData) - , BuiltinList (BuiltinPair BuiltinData BuiltinData) - ) - go = - P.caseList' - nilCase - ( \hd tl -> - let k = BI.fst hd - v = BI.snd hd - (ls', rs') = go tl - in case f' v of - This l' -> (BI.mkCons (BI.mkPairData k (P.toBuiltinData l')) ls', rs') - That r' -> (ls', BI.mkCons (BI.mkPairData k (P.toBuiltinData r')) rs') - These l' r' -> - ( BI.mkCons (BI.mkPairData k (P.toBuiltinData l')) ls' - , BI.mkCons (BI.mkPairData k (P.toBuiltinData r')) rs' - ) - ) - f' :: BuiltinData -> These a b - f' = f . P.unsafeFromBuiltinData + where + nilCase = (nil, nil) + (ls, rs) = go m + go + :: BuiltinList (BuiltinPair BuiltinData BuiltinData) + -> ( BuiltinList (BuiltinPair BuiltinData BuiltinData) + , BuiltinList (BuiltinPair BuiltinData BuiltinData) + ) + go = + P.caseList' + nilCase + ( \hd tl -> + let k = BI.fst hd + v = BI.snd hd + (ls', rs') = go tl + in case f' v of + This l' -> (BI.mkCons (BI.mkPairData k (P.toBuiltinData l')) ls', rs') + That r' -> (ls', BI.mkCons (BI.mkPairData k (P.toBuiltinData r')) rs') + These l' r' -> + ( BI.mkCons (BI.mkPairData k (P.toBuiltinData l')) ls' + , BI.mkCons (BI.mkPairData k (P.toBuiltinData r')) rs' + ) + ) + f' :: BuiltinData -> These a b + f' = f . P.unsafeFromBuiltinData {-# INLINEABLE mapThese #-} map :: forall k a b. (P.UnsafeFromData a, P.ToData b) => (a -> b) -> Map k a -> Map k b map f = coerce go - where - go = - P.caseList' - nil - ( \hd -> - let (k, v) = P.pairToPair hd - in - BI.mkCons + where + go = + P.caseList' + nil + ( \hd -> + let (k, v) = P.pairToPair hd + in BI.mkCons (BI.mkPairData k (P.toBuiltinData (f (P.unsafeFromBuiltinData v)))) . go - ) + ) {-# INLINEABLE map #-} foldr :: forall a b k - . (P.UnsafeFromData a) + . (P.UnsafeFromData a) => (a -> b -> b) -> b -> Map k a -> b foldr f z = coerce go - where - go :: BuiltinList (BuiltinPair BuiltinData BuiltinData) -> b - go = - P.caseList' - z - ( \hd -> - f (P.unsafeFromBuiltinData (BI.snd hd)) . go - ) + where + go :: BuiltinList (BuiltinPair BuiltinData BuiltinData) -> b + go = + P.caseList' + z + ( \hd -> + f (P.unsafeFromBuiltinData (BI.snd hd)) . go + ) {-# INLINEABLE foldr #-} filter :: forall k a - . (P.UnsafeFromData a) + . (P.UnsafeFromData a) => (a -> Bool) -> Map k a -> Map k a filter p = coerce go - where - go = - P.caseList' - nil - ( \hd -> - if p (P.unsafeFromBuiltinData (BI.snd hd)) - then BI.mkCons hd . go - else go - ) + where + go = + P.caseList' + nil + ( \hd -> + if p (P.unsafeFromBuiltinData (BI.snd hd)) + then BI.mkCons hd . go + else go + ) {-# INLINEABLE filter #-} mapWithKey :: forall k a b - . (P.UnsafeFromData k, P.UnsafeFromData a, P.ToData b) + . (P.UnsafeFromData k, P.UnsafeFromData a, P.ToData b) => (k -> a -> b) -> Map k a -> Map k b mapWithKey f = coerce go - where - go = - P.caseList' - nil - ( \hd -> - let (k, v) = P.pairToPair hd - in - BI.mkCons - (BI.mkPairData k - (P.toBuiltinData - (f - (P.unsafeFromBuiltinData k) - (P.unsafeFromBuiltinData v) + where + go = + P.caseList' + nil + ( \hd -> + let (k, v) = P.pairToPair hd + in BI.mkCons + ( BI.mkPairData + k + ( P.toBuiltinData + ( f + (P.unsafeFromBuiltinData k) + (P.unsafeFromBuiltinData v) + ) ) - ) ) . go - ) + ) {-# INLINEABLE mapWithKey #-} mapMaybe :: forall k a b - . (P.UnsafeFromData a, P.ToData b) + . (P.UnsafeFromData a, P.ToData b) => (a -> Maybe b) -> Map k a -> Map k b mapMaybe f = coerce go - where - go = - P.caseList' - nil - ( \hd -> - let (k, v) = P.pairToPair hd - in case f (P.unsafeFromBuiltinData v) of - Just v' -> - BI.mkCons - (BI.mkPairData k (P.toBuiltinData v')) + where + go = + P.caseList' + nil + ( \hd -> + let (k, v) = P.pairToPair hd + in case f (P.unsafeFromBuiltinData v) of + Just v' -> + BI.mkCons + (BI.mkPairData k (P.toBuiltinData v')) . go - Nothing -> go - ) + Nothing -> go + ) {-# INLINEABLE mapMaybe #-} mapMaybeWithKey :: forall k a b - . (P.UnsafeFromData k, P.UnsafeFromData a, P.ToData b) + . (P.UnsafeFromData k, P.UnsafeFromData a, P.ToData b) => (k -> a -> Maybe b) -> Map k a -> Map k b mapMaybeWithKey f = coerce go - where - go = - P.caseList' - nil - ( \hd -> - let (k, v) = P.pairToPair hd - in case f (P.unsafeFromBuiltinData k) (P.unsafeFromBuiltinData v) of - Just v' -> - BI.mkCons - (BI.mkPairData k (P.toBuiltinData v')) + where + go = + P.caseList' + nil + ( \hd -> + let (k, v) = P.pairToPair hd + in case f (P.unsafeFromBuiltinData k) (P.unsafeFromBuiltinData v) of + Just v' -> + BI.mkCons + (BI.mkPairData k (P.toBuiltinData v')) . go - Nothing -> go - ) + Nothing -> go + ) {-# INLINEABLE mapMaybeWithKey #-} makeLift ''Map diff --git a/plutus-tx/src/PlutusTx/Data/List.hs b/plutus-tx/src/PlutusTx/Data/List.hs index cfeb5477bd2..ae6e66b2682 100644 --- a/plutus-tx/src/PlutusTx/Data/List.hs +++ b/plutus-tx/src/PlutusTx/Data/List.hs @@ -6,58 +6,58 @@ {-# LANGUAGE ViewPatterns #-} module PlutusTx.Data.List ( - List, - caseList, - caseList', - null, - append, - find, - findIndices, - filter, - mapMaybe, - any, - all, - foldMap, - map, - length, - mconcat, - (<|), - cons, - nil, - singleton, - uncons, - and, - or, - elem, - notElem, - foldr, - foldl, - concat, - concatMap, - listToMaybe, - uniqueElement, - (!!), - revAppend, - reverse, - replicate, - findIndex, - unzip, - zipWith, - head, - last, - tail, - take, - drop, - dropWhile, - splitAt, - elemBy, - nubBy, - nub, - partition, - toBuiltinList, - fromBuiltinList, - toSOP, - fromSOP, + List, + caseList, + caseList', + null, + append, + find, + findIndices, + filter, + mapMaybe, + any, + all, + foldMap, + map, + length, + mconcat, + (<|), + cons, + nil, + singleton, + uncons, + and, + or, + elem, + notElem, + foldr, + foldl, + concat, + concatMap, + listToMaybe, + uniqueElement, + (!!), + revAppend, + reverse, + replicate, + findIndex, + unzip, + zipWith, + head, + last, + tail, + take, + drop, + dropWhile, + splitAt, + elemBy, + nubBy, + nub, + partition, + toBuiltinList, + fromBuiltinList, + toSOP, + fromSOP, ) where import PlutusTx.Builtins qualified as B @@ -75,46 +75,47 @@ import Data.Semigroup qualified as Haskell import PlutusTx.ErrorCodes (indexTooLargeError, lastEmptyListError, negativeIndexError) import Prelude qualified as Haskell --- | A list type backed directly by 'Data'. It is meant to be used whenever fast --- encoding/decoding to/from 'Data' is needed. +{-| A list type backed directly by 'Data'. It is meant to be used whenever fast +encoding/decoding to/from 'Data' is needed. +-} newtype List a = List (BuiltinList BuiltinData) deriving stock (Haskell.Show, Haskell.Eq) instance Eq (List a) where - {-# INLINEABLE (==) #-} - List l == List l' = B.equalsData (BI.mkList l) (BI.mkList l') + {-# INLINEABLE (==) #-} + List l == List l' = B.equalsData (BI.mkList l) (BI.mkList l') instance ToData (List a) where - {-# INLINEABLE toBuiltinData #-} - toBuiltinData (List l) = BI.mkList l + {-# INLINEABLE toBuiltinData #-} + toBuiltinData (List l) = BI.mkList l instance FromData (List a) where - {-# INLINEABLE fromBuiltinData #-} - fromBuiltinData = Just . List . BI.unsafeDataAsList + {-# INLINEABLE fromBuiltinData #-} + fromBuiltinData = Just . List . BI.unsafeDataAsList instance UnsafeFromData (List a) where - {-# INLINEABLE unsafeFromBuiltinData #-} - unsafeFromBuiltinData = List . BI.unsafeDataAsList + {-# INLINEABLE unsafeFromBuiltinData #-} + unsafeFromBuiltinData = List . BI.unsafeDataAsList instance (UnsafeFromData a, Pretty a) => Pretty (List a) where - {-# INLINEABLE pretty #-} - pretty = pretty . toSOP + {-# INLINEABLE pretty #-} + pretty = pretty . toSOP instance Semigroup (List a) where - (<>) = append - {-# INLINEABLE (<>) #-} + (<>) = append + {-# INLINEABLE (<>) #-} instance Monoid (List a) where - mempty = nil - {-# INLINEABLE mempty #-} + mempty = nil + {-# INLINEABLE mempty #-} -instance Haskell.Semigroup (List a) where - (<>) = append - {-# INLINEABLE (<>) #-} +instance Haskell.Semigroup (List a) where + (<>) = append + {-# INLINEABLE (<>) #-} instance Haskell.Monoid (List a) where - mempty = nil - {-# INLINEABLE mempty #-} + mempty = nil + {-# INLINEABLE mempty #-} {- Note [Making the cons case non-strict in caseList and caseList'] @@ -148,8 +149,7 @@ If `r` is an error or expensive computation, consider using `caseList` instead. caseList' :: forall a r . (UnsafeFromData a) - => - r + => r -- ^ Nil case -> (a -> List a -> r) -- ^ Cons case @@ -165,6 +165,7 @@ null = B.null . coerce @_ @(BuiltinList BuiltinData) -- | Prepend an element to the list. infixr 5 <| + (<|) :: (ToData a) => a -> List a -> List a (<|) h = coerce . BI.mkCons (toBuiltinData h) . coerce {-# INLINEABLE (<|) #-} @@ -186,191 +187,203 @@ singleton a = cons a nil append :: List a -> List a -> List a append (List l) (List l') = List (go l) - where - go = - B.caseList' - l' - (\h t -> BI.mkCons h (go t)) + where + go = + B.caseList' + l' + (\h t -> BI.mkCons h (go t)) {-# INLINEABLE append #-} --- | Find the first element that satisfies a predicate. --- Warning: this function can be very inefficient if the list contains elements --- that are expensive to decode from 'BuiltinData'. +{-| Find the first element that satisfies a predicate. +Warning: this function can be very inefficient if the list contains elements +that are expensive to decode from 'BuiltinData'. +-} find :: (UnsafeFromData a) => (a -> Bool) -> List a -> Maybe a find pred' = go - where - go = - caseList' - Nothing - (\h t -> - if pred' h - then Just h - else go t - ) + where + go = + caseList' + Nothing + ( \h t -> + if pred' h + then Just h + else go t + ) {-# INLINEABLE find #-} --- | Find the indices of all elements that satisfy a predicate. --- Warning: this function can be very inefficient if the list contains elements --- that are expensive to decode from 'BuiltinData'. +{-| Find the indices of all elements that satisfy a predicate. +Warning: this function can be very inefficient if the list contains elements +that are expensive to decode from 'BuiltinData'. +-} findIndices :: (UnsafeFromData a) => (a -> Bool) -> List a -> List Integer findIndices pred' = go 0 - where - go i = - caseList' - mempty - (\h t -> - let indices = go (B.addInteger 1 i) t - in if pred' h - then i <| indices - else indices - ) + where + go i = + caseList' + mempty + ( \h t -> + let indices = go (B.addInteger 1 i) t + in if pred' h + then i <| indices + else indices + ) {-# INLINEABLE findIndices #-} --- | Filter a list using a predicate. --- Warning: this function can be very inefficient if the list contains elements --- that are expensive to decode from 'BuiltinData'. +{-| Filter a list using a predicate. +Warning: this function can be very inefficient if the list contains elements +that are expensive to decode from 'BuiltinData'. +-} filter :: (UnsafeFromData a, ToData a) => (a -> Bool) -> List a -> List a filter pred1 = go - where - go = - caseList' - mempty - (\h t -> - if pred1 h then h <| go t else go t - ) + where + go = + caseList' + mempty + ( \h t -> + if pred1 h then h <| go t else go t + ) {-# INLINEABLE filter #-} --- | Map a function over a list and discard the results that are 'Nothing'. --- Warning: this function can be very inefficient if the list contains elements --- that are expensive to decode from 'BuiltinData', or if the result of applying --- 'f' is expensive to encode to 'BuiltinData'. +{-| Map a function over a list and discard the results that are 'Nothing'. +Warning: this function can be very inefficient if the list contains elements +that are expensive to decode from 'BuiltinData', or if the result of applying +'f' is expensive to encode to 'BuiltinData'. +-} mapMaybe :: (UnsafeFromData a, ToData b) => (a -> Maybe b) -> List a -> List b mapMaybe f = go - where - go = - caseList' - mempty - (\h t -> - case f h of - Just b -> b <| go t - Nothing -> go t - ) + where + go = + caseList' + mempty + ( \h t -> + case f h of + Just b -> b <| go t + Nothing -> go t + ) {-# INLINEABLE mapMaybe #-} --- | Check if any element in the list satisfies a predicate. --- Warning: this function can be very inefficient if the list contains elements --- that are expensive to decode from 'BuiltinData'. +{-| Check if any element in the list satisfies a predicate. +Warning: this function can be very inefficient if the list contains elements +that are expensive to decode from 'BuiltinData'. +-} any :: (UnsafeFromData a) => (a -> Bool) -> List a -> Bool any pred1 = go - where - go = - caseList' - False - (\h t -> pred1 h || go t) + where + go = + caseList' + False + (\h t -> pred1 h || go t) {-# INLINEABLE any #-} --- | Check if all elements in the list satisfy a predicate. --- Warning: this function can be very inefficient if the list contains elements --- that are expensive to decode from 'BuiltinData'. +{-| Check if all elements in the list satisfy a predicate. +Warning: this function can be very inefficient if the list contains elements +that are expensive to decode from 'BuiltinData'. +-} all :: (UnsafeFromData a) => (a -> Bool) -> List a -> Bool all pred1 = go - where - go = - caseList' - True - (\h t -> pred1 h && go t) + where + go = + caseList' + True + (\h t -> pred1 h && go t) {-# INLINEABLE all #-} --- | Fold a list using a monoid. --- Warning: this function can be very inefficient if the list contains elements --- that are expensive to decode from 'BuiltinData'. +{-| Fold a list using a monoid. +Warning: this function can be very inefficient if the list contains elements +that are expensive to decode from 'BuiltinData'. +-} foldMap :: (UnsafeFromData a, Monoid m) => (a -> m) -> List a -> m foldMap f = go - where - go = - caseList' - mempty - (\h t -> f h <> go t) + where + go = + caseList' + mempty + (\h t -> f h <> go t) {-# INLINEABLE foldMap #-} --- | Map a function over a list. --- Warning: this function can be very inefficient if the list contains elements --- that are expensive to decode from 'BuiltinData', or if the result of applying --- 'f' is expensive to encode to 'BuiltinData'. +{-| Map a function over a list. +Warning: this function can be very inefficient if the list contains elements +that are expensive to decode from 'BuiltinData', or if the result of applying +'f' is expensive to encode to 'BuiltinData'. +-} map :: (UnsafeFromData a, ToData b) => (a -> b) -> List a -> List b map f = coerce go - where - go = - caseList' - B.mkNil - (\h t -> - BI.mkCons - (toBuiltinData $ f h) - (go t) - ) + where + go = + caseList' + B.mkNil + ( \h t -> + BI.mkCons + (toBuiltinData $ f h) + (go t) + ) {-# INLINEABLE map #-} -- | Get the length of a list. length :: List a -> Integer length (List l) = go l - where - go = BI.caseList' 0 (\_ -> B.addInteger 1 . go) + where + go = BI.caseList' 0 (\_ -> B.addInteger 1 . go) {-# INLINEABLE length #-} --- | Concatenate a list of monoids. --- Warning: this function can be very inefficient if the list contains elements --- that are expensive to decode from 'BuiltinData'. +{-| Concatenate a list of monoids. +Warning: this function can be very inefficient if the list contains elements +that are expensive to decode from 'BuiltinData'. +-} mconcat :: (Monoid a, UnsafeFromData a) => List a -> a mconcat = go - where - go = - caseList' - mempty - (\h t -> h <> go t) -{-# INLINABLE mconcat #-} + where + go = + caseList' + mempty + (\h t -> h <> go t) +{-# INLINEABLE mconcat #-} -- | Get the first element of a list and the rest of the list. uncons :: (UnsafeFromData a) => List a -> Maybe (a, List a) uncons (List l) = do - (h, t) <- B.uncons l - pure (unsafeFromBuiltinData h, List t) + (h, t) <- B.uncons l + pure (unsafeFromBuiltinData h, List t) {-# INLINEABLE uncons #-} --- | Check if all elements in the list are 'True'. --- Warning: this function can be very inefficient if the list contains elements --- that are expensive to decode from 'BuiltinData'. +{-| Check if all elements in the list are 'True'. +Warning: this function can be very inefficient if the list contains elements +that are expensive to decode from 'BuiltinData'. +-} and :: List Bool -> Bool and = go - where - go = - caseList' - True - (\h t -> h && go t) + where + go = + caseList' + True + (\h t -> h && go t) {-# INLINEABLE and #-} --- | Check if any element in the list is 'True'. --- Warning: this function can be very inefficient if the list contains elements --- that are expensive to decode from 'BuiltinData'. +{-| Check if any element in the list is 'True'. +Warning: this function can be very inefficient if the list contains elements +that are expensive to decode from 'BuiltinData'. +-} or :: List Bool -> Bool or = go . coerce - where - go = - caseList' - False - (\h t -> h || go t) + where + go = + caseList' + False + (\h t -> h || go t) {-# INLINEABLE or #-} --- | Check if an element is in the list. --- Note: this function can leverage the better performance of equality checks --- for 'BuiltinData'. +{-| Check if an element is in the list. +Note: this function can leverage the better performance of equality checks +for 'BuiltinData'. +-} elem :: (ToData a) => a -> List a -> Bool elem x = go . coerce - where - go = - let x' = toBuiltinData x - in B.caseList' - False - (\h t -> x' == h || go t) + where + go = + let x' = toBuiltinData x + in B.caseList' + False + (\h t -> x' == h || go t) {-# INLINEABLE elem #-} -- | Check if an element is not in the list. @@ -378,31 +391,33 @@ notElem :: (ToData a) => a -> List a -> Bool notElem x = not . elem x {-# INLINEABLE notElem #-} --- | Fold a list from the right. --- Warning: this function can be very inefficient if the list contains elements --- that are expensive to decode from 'BuiltinData'. +{-| Fold a list from the right. +Warning: this function can be very inefficient if the list contains elements +that are expensive to decode from 'BuiltinData'. +-} foldr :: (UnsafeFromData a) => (a -> b -> b) -> b -> List a -> b foldr f z = go z . coerce - where - go u = - B.caseList' - u - (\h -> f (unsafeFromBuiltinData h) . go u) + where + go u = + B.caseList' + u + (\h -> f (unsafeFromBuiltinData h) . go u) {-# INLINEABLE foldr #-} --- | Fold a list from the left. --- Warning: this function can be very inefficient if the list contains elements --- that are expensive to decode from 'BuiltinData'. +{-| Fold a list from the left. +Warning: this function can be very inefficient if the list contains elements +that are expensive to decode from 'BuiltinData'. +-} foldl :: (UnsafeFromData a) => (b -> a -> b) -> b -> List a -> b foldl f z = go z . coerce - where - go acc = - B.caseList' - acc - (\h t -> - let h' = unsafeFromBuiltinData h - in go (f acc h') t - ) + where + go acc = + B.caseList' + acc + ( \h t -> + let h' = unsafeFromBuiltinData h + in go (f acc h') t + ) {-# INLINEABLE foldl #-} -- | Flatten a list of lists into a single list. @@ -423,42 +438,44 @@ listToMaybe (List l) = unsafeFromBuiltinData <$> B.headMaybe l -- | Get the element of a list if it has exactly one element. uniqueElement :: (UnsafeFromData a) => List a -> Maybe a uniqueElement (List l) = do - (h, t) <- B.uncons l - if B.null t - then Just $ unsafeFromBuiltinData h - else Nothing + (h, t) <- B.uncons l + if B.null t + then Just $ unsafeFromBuiltinData h + else Nothing {-# INLINEABLE uniqueElement #-} --- | Get the element at a given index. --- Warning: this is a partial function and will fail if the index is negative or --- greater than the length of the list. --- Note: this function has the same precedence as (!!) from 'PlutusTx.List'. +{-| Get the element at a given index. +Warning: this is a partial function and will fail if the index is negative or +greater than the length of the list. +Note: this function has the same precedence as (!!) from 'PlutusTx.List'. +-} infixl 9 !! + (!!) :: (UnsafeFromData a) => List a -> Integer -> a (List l) !! n = - if B.lessThanInteger n 0 - then traceError negativeIndexError - else go n l - where - go n' = - B.caseList - (\() -> traceError indexTooLargeError) - (\h t -> - if B.equalsInteger n' 0 - then unsafeFromBuiltinData h - else go (B.subtractInteger n' 1) t - ) -{-# INLINABLE (!!) #-} + if B.lessThanInteger n 0 + then traceError negativeIndexError + else go n l + where + go n' = + B.caseList + (\() -> traceError indexTooLargeError) + ( \h t -> + if B.equalsInteger n' 0 + then unsafeFromBuiltinData h + else go (B.subtractInteger n' 1) t + ) +{-# INLINEABLE (!!) #-} -- | Append two lists in reverse order. revAppend :: List a -> List a -> List a revAppend (List l) (List l') = List $ rev l l' - where - rev l1 l2 = - B.caseList' - l2 - (\h t -> rev t (BI.mkCons h l2)) - l1 + where + rev l1 l2 = + B.caseList' + l2 + (\h t -> rev t (BI.mkCons h l2)) + l1 {-# INLINEABLE revAppend #-} -- | Reverse a list. @@ -467,233 +484,243 @@ reverse l = revAppend l mempty {-# INLINEABLE reverse #-} -- | Replicate a value n times. -replicate :: (ToData a) => Integer -> a -> List a +replicate :: (ToData a) => Integer -> a -> List a replicate n (toBuiltinData -> x) = coerce $ go n - where - go n' = - if B.equalsInteger n' 0 - then B.mkNil - else BI.mkCons x (go (B.subtractInteger n' 1)) + where + go n' = + if B.equalsInteger n' 0 + then B.mkNil + else BI.mkCons x (go (B.subtractInteger n' 1)) {-# INLINEABLE replicate #-} --- | Find the index of the first element that satisfies a predicate. --- Warning: this function can be very inefficient if the list contains elements --- that are expensive to decode from 'BuiltinData'. +{-| Find the index of the first element that satisfies a predicate. +Warning: this function can be very inefficient if the list contains elements +that are expensive to decode from 'BuiltinData'. +-} findIndex :: (UnsafeFromData a) => (a -> Bool) -> List a -> Maybe Integer findIndex pred' = go 0 . coerce - where - go i = - B.caseList' - Nothing - (\h t -> - if pred' (unsafeFromBuiltinData h) then Just i else go (B.addInteger 1 i) t - ) + where + go i = + B.caseList' + Nothing + ( \h t -> + if pred' (unsafeFromBuiltinData h) then Just i else go (B.addInteger 1 i) t + ) {-# INLINEABLE findIndex #-} -- | Split a list of pairs into a pair of lists. -unzip :: forall a b . List (a, b) -> (List a, List b) +unzip :: forall a b. List (a, b) -> (List a, List b) unzip = - coerce go - where - go :: BuiltinList BuiltinData -> (BuiltinList BuiltinData, BuiltinList BuiltinData) - go = - B.caseList' - (B.mkNil, B.mkNil) - (\h t -> - let (a, b) = unsafeFromBuiltinData h - (as, bs) = go t - in (a `BI.mkCons` as, b `BI.mkCons` bs) - ) + coerce go + where + go :: BuiltinList BuiltinData -> (BuiltinList BuiltinData, BuiltinList BuiltinData) + go = + B.caseList' + (B.mkNil, B.mkNil) + ( \h t -> + let (a, b) = unsafeFromBuiltinData h + (as, bs) = go t + in (a `BI.mkCons` as, b `BI.mkCons` bs) + ) {-# INLINEABLE unzip #-} --- | Zip two lists together using a function. --- Warning: this function can be very inefficient if the lists contain elements --- that are expensive to decode from 'BuiltinData', or if the result of applying --- 'f' is expensive to encode to 'BuiltinData'. +{-| Zip two lists together using a function. +Warning: this function can be very inefficient if the lists contain elements +that are expensive to decode from 'BuiltinData', or if the result of applying +'f' is expensive to encode to 'BuiltinData'. +-} zipWith - :: (UnsafeFromData a, UnsafeFromData b, ToData c) - => (a -> b -> c) -> List a -> List b -> List c + :: (UnsafeFromData a, UnsafeFromData b, ToData c) + => (a -> b -> c) -> List a -> List b -> List c zipWith f = coerce go - where - go :: BuiltinList BuiltinData -> BuiltinList BuiltinData -> BuiltinList BuiltinData - go l1' l2' = - B.caseList' + where + go :: BuiltinList BuiltinData -> BuiltinList BuiltinData -> BuiltinList BuiltinData + go l1' l2' = + B.caseList' + B.mkNil + ( \h1 t1 -> + B.caseList' B.mkNil - (\h1 t1 -> - B.caseList' - B.mkNil - (\h2 t2 -> - BI.mkCons - (toBuiltinData - $ f - (unsafeFromBuiltinData h1) - (unsafeFromBuiltinData h2) - ) - (go t1 t2) - ) - l2' + ( \h2 t2 -> + BI.mkCons + ( toBuiltinData + $ f + (unsafeFromBuiltinData h1) + (unsafeFromBuiltinData h2) + ) + (go t1 t2) ) - l1' + l2' + ) + l1' {-# INLINEABLE zipWith #-} --- | Return the head of a list. --- Warning: this is a partial function and will fail if the list is empty. -head :: forall a . (UnsafeFromData a) => List a -> a +{-| Return the head of a list. +Warning: this is a partial function and will fail if the list is empty. +-} +head :: forall a. (UnsafeFromData a) => List a -> a head = - coerce - @(BuiltinList BuiltinData -> a) - @(List a -> a) - (unsafeFromBuiltinData . B.head) + coerce + @(BuiltinList BuiltinData -> a) + @(List a -> a) + (unsafeFromBuiltinData . B.head) {-# INLINEABLE head #-} --- | Return the last element of a list. --- Warning: this is a partial function and will fail if the list is empty. -last :: forall a . (UnsafeFromData a) => List a -> a +{-| Return the last element of a list. +Warning: this is a partial function and will fail if the list is empty. +-} +last :: forall a. (UnsafeFromData a) => List a -> a last = - coerce - @(BuiltinList BuiltinData -> a) - @(List a -> a) - (unsafeFromBuiltinData . go) - where - go :: BuiltinList BuiltinData -> BuiltinData - go = - B.caseList - (\() -> traceError lastEmptyListError) - (\h t -> - if B.null t - then h - else go t - ) + coerce + @(BuiltinList BuiltinData -> a) + @(List a -> a) + (unsafeFromBuiltinData . go) + where + go :: BuiltinList BuiltinData -> BuiltinData + go = + B.caseList + (\() -> traceError lastEmptyListError) + ( \h t -> + if B.null t + then h + else go t + ) {-# INLINEABLE last #-} --- | Return the tail of a list. --- Warning: this is a partial function and will fail if the list is empty. -tail :: forall a . List a -> List a +{-| Return the tail of a list. +Warning: this is a partial function and will fail if the list is empty. +-} +tail :: forall a. List a -> List a tail = coerce @(BuiltinList BuiltinData) @(List a) . B.tail . coerce {-# INLINEABLE tail #-} -- | Take the first n elements from the list. -take :: forall a . Integer -> List a -> List a +take :: forall a. Integer -> List a -> List a take n = coerce $ go n - where - go :: Integer -> BuiltinList BuiltinData -> BuiltinList BuiltinData - go n' = - B.caseList' - B.mkNil - (\h t -> - if B.equalsInteger n' 0 - then B.mkNil - else BI.mkCons h (go (B.subtractInteger n' 1) t) - ) + where + go :: Integer -> BuiltinList BuiltinData -> BuiltinList BuiltinData + go n' = + B.caseList' + B.mkNil + ( \h t -> + if B.equalsInteger n' 0 + then B.mkNil + else BI.mkCons h (go (B.subtractInteger n' 1) t) + ) {-# INLINEABLE take #-} -- | Drop the first n elements from the list. -drop :: forall a . Integer -> List a -> List a +drop :: forall a. Integer -> List a -> List a drop n = coerce $ go n - where - go :: Integer -> BuiltinList BuiltinData -> BuiltinList BuiltinData - go n' xs = - if n' <= 0 - then xs - else - B.caseList' - B.mkNil - (\_ -> go (B.subtractInteger n' 1)) - xs + where + go :: Integer -> BuiltinList BuiltinData -> BuiltinList BuiltinData + go n' xs = + if n' <= 0 + then xs + else + B.caseList' + B.mkNil + (\_ -> go (B.subtractInteger n' 1)) + xs {-# INLINEABLE drop #-} --- | Drop elements from the list while the predicate holds. --- Warning: this function can be very inefficient if the list contains elements --- that are expensive to decode from 'BuiltinData'. -dropWhile :: forall a . (UnsafeFromData a) => (a -> Bool) -> List a -> List a +{-| Drop elements from the list while the predicate holds. +Warning: this function can be very inefficient if the list contains elements +that are expensive to decode from 'BuiltinData'. +-} +dropWhile :: forall a. (UnsafeFromData a) => (a -> Bool) -> List a -> List a dropWhile pred1 = - coerce @_ @(List a -> List a) $ go - where - go :: BuiltinList BuiltinData -> BuiltinList BuiltinData - go xs = - B.caseList' - B.mkNil - (\h t -> - if pred1 (unsafeFromBuiltinData h) then go t else xs - ) - xs + coerce @_ @(List a -> List a) $ go + where + go :: BuiltinList BuiltinData -> BuiltinList BuiltinData + go xs = + B.caseList' + B.mkNil + ( \h t -> + if pred1 (unsafeFromBuiltinData h) then go t else xs + ) + xs {-# INLINEABLE dropWhile #-} -- | Split a list at a given index. -splitAt :: forall a . Integer -> List a -> (List a, List a) +splitAt :: forall a. Integer -> List a -> (List a, List a) splitAt n l = - coerce $ go n (coerce @_ @(BuiltinList BuiltinData) l) - where - go n' xs = - if n' <= 0 - then (B.mkNil, xs) - else - B.caseList' - (B.mkNil, B.mkNil) - (\h t -> - if B.equalsInteger n' 0 - then (B.mkNil, coerce @_ @(BuiltinList BuiltinData) l) - else - let (l1, l2) = go (B.subtractInteger n' 1) t - in (BI.mkCons h l1, l2) - ) - xs + coerce $ go n (coerce @_ @(BuiltinList BuiltinData) l) + where + go n' xs = + if n' <= 0 + then (B.mkNil, xs) + else + B.caseList' + (B.mkNil, B.mkNil) + ( \h t -> + if B.equalsInteger n' 0 + then (B.mkNil, coerce @_ @(BuiltinList BuiltinData) l) + else + let (l1, l2) = go (B.subtractInteger n' 1) t + in (BI.mkCons h l1, l2) + ) + xs {-# INLINEABLE splitAt #-} --- | Check if an element satisfying a binary predicate is in the list. --- Warning: this function can be very inefficient if the list contains elements --- that are expensive to decode from 'BuiltinData'. +{-| Check if an element satisfying a binary predicate is in the list. +Warning: this function can be very inefficient if the list contains elements +that are expensive to decode from 'BuiltinData'. +-} elemBy :: (UnsafeFromData a) => (a -> a -> Bool) -> a -> List a -> Bool elemBy pred2 x = go . coerce - where - go = - B.caseList' - False - (\h t -> pred2 (unsafeFromBuiltinData h) x || go t) + where + go = + B.caseList' + False + (\h t -> pred2 (unsafeFromBuiltinData h) x || go t) {-# INLINEABLE elemBy #-} --- | Removes elements from the list that satisfy a binary predicate. --- Warning: this function can be very inefficient if the list contains elements --- that are expensive to decode from 'BuiltinData'. -nubBy :: forall a . (UnsafeFromData a) => (a -> a -> Bool) -> List a -> List a +{-| Removes elements from the list that satisfy a binary predicate. +Warning: this function can be very inefficient if the list contains elements +that are expensive to decode from 'BuiltinData'. +-} +nubBy :: forall a. (UnsafeFromData a) => (a -> a -> Bool) -> List a -> List a nubBy pred2 l = - coerce @_ @(List a) $ go (coerce @_ @(BuiltinList BuiltinData) l) B.mkNil - where - go ys xs = - B.caseList' - B.mkNil - (\h t -> - if elemBy pred2 (unsafeFromBuiltinData h) (coerce xs) - then go t xs - else BI.mkCons h (go t (BI.mkCons h xs)) - ) - ys + coerce @_ @(List a) $ go (coerce @_ @(BuiltinList BuiltinData) l) B.mkNil + where + go ys xs = + B.caseList' + B.mkNil + ( \h t -> + if elemBy pred2 (unsafeFromBuiltinData h) (coerce xs) + then go t xs + else BI.mkCons h (go t (BI.mkCons h xs)) + ) + ys {-# INLINEABLE nubBy #-} --- | Removes duplicate elements from the list. --- Warning: this function can be very inefficient if the list contains elements --- that are expensive to decode from 'BuiltinData'. +{-| Removes duplicate elements from the list. +Warning: this function can be very inefficient if the list contains elements +that are expensive to decode from 'BuiltinData'. +-} nub :: (Eq a, UnsafeFromData a) => List a -> List a nub = nubBy (==) {-# INLINEABLE nub #-} --- | Partition a list into two lists based on a predicate. --- Warning: this function can be very inefficient if the list contains elements --- that are expensive to decode from 'BuiltinData'. +{-| Partition a list into two lists based on a predicate. +Warning: this function can be very inefficient if the list contains elements +that are expensive to decode from 'BuiltinData'. +-} partition :: (UnsafeFromData a) => (a -> Bool) -> List a -> (List a, List a) partition pred1 l = - coerce $ go (coerce l) - where - go = - B.caseList' - (B.mkNil, B.mkNil) - (\h t -> - let h' = unsafeFromBuiltinData h - (l1, l2) = go t - in if pred1 h' - then (h `BI.mkCons` l1, l2) - else (l1, h `BI.mkCons` l2) - ) + coerce $ go (coerce l) + where + go = + B.caseList' + (B.mkNil, B.mkNil) + ( \h t -> + let h' = unsafeFromBuiltinData h + (l1, l2) = go t + in if pred1 h' + then (h `BI.mkCons` l1, l2) + else (l1, h `BI.mkCons` l2) + ) {-# INLINEABLE partition #-} toBuiltinList :: List a -> BuiltinList BuiltinData @@ -704,19 +731,21 @@ fromBuiltinList :: BuiltinList BuiltinData -> List a fromBuiltinList = coerce {-# INLINEABLE fromBuiltinList #-} --- | Convert a data-backed list to a sums of products list. --- Warning: this function can be very inefficient if the list contains elements --- that are expensive to decode from 'BuiltinData'. +{-| Convert a data-backed list to a sums of products list. +Warning: this function can be very inefficient if the list contains elements +that are expensive to decode from 'BuiltinData'. +-} toSOP :: forall a. (UnsafeFromData a) => List a -> [a] toSOP = coerce go - where - go :: BuiltinList BuiltinData -> [a] - go = B.caseList' [] (\h t -> unsafeFromBuiltinData h : go t) + where + go :: BuiltinList BuiltinData -> [a] + go = B.caseList' [] (\h t -> unsafeFromBuiltinData h : go t) {-# INLINEABLE toSOP #-} --- | Convert a sums of products list to a data-backed list. --- Warning: this function can be very inefficient if the list contains elements --- that are expensive to encode to 'BuiltinData'. +{-| Convert a sums of products list to a data-backed list. +Warning: this function can be very inefficient if the list contains elements +that are expensive to encode to 'BuiltinData'. +-} fromSOP :: forall a. (ToData a) => [a] -> List a fromSOP = coerce . BI.unsafeDataAsList . B.mkList . fmap toBuiltinData {-# INLINEABLE fromSOP #-} diff --git a/plutus-tx/src/PlutusTx/Data/List/TH.hs b/plutus-tx/src/PlutusTx/Data/List/TH.hs index 89bd1d295ff..0d684ff8239 100644 --- a/plutus-tx/src/PlutusTx/Data/List/TH.hs +++ b/plutus-tx/src/PlutusTx/Data/List/TH.hs @@ -11,22 +11,23 @@ import Language.Haskell.TH qualified as TH import PlutusTx.Data.List qualified as List import Prelude --- | Generate variables bound to the given indices of a @BuiltinList@. --- --- Sample Usage: --- --- @ --- f :: List Integer -> Integer --- f list = --- $( destructList --- "s" --- (Set.fromList [1, 4, 5]) --- 'list --- [|s1 + s4 + s5|] --- ) --- @ --- --- This computes the sum of list elements at indices 1, 4 and 5. +{-| Generate variables bound to the given indices of a @BuiltinList@. + +Sample Usage: + + @ + f :: List Integer -> Integer + f list = + $( destructList + "s" + (Set.fromList [1, 4, 5]) + 'list + [|s1 + s4 + s5|] + ) + @ + +This computes the sum of list elements at indices 1, 4 and 5. +-} destructList :: String -- ^ Prefix of the generated bindings @@ -43,9 +44,10 @@ destructList p is n k = do elemName i = TH.mkName $ p ++ show i tailNames <- for [0 .. maximum is] $ \i -> TH.newName ("tail" ++ show i) decs <- fmap (concat . concat) . for [0 .. maximum is] $ \i -> do - let -- if tailx is only used once, make it non-strict so that it can be inlined - tailStrictness = if Set.member (i + 1) is then strict else nonstrict - n' = if i == 0 then n else tailNames !! (i - 1) + let + -- if tailx is only used once, make it non-strict so that it can be inlined + tailStrictness = if Set.member (i + 1) is then strict else nonstrict + n' = if i == 0 then n else tailNames !! (i - 1) sequence $ [ [d|$(strict (elemName i)) = List.head $(TH.varE n')|] | Set.member i is diff --git a/plutus-tx/src/PlutusTx/Either.hs b/plutus-tx/src/PlutusTx/Either.hs index dd0efb17cae..18b84661e96 100644 --- a/plutus-tx/src/PlutusTx/Either.hs +++ b/plutus-tx/src/PlutusTx/Either.hs @@ -1,5 +1,6 @@ {-# OPTIONS_GHC -fno-omit-interface-pragmas #-} -module PlutusTx.Either (Either(..), isLeft, isRight, either) where + +module PlutusTx.Either (Either (..), isLeft, isRight, either) where {- We export off-chain Haskell's Either type as on-chain Plutus's Either type since they are the same. @@ -8,23 +9,22 @@ We export off-chain Haskell's Either type as on-chain Plutus's Either type since import PlutusTx.Bool (Bool (..)) import Prelude (Either (..)) - {- HLINT ignore -} -- | Return `True` if the given value is a `Left`-value, `False` otherwise. isLeft :: Either a b -> Bool isLeft (Left _) = True isLeft (Right _) = False -{-# INLINABLE isLeft #-} +{-# INLINEABLE isLeft #-} -- | Return `True` if the given value is a `Right`-value, `False` otherwise. isRight :: Either a b -> Bool isRight (Left _) = False isRight (Right _) = True -{-# INLINABLE isRight #-} +{-# INLINEABLE isRight #-} -- | Plutus Tx version of 'Prelude.either' either :: (a -> c) -> (b -> c) -> Either a b -> c either f _ (Left x) = f x either _ g (Right y) = g y -{-# INLINABLE either #-} +{-# INLINEABLE either #-} diff --git a/plutus-tx/src/PlutusTx/Enum.hs b/plutus-tx/src/PlutusTx/Enum.hs index f51f4392fbb..e12442cee97 100644 --- a/plutus-tx/src/PlutusTx/Enum.hs +++ b/plutus-tx/src/PlutusTx/Enum.hs @@ -1,6 +1,7 @@ {-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_GHC -fno-omit-interface-pragmas #-} -module PlutusTx.Enum (Enum(..)) where + +module PlutusTx.Enum (Enum (..)) where import PlutusTx.Bool (Bool (..), otherwise) import PlutusTx.Builtins @@ -12,130 +13,141 @@ import PlutusTx.Trace -- | Class 'Enum' defines operations on sequentially ordered types. class Enum a where - -- | The successor of a value. For numeric types, 'succ' adds 1. - -- - -- For types that implement 'Ord', @succ x@ should be the least element - -- that is greater than @x@, and 'error' if there is none. + {-| The successor of a value. For numeric types, 'succ' adds 1. + + For types that implement 'Ord', @succ x@ should be the least element + that is greater than @x@, and 'error' if there is none. + -} succ :: a -> a - -- | The predecessor of a value. For numeric types, 'pred' subtracts 1. - -- - -- For types that implement 'Ord', @pred x@ should be the greatest element - -- that is less than @x@, and 'error' if there is none. + + {-| The predecessor of a value. For numeric types, 'pred' subtracts 1. + + For types that implement 'Ord', @pred x@ should be the greatest element + that is less than @x@, and 'error' if there is none. + -} pred :: a -> a + -- | Convert from an 'Integer'. toEnum :: Integer -> a + -- | Convert to an 'Integer'. fromEnum :: a -> Integer + -- | Construct a list from the given range (corresponds to [a..b]). enumFromTo :: a -> a -> [a] - -- | Construct a list from the given range (corresponds to [a,b..c]). This - -- has the same semantics as the Haskell version,so if a==b and c>=b then you - -- get an infinite list, which you probably don't want in Plutus Core. + + {-| Construct a list from the given range (corresponds to [a,b..c]). This + has the same semantics as the Haskell version,so if a==b and c>=b then you + get an infinite list, which you probably don't want in Plutus Core. + -} enumFromThenTo :: a -> a -> a -> [a] instance Enum Integer where - {-# INLINABLE succ #-} + {-# INLINEABLE succ #-} succ x = addInteger x 1 - {-# INLINABLE pred #-} + {-# INLINEABLE pred #-} pred x = subtractInteger x 1 - {-# INLINABLE toEnum #-} + {-# INLINEABLE toEnum #-} toEnum x = x - {-# INLINABLE fromEnum #-} + {-# INLINEABLE fromEnum #-} fromEnum x = x - {-# INLINABLE enumFromTo #-} + {-# INLINEABLE enumFromTo #-} enumFromTo x lim | x > lim = [] | otherwise = x : enumFromTo (succ x) lim - {-# INLINABLE enumFromThenTo #-} + {-# INLINEABLE enumFromThenTo #-} enumFromThenTo x y lim = - if delta >= 0 + if delta >= 0 then up_list x else dn_list x - where delta = subtractInteger y x - up_list x1 = - if x1 > lim - then [] - else x1 : up_list (addInteger x1 delta) - dn_list x1 = - if x1 < lim - then [] - else x1 : dn_list (addInteger x1 delta) + where + delta = subtractInteger y x + up_list x1 = + if x1 > lim + then [] + else x1 : up_list (addInteger x1 delta) + dn_list x1 = + if x1 < lim + then [] + else x1 : dn_list (addInteger x1 delta) instance Enum () where - {-# INLINABLE succ #-} + {-# INLINEABLE succ #-} succ _ = traceError succVoidBadArgumentError - {-# INLINABLE pred #-} + {-# INLINEABLE pred #-} pred _ = traceError predVoidBadArgumentError - {-# INLINABLE toEnum #-} - toEnum x | x == 0 = () - | otherwise = traceError toEnumVoidBadArgumentError + {-# INLINEABLE toEnum #-} + toEnum x + | x == 0 = () + | otherwise = traceError toEnumVoidBadArgumentError - {-# INLINABLE fromEnum #-} + {-# INLINEABLE fromEnum #-} fromEnum () = 0 - {-# INLINABLE enumFromTo #-} + {-# INLINEABLE enumFromTo #-} enumFromTo _ _ = [()] - {-# INLINABLE enumFromThenTo #-} + {-# INLINEABLE enumFromThenTo #-} -- enumFromThenTo () () () is an infinite list of ()'s, so this isn't too useful. enumFromThenTo x y lim = map toEnum (enumFromThenTo (fromEnum x) (fromEnum y) (fromEnum lim)) instance Enum Bool where - {-# INLINABLE succ #-} + {-# INLINEABLE succ #-} succ False = True succ True = traceError succBoolBadArgumentError - {-# INLINABLE pred #-} + {-# INLINEABLE pred #-} pred True = False pred False = traceError predBoolBadArgumentError - {-# INLINABLE toEnum #-} - toEnum n | n == 0 = False - | n == 1 = True - | otherwise = traceError toEnumBoolBadArgumentError + {-# INLINEABLE toEnum #-} + toEnum n + | n == 0 = False + | n == 1 = True + | otherwise = traceError toEnumBoolBadArgumentError - {-# INLINABLE fromEnum #-} + {-# INLINEABLE fromEnum #-} fromEnum False = 0 fromEnum True = 1 - {-# INLINABLE enumFromTo #-} + {-# INLINEABLE enumFromTo #-} enumFromTo x lim = map toEnum (enumFromTo (fromEnum x) (fromEnum lim)) - {-# INLINABLE enumFromThenTo #-} + {-# INLINEABLE enumFromThenTo #-} enumFromThenTo x y lim = map toEnum (enumFromThenTo (fromEnum x) (fromEnum y) (fromEnum lim)) instance Enum Ordering where - {-# INLINABLE succ #-} + {-# INLINEABLE succ #-} succ LT = EQ succ EQ = GT succ GT = traceError succOrderingBadArgumentError - {-# INLINABLE pred #-} + {-# INLINEABLE pred #-} pred GT = EQ pred EQ = LT pred LT = traceError predOrderingBadArgumentError - {-# INLINABLE toEnum #-} - toEnum n | n == 0 = LT - | n == 1 = EQ - | n == 2 = GT + {-# INLINEABLE toEnum #-} + toEnum n + | n == 0 = LT + | n == 1 = EQ + | n == 2 = GT toEnum _ = traceError toEnumOrderingBadArgumentError - {-# INLINABLE fromEnum #-} + {-# INLINEABLE fromEnum #-} fromEnum LT = 0 fromEnum EQ = 1 fromEnum GT = 2 - {-# INLINABLE enumFromTo #-} + {-# INLINEABLE enumFromTo #-} enumFromTo x y = map toEnum (enumFromTo (fromEnum x) (fromEnum y)) - {-# INLINABLE enumFromThenTo #-} + {-# INLINEABLE enumFromThenTo #-} enumFromThenTo x y lim = map toEnum (enumFromThenTo (fromEnum x) (fromEnum y) (fromEnum lim)) - diff --git a/plutus-tx/src/PlutusTx/Eq.hs b/plutus-tx/src/PlutusTx/Eq.hs index 67ea8b716ca..6f34ebef1d8 100644 --- a/plutus-tx/src/PlutusTx/Eq.hs +++ b/plutus-tx/src/PlutusTx/Eq.hs @@ -1,5 +1,6 @@ {-# OPTIONS_GHC -fno-omit-interface-pragmas #-} -module PlutusTx.Eq (Eq(..), (/=)) where + +module PlutusTx.Eq (Eq (..), (/=)) where import PlutusTx.Bool import PlutusTx.Builtins qualified as Builtins @@ -12,76 +13,77 @@ import Prelude (Maybe (..)) infix 4 ==, /= -- Copied from the GHC definition + -- | The 'Eq' class defines equality ('=='). class Eq a where - (==) :: a -> a -> Bool + (==) :: a -> a -> Bool - -- (/=) deliberately omitted, to make this a one-method class which has a - -- simpler representation +-- (/=) deliberately omitted, to make this a one-method class which has a +-- simpler representation -(/=) :: Eq a => a -> a -> Bool +(/=) :: (Eq a) => a -> a -> Bool x /= y = not (x == y) -{-# INLINABLE (/=) #-} +{-# INLINEABLE (/=) #-} instance Eq Builtins.Integer where - {-# INLINABLE (==) #-} - (==) = Builtins.equalsInteger + {-# INLINEABLE (==) #-} + (==) = Builtins.equalsInteger instance Eq Builtins.BuiltinByteString where - {-# INLINABLE (==) #-} - (==) = Builtins.equalsByteString + {-# INLINEABLE (==) #-} + (==) = Builtins.equalsByteString instance Eq Builtins.BuiltinData where - {-# INLINABLE (==) #-} - (==) = Builtins.equalsData + {-# INLINEABLE (==) #-} + (==) = Builtins.equalsData instance Eq Builtins.BuiltinString where - {-# INLINABLE (==) #-} - (==) = Builtins.equalsString + {-# INLINEABLE (==) #-} + (==) = Builtins.equalsString instance Eq Builtins.BuiltinBLS12_381_G1_Element where - {-# INLINABLE (==) #-} - (==) = Builtins.bls12_381_G1_equals + {-# INLINEABLE (==) #-} + (==) = Builtins.bls12_381_G1_equals instance Eq Builtins.BuiltinBLS12_381_G2_Element where - {-# INLINABLE (==) #-} - (==) = Builtins.bls12_381_G2_equals + {-# INLINEABLE (==) #-} + (==) = Builtins.bls12_381_G2_equals -instance Eq a => Eq [a] where - {-# INLINABLE (==) #-} - [] == [] = True - (x:xs) == (y:ys) = x == y && xs == ys - _ == _ = False +instance (Eq a) => Eq [a] where + {-# INLINEABLE (==) #-} + [] == [] = True + (x : xs) == (y : ys) = x == y && xs == ys + _ == _ = False instance Eq Bool where - {-# INLINABLE (==) #-} - True == True = True - False == False = True - _ == _ = False + {-# INLINEABLE (==) #-} + True == True = True + False == False = True + _ == _ = False -instance Eq a => Eq (Maybe a) where - {-# INLINABLE (==) #-} - (Just a1) == (Just a2) = a1 == a2 - Nothing == Nothing = True - _ == _ = False +instance (Eq a) => Eq (Maybe a) where + {-# INLINEABLE (==) #-} + (Just a1) == (Just a2) = a1 == a2 + Nothing == Nothing = True + _ == _ = False instance (Eq a, Eq b) => Eq (Either a b) where - {-# INLINABLE (==) #-} - (Left a1) == (Left a2) = a1 == a2 - (Right b1) == (Right b2) = b1 == b2 - _ == _ = False + {-# INLINEABLE (==) #-} + (Left a1) == (Left a2) = a1 == a2 + (Right b1) == (Right b2) = b1 == b2 + _ == _ = False instance Eq () where - {-# INLINABLE (==) #-} - _ == _ = True + {-# INLINEABLE (==) #-} + _ == _ = True instance (Eq a, Eq b) => Eq (a, b) where - {-# INLINABLE (==) #-} - (a, b) == (a', b') = a == a' && b == b' + {-# INLINEABLE (==) #-} + (a, b) == (a', b') = a == a' && b == b' instance (Eq a, Eq b) => Eq (These a b) where - {-# INLINABLE (==) #-} - (This a) == (This a') = a == a' - (That b) == (That b') = b == b' - (These a b) == (These a' b') = a == a' && b == b' - _ == _ = False + {-# INLINEABLE (==) #-} + (This a) == (This a') = a == a' + (That b) == (That b') = b == b' + (These a b) == (These a' b') = a == a' && b == b' + _ == _ = False diff --git a/plutus-tx/src/PlutusTx/ErrorCodes.hs b/plutus-tx/src/PlutusTx/ErrorCodes.hs index 35cd087295f..daec646fc6c 100644 --- a/plutus-tx/src/PlutusTx/ErrorCodes.hs +++ b/plutus-tx/src/PlutusTx/ErrorCodes.hs @@ -1,5 +1,6 @@ {-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_GHC -fno-omit-interface-pragmas #-} + module PlutusTx.ErrorCodes where import Data.Map (Map) @@ -35,131 +36,132 @@ When writing a new error description please follow existing patterns: -- | All error codes used in the plutus prelude associated with a human-readable description. plutusPreludeErrorCodes :: Map Builtins.BuiltinString String -plutusPreludeErrorCodes = Map.fromList - [ ("PT1", "TH Generation of Indexed Data Error") - , ("PT2", "PlutusTx.IsData.Class.unsafeFromBuiltinData: Void is not supported") - , ("PT3", "PlutusTx.Ratio: zero denominator") - , ("PT5", "PlutusTx.Prelude.check: input is 'False'") - , ("PT6", "PlutusTx.List.!!: negative index") - , ("PT7", "PlutusTx.List.!!: index too large") - , ("PT8", "PlutusTx.List.head: empty list") - , ("PT9", "PlutusTx.List.tail: empty list") - , ("PT10", "PlutusTx.Enum.().succ: bad argument") - , ("PT11", "PlutusTx.Enum.().pred: bad argument") - , ("PT12", "PlutusTx.Enum.().toEnum: bad argument") - , ("PT13", "PlutusTx.Enum.Bool.succ: bad argument") - , ("PT14", "PlutusTx.Enum.Bool.pred: bad argument") - , ("PT15", "PlutusTx.Enum.Bool.toEnum: bad argument") - , ("PT16", "PlutusTx.Enum.Ordering.succ: bad argument") - , ("PT17", "PlutusTx.Enum.Ordering.pred: bad argument") - , ("PT18", "PlutusTx.Enum.Ordering.toEnum: bad argument") - , ("PT19", "PlutusTx.List.last: empty list") - , ("PT20", "PlutusTx.Ratio.recip: reciprocal of zero") - , ("PT21", "PlutusTx.List.indexBuiltinList: negative index") - , ("PT22", "PlutusTx.List.indexBuiltinList: index too large") - ] +plutusPreludeErrorCodes = + Map.fromList + [ ("PT1", "TH Generation of Indexed Data Error") + , ("PT2", "PlutusTx.IsData.Class.unsafeFromBuiltinData: Void is not supported") + , ("PT3", "PlutusTx.Ratio: zero denominator") + , ("PT5", "PlutusTx.Prelude.check: input is 'False'") + , ("PT6", "PlutusTx.List.!!: negative index") + , ("PT7", "PlutusTx.List.!!: index too large") + , ("PT8", "PlutusTx.List.head: empty list") + , ("PT9", "PlutusTx.List.tail: empty list") + , ("PT10", "PlutusTx.Enum.().succ: bad argument") + , ("PT11", "PlutusTx.Enum.().pred: bad argument") + , ("PT12", "PlutusTx.Enum.().toEnum: bad argument") + , ("PT13", "PlutusTx.Enum.Bool.succ: bad argument") + , ("PT14", "PlutusTx.Enum.Bool.pred: bad argument") + , ("PT15", "PlutusTx.Enum.Bool.toEnum: bad argument") + , ("PT16", "PlutusTx.Enum.Ordering.succ: bad argument") + , ("PT17", "PlutusTx.Enum.Ordering.pred: bad argument") + , ("PT18", "PlutusTx.Enum.Ordering.toEnum: bad argument") + , ("PT19", "PlutusTx.List.last: empty list") + , ("PT20", "PlutusTx.Ratio.recip: reciprocal of zero") + , ("PT21", "PlutusTx.List.indexBuiltinList: negative index") + , ("PT22", "PlutusTx.List.indexBuiltinList: index too large") + ] -- | The error happens in TH generation of indexed data reconstructCaseError :: Builtins.BuiltinString reconstructCaseError = "PT1" -{-# INLINABLE reconstructCaseError #-} +{-# INLINEABLE reconstructCaseError #-} -- | Error case of 'unsafeFromBuiltinData' voidIsNotSupportedError :: Builtins.BuiltinString voidIsNotSupportedError = "PT2" -{-# INLINABLE voidIsNotSupportedError #-} +{-# INLINEABLE voidIsNotSupportedError #-} -- | Ratio number can't have a zero denominator ratioHasZeroDenominatorError :: Builtins.BuiltinString ratioHasZeroDenominatorError = "PT3" -{-# INLINABLE ratioHasZeroDenominatorError #-} +{-# INLINEABLE ratioHasZeroDenominatorError #-} -- | 'check' input is 'False' checkHasFailedError :: Builtins.BuiltinString checkHasFailedError = "PT5" -{-# INLINABLE checkHasFailedError #-} +{-# INLINEABLE checkHasFailedError #-} -- | PlutusTx.List.!!: negative index negativeIndexError :: Builtins.BuiltinString negativeIndexError = "PT6" -{-# INLINABLE negativeIndexError #-} +{-# INLINEABLE negativeIndexError #-} -- | PlutusTx.List.!!: index too large indexTooLargeError :: Builtins.BuiltinString indexTooLargeError = "PT7" -{-# INLINABLE indexTooLargeError #-} +{-# INLINEABLE indexTooLargeError #-} -- | PlutusTx.List.head: empty list headEmptyListError :: Builtins.BuiltinString headEmptyListError = "PT8" -{-# INLINABLE headEmptyListError #-} +{-# INLINEABLE headEmptyListError #-} -- | PlutusTx.List.tail: empty list tailEmptyListError :: Builtins.BuiltinString tailEmptyListError = "PT9" -{-# INLINABLE tailEmptyListError #-} +{-# INLINEABLE tailEmptyListError #-} -- | PlutusTx.Enum.().succ: bad argument succVoidBadArgumentError :: Builtins.BuiltinString succVoidBadArgumentError = "PT10" -{-# INLINABLE succVoidBadArgumentError #-} +{-# INLINEABLE succVoidBadArgumentError #-} -- | PlutusTx.Enum.().pred: bad argument predVoidBadArgumentError :: Builtins.BuiltinString predVoidBadArgumentError = "PT11" -{-# INLINABLE predVoidBadArgumentError #-} +{-# INLINEABLE predVoidBadArgumentError #-} -- | PlutusTx.Enum.().toEnum: bad argument toEnumVoidBadArgumentError :: Builtins.BuiltinString toEnumVoidBadArgumentError = "PT12" -{-# INLINABLE toEnumVoidBadArgumentError #-} +{-# INLINEABLE toEnumVoidBadArgumentError #-} -- | PlutusTx.Enum.Bool.succ: bad argument succBoolBadArgumentError :: Builtins.BuiltinString succBoolBadArgumentError = "PT13" -{-# INLINABLE succBoolBadArgumentError #-} +{-# INLINEABLE succBoolBadArgumentError #-} -- | PlutusTx.Enum.Bool.pred: bad argument predBoolBadArgumentError :: Builtins.BuiltinString predBoolBadArgumentError = "PT14" -{-# INLINABLE predBoolBadArgumentError #-} +{-# INLINEABLE predBoolBadArgumentError #-} -- | PlutusTx.Enum.Bool.toEnum: bad argument toEnumBoolBadArgumentError :: Builtins.BuiltinString toEnumBoolBadArgumentError = "PT15" -{-# INLINABLE toEnumBoolBadArgumentError #-} +{-# INLINEABLE toEnumBoolBadArgumentError #-} -- | PlutusTx.Enum.Ordering.succ: bad argument succOrderingBadArgumentError :: Builtins.BuiltinString succOrderingBadArgumentError = "PT16" -{-# INLINABLE succOrderingBadArgumentError #-} +{-# INLINEABLE succOrderingBadArgumentError #-} -- | PlutusTx.Enum.Ordering.pred: bad argument predOrderingBadArgumentError :: Builtins.BuiltinString predOrderingBadArgumentError = "PT17" -{-# INLINABLE predOrderingBadArgumentError #-} +{-# INLINEABLE predOrderingBadArgumentError #-} -- | PlutusTx.Enum.Ordering.toEnum: bad argument toEnumOrderingBadArgumentError :: Builtins.BuiltinString toEnumOrderingBadArgumentError = "PT18" -{-# INLINABLE toEnumOrderingBadArgumentError #-} +{-# INLINEABLE toEnumOrderingBadArgumentError #-} -- | PlutusTx.List.last: empty list lastEmptyListError :: Builtins.BuiltinString lastEmptyListError = "PT19" -{-# INLINABLE lastEmptyListError #-} +{-# INLINEABLE lastEmptyListError #-} -- | PlutusTx.Ratio.recip: reciprocal of zero reciprocalOfZeroError :: Builtins.BuiltinString reciprocalOfZeroError = "PT20" -{-# INLINABLE reciprocalOfZeroError #-} +{-# INLINEABLE reciprocalOfZeroError #-} -- | PlutusTx.List.indexBuiltinList: negative index builtinListNegativeIndexError :: Builtins.BuiltinString builtinListNegativeIndexError = "PT21" -{-# INLINABLE builtinListNegativeIndexError #-} +{-# INLINEABLE builtinListNegativeIndexError #-} -- | PlutusTx.List.indexBuiltinList: index too large builtinListIndexTooLargeError :: Builtins.BuiltinString builtinListIndexTooLargeError = "PT22" -{-# INLINABLE builtinListIndexTooLargeError #-} +{-# INLINEABLE builtinListIndexTooLargeError #-} diff --git a/plutus-tx/src/PlutusTx/Foldable.hs b/plutus-tx/src/PlutusTx/Foldable.hs index 7af978d26cb..3f1e2548729 100644 --- a/plutus-tx/src/PlutusTx/Foldable.hs +++ b/plutus-tx/src/PlutusTx/Foldable.hs @@ -1,16 +1,20 @@ {-# LANGUAGE LambdaCase #-} -{-# OPTIONS_GHC -fno-specialise #-} {-# OPTIONS_GHC -fno-omit-interface-pragmas #-} +{-# OPTIONS_GHC -fno-specialise #-} + module PlutusTx.Foldable ( - Foldable(..), + Foldable (..), + -- * Applicative actions traverse_, for_, sequenceA_, asum, + -- * Specialized folds concat, concatMap, + -- * Other foldMap, fold, @@ -18,8 +22,8 @@ module PlutusTx.Foldable ( toList, length, sum, - product - ) where + product, +) where import Control.Applicative (Alternative (..), Const (..)) import Data.Functor.Identity (Identity (..)) @@ -35,67 +39,67 @@ import PlutusTx.Semigroup ((<>)) -- | Plutus Tx version of 'Data.Foldable.Foldable'. class Foldable t where - -- | Plutus Tx version of 'Data.Foldable.foldr'. - foldr :: (a -> b -> b) -> b -> t a -> b + -- | Plutus Tx version of 'Data.Foldable.foldr'. + foldr :: (a -> b -> b) -> b -> t a -> b - -- All the other methods are deliberately omitted, - -- to make this a one-method class which has a simpler representation +-- All the other methods are deliberately omitted, +-- to make this a one-method class which has a simpler representation instance Foldable [] where - {-# INLINABLE foldr #-} - foldr f z = go - where - go = \case - [] -> z - x : xs -> f x (go xs) + {-# INLINEABLE foldr #-} + foldr f z = go + where + go = \case + [] -> z + x : xs -> f x (go xs) instance Foldable Maybe where - {-# INLINABLE foldr #-} - foldr f z = \case - Nothing -> z - Just a -> f a z + {-# INLINEABLE foldr #-} + foldr f z = \case + Nothing -> z + Just a -> f a z instance Foldable (Either c) where - {-# INLINABLE foldr #-} - foldr f z = \case - Left _ -> z - Right a -> f a z + {-# INLINEABLE foldr #-} + foldr f z = \case + Left _ -> z + Right a -> f a z instance Foldable ((,) c) where - {-# INLINABLE foldr #-} - foldr f z (_, a) = f a z + {-# INLINEABLE foldr #-} + foldr f z (_, a) = f a z instance Foldable Identity where - {-# INLINABLE foldr #-} - foldr f z (Identity a) = f a z + {-# INLINEABLE foldr #-} + foldr f z (Identity a) = f a z instance Foldable (Const c) where - {-# INLINABLE foldr #-} - foldr _ z _ = z + {-# INLINEABLE foldr #-} + foldr _ z _ = z -- | Plutus Tx version of 'Data.Foldable.fold'. fold :: (Foldable t, Monoid m) => t m -> m fold = foldMap id -{-# INLINABLE fold #-} +{-# INLINEABLE fold #-} -- | Plutus Tx version of 'Data.Foldable.foldMap'. foldMap :: (Foldable t, Monoid m) => (a -> m) -> t a -> m foldMap f = foldr ((<>) . f) mempty -- | Plutus Tx version of 'Data.Foldable.foldl'. -foldl :: Foldable t => (b -> a -> b) -> b -> t a -> b +foldl :: (Foldable t) => (b -> a -> b) -> b -> t a -> b foldl f z t = foldr (\a g b -> g (f b a)) id t z -{-# INLINABLE foldl #-} +{-# INLINEABLE foldl #-} -- | Plutus Tx version of 'Data.Foldable.toList'. -toList :: Foldable t => t a -> [a] -toList t = build (\ c n -> foldr c n t) +toList :: (Foldable t) => t a -> [a] +toList t = build (\c n -> foldr c n t) {-# INLINE toList #-} -- | Plutus Tx version of 'Data.Foldable.length'. -length :: Foldable t => t a -> Integer +length :: (Foldable t) => t a -> Integer length = foldr (\_ acc -> acc + 1) 0 -{-# INLINABLE length #-} +{-# INLINEABLE length #-} -- | Plutus Tx version of 'Data.Foldable.sum'. sum :: (Foldable t, AdditiveMonoid a) => t a -> a @@ -105,13 +109,14 @@ sum = foldr (+) zero -- | Plutus Tx version of 'Data.Foldable.product'. product :: (Foldable t, MultiplicativeMonoid a) => t a -> a product = foldr (*) one -{-# INLINABLE product #-} +{-# INLINEABLE product #-} -- | Plutus Tx version of 'Data.Foldable.traverse_'. traverse_ :: (Foldable t, Applicative f) => (a -> f b) -> t a -> f () traverse_ f = foldr c (pure ()) - where c x k = f x *> k - {-# INLINE c #-} + where + c x k = f x *> k + {-# INLINE c #-} -- | Plutus Tx version of 'Data.Foldable.for_'. for_ :: (Foldable t, Applicative f) => t a -> (a -> f b) -> f () @@ -121,8 +126,9 @@ for_ = flip traverse_ -- | Plutus Tx version of 'Data.Foldable.sequenceA_'. sequenceA_ :: (Foldable t, Applicative f) => t (f a) -> f () sequenceA_ = foldr c (pure ()) - where c m k = m *> k - {-# INLINE c #-} + where + c m k = m *> k + {-# INLINE c #-} -- | Plutus Tx version of 'Data.Foldable.asum'. asum :: (Foldable t, Alternative f) => t (f a) -> f a @@ -130,11 +136,11 @@ asum = foldr (<|>) empty {-# INLINE asum #-} -- | Plutus Tx version of 'Data.Foldable.concat'. -concat :: Foldable t => t [a] -> [a] +concat :: (Foldable t) => t [a] -> [a] concat xs = build (\c n -> foldr (\x y -> foldr c y x) n xs) {-# INLINE concat #-} -- | Plutus Tx version of 'Data.Foldable.concatMap'. -concatMap :: Foldable t => (a -> [b]) -> t a -> [b] +concatMap :: (Foldable t) => (a -> [b]) -> t a -> [b] concatMap f xs = build (\c n -> foldr (\x b -> foldr c b (f x)) n xs) {-# INLINE concatMap #-} diff --git a/plutus-tx/src/PlutusTx/Functor.hs b/plutus-tx/src/PlutusTx/Functor.hs index 1b533768889..c427a94c5f7 100644 --- a/plutus-tx/src/PlutusTx/Functor.hs +++ b/plutus-tx/src/PlutusTx/Functor.hs @@ -1,7 +1,8 @@ {-# LANGUAGE InstanceSigs #-} {-# LANGUAGE LambdaCase #-} {-# OPTIONS_GHC -fno-omit-interface-pragmas #-} -module PlutusTx.Functor (Functor(..), (<$>), (<&>), (<$)) where + +module PlutusTx.Functor (Functor (..), (<$>), (<&>), (<$)) where import Control.Applicative (Const (..)) import Data.Functor.Identity (Identity (..)) @@ -15,56 +16,60 @@ import Prelude (Maybe (..)) -- | Plutus Tx version of 'Data.Functor.Functor'. class Functor f where - -- | Plutus Tx version of 'Data.Functor.fmap'. - fmap :: (a -> b) -> f a -> f b + -- | Plutus Tx version of 'Data.Functor.fmap'. + fmap :: (a -> b) -> f a -> f b - -- (<$) deliberately omitted, to make this a one-method class which has a - -- simpler representation +-- (<$) deliberately omitted, to make this a one-method class which has a +-- simpler representation infixl 4 <$> + -- | Plutus Tx version of '(Data.Functor.<$>)'. -(<$>) :: Functor f => (a -> b) -> f a -> f b +(<$>) :: (Functor f) => (a -> b) -> f a -> f b (<$>) = fmap -{-# INLINABLE (<$>) #-} +{-# INLINEABLE (<$>) #-} infixl 1 <&> + -- | Plutus Tx version of '(Data.Functor.<&>)'. -(<&>) :: Functor f => f a -> (a -> b) -> f b +(<&>) :: (Functor f) => f a -> (a -> b) -> f b as <&> f = f <$> as -{-# INLINABLE (<&>) #-} +{-# INLINEABLE (<&>) #-} infixl 4 <$ + -- | Plutus Tx version of '(Data.Functor.<$)'. -(<$) :: Functor f => a -> f b -> f a +(<$) :: (Functor f) => a -> f b -> f a (<$) a = fmap (const a) -{-# INLINABLE (<$) #-} +{-# INLINEABLE (<$) #-} instance Functor [] where - {-# INLINABLE fmap #-} - fmap f = go where - go = \case - [] -> [] - x:xs -> f x : go xs + {-# INLINEABLE fmap #-} + fmap f = go + where + go = \case + [] -> [] + x : xs -> f x : go xs instance Functor Maybe where - {-# INLINABLE fmap #-} - fmap f (Just a) = Just (f a) - fmap _ Nothing = Nothing + {-# INLINEABLE fmap #-} + fmap f (Just a) = Just (f a) + fmap _ Nothing = Nothing instance Functor (Either c) where - {-# INLINABLE fmap #-} - fmap f (Right a) = Right (f a) - fmap _ (Left c) = Left c + {-# INLINEABLE fmap #-} + fmap f (Right a) = Right (f a) + fmap _ (Left c) = Left c instance Functor ((,) c) where - {-# INLINABLE fmap #-} - fmap f (c, a) = (c, f a) + {-# INLINEABLE fmap #-} + fmap f (c, a) = (c, f a) instance Functor Identity where - {-# INLINABLE fmap #-} - fmap :: forall a b. (a -> b) -> Identity a -> Identity b - fmap = coerce (id :: (a -> b) -> a -> b) + {-# INLINEABLE fmap #-} + fmap :: forall a b. (a -> b) -> Identity a -> Identity b + fmap = coerce (id :: (a -> b) -> a -> b) instance Functor (Const m) where - {-# INLINABLE fmap #-} - fmap _ = coerce (id :: m -> m) + {-# INLINEABLE fmap #-} + fmap _ = coerce (id :: m -> m) diff --git a/plutus-tx/src/PlutusTx/IsData/Class.hs b/plutus-tx/src/PlutusTx/IsData/Class.hs index a44358e484b..2ce679b9b24 100644 --- a/plutus-tx/src/PlutusTx/IsData/Class.hs +++ b/plutus-tx/src/PlutusTx/IsData/Class.hs @@ -7,8 +7,9 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE UndecidableInstances #-} -{-# OPTIONS_GHC -fno-specialise #-} {-# OPTIONS_GHC -fno-omit-interface-pragmas #-} +{-# OPTIONS_GHC -fno-specialise #-} + module PlutusTx.IsData.Class where import Prelude qualified as Haskell (Int, error) @@ -29,120 +30,127 @@ import Data.Void import GHC.TypeLits (ErrorMessage (..), TypeError) - {- HLINT ignore -} -- | A typeclass for types that can be converted to and from 'BuiltinData'. class ToData (a :: Type) where - -- | Convert a value to 'BuiltinData'. - toBuiltinData :: a -> BuiltinData + -- | Convert a value to 'BuiltinData'. + toBuiltinData :: a -> BuiltinData class FromData (a :: Type) where - -- TODO: this should probably provide some kind of diagnostics - -- | Convert a value from 'BuiltinData', returning 'Nothing' if this fails. - fromBuiltinData :: BuiltinData -> Maybe a + -- TODO: this should probably provide some kind of diagnostics + + -- | Convert a value from 'BuiltinData', returning 'Nothing' if this fails. + fromBuiltinData :: BuiltinData -> Maybe a class UnsafeFromData (a :: Type) where - -- | Convert a value from 'BuiltinData', calling 'error' if this fails. - -- This is typically much faster than 'fromBuiltinData'. - -- - -- When implementing this function, make sure to call 'unsafeFromBuiltinData' - -- rather than 'fromBuiltinData' when converting substructures! - -- - -- This is a simple type without any validation, __use with caution__. - unsafeFromBuiltinData :: BuiltinData -> a + {-| Convert a value from 'BuiltinData', calling 'error' if this fails. + This is typically much faster than 'fromBuiltinData'. + + When implementing this function, make sure to call 'unsafeFromBuiltinData' + rather than 'fromBuiltinData' when converting substructures! + + This is a simple type without any validation, __use with caution__. + -} + unsafeFromBuiltinData :: BuiltinData -> a instance ToData BuiltinData where - {-# INLINABLE toBuiltinData #-} - toBuiltinData = id + {-# INLINEABLE toBuiltinData #-} + toBuiltinData = id instance FromData BuiltinData where - {-# INLINABLE fromBuiltinData #-} - fromBuiltinData d = Just d + {-# INLINEABLE fromBuiltinData #-} + fromBuiltinData d = Just d instance UnsafeFromData BuiltinData where - {-# INLINABLE unsafeFromBuiltinData #-} - unsafeFromBuiltinData d = d - -instance (TypeError ('Text "Int is not supported, use Integer instead")) - => ToData Haskell.Int where - toBuiltinData = Haskell.error "unsupported" -instance (TypeError ('Text "Int is not supported, use Integer instead")) - => FromData Haskell.Int where - fromBuiltinData = Haskell.error "unsupported" -instance (TypeError ('Text "Int is not supported, use Integer instead")) - => UnsafeFromData Haskell.Int where - unsafeFromBuiltinData = Haskell.error "unsupported" + {-# INLINEABLE unsafeFromBuiltinData #-} + unsafeFromBuiltinData d = d + +instance + (TypeError ('Text "Int is not supported, use Integer instead")) + => ToData Haskell.Int + where + toBuiltinData = Haskell.error "unsupported" +instance + (TypeError ('Text "Int is not supported, use Integer instead")) + => FromData Haskell.Int + where + fromBuiltinData = Haskell.error "unsupported" +instance + (TypeError ('Text "Int is not supported, use Integer instead")) + => UnsafeFromData Haskell.Int + where + unsafeFromBuiltinData = Haskell.error "unsupported" instance ToData Integer where - {-# INLINABLE toBuiltinData #-} - toBuiltinData i = mkI i + {-# INLINEABLE toBuiltinData #-} + toBuiltinData i = mkI i instance FromData Integer where - {-# INLINABLE fromBuiltinData #-} - fromBuiltinData = - caseData' (\_ _ -> Nothing) (\_ -> Nothing) (\_ -> Nothing) Just (\_ -> Nothing) + {-# INLINEABLE fromBuiltinData #-} + fromBuiltinData = + caseData' (\_ _ -> Nothing) (\_ -> Nothing) (\_ -> Nothing) Just (\_ -> Nothing) instance UnsafeFromData Integer where - {-# INLINABLE unsafeFromBuiltinData #-} - unsafeFromBuiltinData = BI.unsafeDataAsI + {-# INLINEABLE unsafeFromBuiltinData #-} + unsafeFromBuiltinData = BI.unsafeDataAsI instance ToData Builtins.BuiltinByteString where - {-# INLINABLE toBuiltinData #-} - toBuiltinData = mkB + {-# INLINEABLE toBuiltinData #-} + toBuiltinData = mkB instance FromData Builtins.BuiltinByteString where - {-# INLINABLE fromBuiltinData #-} - fromBuiltinData = - caseData' (\_ _ -> Nothing) (\_ -> Nothing) (\_ -> Nothing) (\_ -> Nothing) Just + {-# INLINEABLE fromBuiltinData #-} + fromBuiltinData = + caseData' (\_ _ -> Nothing) (\_ -> Nothing) (\_ -> Nothing) (\_ -> Nothing) Just instance UnsafeFromData Builtins.BuiltinByteString where - {-# INLINABLE unsafeFromBuiltinData #-} - unsafeFromBuiltinData = BI.unsafeDataAsB - -instance ToData a => ToData [a] where - {-# INLINABLE toBuiltinData #-} - toBuiltinData l = BI.mkList (mapToBuiltin l) - where - {-# INLINE mapToBuiltin #-} - mapToBuiltin :: [a] -> BI.BuiltinList BI.BuiltinData - mapToBuiltin = go - where - go :: [a] -> BI.BuiltinList BI.BuiltinData - go [] = mkNil - go (x:xs) = BI.mkCons (toBuiltinData x) (go xs) -instance FromData a => FromData [a] where - {-# INLINABLE fromBuiltinData #-} - fromBuiltinData = - caseData' - (\_ _ -> Nothing) - (\_ -> Nothing) - traverseFromBuiltin - (\_ -> Nothing) - (\_ -> Nothing) - where - {-# INLINE traverseFromBuiltin #-} - traverseFromBuiltin :: BI.BuiltinList BI.BuiltinData -> Maybe [a] - traverseFromBuiltin = go - where - go :: BI.BuiltinList BI.BuiltinData -> Maybe [a] - go = caseList' (pure []) (\x xs -> liftA2 (:) (fromBuiltinData x) (go xs)) -instance UnsafeFromData a => UnsafeFromData [a] where - {-# INLINABLE unsafeFromBuiltinData #-} - unsafeFromBuiltinData d = mapFromBuiltin (BI.unsafeDataAsList d) - where - {-# INLINE mapFromBuiltin #-} - mapFromBuiltin :: BI.BuiltinList BI.BuiltinData -> [a] - mapFromBuiltin = go - where - go :: BI.BuiltinList BI.BuiltinData -> [a] - go = caseList' [] (\x xs -> unsafeFromBuiltinData x : go xs) + {-# INLINEABLE unsafeFromBuiltinData #-} + unsafeFromBuiltinData = BI.unsafeDataAsB + +instance (ToData a) => ToData [a] where + {-# INLINEABLE toBuiltinData #-} + toBuiltinData l = BI.mkList (mapToBuiltin l) + where + {-# INLINE mapToBuiltin #-} + mapToBuiltin :: [a] -> BI.BuiltinList BI.BuiltinData + mapToBuiltin = go + where + go :: [a] -> BI.BuiltinList BI.BuiltinData + go [] = mkNil + go (x : xs) = BI.mkCons (toBuiltinData x) (go xs) +instance (FromData a) => FromData [a] where + {-# INLINEABLE fromBuiltinData #-} + fromBuiltinData = + caseData' + (\_ _ -> Nothing) + (\_ -> Nothing) + traverseFromBuiltin + (\_ -> Nothing) + (\_ -> Nothing) + where + {-# INLINE traverseFromBuiltin #-} + traverseFromBuiltin :: BI.BuiltinList BI.BuiltinData -> Maybe [a] + traverseFromBuiltin = go + where + go :: BI.BuiltinList BI.BuiltinData -> Maybe [a] + go = caseList' (pure []) (\x xs -> liftA2 (:) (fromBuiltinData x) (go xs)) +instance (UnsafeFromData a) => UnsafeFromData [a] where + {-# INLINEABLE unsafeFromBuiltinData #-} + unsafeFromBuiltinData d = mapFromBuiltin (BI.unsafeDataAsList d) + where + {-# INLINE mapFromBuiltin #-} + mapFromBuiltin :: BI.BuiltinList BI.BuiltinData -> [a] + mapFromBuiltin = go + where + go :: BI.BuiltinList BI.BuiltinData -> [a] + go = caseList' [] (\x xs -> unsafeFromBuiltinData x : go xs) instance ToData Void where - {-# INLINABLE toBuiltinData #-} - toBuiltinData = \case {} + {-# INLINEABLE toBuiltinData #-} + toBuiltinData = \case {} instance FromData Void where - {-# INLINABLE fromBuiltinData #-} - fromBuiltinData _ = Nothing + {-# INLINEABLE fromBuiltinData #-} + fromBuiltinData _ = Nothing instance UnsafeFromData Void where - {-# INLINABLE unsafeFromBuiltinData #-} - unsafeFromBuiltinData _ = traceError voidIsNotSupportedError + {-# INLINEABLE unsafeFromBuiltinData #-} + unsafeFromBuiltinData _ = traceError voidIsNotSupportedError -{- | For the BLS12-381 G1 and G2 types we use the `compress` functions to convert +{-| For the BLS12-381 G1 and G2 types we use the `compress` functions to convert to a ByteString and then encode that as Data as usual. We have to be more careful going the other way because we decode a Data object to (possibly) get a BuiltinByteString and then uncompress the underlying ByteString to get a @@ -151,45 +159,53 @@ instance UnsafeFromData Void where something goes wrong (but we do use it for unsafeFromData). -} instance ToData Builtins.BuiltinBLS12_381_G1_Element where - {-# INLINABLE toBuiltinData #-} - toBuiltinData = toBuiltinData . Builtins.bls12_381_G1_compress + {-# INLINEABLE toBuiltinData #-} + toBuiltinData = toBuiltinData . Builtins.bls12_381_G1_compress + instance FromData Builtins.BuiltinBLS12_381_G1_Element where - {-# INLINABLE fromBuiltinData #-} - fromBuiltinData d = - case fromBuiltinData d of - Nothing -> Nothing - Just bs -> Just $ bls12_381_G1_uncompress bs + {-# INLINEABLE fromBuiltinData #-} + fromBuiltinData d = + case fromBuiltinData d of + Nothing -> Nothing + Just bs -> Just $ bls12_381_G1_uncompress bs instance UnsafeFromData Builtins.BuiltinBLS12_381_G1_Element where - {-# INLINABLE unsafeFromBuiltinData #-} - unsafeFromBuiltinData = Builtins.bls12_381_G1_uncompress . unsafeFromBuiltinData + {-# INLINEABLE unsafeFromBuiltinData #-} + unsafeFromBuiltinData = Builtins.bls12_381_G1_uncompress . unsafeFromBuiltinData instance ToData Builtins.BuiltinBLS12_381_G2_Element where - {-# INLINABLE toBuiltinData #-} - toBuiltinData = toBuiltinData . Builtins.bls12_381_G2_compress + {-# INLINEABLE toBuiltinData #-} + toBuiltinData = toBuiltinData . Builtins.bls12_381_G2_compress instance FromData Builtins.BuiltinBLS12_381_G2_Element where - {-# INLINABLE fromBuiltinData #-} - fromBuiltinData d = - case fromBuiltinData d of - Nothing -> Nothing - Just bs -> Just $ bls12_381_G2_uncompress bs + {-# INLINEABLE fromBuiltinData #-} + fromBuiltinData d = + case fromBuiltinData d of + Nothing -> Nothing + Just bs -> Just $ bls12_381_G2_uncompress bs instance UnsafeFromData Builtins.BuiltinBLS12_381_G2_Element where - {-# INLINABLE unsafeFromBuiltinData #-} - unsafeFromBuiltinData = Builtins.bls12_381_G2_uncompress . unsafeFromBuiltinData + {-# INLINEABLE unsafeFromBuiltinData #-} + unsafeFromBuiltinData = Builtins.bls12_381_G2_uncompress . unsafeFromBuiltinData -{- | We do not provide instances of any of these classes for +{-| We do not provide instances of any of these classes for BuiltinBLS12_381_MlResult since there is no serialisation format: we expect that values of that type will only occur as the result of on-chain computations. -} -instance (TypeError ('Text "toBuiltinData is not supported for BuiltinBLS12_381_MlResult")) - => ToData Builtins.BuiltinBLS12_381_MlResult where - toBuiltinData = Haskell.error "unsupported" -instance (TypeError ('Text "fromBuiltinData is not supported for BuiltinBLS12_381_MlResult")) - => FromData Builtins.BuiltinBLS12_381_MlResult where - fromBuiltinData = Haskell.error "unsupported" -instance (TypeError ('Text "unsafeFromBuiltinData is not supported for BuiltinBLS12_381_MlResult")) - => UnsafeFromData Builtins.BuiltinBLS12_381_MlResult where - unsafeFromBuiltinData = Haskell.error "unsupported" +instance + (TypeError ('Text "toBuiltinData is not supported for BuiltinBLS12_381_MlResult")) + => ToData Builtins.BuiltinBLS12_381_MlResult + where + toBuiltinData = Haskell.error "unsupported" + +instance + (TypeError ('Text "fromBuiltinData is not supported for BuiltinBLS12_381_MlResult")) + => FromData Builtins.BuiltinBLS12_381_MlResult + where + fromBuiltinData = Haskell.error "unsupported" +instance + (TypeError ('Text "unsafeFromBuiltinData is not supported for BuiltinBLS12_381_MlResult")) + => UnsafeFromData Builtins.BuiltinBLS12_381_MlResult + where + unsafeFromBuiltinData = Haskell.error "unsupported" -- | Convert a value to 'PLC.Data'. toData :: (ToData a) => a -> PLC.Data diff --git a/plutus-tx/src/PlutusTx/IsData/TH.hs b/plutus-tx/src/PlutusTx/IsData/TH.hs index 1ac8ec05ca2..cc938d279ef 100644 --- a/plutus-tx/src/PlutusTx/IsData/TH.hs +++ b/plutus-tx/src/PlutusTx/IsData/TH.hs @@ -3,6 +3,7 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE ViewPatterns #-} + module PlutusTx.IsData.TH ( unstableMakeIsData, makeIsDataIndexed, @@ -34,31 +35,36 @@ mkConstrCreateExpr :: Integer -> [TH.Name] -> TH.ExpQ mkConstrCreateExpr conIx createFieldNames = let createArgsExpr :: TH.ExpQ - createArgsExpr = foldr - (\v e -> [| BI.mkCons (toBuiltinData $(TH.varE v)) $e |]) - [| BI.mkNilData BI.unitval |] - createFieldNames - createExpr = [| BI.mkConstr (conIx :: Integer) $createArgsExpr |] - in createExpr + createArgsExpr = + foldr + (\v e -> [|BI.mkCons (toBuiltinData $(TH.varE v)) $e|]) + [|BI.mkNilData BI.unitval|] + createFieldNames + createExpr = [|BI.mkConstr (conIx :: Integer) $createArgsExpr|] + in + createExpr mkConstrPartsMatchPattern :: Integer -> [TH.Name] -> TH.PatQ mkConstrPartsMatchPattern conIx extractFieldNames = let -- (==) i -> True - ixMatchPat = [p| ((PlutusTx.==) (conIx :: Integer) -> True) |] + ixMatchPat = [p|((PlutusTx.==) (conIx :: Integer) -> True)|] -- [unsafeFromBuiltinData -> arg1, ...] - extractArgPats = extractFieldNames <&> \n -> - [p| (fromBuiltinData -> Just $(TH.varP n)) |] + extractArgPats = + extractFieldNames <&> \n -> + [p|(fromBuiltinData -> Just $(TH.varP n))|] extractArgsPat = go extractArgPats - where - go [] = [p| _ |] - go [x] = [p| (Builtins.headMaybe -> Just $x) |] - go (x:xs) = [p| (Builtins.uncons -> Just ($x, $(go xs))) |] - pat = [p| ($ixMatchPat, $extractArgsPat) |] - in pat - --- | If generating pattern synonyms for a product type declared with 'asData', --- we can avoid the index match, as we know that the type only has one constructor. + where + go [] = [p|_|] + go [x] = [p|(Builtins.headMaybe -> Just $x)|] + go (x : xs) = [p|(Builtins.uncons -> Just ($x, $(go xs)))|] + pat = [p|($ixMatchPat, $extractArgsPat)|] + in + pat + +{-| If generating pattern synonyms for a product type declared with 'asData', +we can avoid the index match, as we know that the type only has one constructor. +-} data AsDataProdType = IsAsDataProdType | IsNotAsDataProdType @@ -73,20 +79,21 @@ mkUnsafeConstrMatchPattern mkUnsafeConstrMatchPattern isProduct conIx extractFieldNames = case isProduct of IsAsDataProdType -> - [p| (wrapUnsafeDataAsConstr -> - (BI.snd -> - $(mkUnsafeConstrPartsMatchPattern isProduct conIx extractFieldNames) - ) + [p| + ( wrapUnsafeDataAsConstr -> + ( BI.snd -> + $(mkUnsafeConstrPartsMatchPattern isProduct conIx extractFieldNames) + ) ) - |] + |] IsNotAsDataProdType -> [p| - (wrapUnsafeDataAsConstr -> - (Builtins.pairToPair -> - $(mkUnsafeConstrPartsMatchPattern isProduct conIx extractFieldNames) + ( wrapUnsafeDataAsConstr -> + ( Builtins.pairToPair -> + $(mkUnsafeConstrPartsMatchPattern isProduct conIx extractFieldNames) + ) ) - ) - |] + |] mkUnsafeConstrPartsMatchPattern :: AsDataProdType @@ -96,110 +103,123 @@ mkUnsafeConstrPartsMatchPattern mkUnsafeConstrPartsMatchPattern isProduct conIx extractFieldNames = let -- (==) i -> True - ixMatchPat = [p| ((PlutusTx.==) (conIx :: Integer) -> True) |] + ixMatchPat = [p|((PlutusTx.==) (conIx :: Integer) -> True)|] -- [unsafeFromBuiltinData -> arg1, ...] - extractArgPats = extractFieldNames <&> \n -> - [p| (unsafeFromBuiltinData -> $(TH.varP n)) |] + extractArgPats = + extractFieldNames <&> \n -> + [p|(unsafeFromBuiltinData -> $(TH.varP n))|] extractArgsPat = go extractArgPats - where - go [] = [p| _ |] - go [x] = [p| (BI.head -> $x) |] - go (x:xs) = [p| (wrapUnsafeUncons -> ($x, $(go xs))) |] + where + go [] = [p|_|] + go [x] = [p|(BI.head -> $x)|] + go (x : xs) = [p|(wrapUnsafeUncons -> ($x, $(go xs)))|] pat = -- We can safely omit the index match if we know that the type is a product type case isProduct of - IsAsDataProdType -> [p| $extractArgsPat |] - IsNotAsDataProdType -> [p| ($ixMatchPat, $extractArgsPat) |] - in pat + IsAsDataProdType -> [p|$extractArgsPat|] + IsNotAsDataProdType -> [p|($ixMatchPat, $extractArgsPat)|] + in + pat toDataClause :: (TH.ConstructorInfo, Int) -> TH.Q TH.Clause -toDataClause (TH.ConstructorInfo{TH.constructorName=name, TH.constructorFields=argTys}, index) = do - argNames <- for argTys $ \_ -> TH.newName "arg" - let create = mkConstrCreateExpr (fromIntegral index) argNames - TH.clause [TH.conP name (fmap TH.varP argNames)] (TH.normalB create) [] +toDataClause (TH.ConstructorInfo{TH.constructorName = name, TH.constructorFields = argTys}, index) = do + argNames <- for argTys $ \_ -> TH.newName "arg" + let create = mkConstrCreateExpr (fromIntegral index) argNames + TH.clause [TH.conP name (fmap TH.varP argNames)] (TH.normalB create) [] toDataClauses :: [(TH.ConstructorInfo, Int)] -> [TH.Q TH.Clause] toDataClauses indexedCons = toDataClause <$> indexedCons reconstructCase :: (TH.ConstructorInfo, Int) -> TH.MatchQ -reconstructCase (TH.ConstructorInfo{TH.constructorName=name, TH.constructorFields=argTys}, index) = do - argNames <- for argTys $ \_ -> TH.newName "arg" +reconstructCase (TH.ConstructorInfo{TH.constructorName = name, TH.constructorFields = argTys}, index) = do + argNames <- for argTys $ \_ -> TH.newName "arg" - -- Build the constructor application, assuming that all the arguments are in scope - let app = Foldable.foldl' (\h v -> [| $h $(TH.varE v) |]) (TH.conE name) argNames + -- Build the constructor application, assuming that all the arguments are in scope + let app = Foldable.foldl' (\h v -> [|$h $(TH.varE v)|]) (TH.conE name) argNames - TH.match (mkConstrPartsMatchPattern (fromIntegral index) argNames) (TH.normalB [| Just $app |]) [] + TH.match (mkConstrPartsMatchPattern (fromIntegral index) argNames) (TH.normalB [|Just $app|]) [] fromDataClause :: [(TH.ConstructorInfo, Int)] -> TH.Q TH.Clause fromDataClause indexedCons = do - dName <- TH.newName "d" - indexName <- TH.newName "index" - argsName <- TH.newName "args" - -- Call the clause for each constructor, falling through to the next one, until we get to the end in which case we call 'error' - let - conCases :: [TH.MatchQ] - conCases = (fmap (\ixCon -> reconstructCase ixCon) indexedCons) - finalCase :: TH.MatchQ - finalCase = TH.match TH.wildP (TH.normalB [| Nothing |]) [] - cases = conCases ++ [finalCase] - kase :: TH.ExpQ - kase = TH.caseE [| ($(TH.varE indexName), $(TH.varE argsName))|] cases - let body = - [| - -- See Note [Bang patterns in TH quotes] - let constrFun $(TH.bangP $ TH.varP indexName) $(TH.bangP $ TH.varP argsName) = $kase - in matchData' $(TH.varE dName) constrFun (const Nothing) (const Nothing) (const Nothing) (const Nothing) + dName <- TH.newName "d" + indexName <- TH.newName "index" + argsName <- TH.newName "args" + -- Call the clause for each constructor, falling through to the next one, until we get to the end in which case we call 'error' + let + conCases :: [TH.MatchQ] + conCases = (fmap (\ixCon -> reconstructCase ixCon) indexedCons) + finalCase :: TH.MatchQ + finalCase = TH.match TH.wildP (TH.normalB [|Nothing|]) [] + cases = conCases ++ [finalCase] + kase :: TH.ExpQ + kase = TH.caseE [|($(TH.varE indexName), $(TH.varE argsName))|] cases + let body = + [| + -- See Note [Bang patterns in TH quotes] + let constrFun $(TH.bangP $ TH.varP indexName) $(TH.bangP $ TH.varP argsName) = $kase + in matchData' + $(TH.varE dName) + constrFun + (const Nothing) + (const Nothing) + (const Nothing) + (const Nothing) |] - TH.clause [TH.varP dName] (TH.normalB body) [] + TH.clause [TH.varP dName] (TH.normalB body) [] unsafeReconstructCase :: (TH.ConstructorInfo, Int) -> TH.MatchQ -unsafeReconstructCase (TH.ConstructorInfo{TH.constructorName=name, TH.constructorFields=argTys}, index) = do - argNames <- for argTys $ \_ -> TH.newName "arg" +unsafeReconstructCase (TH.ConstructorInfo{TH.constructorName = name, TH.constructorFields = argTys}, index) = do + argNames <- for argTys $ \_ -> TH.newName "arg" - -- Build the constructor application, assuming that all the arguments are in scope - let app = foldl' (\h v -> [| $h $(TH.varE v) |]) (TH.conE name) argNames + -- Build the constructor application, assuming that all the arguments are in scope + let app = foldl' (\h v -> [|$h $(TH.varE v)|]) (TH.conE name) argNames - TH.match (mkUnsafeConstrPartsMatchPattern IsNotAsDataProdType (fromIntegral index) argNames) (TH.normalB app) [] + TH.match + (mkUnsafeConstrPartsMatchPattern IsNotAsDataProdType (fromIntegral index) argNames) + (TH.normalB app) + [] unsafeFromDataClause :: [(TH.ConstructorInfo, Int)] -> TH.Q TH.Clause unsafeFromDataClause indexedCons = do - dName <- TH.newName "d" - tupName <- TH.newName "tup" - indexName <- TH.newName "index" - argsName <- TH.newName "args" - -- Call the clause for each constructor, falling through to the next one, until we get to the end in which case we call 'error' - let - conCases :: [TH.MatchQ] - conCases = (fmap (\ixCon -> unsafeReconstructCase ixCon) indexedCons) - finalCase :: TH.MatchQ - finalCase = TH.match TH.wildP (TH.normalB [| traceError reconstructCaseError |]) [] - cases = conCases ++ [finalCase] - kase :: TH.ExpQ - kase = TH.caseE [| ($(TH.varE indexName), $(TH.varE argsName))|] cases - let body = - [| - -- See Note [Bang patterns in TH quotes] - let $(TH.bangP $ TH.varP tupName) = BI.unsafeDataAsConstr $(TH.varE dName) - $(TH.bangP $ TH.varP indexName) = BI.fst $(TH.varE tupName) - $(TH.bangP $ TH.varP argsName) = BI.snd $(TH.varE tupName) - in $kase + dName <- TH.newName "d" + tupName <- TH.newName "tup" + indexName <- TH.newName "index" + argsName <- TH.newName "args" + -- Call the clause for each constructor, falling through to the next one, until we get to the end in which case we call 'error' + let + conCases :: [TH.MatchQ] + conCases = (fmap (\ixCon -> unsafeReconstructCase ixCon) indexedCons) + finalCase :: TH.MatchQ + finalCase = TH.match TH.wildP (TH.normalB [|traceError reconstructCaseError|]) [] + cases = conCases ++ [finalCase] + kase :: TH.ExpQ + kase = TH.caseE [|($(TH.varE indexName), $(TH.varE argsName))|] cases + let body = + [| + -- See Note [Bang patterns in TH quotes] + let $(TH.bangP $ TH.varP tupName) = BI.unsafeDataAsConstr $(TH.varE dName) + $(TH.bangP $ TH.varP indexName) = BI.fst $(TH.varE tupName) + $(TH.bangP $ TH.varP argsName) = BI.snd $(TH.varE tupName) + in $kase |] - TH.clause [TH.varP dName] (TH.normalB body) [] + TH.clause [TH.varP dName] (TH.normalB body) [] defaultIndex :: TH.Name -> TH.Q [(TH.Name, Int)] defaultIndex name = do - info <- TH.reifyDatatype name - pure $ zip (TH.constructorName <$> TH.datatypeCons info) [0..] + info <- TH.reifyDatatype name + pure $ zip (TH.constructorName <$> TH.datatypeCons info) [0 ..] --- | Generate a 'FromData' and a 'ToData' instance for a type. --- This may not be stable in the face of constructor additions, --- renamings, etc. Use 'makeIsDataIndexed' if you need stability. +{-| Generate a 'FromData' and a 'ToData' instance for a type. +This may not be stable in the face of constructor additions, +renamings, etc. Use 'makeIsDataIndexed' if you need stability. +-} unstableMakeIsData :: TH.Name -> TH.Q [TH.Dec] unstableMakeIsData name = makeIsDataIndexed name =<< defaultIndex name --- | Generate a 'ToData', 'FromData and a 'UnsafeFromData' instances for a type, --- using an explicit mapping of constructor names to indices. --- Use this for types where you need to keep the representation stable. +{-| Generate a 'ToData', 'FromData and a 'UnsafeFromData' instances for a type, +using an explicit mapping of constructor names to indices. +Use this for types where you need to keep the representation stable. +-} makeIsDataIndexed :: TH.Name -> [(TH.Name, Int)] -> TH.Q [TH.Dec] makeIsDataIndexed dataTypeName indices = do dataTypeInfo <- TH.reifyDatatype dataTypeName @@ -212,38 +232,43 @@ makeIsDataIndexed dataTypeName indices = do Nothing -> fail $ "No index given for constructor" ++ show (TH.constructorName ctorInfo) toDataInst <- do - let constraints = TH.datatypeVars dataTypeInfo <&> \tyVarBinder -> - TH.classPred ''ToData [TH.VarT (tyvarbndrName tyVarBinder)] + let constraints = + TH.datatypeVars dataTypeInfo <&> \tyVarBinder -> + TH.classPred ''ToData [TH.VarT (tyvarbndrName tyVarBinder)] toDataDecl <- TH.funD 'toBuiltinData (toDataClauses indexedCons) toDataPrag <- TH.pragInlD 'toBuiltinData TH.Inlinable TH.FunLike TH.AllPhases - pure $ nonOverlapInstance - constraints - (TH.classPred ''ToData [appliedType]) - [toDataPrag, toDataDecl] + pure $ + nonOverlapInstance + constraints + (TH.classPred ''ToData [appliedType]) + [toDataPrag, toDataDecl] fromDataInst <- do - let constraints = TH.datatypeVars dataTypeInfo <&> \tyVarBinder -> - TH.classPred ''FromData [TH.VarT (tyvarbndrName tyVarBinder)] + let constraints = + TH.datatypeVars dataTypeInfo <&> \tyVarBinder -> + TH.classPred ''FromData [TH.VarT (tyvarbndrName tyVarBinder)] fromDataDecl <- TH.funD 'fromBuiltinData [fromDataClause indexedCons] fromDataPrag <- TH.pragInlD 'fromBuiltinData TH.Inlinable TH.FunLike TH.AllPhases - pure $ nonOverlapInstance - constraints - (TH.classPred ''FromData [appliedType]) - [fromDataPrag, fromDataDecl] + pure $ + nonOverlapInstance + constraints + (TH.classPred ''FromData [appliedType]) + [fromDataPrag, fromDataDecl] unsafeFromDataInst <- do - let constraints = TH.datatypeVars dataTypeInfo <&> \tyVarBinder -> - TH.classPred ''UnsafeFromData [TH.VarT (tyvarbndrName tyVarBinder)] + let constraints = + TH.datatypeVars dataTypeInfo <&> \tyVarBinder -> + TH.classPred ''UnsafeFromData [TH.VarT (tyvarbndrName tyVarBinder)] unsafeFromDataDecl <- TH.funD 'unsafeFromBuiltinData [unsafeFromDataClause indexedCons] unsafeFromDataPrag <- TH.pragInlD 'unsafeFromBuiltinData TH.Inlinable TH.FunLike TH.AllPhases - pure $ nonOverlapInstance - constraints - (TH.classPred ''UnsafeFromData [appliedType]) - [unsafeFromDataPrag, unsafeFromDataDecl] + pure $ + nonOverlapInstance + constraints + (TH.classPred ''UnsafeFromData [appliedType]) + [unsafeFromDataPrag, unsafeFromDataDecl] pure [toDataInst, fromDataInst, unsafeFromDataInst] - - where + where #if MIN_VERSION_template_haskell(2,17,0) tyvarbndrName (TH.PlainTV n _) = n tyvarbndrName (TH.KindedTV n _ _) = n diff --git a/plutus-tx/src/PlutusTx/Lattice.hs b/plutus-tx/src/PlutusTx/Lattice.hs index 46bfd378374..5f6daa3e031 100644 --- a/plutus-tx/src/PlutusTx/Lattice.hs +++ b/plutus-tx/src/PlutusTx/Lattice.hs @@ -1,38 +1,43 @@ {-# LANGUAGE ConstraintKinds #-} + module PlutusTx.Lattice where import PlutusTx.Bool import PlutusTx.Monoid import PlutusTx.Semigroup --- | A join semi-lattice, i.e. a partially ordered set equipped with a --- binary operation '(\/)'. --- --- Note that the mathematical definition would require an ordering constraint - --- we omit that so we can define instances for e.g. '(->)'. +{-| A join semi-lattice, i.e. a partially ordered set equipped with a +binary operation '(\/)'. + +Note that the mathematical definition would require an ordering constraint - +we omit that so we can define instances for e.g. '(->)'. +-} class JoinSemiLattice a where - (\/) :: a -> a -> a + (\/) :: a -> a -> a + +{-| A meet semi-lattice, i.e. a partially ordered set equipped with a +binary operation '(/\)'. --- | A meet semi-lattice, i.e. a partially ordered set equipped with a --- binary operation '(/\)'. --- --- Note that the mathematical definition would require an ordering constraint - --- we omit that so we can define instances for e.g. '(->)'. +Note that the mathematical definition would require an ordering constraint - +we omit that so we can define instances for e.g. '(->)'. +-} class MeetSemiLattice a where - (/\) :: a -> a -> a + (/\) :: a -> a -> a -- | A lattice. type Lattice a = (JoinSemiLattice a, MeetSemiLattice a) --- | A bounded join semi-lattice, i.e. a join semi-lattice augmented with --- a distinguished element 'bottom' which is the unit of '(\/)'. -class JoinSemiLattice a => BoundedJoinSemiLattice a where - bottom :: a +{-| A bounded join semi-lattice, i.e. a join semi-lattice augmented with +a distinguished element 'bottom' which is the unit of '(\/)'. +-} +class (JoinSemiLattice a) => BoundedJoinSemiLattice a where + bottom :: a --- | A bounded meet semi-lattice, i.e. a meet semi-lattice augmented with --- a distinguished element 'top' which is the unit of '(/\)'. -class MeetSemiLattice a => BoundedMeetSemiLattice a where - top :: a +{-| A bounded meet semi-lattice, i.e. a meet semi-lattice augmented with +a distinguished element 'top' which is the unit of '(/\)'. +-} +class (MeetSemiLattice a) => BoundedMeetSemiLattice a where + top :: a -- | A bounded lattice. type BoundedLattice a = (BoundedJoinSemiLattice a, BoundedMeetSemiLattice a) @@ -42,67 +47,67 @@ type BoundedLattice a = (BoundedJoinSemiLattice a, BoundedMeetSemiLattice a) -- | A wrapper witnessing that a join semi-lattice is a monoid with '(\/)' and 'bottom'. newtype Join a = Join a -instance JoinSemiLattice a => Semigroup (Join a) where - Join l <> Join r = Join (l \/ r) +instance (JoinSemiLattice a) => Semigroup (Join a) where + Join l <> Join r = Join (l \/ r) -instance BoundedJoinSemiLattice a => Monoid (Join a) where - mempty = Join bottom +instance (BoundedJoinSemiLattice a) => Monoid (Join a) where + mempty = Join bottom -- | A wrapper witnessing that a meet semi-lattice is a monoid with '(/\)' and 'top'. newtype Meet a = Meet a -instance MeetSemiLattice a => Semigroup (Meet a) where - Meet l <> Meet r = Meet (l /\ r) +instance (MeetSemiLattice a) => Semigroup (Meet a) where + Meet l <> Meet r = Meet (l /\ r) -instance BoundedMeetSemiLattice a => Monoid (Meet a) where - mempty = Meet top +instance (BoundedMeetSemiLattice a) => Monoid (Meet a) where + mempty = Meet top -- Instances instance JoinSemiLattice Bool where - {-# INLINABLE (\/) #-} - (\/) = (||) + {-# INLINEABLE (\/) #-} + (\/) = (||) instance BoundedJoinSemiLattice Bool where - {-# INLINABLE bottom #-} - bottom = False + {-# INLINEABLE bottom #-} + bottom = False instance MeetSemiLattice Bool where - {-# INLINABLE (/\) #-} - (/\) = (&&) + {-# INLINEABLE (/\) #-} + (/\) = (&&) instance BoundedMeetSemiLattice Bool where - {-# INLINABLE top #-} - top = True + {-# INLINEABLE top #-} + top = True instance (JoinSemiLattice a, JoinSemiLattice b) => JoinSemiLattice (a, b) where - {-# INLINABLE (\/) #-} - (a1, b1) \/ (a2, b2) = (a1 \/ a2, b1 \/ b2) + {-# INLINEABLE (\/) #-} + (a1, b1) \/ (a2, b2) = (a1 \/ a2, b1 \/ b2) instance (BoundedJoinSemiLattice a, BoundedJoinSemiLattice b) => BoundedJoinSemiLattice (a, b) where - {-# INLINABLE bottom #-} - bottom = (bottom, bottom) + {-# INLINEABLE bottom #-} + bottom = (bottom, bottom) instance (MeetSemiLattice a, MeetSemiLattice b) => MeetSemiLattice (a, b) where - {-# INLINABLE (/\) #-} - (a1, b1) /\ (a2, b2) = (a1 /\ a2, b1 /\ b2) + {-# INLINEABLE (/\) #-} + (a1, b1) /\ (a2, b2) = (a1 /\ a2, b1 /\ b2) instance (BoundedMeetSemiLattice a, BoundedMeetSemiLattice b) => BoundedMeetSemiLattice (a, b) where - {-# INLINABLE top #-} - top = (top, top) + {-# INLINEABLE top #-} + top = (top, top) -instance JoinSemiLattice b => JoinSemiLattice (a -> b) where - {-# INLINABLE (\/) #-} - (f \/ g) a = f a \/ g a +instance (JoinSemiLattice b) => JoinSemiLattice (a -> b) where + {-# INLINEABLE (\/) #-} + (f \/ g) a = f a \/ g a -instance BoundedJoinSemiLattice b => BoundedJoinSemiLattice (a -> b) where - {-# INLINABLE bottom #-} - bottom _ = bottom +instance (BoundedJoinSemiLattice b) => BoundedJoinSemiLattice (a -> b) where + {-# INLINEABLE bottom #-} + bottom _ = bottom -instance MeetSemiLattice b => MeetSemiLattice (a -> b) where - {-# INLINABLE (/\) #-} - (f /\ g) a = f a /\ g a +instance (MeetSemiLattice b) => MeetSemiLattice (a -> b) where + {-# INLINEABLE (/\) #-} + (f /\ g) a = f a /\ g a -instance BoundedMeetSemiLattice b => BoundedMeetSemiLattice (a -> b) where - {-# INLINABLE top #-} - top _ = top +instance (BoundedMeetSemiLattice b) => BoundedMeetSemiLattice (a -> b) where + {-# INLINEABLE top #-} + top _ = top diff --git a/plutus-tx/src/PlutusTx/Lift.hs b/plutus-tx/src/PlutusTx/Lift.hs index 33794eeaa7e..6c1a45fbb42 100644 --- a/plutus-tx/src/PlutusTx/Lift.hs +++ b/plutus-tx/src/PlutusTx/Lift.hs @@ -5,28 +5,28 @@ {-# LANGUAGE ScopedTypeVariables #-} module PlutusTx.Lift ( - safeLiftWith, - safeLift, - safeLiftUnopt, - safeLiftProgram, - safeLiftProgramUnopt, - safeLiftCode, - safeLiftCodeUnopt, - lift, - liftUnopt, - liftProgram, - liftProgramUnopt, - liftProgramDef, - liftProgramDefUnopt, - liftCode, - liftCodeUnopt, - liftCodeDef, - liftCodeDefUnopt, - typeCheckAgainst, - typeCode, - makeTypeable, - makeLift, - LiftError(..) + safeLiftWith, + safeLift, + safeLiftUnopt, + safeLiftProgram, + safeLiftProgramUnopt, + safeLiftCode, + safeLiftCodeUnopt, + lift, + liftUnopt, + liftProgram, + liftProgramUnopt, + liftProgramDef, + liftProgramDefUnopt, + liftCode, + liftCodeUnopt, + liftCodeDef, + liftCodeDefUnopt, + typeCheckAgainst, + typeCode, + makeTypeable, + makeLift, + LiftError (..), ) where import PlutusTx.Code @@ -143,8 +143,9 @@ safeLift -> m (PIR.Term PLC.TyName PLC.Name uni fun (), UPLC.Term UPLC.NamedDeBruijn uni fun ()) safeLift = safeLiftWith id id --- | Like `safeLift` but does not apply PIR/UPLC optimizations. Use this option --- where lifting speed is more important than optimal code. +{-| Like `safeLift` but does not apply PIR/UPLC optimizations. Use this option +where lifting speed is more important than optimal code. +-} safeLiftUnopt :: forall a e uni fun m . ( Lift.Lift uni a @@ -175,224 +176,291 @@ safeLiftUnopt = . set (PLC.coSimplifyOpts . UPLC.soMaxCseIterations) 0 ) --- | Get a Plutus Core program corresponding to the given value, applying default PIR/UPLC --- optimizations. +{-| Get a Plutus Core program corresponding to the given value, applying default PIR/UPLC +optimizations. +-} safeLiftProgram - :: (Lift.Lift uni a - , PIR.AsTypeError e (PIR.Term TyName Name uni fun ()) uni fun (Provenance ()), PLC.GEq uni - , PIR.AsTypeErrorExt e uni (Provenance ()) - , PLC.AsFreeVariableError e - , AsError e uni fun (Provenance ()), MonadError e m, MonadQuote m - , PLC.Typecheckable uni fun - , PLC.CaseBuiltin (PIR.Term TyName Name uni fun (Provenance ())) uni - , PLC.CaseBuiltin (UPLC.Term Name uni fun (Provenance ())) uni - , PrettyUni uni, Pretty fun - , Default (PLC.CostingPart uni fun) - , Default (PIR.BuiltinsInfo uni fun) - , Default (PIR.RewriteRules uni fun) - , Hashable fun - ) - => PLC.Version -> a -> m (PIR.Program PLC.TyName PLC.Name uni fun (), UPLC.Program UPLC.NamedDeBruijn uni fun ()) + :: ( Lift.Lift uni a + , PIR.AsTypeError e (PIR.Term TyName Name uni fun ()) uni fun (Provenance ()) + , PLC.GEq uni + , PIR.AsTypeErrorExt e uni (Provenance ()) + , PLC.AsFreeVariableError e + , AsError e uni fun (Provenance ()) + , MonadError e m + , MonadQuote m + , PLC.Typecheckable uni fun + , PLC.CaseBuiltin (PIR.Term TyName Name uni fun (Provenance ())) uni + , PLC.CaseBuiltin (UPLC.Term Name uni fun (Provenance ())) uni + , PrettyUni uni + , Pretty fun + , Default (PLC.CostingPart uni fun) + , Default (PIR.BuiltinsInfo uni fun) + , Default (PIR.RewriteRules uni fun) + , Hashable fun + ) + => PLC.Version + -> a + -> m (PIR.Program PLC.TyName PLC.Name uni fun (), UPLC.Program UPLC.NamedDeBruijn uni fun ()) safeLiftProgram v x = bimap (PIR.Program () v) (UPLC.Program () v) <$> safeLift v x --- | Like `safeLiftProgram` but does not apply PIR/UPLC optimizations. Use this option --- where lifting speed is more important than optimal code. +{-| Like `safeLiftProgram` but does not apply PIR/UPLC optimizations. Use this option +where lifting speed is more important than optimal code. +-} safeLiftProgramUnopt - :: (Lift.Lift uni a - , PIR.AsTypeError e (PIR.Term TyName Name uni fun ()) uni fun (Provenance ()), PLC.GEq uni - , PIR.AsTypeErrorExt e uni (Provenance ()) - , PLC.AsFreeVariableError e - , AsError e uni fun (Provenance ()), MonadError e m, MonadQuote m - , PLC.Typecheckable uni fun - , PLC.CaseBuiltin (PIR.Term TyName Name uni fun (Provenance ())) uni - , PLC.CaseBuiltin (UPLC.Term Name uni fun (Provenance ())) uni - , PrettyUni uni, Pretty fun - , Default (PLC.CostingPart uni fun) - , Default (PIR.BuiltinsInfo uni fun) - , Default (PIR.RewriteRules uni fun) - , Hashable fun - ) - => PLC.Version -> a -> m (PIR.Program PLC.TyName PLC.Name uni fun (), UPLC.Program UPLC.NamedDeBruijn uni fun ()) + :: ( Lift.Lift uni a + , PIR.AsTypeError e (PIR.Term TyName Name uni fun ()) uni fun (Provenance ()) + , PLC.GEq uni + , PIR.AsTypeErrorExt e uni (Provenance ()) + , PLC.AsFreeVariableError e + , AsError e uni fun (Provenance ()) + , MonadError e m + , MonadQuote m + , PLC.Typecheckable uni fun + , PLC.CaseBuiltin (PIR.Term TyName Name uni fun (Provenance ())) uni + , PLC.CaseBuiltin (UPLC.Term Name uni fun (Provenance ())) uni + , PrettyUni uni + , Pretty fun + , Default (PLC.CostingPart uni fun) + , Default (PIR.BuiltinsInfo uni fun) + , Default (PIR.RewriteRules uni fun) + , Hashable fun + ) + => PLC.Version + -> a + -> m (PIR.Program PLC.TyName PLC.Name uni fun (), UPLC.Program UPLC.NamedDeBruijn uni fun ()) safeLiftProgramUnopt v x = bimap (PIR.Program () v) (UPLC.Program () v) <$> safeLiftUnopt v x safeLiftCode - :: (Lift.Lift uni a - , PIR.AsTypeError e (PIR.Term TyName Name uni fun ()) uni fun (Provenance ()), PLC.GEq uni - , PIR.AsTypeErrorExt e uni (Provenance ()) - , PLC.AsFreeVariableError e - , AsError e uni fun (Provenance ()), MonadError e m, MonadQuote m - , PLC.Typecheckable uni fun - , PLC.CaseBuiltin (PIR.Term TyName Name uni fun (Provenance ())) uni - , PLC.CaseBuiltin (UPLC.Term Name uni fun (Provenance ())) uni - , PrettyUni uni, Pretty fun - , Default (PLC.CostingPart uni fun) - , Default (PIR.BuiltinsInfo uni fun) - , Default (PIR.RewriteRules uni fun) - , Hashable fun - ) - => PLC.Version -> a -> m (CompiledCodeIn uni fun a) + :: ( Lift.Lift uni a + , PIR.AsTypeError e (PIR.Term TyName Name uni fun ()) uni fun (Provenance ()) + , PLC.GEq uni + , PIR.AsTypeErrorExt e uni (Provenance ()) + , PLC.AsFreeVariableError e + , AsError e uni fun (Provenance ()) + , MonadError e m + , MonadQuote m + , PLC.Typecheckable uni fun + , PLC.CaseBuiltin (PIR.Term TyName Name uni fun (Provenance ())) uni + , PLC.CaseBuiltin (UPLC.Term Name uni fun (Provenance ())) uni + , PrettyUni uni + , Pretty fun + , Default (PLC.CostingPart uni fun) + , Default (PIR.BuiltinsInfo uni fun) + , Default (PIR.RewriteRules uni fun) + , Hashable fun + ) + => PLC.Version -> a -> m (CompiledCodeIn uni fun a) safeLiftCode v = - fmap - ( \(pir, uplc) -> - DeserializedCode (mempty <$ uplc) (Just (mempty <$ pir)) mempty - ) - . safeLiftProgram v + fmap + ( \(pir, uplc) -> + DeserializedCode (mempty <$ uplc) (Just (mempty <$ pir)) mempty + ) + . safeLiftProgram v --- | Like `safeLiftCode` but does not apply PIR/UPLC optimizations. Use this option --- where lifting speed is more important than optimal code. +{-| Like `safeLiftCode` but does not apply PIR/UPLC optimizations. Use this option +where lifting speed is more important than optimal code. +-} safeLiftCodeUnopt - :: (Lift.Lift uni a - , PIR.AsTypeError e (PIR.Term TyName Name uni fun ()) uni fun (Provenance ()), PLC.GEq uni - , PIR.AsTypeErrorExt e uni (Provenance ()) - , PLC.AsFreeVariableError e - , AsError e uni fun (Provenance ()), MonadError e m, MonadQuote m - , PLC.Typecheckable uni fun - , PLC.CaseBuiltin (PIR.Term TyName Name uni fun (Provenance ())) uni - , PLC.CaseBuiltin (UPLC.Term Name uni fun (Provenance ())) uni - , PrettyUni uni, Pretty fun - , Default (PLC.CostingPart uni fun) - , Default (PIR.BuiltinsInfo uni fun) - , Default (PIR.RewriteRules uni fun) - , Hashable fun - ) - => PLC.Version -> a -> m (CompiledCodeIn uni fun a) + :: ( Lift.Lift uni a + , PIR.AsTypeError e (PIR.Term TyName Name uni fun ()) uni fun (Provenance ()) + , PLC.GEq uni + , PIR.AsTypeErrorExt e uni (Provenance ()) + , PLC.AsFreeVariableError e + , AsError e uni fun (Provenance ()) + , MonadError e m + , MonadQuote m + , PLC.Typecheckable uni fun + , PLC.CaseBuiltin (PIR.Term TyName Name uni fun (Provenance ())) uni + , PLC.CaseBuiltin (UPLC.Term Name uni fun (Provenance ())) uni + , PrettyUni uni + , Pretty fun + , Default (PLC.CostingPart uni fun) + , Default (PIR.BuiltinsInfo uni fun) + , Default (PIR.RewriteRules uni fun) + , Hashable fun + ) + => PLC.Version -> a -> m (CompiledCodeIn uni fun a) safeLiftCodeUnopt v = - fmap - ( \(pir, uplc) -> - DeserializedCode (mempty <$ uplc) (Just (mempty <$ pir)) mempty - ) - . safeLiftProgramUnopt v + fmap + ( \(pir, uplc) -> + DeserializedCode (mempty <$ uplc) (Just (mempty <$ pir)) mempty + ) + . safeLiftProgramUnopt v unsafely - :: ThrowableBuiltins uni fun - => ExceptT (Error uni fun (Provenance ())) Quote a -> a + :: (ThrowableBuiltins uni fun) + => ExceptT (Error uni fun (Provenance ())) Quote a -> a unsafely ma = runQuote $ do - run <- runExceptT ma - case run of - Left e -> throw e - Right t -> pure t + run <- runExceptT ma + case run of + Left e -> throw e + Right t -> pure t --- | Get a Plutus Core term corresponding to the given value, throwing any errors that --- occur as exceptions and ignoring fresh names. The default PIR/UPLC optimizations --- are applied. +{-| Get a Plutus Core term corresponding to the given value, throwing any errors that +occur as exceptions and ignoring fresh names. The default PIR/UPLC optimizations +are applied. +-} lift - :: ( Lift.Lift uni a, ThrowableBuiltins uni fun, PLC.Typecheckable uni fun, PLC.GEq uni - , PLC.CaseBuiltin (PIR.Term TyName Name uni fun (Provenance ())) uni - , PLC.CaseBuiltin (UPLC.Term Name uni fun (Provenance ())) uni - , Default (PLC.CostingPart uni fun) - , Default (PIR.BuiltinsInfo uni fun) - , Default (PIR.RewriteRules uni fun) - , Hashable fun - ) - => PLC.Version -> a -> (PIR.Term PLC.TyName PLC.Name uni fun (), UPLC.Term UPLC.NamedDeBruijn uni fun ()) + :: ( Lift.Lift uni a + , ThrowableBuiltins uni fun + , PLC.Typecheckable uni fun + , PLC.GEq uni + , PLC.CaseBuiltin (PIR.Term TyName Name uni fun (Provenance ())) uni + , PLC.CaseBuiltin (UPLC.Term Name uni fun (Provenance ())) uni + , Default (PLC.CostingPart uni fun) + , Default (PIR.BuiltinsInfo uni fun) + , Default (PIR.RewriteRules uni fun) + , Hashable fun + ) + => PLC.Version + -> a + -> (PIR.Term PLC.TyName PLC.Name uni fun (), UPLC.Term UPLC.NamedDeBruijn uni fun ()) lift v a = unsafely $ safeLift v a --- | Like `lift` but does not apply PIR/UPLC optimizations. Use this option --- where lifting speed is more important than optimal code. +{-| Like `lift` but does not apply PIR/UPLC optimizations. Use this option +where lifting speed is more important than optimal code. +-} liftUnopt - :: ( Lift.Lift uni a, ThrowableBuiltins uni fun, PLC.Typecheckable uni fun, PLC.GEq uni - , PLC.CaseBuiltin (PIR.Term TyName Name uni fun (Provenance ())) uni - , PLC.CaseBuiltin (UPLC.Term Name uni fun (Provenance ())) uni - , Default (PLC.CostingPart uni fun) - , Default (PIR.BuiltinsInfo uni fun) - , Default (PIR.RewriteRules uni fun) - , Hashable fun - ) - => PLC.Version -> a -> (PIR.Term PLC.TyName PLC.Name uni fun (), UPLC.Term UPLC.NamedDeBruijn uni fun ()) + :: ( Lift.Lift uni a + , ThrowableBuiltins uni fun + , PLC.Typecheckable uni fun + , PLC.GEq uni + , PLC.CaseBuiltin (PIR.Term TyName Name uni fun (Provenance ())) uni + , PLC.CaseBuiltin (UPLC.Term Name uni fun (Provenance ())) uni + , Default (PLC.CostingPart uni fun) + , Default (PIR.BuiltinsInfo uni fun) + , Default (PIR.RewriteRules uni fun) + , Hashable fun + ) + => PLC.Version + -> a + -> (PIR.Term PLC.TyName PLC.Name uni fun (), UPLC.Term UPLC.NamedDeBruijn uni fun ()) liftUnopt v a = unsafely $ safeLiftUnopt v a -- | Get a Plutus Core program corresponding to the given value, throwing any errors that occur as exceptions and ignoring fresh names. liftProgram - :: ( Lift.Lift uni a, ThrowableBuiltins uni fun, PLC.Typecheckable uni fun, PLC.GEq uni - , PLC.CaseBuiltin (PIR.Term TyName Name uni fun (Provenance ())) uni - , PLC.CaseBuiltin (UPLC.Term Name uni fun (Provenance ())) uni - , Default (PLC.CostingPart uni fun) - , Default (PIR.BuiltinsInfo uni fun) - , Default (PIR.RewriteRules uni fun) - , Hashable fun - ) - => PLC.Version -> a -> (PIR.Program PLC.TyName PLC.Name uni fun (), UPLC.Program UPLC.NamedDeBruijn uni fun ()) + :: ( Lift.Lift uni a + , ThrowableBuiltins uni fun + , PLC.Typecheckable uni fun + , PLC.GEq uni + , PLC.CaseBuiltin (PIR.Term TyName Name uni fun (Provenance ())) uni + , PLC.CaseBuiltin (UPLC.Term Name uni fun (Provenance ())) uni + , Default (PLC.CostingPart uni fun) + , Default (PIR.BuiltinsInfo uni fun) + , Default (PIR.RewriteRules uni fun) + , Hashable fun + ) + => PLC.Version + -> a + -> (PIR.Program PLC.TyName PLC.Name uni fun (), UPLC.Program UPLC.NamedDeBruijn uni fun ()) liftProgram v x = unsafely $ safeLiftProgram v x --- | Like `liftProgram` but does not apply PIR/UPLC optimizations. Use this option --- where lifting speed is more important than optimal code. +{-| Like `liftProgram` but does not apply PIR/UPLC optimizations. Use this option +where lifting speed is more important than optimal code. +-} liftProgramUnopt - :: ( Lift.Lift uni a, ThrowableBuiltins uni fun, PLC.Typecheckable uni fun, PLC.GEq uni - , PLC.CaseBuiltin (PIR.Term TyName Name uni fun (Provenance ())) uni - , PLC.CaseBuiltin (UPLC.Term Name uni fun (Provenance ())) uni - , Default (PLC.CostingPart uni fun) - , Default (PIR.BuiltinsInfo uni fun) - , Default (PIR.RewriteRules uni fun) - , Hashable fun - ) - => PLC.Version -> a -> (PIR.Program PLC.TyName PLC.Name uni fun (), UPLC.Program UPLC.NamedDeBruijn uni fun ()) + :: ( Lift.Lift uni a + , ThrowableBuiltins uni fun + , PLC.Typecheckable uni fun + , PLC.GEq uni + , PLC.CaseBuiltin (PIR.Term TyName Name uni fun (Provenance ())) uni + , PLC.CaseBuiltin (UPLC.Term Name uni fun (Provenance ())) uni + , Default (PLC.CostingPart uni fun) + , Default (PIR.BuiltinsInfo uni fun) + , Default (PIR.RewriteRules uni fun) + , Hashable fun + ) + => PLC.Version + -> a + -> (PIR.Program PLC.TyName PLC.Name uni fun (), UPLC.Program UPLC.NamedDeBruijn uni fun ()) liftProgramUnopt v x = unsafely $ safeLiftProgram v x -- | Get a Plutus Core program in the default universe with the default version, corresponding to the given value, throwing any errors that occur as exceptions and ignoring fresh names. liftProgramDef - :: Lift.Lift PLC.DefaultUni a - => a -> (PIR.Program PLC.TyName PLC.Name PLC.DefaultUni PLC.DefaultFun (), UPLC.Program UPLC.NamedDeBruijn PLC.DefaultUni PLC.DefaultFun ()) + :: (Lift.Lift PLC.DefaultUni a) + => a + -> ( PIR.Program PLC.TyName PLC.Name PLC.DefaultUni PLC.DefaultFun () + , UPLC.Program UPLC.NamedDeBruijn PLC.DefaultUni PLC.DefaultFun () + ) liftProgramDef = liftProgram PLC.latestVersion --- | Like `liftProgramDef` but does not apply PIR/UPLC optimizations. Use this option --- where lifting speed is more important than optimal code. +{-| Like `liftProgramDef` but does not apply PIR/UPLC optimizations. Use this option +where lifting speed is more important than optimal code. +-} liftProgramDefUnopt - :: Lift.Lift PLC.DefaultUni a - => a -> (PIR.Program PLC.TyName PLC.Name PLC.DefaultUni PLC.DefaultFun (), UPLC.Program UPLC.NamedDeBruijn PLC.DefaultUni PLC.DefaultFun ()) + :: (Lift.Lift PLC.DefaultUni a) + => a + -> ( PIR.Program PLC.TyName PLC.Name PLC.DefaultUni PLC.DefaultFun () + , UPLC.Program UPLC.NamedDeBruijn PLC.DefaultUni PLC.DefaultFun () + ) liftProgramDefUnopt = liftProgramUnopt PLC.latestVersion -- | Get a Plutus Core program corresponding to the given value as a 'CompiledCodeIn', throwing any errors that occur as exceptions and ignoring fresh names. liftCode - :: ( Lift.Lift uni a, PLC.GEq uni, ThrowableBuiltins uni fun, PLC.Typecheckable uni fun - , PLC.CaseBuiltin (PIR.Term TyName Name uni fun (Provenance ())) uni - , PLC.CaseBuiltin (UPLC.Term Name uni fun (Provenance ())) uni - , Default (PLC.CostingPart uni fun) - , Default (PIR.BuiltinsInfo uni fun) - , Default (PIR.RewriteRules uni fun) - , Hashable fun - ) - => PLC.Version -> a -> CompiledCodeIn uni fun a + :: ( Lift.Lift uni a + , PLC.GEq uni + , ThrowableBuiltins uni fun + , PLC.Typecheckable uni fun + , PLC.CaseBuiltin (PIR.Term TyName Name uni fun (Provenance ())) uni + , PLC.CaseBuiltin (UPLC.Term Name uni fun (Provenance ())) uni + , Default (PLC.CostingPart uni fun) + , Default (PIR.BuiltinsInfo uni fun) + , Default (PIR.RewriteRules uni fun) + , Hashable fun + ) + => PLC.Version -> a -> CompiledCodeIn uni fun a liftCode v x = unsafely $ safeLiftCode v x --- | Like `liftCode` but does not apply PIR/UPLC optimizations. Use this option --- where lifting speed is more important than optimal code. +{-| Like `liftCode` but does not apply PIR/UPLC optimizations. Use this option +where lifting speed is more important than optimal code. +-} liftCodeUnopt - :: ( Lift.Lift uni a, PLC.GEq uni, ThrowableBuiltins uni fun, PLC.Typecheckable uni fun - , PLC.CaseBuiltin (PIR.Term TyName Name uni fun (Provenance ())) uni - , PLC.CaseBuiltin (UPLC.Term Name uni fun (Provenance ())) uni - , Default (PLC.CostingPart uni fun) - , Default (PIR.BuiltinsInfo uni fun) - , Default (PIR.RewriteRules uni fun) - , Hashable fun - ) - => PLC.Version -> a -> CompiledCodeIn uni fun a + :: ( Lift.Lift uni a + , PLC.GEq uni + , ThrowableBuiltins uni fun + , PLC.Typecheckable uni fun + , PLC.CaseBuiltin (PIR.Term TyName Name uni fun (Provenance ())) uni + , PLC.CaseBuiltin (UPLC.Term Name uni fun (Provenance ())) uni + , Default (PLC.CostingPart uni fun) + , Default (PIR.BuiltinsInfo uni fun) + , Default (PIR.RewriteRules uni fun) + , Hashable fun + ) + => PLC.Version -> a -> CompiledCodeIn uni fun a liftCodeUnopt v x = unsafely $ safeLiftCodeUnopt v x -- | Get a Plutus Core program with the default version, corresponding to the given value as a 'CompiledCodeIn', throwing any errors that occur as exceptions and ignoring fresh names. liftCodeDef - :: ( Lift.Lift uni a, PLC.GEq uni, ThrowableBuiltins uni fun, PLC.Typecheckable uni fun - , PLC.CaseBuiltin (PIR.Term TyName Name uni fun (Provenance ())) uni - , PLC.CaseBuiltin (UPLC.Term Name uni fun (Provenance ())) uni - , Default (PLC.CostingPart uni fun) - , Default (PIR.BuiltinsInfo uni fun) - , Default (PIR.RewriteRules uni fun) - , Hashable fun - ) - => a -> CompiledCodeIn uni fun a + :: ( Lift.Lift uni a + , PLC.GEq uni + , ThrowableBuiltins uni fun + , PLC.Typecheckable uni fun + , PLC.CaseBuiltin (PIR.Term TyName Name uni fun (Provenance ())) uni + , PLC.CaseBuiltin (UPLC.Term Name uni fun (Provenance ())) uni + , Default (PLC.CostingPart uni fun) + , Default (PIR.BuiltinsInfo uni fun) + , Default (PIR.RewriteRules uni fun) + , Hashable fun + ) + => a -> CompiledCodeIn uni fun a liftCodeDef = liftCode PLC.latestVersion --- | Like `liftCodeDef` but does not apply PIR/UPLC optimizations. Use this option --- where lifting speed is more important than optimal code. +{-| Like `liftCodeDef` but does not apply PIR/UPLC optimizations. Use this option +where lifting speed is more important than optimal code. +-} liftCodeDefUnopt - :: ( Lift.Lift uni a, PLC.GEq uni, ThrowableBuiltins uni fun, PLC.Typecheckable uni fun - , PLC.CaseBuiltin (PIR.Term TyName Name uni fun (Provenance ())) uni - , PLC.CaseBuiltin (UPLC.Term Name uni fun (Provenance ())) uni - , Default (PLC.CostingPart uni fun) - , Default (PIR.BuiltinsInfo uni fun) - , Default (PIR.RewriteRules uni fun) - , Hashable fun - ) - => a -> CompiledCodeIn uni fun a + :: ( Lift.Lift uni a + , PLC.GEq uni + , ThrowableBuiltins uni fun + , PLC.Typecheckable uni fun + , PLC.CaseBuiltin (PIR.Term TyName Name uni fun (Provenance ())) uni + , PLC.CaseBuiltin (UPLC.Term Name uni fun (Provenance ())) uni + , Default (PLC.CostingPart uni fun) + , Default (PIR.BuiltinsInfo uni fun) + , Default (PIR.RewriteRules uni fun) + , Hashable fun + ) + => a -> CompiledCodeIn uni fun a liftCodeDefUnopt = liftCodeUnopt PLC.latestVersion {- Note [Checking the type of a term with Typeable] @@ -409,74 +477,79 @@ iff the original term has the given type. We opt for `(\x : -> x) ter -- | Check that PLC term has the given type. typeCheckAgainst - :: forall e a uni fun m . - ( Lift.Typeable uni a - , PIR.AsTypeError e (PIR.Term TyName Name uni fun ()) uni fun (Provenance ()) - , PIR.AsTypeErrorExt e uni (Provenance ()) - , PIR.AsError e uni fun (Provenance ()) - , MonadError e m, MonadQuote m - , PLC.GEq uni - , PLC.Typecheckable uni fun - , PLC.CaseBuiltin (PIR.Term TyName Name uni fun (Provenance ())) uni - , PrettyUni uni, Pretty fun - , Default (PLC.CostingPart uni fun) - , Default (PIR.BuiltinsInfo uni fun) - , Default (PIR.RewriteRules uni fun) - ) - => Proxy a - -> PLC.Program PLC.TyName PLC.Name uni fun () - -> m () + :: forall e a uni fun m + . ( Lift.Typeable uni a + , PIR.AsTypeError e (PIR.Term TyName Name uni fun ()) uni fun (Provenance ()) + , PIR.AsTypeErrorExt e uni (Provenance ()) + , PIR.AsError e uni fun (Provenance ()) + , MonadError e m + , MonadQuote m + , PLC.GEq uni + , PLC.Typecheckable uni fun + , PLC.CaseBuiltin (PIR.Term TyName Name uni fun (Provenance ())) uni + , PrettyUni uni + , Pretty fun + , Default (PLC.CostingPart uni fun) + , Default (PIR.BuiltinsInfo uni fun) + , Default (PIR.RewriteRules uni fun) + ) + => Proxy a + -> PLC.Program PLC.TyName PLC.Name uni fun () + -> m () typeCheckAgainst p (PLC.Program _ v plcTerm) = do - -- See Note [Checking the type of a term with Typeable] - term <- PIR.embedTerm <$> PLC.rename plcTerm - -- We need to run Def *before* applying to the term, otherwise we may refer to abstract - -- types and we won't match up with the term. - idFun <- liftQuote $ runDefT () $ do - ty <- Lift.typeRep p - pure $ TyInst () PLC.idFun ty - let applied = Apply () idFun term - -- Here we use a 'Default' builtin semantics variant, because the - -- typechecker needs to be handed a builtin semantics variant (implementation detail). - -- See Note [Builtin semantics variants] - tcConfig <- PLC.getDefTypeCheckConfig (Original ()) - -- The PIR compiler *pointfully* needs a builtin semantics variant, but in - -- this instance of only "lifting" it is safe to default to any builtin - -- semantics variant, since the 'Lift' is impervious to builtins and will - -- not generate code containing builtins. See Note [Builtin semantics variants] - compiled <- flip runReaderT (toDefaultCompilationCtx tcConfig) $ compileProgram (Program () v applied) - -- PLC errors are parameterized over PLC.Terms, whereas PIR errors over PIR.Terms and as such, these prism errors cannot be unified. - -- We instead run the ExceptT, collect any PLC error and explicitly lift into a PIR error by wrapping with PIR._PLCError - plcConcrete <- runExceptT $ void $ PLC.inferTypeOfProgram tcConfig compiled - -- note: e is a scoped tyvar acting here AsError e uni (Provenance ()) - let plcPrismatic = first (view (re PIR._PLCError)) plcConcrete - liftEither plcPrismatic -- embed prismatic-either to a monaderror + -- See Note [Checking the type of a term with Typeable] + term <- PIR.embedTerm <$> PLC.rename plcTerm + -- We need to run Def *before* applying to the term, otherwise we may refer to abstract + -- types and we won't match up with the term. + idFun <- liftQuote $ runDefT () $ do + ty <- Lift.typeRep p + pure $ TyInst () PLC.idFun ty + let applied = Apply () idFun term + -- Here we use a 'Default' builtin semantics variant, because the + -- typechecker needs to be handed a builtin semantics variant (implementation detail). + -- See Note [Builtin semantics variants] + tcConfig <- PLC.getDefTypeCheckConfig (Original ()) + -- The PIR compiler *pointfully* needs a builtin semantics variant, but in + -- this instance of only "lifting" it is safe to default to any builtin + -- semantics variant, since the 'Lift' is impervious to builtins and will + -- not generate code containing builtins. See Note [Builtin semantics variants] + compiled <- + flip runReaderT (toDefaultCompilationCtx tcConfig) $ compileProgram (Program () v applied) + -- PLC errors are parameterized over PLC.Terms, whereas PIR errors over PIR.Terms and as such, these prism errors cannot be unified. + -- We instead run the ExceptT, collect any PLC error and explicitly lift into a PIR error by wrapping with PIR._PLCError + plcConcrete <- runExceptT $ void $ PLC.inferTypeOfProgram tcConfig compiled + -- note: e is a scoped tyvar acting here AsError e uni (Provenance ()) + let plcPrismatic = first (view (re PIR._PLCError)) plcConcrete + liftEither plcPrismatic -- embed prismatic-either to a monaderror -- | Try to interpret a PLC program as a 'CompiledCodeIn' of the given type. Returns successfully iff the program has the right type. typeCode - :: forall e a uni fun m . - ( Lift.Typeable uni a - , PIR.AsTypeError e (PIR.Term TyName Name uni fun ()) uni fun (Provenance ()) - , PIR.AsTypeErrorExt e uni (Provenance ()) - , PLC.AsFreeVariableError e - , PIR.AsError e uni fun (Provenance ()) - , MonadError e m, MonadQuote m - , PLC.GEq uni - , PLC.Typecheckable uni fun - , PLC.CaseBuiltin (PIR.Term TyName Name uni fun (Provenance ())) uni - , PLC.CaseBuiltin (UPLC.Term Name uni fun ()) uni - , PrettyUni uni, Pretty fun - , Default (PLC.CostingPart uni fun) - , Default (PIR.BuiltinsInfo uni fun) - , Default (PIR.RewriteRules uni fun) - , Hashable fun - ) - => Proxy a - -> PLC.Program PLC.TyName PLC.Name uni fun () - -> m (CompiledCodeIn uni fun a) + :: forall e a uni fun m + . ( Lift.Typeable uni a + , PIR.AsTypeError e (PIR.Term TyName Name uni fun ()) uni fun (Provenance ()) + , PIR.AsTypeErrorExt e uni (Provenance ()) + , PLC.AsFreeVariableError e + , PIR.AsError e uni fun (Provenance ()) + , MonadError e m + , MonadQuote m + , PLC.GEq uni + , PLC.Typecheckable uni fun + , PLC.CaseBuiltin (PIR.Term TyName Name uni fun (Provenance ())) uni + , PLC.CaseBuiltin (UPLC.Term Name uni fun ()) uni + , PrettyUni uni + , Pretty fun + , Default (PLC.CostingPart uni fun) + , Default (PIR.BuiltinsInfo uni fun) + , Default (PIR.RewriteRules uni fun) + , Hashable fun + ) + => Proxy a + -> PLC.Program PLC.TyName PLC.Name uni fun () + -> m (CompiledCodeIn uni fun a) typeCode p prog = do - _ <- typeCheckAgainst p prog - compiled <- - flip runReaderT PLC.defaultCompilationOpts - $ PLC.compileProgram prog - db <- traverseOf UPLC.progTerm UPLC.deBruijnTerm compiled - pure $ DeserializedCode (mempty <$ db) Nothing mempty + _ <- typeCheckAgainst p prog + compiled <- + flip runReaderT PLC.defaultCompilationOpts $ + PLC.compileProgram prog + db <- traverseOf UPLC.progTerm UPLC.deBruijnTerm compiled + pure $ DeserializedCode (mempty <$ db) Nothing mempty diff --git a/plutus-tx/src/PlutusTx/Lift/Class.hs b/plutus-tx/src/PlutusTx/Lift/Class.hs index 89f9e9d2053..0a86fefef03 100644 --- a/plutus-tx/src/PlutusTx/Lift/Class.hs +++ b/plutus-tx/src/PlutusTx/Lift/Class.hs @@ -13,11 +13,12 @@ {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} -module PlutusTx.Lift.Class - ( Typeable (..) - , Lift (..) - , RTCompile - ) where + +module PlutusTx.Lift.Class ( + Typeable (..), + Lift (..), + RTCompile, +) where import PlutusIR import PlutusIR.Compiler.Definitions @@ -75,23 +76,25 @@ inline all the definitions so that the overall expression can have the right con type RTCompile uni fun = DefT TH.Name uni fun () Quote --- | Class for types which have a corresponding Plutus IR type. Instances should always be derived, --- do not write your own instance! +{-| Class for types which have a corresponding Plutus IR type. Instances should always be derived, +do not write your own instance! +-} class Typeable uni (a :: k) where - -- | Get the Plutus IR type corresponding to this type. - typeRep :: Proxy a -> RTCompile uni fun (Type TyName uni ()) + -- | Get the Plutus IR type corresponding to this type. + typeRep :: Proxy a -> RTCompile uni fun (Type TyName uni ()) --- | Class for types which can be lifted into Plutus IR. Instances should be derived, do not write --- your own instance! +{-| Class for types which can be lifted into Plutus IR. Instances should be derived, do not write +your own instance! +-} class Lift uni a where - -- | Get a Plutus IR term corresponding to the given value. - lift :: a -> RTCompile uni fun (Term TyName Name uni fun ()) + -- | Get a Plutus IR term corresponding to the given value. + lift :: a -> RTCompile uni fun (Term TyName Name uni fun ()) -- This instance ensures that we can apply typeable type constructors to typeable arguments and get -- a typeable type. We need the kind variable, so that partial application of type constructors -- works. instance (Typeable uni (f :: GHC.Type -> k), Typeable uni (a :: GHC.Type)) => Typeable uni (f a) where - typeRep _ = TyApp () <$> typeRep (Proxy :: Proxy f) <*> typeRep (Proxy :: Proxy a) + typeRep _ = TyApp () <$> typeRep (Proxy :: Proxy f) <*> typeRep (Proxy :: Proxy a) {- Note [Typeable instances for function types] Surely there is an obvious 'Typeable' instance for 'a -> b': we just turn it directly @@ -106,137 +109,163 @@ silly thing to write, but it does work. -} -- See Note [Typeable instances for function types] instance Typeable uni (->) where - typeRep _ = do - a <- PLC.liftQuote $ PLC.freshTyName "a" - b <- PLC.liftQuote $ PLC.freshTyName "b" - let tvda = TyVarDecl () a (Type ()) - tvdb = TyVarDecl () b (Type ()) - pure $ mkIterTyLam [tvda, tvdb] $ TyFun () (mkTyVar () tvda) (mkTyVar () tvdb) + typeRep _ = do + a <- PLC.liftQuote $ PLC.freshTyName "a" + b <- PLC.liftQuote $ PLC.freshTyName "b" + let tvda = TyVarDecl () a (Type ()) + tvdb = TyVarDecl () b (Type ()) + pure $ mkIterTyLam [tvda, tvdb] $ TyFun () (mkTyVar () tvda) (mkTyVar () tvdb) -- Primitives typeRepBuiltin - :: forall k (a :: k) uni fun. uni `PLC.HasTypeLevel` a - => Proxy a -> RTCompile uni fun (Type TyName uni ()) + :: forall k (a :: k) uni fun + . (uni `PLC.HasTypeLevel` a) + => Proxy a -> RTCompile uni fun (Type TyName uni ()) typeRepBuiltin (_ :: Proxy a) = pure $ mkTyBuiltin @_ @a () liftBuiltin - :: forall a uni fun. uni `PLC.HasTermLevel` a - => a -> RTCompile uni fun (Term TyName Name uni fun ()) + :: forall a uni fun + . (uni `PLC.HasTermLevel` a) + => a -> RTCompile uni fun (Term TyName Name uni fun ()) liftBuiltin = pure . mkConstant () -instance (TypeError ('Text "Int is not supported, use Integer instead")) - => Typeable uni Int where - typeRep = Haskell.error "unsupported" +instance + (TypeError ('Text "Int is not supported, use Integer instead")) + => Typeable uni Int + where + typeRep = Haskell.error "unsupported" -instance (TypeError ('Text "Int is not supported, use Integer instead")) - => Lift uni Int where - lift = Haskell.error "unsupported" +instance + (TypeError ('Text "Int is not supported, use Integer instead")) + => Lift uni Int + where + lift = Haskell.error "unsupported" -instance uni `PLC.HasTypeLevel` Integer => Typeable uni BuiltinInteger where - typeRep = typeRepBuiltin +instance (uni `PLC.HasTypeLevel` Integer) => Typeable uni BuiltinInteger where + typeRep = typeRepBuiltin -- See Note [Lift and Typeable instances for builtins] -instance uni `PLC.HasTermLevel` Integer => Lift uni BuiltinInteger where - lift = liftBuiltin +instance (uni `PLC.HasTermLevel` Integer) => Lift uni BuiltinInteger where + lift = liftBuiltin -- See Note [Lift and Typeable instances for builtins] -instance uni `PLC.HasTypeLevel` BS.ByteString => Typeable uni BuiltinByteString where - typeRep _ = typeRepBuiltin (Proxy @BS.ByteString) +instance (uni `PLC.HasTypeLevel` BS.ByteString) => Typeable uni BuiltinByteString where + typeRep _ = typeRepBuiltin (Proxy @BS.ByteString) -- See Note [Lift and Typeable instances for builtins] -instance uni `PLC.HasTermLevel` BS.ByteString => Lift uni BuiltinByteString where - lift = liftBuiltin . fromBuiltin +instance (uni `PLC.HasTermLevel` BS.ByteString) => Lift uni BuiltinByteString where + lift = liftBuiltin . fromBuiltin -- See Note [Lift and Typeable instances for builtins] -instance uni `PLC.HasTypeLevel` T.Text => Typeable uni BuiltinString where - typeRep _ = typeRepBuiltin (Proxy @T.Text) +instance (uni `PLC.HasTypeLevel` T.Text) => Typeable uni BuiltinString where + typeRep _ = typeRepBuiltin (Proxy @T.Text) -- See Note [Lift and Typeable instances for builtins] -instance uni `PLC.HasTermLevel` T.Text => Lift uni BuiltinString where - lift = liftBuiltin . fromBuiltin +instance (uni `PLC.HasTermLevel` T.Text) => Lift uni BuiltinString where + lift = liftBuiltin . fromBuiltin -- See Note [Lift and Typeable instances for builtins] -instance uni `PLC.HasTypeLevel` () => Typeable uni BuiltinUnit where - typeRep _ = typeRepBuiltin (Proxy @()) +instance (uni `PLC.HasTypeLevel` ()) => Typeable uni BuiltinUnit where + typeRep _ = typeRepBuiltin (Proxy @()) -- See Note [Lift and Typeable instances for builtins] -instance uni `PLC.HasTermLevel` () => Lift uni BuiltinUnit where - lift = liftBuiltin . fromBuiltin +instance (uni `PLC.HasTermLevel` ()) => Lift uni BuiltinUnit where + lift = liftBuiltin . fromBuiltin -- See Note [Lift and Typeable instances for builtins] -instance uni `PLC.HasTypeLevel` Bool => Typeable uni BuiltinBool where - typeRep _ = typeRepBuiltin (Proxy @Bool) +instance (uni `PLC.HasTypeLevel` Bool) => Typeable uni BuiltinBool where + typeRep _ = typeRepBuiltin (Proxy @Bool) -- See Note [Lift and Typeable instances for builtins] -instance uni `PLC.HasTermLevel` Bool => Lift uni BuiltinBool where - lift = liftBuiltin . fromBuiltin +instance (uni `PLC.HasTermLevel` Bool) => Lift uni BuiltinBool where + lift = liftBuiltin . fromBuiltin -- See Note [Lift and Typeable instances for builtins] -instance uni `PLC.HasTypeLevel` [] => Typeable uni BuiltinList where - typeRep _ = typeRepBuiltin (Proxy @[]) +instance (uni `PLC.HasTypeLevel` []) => Typeable uni BuiltinList where + typeRep _ = typeRepBuiltin (Proxy @[]) -- See Note [Lift and Typeable instances for builtins] -instance (HasFromBuiltin arep, uni `PLC.HasTermLevel` [FromBuiltin arep]) => - Lift uni (BuiltinList arep) where - lift = liftBuiltin . fromBuiltin +instance + (HasFromBuiltin arep, uni `PLC.HasTermLevel` [FromBuiltin arep]) + => Lift uni (BuiltinList arep) + where + lift = liftBuiltin . fromBuiltin -- See Note [Lift and Typeable instances for builtins] -instance uni `PLC.HasTypeLevel` Strict.Vector => Typeable uni BuiltinArray where - typeRep _ = typeRepBuiltin (Proxy @Strict.Vector) +instance (uni `PLC.HasTypeLevel` Strict.Vector) => Typeable uni BuiltinArray where + typeRep _ = typeRepBuiltin (Proxy @Strict.Vector) -- See Note [Lift and Typeable instances for builtins] -instance ( HasFromBuiltin arep - , uni `PLC.HasTermLevel` Strict.Vector (FromBuiltin arep) - ) => Lift uni (BuiltinArray arep) where - lift = liftBuiltin . fromBuiltin +instance + ( HasFromBuiltin arep + , uni `PLC.HasTermLevel` Strict.Vector (FromBuiltin arep) + ) + => Lift uni (BuiltinArray arep) + where + lift = liftBuiltin . fromBuiltin -instance uni `PLC.HasTypeLevel` (,) => Typeable uni BuiltinPair where - typeRep _ = typeRepBuiltin (Proxy @(,)) +instance (uni `PLC.HasTypeLevel` (,)) => Typeable uni BuiltinPair where + typeRep _ = typeRepBuiltin (Proxy @(,)) instance - ( HasFromBuiltin arep, HasFromBuiltin brep - , uni `PLC.HasTermLevel` (FromBuiltin arep, FromBuiltin brep) - ) => Lift uni (BuiltinPair arep brep) where - lift = liftBuiltin . fromBuiltin + ( HasFromBuiltin arep + , HasFromBuiltin brep + , uni `PLC.HasTermLevel` (FromBuiltin arep, FromBuiltin brep) + ) + => Lift uni (BuiltinPair arep brep) + where + lift = liftBuiltin . fromBuiltin -- See Note [Lift and Typeable instances for builtins] -instance uni `PLC.HasTypeLevel` Data => Typeable uni BuiltinData where - typeRep _ = typeRepBuiltin (Proxy @Data) +instance (uni `PLC.HasTypeLevel` Data) => Typeable uni BuiltinData where + typeRep _ = typeRepBuiltin (Proxy @Data) -- See Note [Lift and Typeable instances for builtins] -instance uni `PLC.HasTermLevel` Data => Lift uni BuiltinData where - lift = liftBuiltin . fromBuiltin +instance (uni `PLC.HasTermLevel` Data) => Lift uni BuiltinData where + lift = liftBuiltin . fromBuiltin -- See Note [Lift and Typeable instances for builtins] -instance uni `PLC.HasTypeLevel` PlutusCore.Crypto.BLS12_381.G1.Element => - Typeable uni BuiltinBLS12_381_G1_Element where - typeRep _ = typeRepBuiltin (Proxy @PlutusCore.Crypto.BLS12_381.G1.Element) +instance + (uni `PLC.HasTypeLevel` PlutusCore.Crypto.BLS12_381.G1.Element) + => Typeable uni BuiltinBLS12_381_G1_Element + where + typeRep _ = typeRepBuiltin (Proxy @PlutusCore.Crypto.BLS12_381.G1.Element) -- See Note [Lift and Typeable instances for builtins] -instance uni `PLC.HasTermLevel` PlutusCore.Crypto.BLS12_381.G1.Element => - Lift uni BuiltinBLS12_381_G1_Element where - lift = liftBuiltin . fromBuiltin +instance + (uni `PLC.HasTermLevel` PlutusCore.Crypto.BLS12_381.G1.Element) + => Lift uni BuiltinBLS12_381_G1_Element + where + lift = liftBuiltin . fromBuiltin -- See Note [Lift and Typeable instances for builtins] -instance uni `PLC.HasTypeLevel` PlutusCore.Crypto.BLS12_381.G2.Element => - Typeable uni BuiltinBLS12_381_G2_Element where - typeRep _ = typeRepBuiltin (Proxy @PlutusCore.Crypto.BLS12_381.G2.Element) +instance + (uni `PLC.HasTypeLevel` PlutusCore.Crypto.BLS12_381.G2.Element) + => Typeable uni BuiltinBLS12_381_G2_Element + where + typeRep _ = typeRepBuiltin (Proxy @PlutusCore.Crypto.BLS12_381.G2.Element) -- See Note [Lift and Typeable instances for builtins] -instance uni `PLC.HasTermLevel` PlutusCore.Crypto.BLS12_381.G2.Element => - Lift uni BuiltinBLS12_381_G2_Element where - lift = liftBuiltin . fromBuiltin +instance + (uni `PLC.HasTermLevel` PlutusCore.Crypto.BLS12_381.G2.Element) + => Lift uni BuiltinBLS12_381_G2_Element + where + lift = liftBuiltin . fromBuiltin -- See Note [Lift and Typeable instances for builtins] -instance uni `PLC.HasTypeLevel` PlutusCore.Crypto.BLS12_381.Pairing.MlResult => - Typeable uni BuiltinBLS12_381_MlResult where - typeRep _ = typeRepBuiltin (Proxy @PlutusCore.Crypto.BLS12_381.Pairing.MlResult) +instance + (uni `PLC.HasTypeLevel` PlutusCore.Crypto.BLS12_381.Pairing.MlResult) + => Typeable uni BuiltinBLS12_381_MlResult + where + typeRep _ = typeRepBuiltin (Proxy @PlutusCore.Crypto.BLS12_381.Pairing.MlResult) -- See Note [Lift and Typeable instances for builtins] -instance uni `PLC.HasTermLevel` PlutusCore.Crypto.BLS12_381.Pairing.MlResult => - Lift uni BuiltinBLS12_381_MlResult where - lift = liftBuiltin . fromBuiltin +instance + (uni `PLC.HasTermLevel` PlutusCore.Crypto.BLS12_381.Pairing.MlResult) + => Lift uni BuiltinBLS12_381_MlResult + where + lift = liftBuiltin . fromBuiltin {- Note [Lift and Typeable instances for builtins] We can, generally, lift builtin values. We just make a constant with the value inside. diff --git a/plutus-tx/src/PlutusTx/Lift/Instances.hs b/plutus-tx/src/PlutusTx/Lift/Instances.hs index 98832e7b576..8aa452ae83f 100644 --- a/plutus-tx/src/PlutusTx/Lift/Instances.hs +++ b/plutus-tx/src/PlutusTx/Lift/Instances.hs @@ -12,6 +12,7 @@ {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -Wno-orphans #-} + module PlutusTx.Lift.Instances () where import PlutusTx.Bool (Bool (..)) @@ -29,9 +30,9 @@ makeLift ''Either makeLift ''These makeLift ''[] makeLift ''() + -- include a few tuple instances for convenience makeLift ''(,) makeLift ''(,,) makeLift ''(,,,) makeLift ''(,,,,) - diff --git a/plutus-tx/src/PlutusTx/Lift/TH.hs b/plutus-tx/src/PlutusTx/Lift/TH.hs index 0d1cc0313b6..4ded54adb92 100644 --- a/plutus-tx/src/PlutusTx/Lift/TH.hs +++ b/plutus-tx/src/PlutusTx/Lift/TH.hs @@ -18,11 +18,12 @@ -- It is complex to mix TH with polymorphisms. Core lint can sometimes catch problems -- caused by using polymorphisms the wrong way, e.g., accidentally using impredicative types. {-# OPTIONS_GHC -dcore-lint #-} + module PlutusTx.Lift.TH ( - makeTypeable - , makeLift - , LiftError (..) - ) where + makeTypeable, + makeLift, + LiftError (..), +) where import PlutusTx.Lift.Class import PlutusTx.Lift.THUtils @@ -63,29 +64,30 @@ import Prelude as Haskell type RTCompileScope uni fun = ReaderT (LocalVars uni) (RTCompile uni fun) type THCompile = StateT Deps (ReaderT THLocalVars (ExceptT LiftError TH.Q)) -data LiftError = UnsupportedLiftKind !TH.Kind - | UnsupportedLiftType !TH.Type - | UserLiftError !T.Text - | LiftMissingDataCons !TH.Name - | LiftMissingVar !TH.Name - deriving anyclass (Prelude.Exception) +data LiftError + = UnsupportedLiftKind !TH.Kind + | UnsupportedLiftType !TH.Type + | UserLiftError !T.Text + | LiftMissingDataCons !TH.Name + | LiftMissingVar !TH.Name + deriving anyclass (Prelude.Exception) instance PP.Pretty LiftError where - pretty (UnsupportedLiftType t) = "Unsupported lift type: " PP.<+> PP.viaShow t - pretty (UnsupportedLiftKind t) = "Unsupported lift kind: " PP.<+> PP.viaShow t - pretty (UserLiftError t) = PP.pretty t - pretty (LiftMissingDataCons n) = "Constructors not created for type: " PP.<+> PP.viaShow n - pretty (LiftMissingVar n) = "Unknown local variable: " PP.<+> PP.viaShow n + pretty (UnsupportedLiftType t) = "Unsupported lift type: " PP.<+> PP.viaShow t + pretty (UnsupportedLiftKind t) = "Unsupported lift kind: " PP.<+> PP.viaShow t + pretty (UserLiftError t) = PP.pretty t + pretty (LiftMissingDataCons n) = "Constructors not created for type: " PP.<+> PP.viaShow n + pretty (LiftMissingVar n) = "Unknown local variable: " PP.<+> PP.viaShow n instance Show LiftError where - show = show . PP.pretty -- for Control.Exception + show = show . PP.pretty -- for Control.Exception {- Note [Impredicative function universe wrappers] We are completely independent of the function universe. We generate constants (so we care about the type universe), but we never generate builtin functions. This is indicated in the fact that e.g. 'typeRep' has type 'forall fun . ...'. Note what this says: the -*caller* of 'typeRep` can decide on 'fun'. +\*caller* of 'typeRep` can decide on 'fun'. So how do we deal with this? A wrong way is to parameterize our (TH) functions by 'fun'. This is wrong, because this 'fun' is a type variable at TH-generation time, and we want a type variable in the generated code. @@ -109,25 +111,25 @@ for different variants of this impredicative type. Which is annoying, but does w -- See Note [Impredicative function universe wrappers] newtype CompileTerm = CompileTerm - { unCompileTerm :: - forall fun. - RTCompile PLC.DefaultUni fun (Term TyName Name PLC.DefaultUni fun ()) + { unCompileTerm + :: forall fun + . RTCompile PLC.DefaultUni fun (Term TyName Name PLC.DefaultUni fun ()) } newtype CompileType = CompileType - { unCompileType :: - forall fun. - RTCompile PLC.DefaultUni fun (Type TyName PLC.DefaultUni ()) + { unCompileType + :: forall fun + . RTCompile PLC.DefaultUni fun (Type TyName PLC.DefaultUni ()) } newtype CompileTypeScope = CompileTypeScope - { unCompileTypeScope :: - forall fun. - RTCompileScope PLC.DefaultUni fun (Type TyName PLC.DefaultUni ()) + { unCompileTypeScope + :: forall fun + . RTCompileScope PLC.DefaultUni fun (Type TyName PLC.DefaultUni ()) } newtype CompileDeclFun = CompileDeclFun - { unCompileDeclFun :: - forall fun. - Type TyName PLC.DefaultUni () -> - RTCompileScope PLC.DefaultUni fun (VarDecl TyName Name PLC.DefaultUni ()) + { unCompileDeclFun + :: forall fun + . Type TyName PLC.DefaultUni () + -> RTCompileScope PLC.DefaultUni fun (VarDecl TyName Name PLC.DefaultUni ()) } {- Note [Type variables] @@ -150,6 +152,7 @@ but in the Lift case we will never populate the local scope. -- | A scope for type variables. See Note [Type variables]. type LocalVars uni = Map.Map TH.Name (Type TyName uni ()) + type THLocalVars = Set.Set TH.Name {- Note [Lifting newtypes] @@ -185,24 +188,25 @@ withTyVars mappings = local (\scope -> foldl' (\acc (n, tvd) -> Map.insert n (mk thWithTyVars :: (MonadReader THLocalVars m) => [TH.Name] -> m a -> m a thWithTyVars names = local (\scope -> foldr Set.insert scope names) --- | Get all the named types which we depend on to define the current type. --- Note that this relies on dependencies having been added with type synonyms --- resolved! +{-| Get all the named types which we depend on to define the current type. +Note that this relies on dependencies having been added with type synonyms +resolved! +-} getTyConDeps :: Deps -> Set.Set TH.Name getTyConDeps deps = Set.fromList $ mapMaybe typeableDep $ Set.toList deps - where - typeableDep (TypeableDep (TH.ConT n)) = Just n - typeableDep _ = Nothing + where + typeableDep (TypeableDep (TH.ConT n)) = Just n + typeableDep _ = Nothing addTypeableDep :: TH.Type -> THCompile () addTypeableDep ty = do - ty' <- normalizeAndResolve ty - modify $ Set.insert $ TypeableDep ty' + ty' <- normalizeAndResolve ty + modify $ Set.insert $ TypeableDep ty' addLiftDep :: TH.Type -> THCompile () addLiftDep ty = do - ty' <- normalizeAndResolve ty - modify $ Set.insert $ LiftDep ty' + ty' <- normalizeAndResolve ty + modify $ Set.insert $ LiftDep ty' -- Constraints @@ -216,8 +220,8 @@ liftPir uni ty = TH.classPred ''Lift [uni, ty] toConstraint :: TH.Type -> Dep -> TH.Pred toConstraint uni = \case - TypeableDep n -> typeablePir uni n - LiftDep ty -> liftPir uni ty + TypeableDep n -> typeablePir uni n + LiftDep ty -> liftPir uni ty {- Note [Closed constraints] There is no point adding constraints that are "closed", i.e. don't mention any of the @@ -235,10 +239,13 @@ normalizeAndResolve ty = normalizeType <$> (Trans.lift $ Trans.lift $ Trans.lift -- See Note [Ordering of constructors] sortedCons :: TH.DatatypeInfo -> [TH.ConstructorInfo] -sortedCons TH.DatatypeInfo{TH.datatypeName=tyName, TH.datatypeCons=cons} = - -- We need to compare 'TH.Name's on their string name *not* on the unique - let sorted = sortBy (\(TH.constructorName -> (TH.Name o1 _)) (TH.constructorName -> (TH.Name o2 _)) -> compare o1 o2) cons - in if tyName == ''Bool || tyName == ''[] then reverse sorted else sorted +sortedCons TH.DatatypeInfo{TH.datatypeName = tyName, TH.datatypeCons = cons} = + -- We need to compare 'TH.Name's on their string name *not* on the unique + let sorted = + sortBy + (\(TH.constructorName -> (TH.Name o1 _)) (TH.constructorName -> (TH.Name o2 _)) -> compare o1 o2) + cons + in if tyName == ''Bool || tyName == ''[] then reverse sorted else sorted #if MIN_VERSION_template_haskell(2,17,0) tvNameAndKind :: TH.TyVarBndrUnit -> THCompile (TH.Name, Kind ()) @@ -265,272 +272,299 @@ tvNameAndKind = \case -- Note: we can actually do this entirely at TH-time, which is nice compileKind :: TH.Kind -> THCompile (Kind ()) compileKind = \case - TH.StarT -> pure $ Type () - TH.AppT (TH.AppT TH.ArrowT k1) k2 -> KindArrow () <$> compileKind k1 <*> compileKind k2 - k -> throwError $ UnsupportedLiftKind k + TH.StarT -> pure $ Type () + TH.AppT (TH.AppT TH.ArrowT k1) k2 -> KindArrow () <$> compileKind k1 <*> compileKind k2 + k -> throwError $ UnsupportedLiftKind k compileType :: TH.Type -> THCompile (TH.TExpQ CompileTypeScope) compileType = \case - TH.AppT t1 t2 -> do - t1' <- compileType t1 - t2' <- compileType t2 - pure . TH.examineCode $ [|| CompileTypeScope (TyApp () <$> unCompileTypeScope ($$(TH.liftCode t1')) <*> unCompileTypeScope ($$(TH.liftCode t2'))) ||] - t@(TH.ConT name) -> compileTypeableType t name - -- See Note [Type variables] - t@(TH.VarT name) -> do - isLocal <- asks (Set.member name) - if isLocal - then pure . TH.examineCode $ [|| - CompileTypeScope $ do - vars <- ask - case Map.lookup name vars of - Just ty -> pure ty - Nothing -> Prelude.throw $ LiftMissingVar name - ||] - else compileTypeableType t name - t -> throwError $ UnsupportedLiftType t + TH.AppT t1 t2 -> do + t1' <- compileType t1 + t2' <- compileType t2 + pure . TH.examineCode $ + [|| + CompileTypeScope + (TyApp () <$> unCompileTypeScope ($$(TH.liftCode t1')) <*> unCompileTypeScope ($$(TH.liftCode t2'))) + ||] + t@(TH.ConT name) -> compileTypeableType t name + -- See Note [Type variables] + t@(TH.VarT name) -> do + isLocal <- asks (Set.member name) + if isLocal + then + pure . TH.examineCode $ + [|| + CompileTypeScope $ do + vars <- ask + case Map.lookup name vars of + Just ty -> pure ty + Nothing -> Prelude.throw $ LiftMissingVar name + ||] + else compileTypeableType t name + t -> throwError $ UnsupportedLiftType t -- | Compile a type with the given name using 'typeRep' and incurring a corresponding 'Typeable' dependency. compileTypeableType :: TH.Type -> TH.Name -> THCompile (TH.TExpQ CompileTypeScope) compileTypeableType ty name = do - addTypeableDep ty - -- We need the `unsafeTExpCoerce` since this will necessarily involve - -- types we don't know now: the type which this instance is for (which - -- appears in the proxy argument). However, since we know the type of - -- `typeRep` we can get back into typed land quickly. - let trep :: TH.TExpQ CompileType - trep = TH.unsafeTExpCoerce [| CompileType (typeRep (Proxy :: Proxy $(pure ty))) |] - pure . TH.examineCode $ [|| - let trep' :: forall fun . RTCompileScope PLC.DefaultUni fun (Type TyName PLC.DefaultUni ()) - trep' = Trans.lift $ unCompileType ($$(TH.liftCode trep)) - in CompileTypeScope $ do - maybeType <- lookupType () name - case maybeType of - Just t -> pure t - -- this will need some additional constraints in scope - Nothing -> trep' - ||] + addTypeableDep ty + -- We need the `unsafeTExpCoerce` since this will necessarily involve + -- types we don't know now: the type which this instance is for (which + -- appears in the proxy argument). However, since we know the type of + -- `typeRep` we can get back into typed land quickly. + let trep :: TH.TExpQ CompileType + trep = TH.unsafeTExpCoerce [|CompileType (typeRep (Proxy :: Proxy $(pure ty)))|] + pure . TH.examineCode $ + [|| + let trep' :: forall fun. RTCompileScope PLC.DefaultUni fun (Type TyName PLC.DefaultUni ()) + trep' = Trans.lift $ unCompileType ($$(TH.liftCode trep)) + in CompileTypeScope $ do + maybeType <- lookupType () name + case maybeType of + Just t -> pure t + -- this will need some additional constraints in scope + Nothing -> trep' + ||] -- Just here so we can pin down the type variables without using TypeApplications in the generated code recordAlias' :: TH.Name -> RTCompileScope PLC.DefaultUni fun () recordAlias' = recordAlias -- Just here so we can pin down the type variables without using TypeApplications in the generated code -defineDatatype' :: TH.Name -> DatatypeDef TyName Name PLC.DefaultUni () -> Set.Set TH.Name -> RTCompileScope PLC.DefaultUni fun () +defineDatatype' + :: TH.Name + -> DatatypeDef TyName Name PLC.DefaultUni () + -> Set.Set TH.Name + -> RTCompileScope PLC.DefaultUni fun () defineDatatype' = defineDatatype -- TODO: there is an unpleasant amount of duplication between this and the main compiler, but -- I'm not sure how to unify them better compileTypeRep :: TH.DatatypeInfo -> THCompile (TH.TExpQ CompileType) -compileTypeRep dt@TH.DatatypeInfo{TH.datatypeName=tyName, TH.datatypeVars=tvs} = do - tvNamesAndKinds <- traverse tvNameAndKind tvs - -- annoyingly th-abstraction doesn't give us a kind we can compile here - let typeKind = foldr (\(_, k) acc -> KindArrow () k acc) (Type ()) tvNamesAndKinds - let cons = sortedCons dt - - thWithTyVars (fmap fst tvNamesAndKinds) $ if isNewtype dt - then do +compileTypeRep dt@TH.DatatypeInfo{TH.datatypeName = tyName, TH.datatypeVars = tvs} = do + tvNamesAndKinds <- traverse tvNameAndKind tvs + -- annoyingly th-abstraction doesn't give us a kind we can compile here + let typeKind = foldr (\(_, k) acc -> KindArrow () k acc) (Type ()) tvNamesAndKinds + let cons = sortedCons dt + + thWithTyVars (fmap fst tvNamesAndKinds) $ + if isNewtype dt + then do -- Extract the unique field of the unique constructor argTy <- case cons of - [ TH.ConstructorInfo {TH.constructorFields=[argTy]} ] -> (compileType <=< normalizeAndResolve) argTy - _ -> throwError $ UserLiftError "Newtypes must have a single constructor with a single argument" + [TH.ConstructorInfo{TH.constructorFields = [argTy]}] -> (compileType <=< normalizeAndResolve) argTy + _ -> throwError $ UserLiftError "Newtypes must have a single constructor with a single argument" deps <- gets getTyConDeps - pure . TH.examineCode $ [|| - let - argTy' :: forall fun . RTCompileScope PLC.DefaultUni fun (Type TyName PLC.DefaultUni ()) - argTy' = unCompileTypeScope $$(TH.liftCode argTy) - act :: forall fun . RTCompileScope PLC.DefaultUni fun (Type TyName PLC.DefaultUni ()) - act = do - maybeDefined <- lookupType () tyName - case maybeDefined of - Just ty -> pure ty - Nothing -> do - (_, dtvd) <- mkTyVarDecl tyName typeKind - tvds <- traverse (uncurry mkTyVarDecl) tvNamesAndKinds - - alias <- withTyVars tvds $ mkIterTyLam (fmap snd tvds) <$> argTy' - defineType tyName (PLC.Def dtvd alias) deps - recordAlias' tyName - pure alias - in CompileType $ runReaderT act mempty - ||] - else do + pure . TH.examineCode $ + [|| + let + argTy' :: forall fun. RTCompileScope PLC.DefaultUni fun (Type TyName PLC.DefaultUni ()) + argTy' = unCompileTypeScope $$(TH.liftCode argTy) + act :: forall fun. RTCompileScope PLC.DefaultUni fun (Type TyName PLC.DefaultUni ()) + act = do + maybeDefined <- lookupType () tyName + case maybeDefined of + Just ty -> pure ty + Nothing -> do + (_, dtvd) <- mkTyVarDecl tyName typeKind + tvds <- traverse (uncurry mkTyVarDecl) tvNamesAndKinds + + alias <- withTyVars tvds $ mkIterTyLam (fmap snd tvds) <$> argTy' + defineType tyName (PLC.Def dtvd alias) deps + recordAlias' tyName + pure alias + in + CompileType $ runReaderT act mempty + ||] + else do constrExprs <- traverse compileConstructorDecl cons deps <- gets getTyConDeps - pure . TH.examineCode $ [|| + pure . TH.examineCode $ + [|| let - constrExprs' :: [CompileDeclFun] - constrExprs' = $$(TH.liftCode $ tyListE constrExprs) - act :: forall fun . RTCompileScope PLC.DefaultUni fun (Type TyName PLC.DefaultUni ()) - act = do - maybeDefined <- lookupType () tyName - case maybeDefined of - Just ty -> pure ty - Nothing -> do - (_, dtvd) <- mkTyVarDecl tyName typeKind - tvds <- traverse (uncurry mkTyVarDecl) tvNamesAndKinds - - let resultType = mkIterTyAppNoAnn (mkTyVar () dtvd) (fmap (mkTyVar () . snd) tvds) - matchName <- safeFreshName (T.pack "match_" <> showName tyName) - - -- See Note [Occurrences of recursive names] - let fakeDatatype = Datatype () dtvd [] matchName [] - - defineDatatype' tyName (PLC.Def dtvd fakeDatatype) Set.empty - - withTyVars tvds $ do - -- The TH expressions are in fact all functions that take the result type, so - -- we need to apply them - let constrActs :: RTCompileScope PLC.DefaultUni fun [VarDecl TyName Name PLC.DefaultUni ()] - constrActs = sequence $ fmap (\x -> unCompileDeclFun x) constrExprs' <*> [resultType] - constrs <- constrActs - - let datatype = Datatype () dtvd (fmap snd tvds) matchName constrs - - defineDatatype tyName (PLC.Def dtvd datatype) deps - pure $ mkTyVar () dtvd - in CompileType $ runReaderT act mempty + constrExprs' :: [CompileDeclFun] + constrExprs' = $$(TH.liftCode $ tyListE constrExprs) + act :: forall fun. RTCompileScope PLC.DefaultUni fun (Type TyName PLC.DefaultUni ()) + act = do + maybeDefined <- lookupType () tyName + case maybeDefined of + Just ty -> pure ty + Nothing -> do + (_, dtvd) <- mkTyVarDecl tyName typeKind + tvds <- traverse (uncurry mkTyVarDecl) tvNamesAndKinds + + let resultType = mkIterTyAppNoAnn (mkTyVar () dtvd) (fmap (mkTyVar () . snd) tvds) + matchName <- safeFreshName (T.pack "match_" <> showName tyName) + + -- See Note [Occurrences of recursive names] + let fakeDatatype = Datatype () dtvd [] matchName [] + + defineDatatype' tyName (PLC.Def dtvd fakeDatatype) Set.empty + + withTyVars tvds $ do + -- The TH expressions are in fact all functions that take the result type, so + -- we need to apply them + let constrActs :: RTCompileScope PLC.DefaultUni fun [VarDecl TyName Name PLC.DefaultUni ()] + constrActs = sequence $ fmap (\x -> unCompileDeclFun x) constrExprs' <*> [resultType] + constrs <- constrActs + + let datatype = Datatype () dtvd (fmap snd tvds) matchName constrs + + defineDatatype tyName (PLC.Def dtvd datatype) deps + pure $ mkTyVar () dtvd + in + CompileType $ runReaderT act mempty ||] compileConstructorDecl - :: TH.ConstructorInfo - -> THCompile (TH.TExpQ CompileDeclFun) -compileConstructorDecl TH.ConstructorInfo{TH.constructorName=name, TH.constructorFields=argTys} = do - tyExprs <- traverse (compileType <=< normalizeAndResolve) argTys - pure . TH.examineCode $ [|| - let - tyExprs' :: forall fun . [RTCompileScope PLC.DefaultUni fun (Type TyName PLC.DefaultUni ())] - tyExprs' = fmap (\x -> unCompileTypeScope x) $$(TH.liftCode $ tyListE tyExprs) - -- we won't know the result type until runtime, so take it as an argument - in CompileDeclFun $ \resultType -> do - tys' <- sequence tyExprs' - let constrTy = mkIterTyFun () tys' resultType - constrName <- safeFreshName $ showName name - pure $ VarDecl () constrName constrTy - ||] + :: TH.ConstructorInfo + -> THCompile (TH.TExpQ CompileDeclFun) +compileConstructorDecl TH.ConstructorInfo{TH.constructorName = name, TH.constructorFields = argTys} = do + tyExprs <- traverse (compileType <=< normalizeAndResolve) argTys + pure . TH.examineCode $ + [|| + let + tyExprs' :: forall fun. [RTCompileScope PLC.DefaultUni fun (Type TyName PLC.DefaultUni ())] + tyExprs' = fmap (\x -> unCompileTypeScope x) $$(TH.liftCode $ tyListE tyExprs) + in + -- we won't know the result type until runtime, so take it as an argument + CompileDeclFun $ \resultType -> do + tys' <- sequence tyExprs' + let constrTy = mkIterTyFun () tys' resultType + constrName <- safeFreshName $ showName name + pure $ VarDecl () constrName constrTy + ||] makeTypeable :: TH.Type -> TH.Name -> TH.Q [TH.Dec] makeTypeable uni name = do - requireExtension TH.ScopedTypeVariables + requireExtension TH.ScopedTypeVariables - info <- TH.reifyDatatype name - (rhs, deps) <- runTHCompile $ compileTypeRep info + info <- TH.reifyDatatype name + (rhs, deps) <- runTHCompile $ compileTypeRep info - -- See Note [Closed constraints] - let constraints = filter (not . isClosedConstraint) $ toConstraint uni <$> Set.toList deps - -- We need to unwrap the wrapper at the last minute, see Note [Impredicative function universe wrappers] - let unwrappedRhs = [| unCompileType |] `TH.appE` TH.unTypeQ rhs + -- See Note [Closed constraints] + let constraints = filter (not . isClosedConstraint) $ toConstraint uni <$> Set.toList deps + -- We need to unwrap the wrapper at the last minute, see Note [Impredicative function universe wrappers] + let unwrappedRhs = [|unCompileType|] `TH.appE` TH.unTypeQ rhs - decl <- TH.funD 'typeRep [TH.clause [TH.wildP] (TH.normalB unwrappedRhs) []] - pure [TH.InstanceD Nothing constraints (typeablePir uni (TH.ConT name)) [decl]] + decl <- TH.funD 'typeRep [TH.clause [TH.wildP] (TH.normalB unwrappedRhs) []] + pure [TH.InstanceD Nothing constraints (typeablePir uni (TH.ConT name)) [decl]] compileLift :: TH.DatatypeInfo -> THCompile [TH.Q TH.Clause] -compileLift dt = traverse (uncurry (compileConstructorClause dt)) (zip [0..] (sortedCons dt)) +compileLift dt = traverse (uncurry (compileConstructorClause dt)) (zip [0 ..] (sortedCons dt)) compileConstructorClause - :: TH.DatatypeInfo -> Int -> TH.ConstructorInfo -> THCompile (TH.Q TH.Clause) -compileConstructorClause dt@TH.DatatypeInfo{TH.datatypeName=tyName, TH.datatypeVars=tvs} index TH.ConstructorInfo{TH.constructorName=name, TH.constructorFields=argTys} = do - -- need to be able to lift the argument types - traverse_ addLiftDep argTys - - -- We need the actual type parameters for the non-newtype case, and we have to do - -- it out here, but it will give us redundant constraints in the newtype case, - -- so we fudge it. - tyExprs <- if isNewtype dt then pure [] else for tvs $ \tv -> do - (n, _) <- tvNameAndKind tv - compileType (TH.VarT n) - - -- Build the patter for the clause definition. All the argument will be called "arg". - patNames <- Trans.lift $ Trans.lift $ Trans.lift $ for argTys $ \_ -> TH.newName "arg" - let pat = TH.conP name (fmap TH.varP patNames) - - -- `lift arg` for each arg we bind in the pattern. We need the `unsafeTExpCoerce` since this will - -- necessarily involve types we don't know now: the types of each argument. However, since we - -- know the type of `lift arg` we can get back into typed land quickly. - let liftExprs :: [TH.TExpQ CompileTerm] - liftExprs = fmap (\pn -> TH.unsafeTExpCoerce $ [| CompileTerm $(TH.varE 'lift `TH.appE` TH.varE pn) |]) patNames - - rhsExpr <- if isNewtype dt - then case liftExprs of - [argExpr] -> pure argExpr - _ -> throwError $ UserLiftError "Newtypes must have a single constructor with a single argument" - else - pure . TH.examineCode $ [|| - -- We bind all the splices with explicit signatures to ensure we - -- get type errors as soon as possible, and to aid debugging. - let - liftExprs' :: [CompileTerm] - liftExprs' = $$(TH.liftCode $ tyListE liftExprs) - -- We need the `unsafeTExpCoerce` since this will necessarily involve - -- types we don't know now: the type which this instance is for (which - -- appears in the proxy argument). However, since we know the type of - -- `typeRep` we can get back into typed land quickly. - trep :: CompileType - trep = $$(TH.unsafeCodeCoerce [| CompileType (typeRep (Proxy :: Proxy $(TH.conT tyName))) |]) - in CompileTerm $ do - -- force creation of datatype - _ <- unCompileType trep - - -- get the right constructor - maybeConstructors <- lookupConstructors tyName - constrs <- case maybeConstructors of - Nothing -> Prelude.throw $ LiftMissingDataCons tyName - Just cs -> pure cs - let constr = constrs !! index - - lifts :: [Term TyName Name PLC.DefaultUni fun ()] <- sequence (unCompileTerm <$> liftExprs') - -- The 'fun' that is referenced here is the 'fun' that we bind the line above. - -- If it was forall-bound instead, 'typeExprs\'' wouldn't type check, - -- because 'Type' does not determine 'fun' (unlike 'Term' in 'liftExprs\'' - -- above). - let tyExprs' :: [RTCompileScope PLC.DefaultUni fun (Type TyName PLC.DefaultUni ())] - tyExprs' = fmap (\x -> unCompileTypeScope x) $$(TH.liftCode $ tyListE tyExprs) - -- The types are compiled in an (empty) local scope. - types <- flip runReaderT mempty $ sequence tyExprs' - - pure $ mkIterAppNoAnn (mkIterInstNoAnn constr types) lifts - ||] - pure $ TH.clause [pat] (TH.normalB $ [| unCompileTerm $(TH.unTypeQ rhsExpr) |]) [] + :: TH.DatatypeInfo -> Int -> TH.ConstructorInfo -> THCompile (TH.Q TH.Clause) +compileConstructorClause dt@TH.DatatypeInfo{TH.datatypeName = tyName, TH.datatypeVars = tvs} index TH.ConstructorInfo{TH.constructorName = name, TH.constructorFields = argTys} = do + -- need to be able to lift the argument types + traverse_ addLiftDep argTys + + -- We need the actual type parameters for the non-newtype case, and we have to do + -- it out here, but it will give us redundant constraints in the newtype case, + -- so we fudge it. + tyExprs <- + if isNewtype dt + then pure [] + else for tvs $ \tv -> do + (n, _) <- tvNameAndKind tv + compileType (TH.VarT n) + + -- Build the patter for the clause definition. All the argument will be called "arg". + patNames <- Trans.lift $ Trans.lift $ Trans.lift $ for argTys $ \_ -> TH.newName "arg" + let pat = TH.conP name (fmap TH.varP patNames) + + -- `lift arg` for each arg we bind in the pattern. We need the `unsafeTExpCoerce` since this will + -- necessarily involve types we don't know now: the types of each argument. However, since we + -- know the type of `lift arg` we can get back into typed land quickly. + let liftExprs :: [TH.TExpQ CompileTerm] + liftExprs = + fmap (\pn -> TH.unsafeTExpCoerce $ [|CompileTerm $(TH.varE 'lift `TH.appE` TH.varE pn)|]) patNames + + rhsExpr <- + if isNewtype dt + then case liftExprs of + [argExpr] -> pure argExpr + _ -> + throwError $ UserLiftError "Newtypes must have a single constructor with a single argument" + else + pure . TH.examineCode $ + [|| + -- We bind all the splices with explicit signatures to ensure we + -- get type errors as soon as possible, and to aid debugging. + let + liftExprs' :: [CompileTerm] + liftExprs' = $$(TH.liftCode $ tyListE liftExprs) + -- We need the `unsafeTExpCoerce` since this will necessarily involve + -- types we don't know now: the type which this instance is for (which + -- appears in the proxy argument). However, since we know the type of + -- `typeRep` we can get back into typed land quickly. + trep :: CompileType + trep = $$(TH.unsafeCodeCoerce [|CompileType (typeRep (Proxy :: Proxy $(TH.conT tyName)))|]) + in + CompileTerm $ do + -- force creation of datatype + _ <- unCompileType trep + + -- get the right constructor + maybeConstructors <- lookupConstructors tyName + constrs <- case maybeConstructors of + Nothing -> Prelude.throw $ LiftMissingDataCons tyName + Just cs -> pure cs + let constr = constrs !! index + + lifts :: [Term TyName Name PLC.DefaultUni fun ()] <- sequence (unCompileTerm <$> liftExprs') + -- The 'fun' that is referenced here is the 'fun' that we bind the line above. + -- If it was forall-bound instead, 'typeExprs\'' wouldn't type check, + -- because 'Type' does not determine 'fun' (unlike 'Term' in 'liftExprs\'' + -- above). + let tyExprs' :: [RTCompileScope PLC.DefaultUni fun (Type TyName PLC.DefaultUni ())] + tyExprs' = fmap (\x -> unCompileTypeScope x) $$(TH.liftCode $ tyListE tyExprs) + -- The types are compiled in an (empty) local scope. + types <- flip runReaderT mempty $ sequence tyExprs' + + pure $ mkIterAppNoAnn (mkIterInstNoAnn constr types) lifts + ||] + pure $ TH.clause [pat] (TH.normalB $ [|unCompileTerm $(TH.unTypeQ rhsExpr)|]) [] makeLift :: TH.Name -> TH.Q [TH.Dec] makeLift name = do - requireExtension TH.ScopedTypeVariables + requireExtension TH.ScopedTypeVariables - let uni = TH.ConT ''PLC.DefaultUni - -- we need this too if we're lifting - typeableDecs <- makeTypeable uni name - info <- TH.reifyDatatype name + let uni = TH.ConT ''PLC.DefaultUni + -- we need this too if we're lifting + typeableDecs <- makeTypeable uni name + info <- TH.reifyDatatype name - let datatypeType = TH.datatypeType info + let datatypeType = TH.datatypeType info - (clauses, deps) <- runTHCompile $ compileLift info + (clauses, deps) <- runTHCompile $ compileLift info - {- - Here we *do* need to add some constraints, because we're going to generate things like - `instance Lift a => Lift (Maybe a)`. We can't just leave these open because they refer to type variables. + {- + Here we *do* need to add some constraints, because we're going to generate things like + `instance Lift a => Lift (Maybe a)`. We can't just leave these open because they refer to type variables. - We *could* put in a Typeable constraint for the type itself. This is somewhat more correct, - but GHC warns us if we do this because we always also define the instance alongside. So we just - leave it out. + We *could* put in a Typeable constraint for the type itself. This is somewhat more correct, + but GHC warns us if we do this because we always also define the instance alongside. So we just + leave it out. - We also need to remove any Lift constraints we get for the type we're defining. This can happen if - we're recursive, since we'll probably end up with constructor arguments of the current type. - We don't want `instance Lift [a] => Lift [a]`! - -} - let prunedDeps = Set.delete (LiftDep datatypeType) deps - -- See Note [Closed constraints] - let constraints = filter (not . isClosedConstraint) $ toConstraint uni <$> Set.toList prunedDeps + We also need to remove any Lift constraints we get for the type we're defining. This can happen if + we're recursive, since we'll probably end up with constructor arguments of the current type. + We don't want `instance Lift [a] => Lift [a]`! + -} + let prunedDeps = Set.delete (LiftDep datatypeType) deps + -- See Note [Closed constraints] + let constraints = filter (not . isClosedConstraint) $ toConstraint uni <$> Set.toList prunedDeps - decl <- TH.funD 'lift clauses - let liftDecs = [TH.InstanceD Nothing constraints (liftPir uni datatypeType) [decl]] - pure $ typeableDecs ++ liftDecs + decl <- TH.funD 'lift clauses + let liftDecs = [TH.InstanceD Nothing constraints (liftPir uni datatypeType) [decl]] + pure $ typeableDecs ++ liftDecs -- | In case of exception, it will call `fail` in TemplateHaskell runTHCompile :: THCompile a -> TH.Q (a, Deps) runTHCompile m = do - res <- runExceptT . - flip runReaderT mempty $ - flip runStateT mempty m - case res of - Left a -> fail $ "Generating Lift instances: " ++ show (PP.pretty a) - Right b -> pure b + res <- + runExceptT + . flip runReaderT mempty + $ flip runStateT mempty m + case res of + Left a -> fail $ "Generating Lift instances: " ++ show (PP.pretty a) + Right b -> pure b diff --git a/plutus-tx/src/PlutusTx/Lift/THUtils.hs b/plutus-tx/src/PlutusTx/Lift/THUtils.hs index 0083289b006..0ccbb31c827 100644 --- a/plutus-tx/src/PlutusTx/Lift/THUtils.hs +++ b/plutus-tx/src/PlutusTx/Lift/THUtils.hs @@ -1,6 +1,7 @@ -- editorconfig-checker-disable-file {-# LANGUAGE LambdaCase #-} {-# LANGUAGE TemplateHaskell #-} + module PlutusTx.Lift.THUtils where import PlutusIR @@ -19,47 +20,48 @@ import Language.Haskell.TH.Syntax qualified as TH -- We do not use qualified import because the whole module contains off-chain code import Prelude as Haskell --- | Very nearly the same as 'TH.showName', but doesn't print uniques, since we don't need to --- incorporate them into our names. +{-| Very nearly the same as 'TH.showName', but doesn't print uniques, since we don't need to +incorporate them into our names. +-} showName :: TH.Name -> T.Text showName n = T.pack $ case n of - TH.Name occ TH.NameS -> TH.occString occ - TH.Name occ (TH.NameQ m) -> TH.modString m ++ "." ++ TH.occString occ - TH.Name occ (TH.NameG _ _ m) -> TH.modString m ++ "." ++ TH.occString occ - TH.Name occ (TH.NameU _) -> TH.occString occ - TH.Name occ (TH.NameL _) -> TH.occString occ + TH.Name occ TH.NameS -> TH.occString occ + TH.Name occ (TH.NameQ m) -> TH.modString m ++ "." ++ TH.occString occ + TH.Name occ (TH.NameG _ _ m) -> TH.modString m ++ "." ++ TH.occString occ + TH.Name occ (TH.NameU _) -> TH.occString occ + TH.Name occ (TH.NameL _) -> TH.occString occ -- | Normalize a type, in particular getting rid of things like 'TH.ListT' in favour of applications of the actual name. normalizeType :: TH.Type -> TH.Type normalizeType = \case - TH.ForallT b c t -> TH.ForallT b c (normalizeType t) - TH.AppT t1 t2 -> TH.AppT (normalizeType t1) (normalizeType t2) - TH.SigT t _ -> normalizeType t - TH.InfixT t1 n t2 -> TH.ConT n `TH.AppT` normalizeType t1 `TH.AppT` normalizeType t2 - TH.UInfixT t1 n t2 -> TH.ConT n `TH.AppT` normalizeType t1 `TH.AppT` normalizeType t2 - TH.ParensT t -> normalizeType t - TH.ListT -> TH.ConT ''[] - TH.TupleT arity -> TH.ConT (TH.tupleTypeName arity) - TH.UnboxedTupleT arity -> TH.ConT (TH.unboxedTupleTypeName arity) - TH.UnboxedSumT arity -> TH.ConT (TH.unboxedSumTypeName arity) - -- some of this stuff probably should be normalized (like tuples) but I don't know quite what to do - t -> t + TH.ForallT b c t -> TH.ForallT b c (normalizeType t) + TH.AppT t1 t2 -> TH.AppT (normalizeType t1) (normalizeType t2) + TH.SigT t _ -> normalizeType t + TH.InfixT t1 n t2 -> TH.ConT n `TH.AppT` normalizeType t1 `TH.AppT` normalizeType t2 + TH.UInfixT t1 n t2 -> TH.ConT n `TH.AppT` normalizeType t1 `TH.AppT` normalizeType t2 + TH.ParensT t -> normalizeType t + TH.ListT -> TH.ConT ''[] + TH.TupleT arity -> TH.ConT (TH.tupleTypeName arity) + TH.UnboxedTupleT arity -> TH.ConT (TH.unboxedTupleTypeName arity) + TH.UnboxedSumT arity -> TH.ConT (TH.unboxedSumTypeName arity) + -- some of this stuff probably should be normalized (like tuples) but I don't know quite what to do + t -> t requireExtension :: TH.Extension -> TH.Q () requireExtension ext = do - enabled <- TH.isExtEnabled ext - unless enabled $ fail $ "Extension must be enabled: " ++ show ext + enabled <- TH.isExtEnabled ext + unless enabled $ fail $ "Extension must be enabled: " ++ show ext mkTyVarDecl :: (MonadQuote m) => TH.Name -> Kind () -> m (TH.Name, TyVarDecl TyName ()) mkTyVarDecl name kind = do - tyName <- safeFreshTyName $ showName name - pure (name, TyVarDecl () tyName kind) + tyName <- safeFreshTyName $ showName name + pure (name, TyVarDecl () tyName kind) isNewtype :: TH.DatatypeInfo -> Bool -isNewtype TH.DatatypeInfo{TH.datatypeVariant=variant} = case variant of - TH.Newtype -> True - _ -> False +isNewtype TH.DatatypeInfo{TH.datatypeVariant = variant} = case variant of + TH.Newtype -> True + _ -> False -- | "Safe" wrapper around 'TH.listE' for typed TH. tyListE :: [TH.TExpQ a] -> TH.TExpQ [a] -tyListE texps = TH.unsafeTExpCoerce [| $(TH.listE (fmap TH.unTypeQ texps)) |] +tyListE texps = TH.unsafeTExpCoerce [|$(TH.listE (fmap TH.unTypeQ texps))|] diff --git a/plutus-tx/src/PlutusTx/Lift/TestInstances.hs b/plutus-tx/src/PlutusTx/Lift/TestInstances.hs index e1badf87e55..de84f39b508 100644 --- a/plutus-tx/src/PlutusTx/Lift/TestInstances.hs +++ b/plutus-tx/src/PlutusTx/Lift/TestInstances.hs @@ -19,30 +19,35 @@ import Data.Kind qualified as GHC -- | @BuiltinSatisfies pre post a@ holds if @pre (ToBuiltin a)@ implies @post (ToBuiltin a)@. type BuiltinSatisfies - :: (GHC.Type -> GHC.Constraint) - -> (GHC.Type -> GHC.Constraint) - -> GHC.Type - -> GHC.Constraint -class (pre (ToBuiltin a) => post (ToBuiltin a)) => BuiltinSatisfies pre post a -instance (pre (ToBuiltin a) => post (ToBuiltin a)) => BuiltinSatisfies pre post a - --- | Test that each built-in type @a@ from 'PLC.DefaultUni' satisfies @post (ToBuiltin a)@ given --- @pre (ToBuiltin a)@. + :: (GHC.Type -> GHC.Constraint) + -> (GHC.Type -> GHC.Constraint) + -> GHC.Type + -> GHC.Constraint +class ((pre (ToBuiltin a)) => post (ToBuiltin a)) => BuiltinSatisfies pre post a + +instance ((pre (ToBuiltin a)) => post (ToBuiltin a)) => BuiltinSatisfies pre post a + +{-| Test that each built-in type @a@ from 'PLC.DefaultUni' satisfies @post (ToBuiltin a)@ given +@pre (ToBuiltin a)@. +-} type TestAllBuiltinsSatisfy - :: (GHC.Type -> GHC.Constraint) - -> (GHC.Type -> GHC.Constraint) - -> GHC.Constraint -class PLC.DefaultUni `PLC.Everywhere` BuiltinSatisfies pre post => TestAllBuiltinsSatisfy pre post + :: (GHC.Type -> GHC.Constraint) + -> (GHC.Type -> GHC.Constraint) + -> GHC.Constraint +class (PLC.DefaultUni `PLC.Everywhere` BuiltinSatisfies pre post) => TestAllBuiltinsSatisfy pre post -- | Test that each built-in type from 'PLC.DefaultUni' has a 'Typeable' instance. -instance TestAllBuiltinsSatisfy +instance + TestAllBuiltinsSatisfy (PLC.AllBuiltinArgs PLC.DefaultUni (Typeable PLC.DefaultUni)) (Typeable PLC.DefaultUni) --- | Test that each built-in type from 'PLC.DefaultUni' has a 'Lift' instance. Since the 'Lift' --- instances are defined in terms of 'fromBuiltin', this also tests that each built-in type has a --- 'FromBuiltin' instance. Which in turn requires a 'ToBuiltin' instance to exist due to the --- superclass constraint, so this is implicitly tested as well. -instance TestAllBuiltinsSatisfy +{-| Test that each built-in type from 'PLC.DefaultUni' has a 'Lift' instance. Since the 'Lift' +instances are defined in terms of 'fromBuiltin', this also tests that each built-in type has a +'FromBuiltin' instance. Which in turn requires a 'ToBuiltin' instance to exist due to the +superclass constraint, so this is implicitly tested as well. +-} +instance + TestAllBuiltinsSatisfy (PLC.AllBuiltinArgs PLC.DefaultUni HasFromBuiltin) (Lift PLC.DefaultUni) diff --git a/plutus-tx/src/PlutusTx/List.hs b/plutus-tx/src/PlutusTx/List.hs index 59b511e1ee4..df37103268f 100644 --- a/plutus-tx/src/PlutusTx/List.hs +++ b/plutus-tx/src/PlutusTx/List.hs @@ -2,49 +2,50 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_GHC -fno-omit-interface-pragmas #-} + module PlutusTx.List ( - uncons, - null, - length, - map, - and, - or, - any, - all, - elem, - notElem, - find, - filter, - listToMaybe, - uniqueElement, - findIndices, - findIndex, - foldr, - foldl, - revAppend, - reverse, - concat, - concatMap, - zip, - unzip, - (++), - (!!), - head, - last, - tail, - take, - drop, - splitAt, - nub, - nubBy, - zipWith, - dropWhile, - replicate, - partition, - sort, - sortBy, - elemBy, - ) where + uncons, + null, + length, + map, + and, + or, + any, + all, + elem, + notElem, + find, + filter, + listToMaybe, + uniqueElement, + findIndices, + findIndex, + foldr, + foldl, + revAppend, + reverse, + concat, + concatMap, + zip, + unzip, + (++), + (!!), + head, + last, + tail, + take, + drop, + splitAt, + nub, + nubBy, + zipWith, + dropWhile, + replicate, + partition, + sort, + sortBy, + elemBy, +) where import PlutusTx.Bool (Bool (..), not, otherwise, (||)) import PlutusTx.Builtins (Integer) @@ -60,387 +61,397 @@ import Prelude (Maybe (..), (.)) -- | Plutus Tx version of 'Data.List.uncons'. uncons :: [a] -> Maybe (a, [a]) uncons = \case - [] -> Nothing - x:xs -> Just (x, xs) -{-# INLINABLE uncons #-} + [] -> Nothing + x : xs -> Just (x, xs) +{-# INLINEABLE uncons #-} -- | Test whether a list is empty. null :: [a] -> Bool null = \case - [] -> True - _ -> False -{-# INLINABLE null #-} + [] -> True + _ -> False +{-# INLINEABLE null #-} length :: [a] -> Integer length = go - where - go = \case - [] -> 0 - _:xs -> Builtins.addInteger 1 (go xs) -{-# INLINABLE length #-} - --- | Plutus Tx version of 'Data.List.map'. --- --- >>> map (\i -> i + 1) [1, 2, 3] --- [2,3,4] --- + where + go = \case + [] -> 0 + _ : xs -> Builtins.addInteger 1 (go xs) +{-# INLINEABLE length #-} + +{-| Plutus Tx version of 'Data.List.map'. + + >>> map (\i -> i + 1) [1, 2, 3] + [2,3,4] +-} map :: forall a b. (a -> b) -> [a] -> [b] map f = go - where - go :: [a] -> [b] - go = \case - [] -> [] - x:xs -> f x : go xs -{-# INLINABLE map #-} + where + go :: [a] -> [b] + go = \case + [] -> [] + x : xs -> f x : go xs +{-# INLINEABLE map #-} -- | Returns the conjunction of a list of Bools. and :: [Bool] -> Bool and = \case - [] -> True - x : xs -> if x then and xs else False -{-# INLINABLE and #-} + [] -> True + x : xs -> if x then and xs else False +{-# INLINEABLE and #-} -- | Returns the disjunction of a list of Bools. or :: [Bool] -> Bool or = \case - [] -> False - x : xs -> if x then True else or xs -{-# INLINABLE or #-} + [] -> False + x : xs -> if x then True else or xs +{-# INLINEABLE or #-} -- | Determines whether any element of the structure satisfies the predicate. any :: forall a. (a -> Bool) -> [a] -> Bool any f = go - where - go :: [a] -> Bool - go = \case - [] -> False - x : xs -> if f x then True else go xs -{-# INLINABLE any #-} + where + go :: [a] -> Bool + go = \case + [] -> False + x : xs -> if f x then True else go xs +{-# INLINEABLE any #-} -- The pragma improves some of the budget tests. + -- | Determines whether all elements of the list satisfy the predicate. all :: forall a. (a -> Bool) -> [a] -> Bool all f = go - where - go :: [a] -> Bool - go = \case - [] -> True - x : xs -> if f x then go xs else False -{-# INLINABLE all #-} + where + go :: [a] -> Bool + go = \case + [] -> True + x : xs -> if f x then go xs else False +{-# INLINEABLE all #-} -- | Does the element occur in the list? -elem :: Eq a => a -> [a] -> Bool +elem :: (Eq a) => a -> [a] -> Bool elem = any . (==) -{-# INLINABLE elem #-} +{-# INLINEABLE elem #-} -- | The negation of `elem`. -notElem :: Eq a => a -> [a] -> Bool +notElem :: (Eq a) => a -> [a] -> Bool notElem a = not . elem a -{-# INLINABLE notElem #-} +{-# INLINEABLE notElem #-} -- | Returns the leftmost element matching the predicate, or `Nothing` if there's no such element. find :: forall a. (a -> Bool) -> [a] -> Maybe a find f = go - where - go :: [a] -> Maybe a - go = \case - [] -> Nothing - x : xs -> if f x then Just x else go xs -{-# INLINABLE find #-} - --- | Plutus Tx version of 'Data.List.foldr'. --- --- >>> foldr (\i s -> s + i) 0 [1, 2, 3, 4] --- 10 --- + where + go :: [a] -> Maybe a + go = \case + [] -> Nothing + x : xs -> if f x then Just x else go xs +{-# INLINEABLE find #-} + +{-| Plutus Tx version of 'Data.List.foldr'. + + >>> foldr (\i s -> s + i) 0 [1, 2, 3, 4] + 10 +-} foldr :: forall a b. (a -> b -> b) -> b -> [a] -> b foldr f acc = go - where - go :: [a] -> b - go = \case - [] -> acc - x:xs -> f x (go xs) -{-# INLINABLE foldr #-} - --- | Plutus Tx velsion of 'Data.List.foldl'. --- --- >>> foldl (\s i -> s + i) 0 [1, 2, 3, 4] --- 10 --- + where + go :: [a] -> b + go = \case + [] -> acc + x : xs -> f x (go xs) +{-# INLINEABLE foldr #-} + +{-| Plutus Tx velsion of 'Data.List.foldl'. + + >>> foldl (\s i -> s + i) 0 [1, 2, 3, 4] + 10 +-} foldl :: forall a b. (b -> a -> b) -> b -> [a] -> b foldl f = go - where - go :: b -> [a] -> b - go acc = \case - [] -> acc - x:xs -> go (f acc x) xs -{-# INLINABLE foldl #-} - --- | Plutus Tx version of '(Data.List.++)'. --- --- >>> [0, 1, 2] ++ [1, 2, 3, 4] --- [0,1,2,1,2,3,4] --- + where + go :: b -> [a] -> b + go acc = \case + [] -> acc + x : xs -> go (f acc x) xs +{-# INLINEABLE foldl #-} + +{-| Plutus Tx version of '(Data.List.++)'. + + >>> [0, 1, 2] ++ [1, 2, 3, 4] + [0,1,2,1,2,3,4] +-} infixr 5 ++ + (++) :: [a] -> [a] -> [a] (++) l r = foldr (:) r l -{-# INLINABLE (++) #-} +{-# INLINEABLE (++) #-} + +{-| Plutus Tx version of 'Data.List.concat'. --- | Plutus Tx version of 'Data.List.concat'. --- --- >>> concat [[1, 2], [3], [4, 5]] --- [1,2,3,4,5] + >>> concat [[1, 2], [3], [4, 5]] + [1,2,3,4,5] +-} concat :: [[a]] -> [a] concat = foldr (++) [] -{-# INLINABLE concat #-} +{-# INLINEABLE concat #-} -- | Plutus Tx version of 'Data.List.concatMap'. concatMap :: (a -> [b]) -> [a] -> [b] concatMap f = foldr (\x ys -> f x ++ ys) [] -{-# INLINABLE concatMap #-} +{-# INLINEABLE concatMap #-} + +{-| Plutus Tx version of 'Data.List.filter'. --- | Plutus Tx version of 'Data.List.filter'. --- --- >>> filter (> 1) [1, 2, 3, 4] --- [2,3,4] --- + >>> filter (> 1) [1, 2, 3, 4] + [2,3,4] +-} filter :: (a -> Bool) -> [a] -> [a] -filter p = foldr (\e xs -> if p e then e:xs else xs) [] -{-# INLINABLE filter #-} +filter p = foldr (\e xs -> if p e then e : xs else xs) [] +{-# INLINEABLE filter #-} -- | Plutus Tx version of 'Data.List.listToMaybe'. listToMaybe :: [a] -> Maybe a -listToMaybe [] = Nothing -listToMaybe (x:_) = Just x -{-# INLINABLE listToMaybe #-} +listToMaybe [] = Nothing +listToMaybe (x : _) = Just x +{-# INLINEABLE listToMaybe #-} -- | Return the element in the list, if there is precisely one. uniqueElement :: [a] -> Maybe a uniqueElement [x] = Just x uniqueElement _ = Nothing -{-# INLINABLE uniqueElement #-} +{-# INLINEABLE uniqueElement #-} -- | Plutus Tx version of 'Data.List.findIndices'. findIndices :: (a -> Bool) -> [a] -> [Integer] findIndices p = go 0 - where - go i l = case l of - [] -> [] - (x:xs) -> let indices = go (Builtins.addInteger i 1) xs in if p x then i:indices else indices -{-# INLINABLE findIndices #-} + where + go i l = case l of + [] -> [] + (x : xs) -> let indices = go (Builtins.addInteger i 1) xs in if p x then i : indices else indices +{-# INLINEABLE findIndices #-} -- | Plutus Tx version of 'Data.List.findIndex'. findIndex :: (a -> Bool) -> [a] -> Maybe Integer findIndex f = go 0 - where - go i = \case - [] -> Nothing - x : xs -> if f x then Just i else go (Builtins.addInteger i 1) xs -{-# INLINABLE findIndex #-} - --- | Plutus Tx version of '(GHC.List.!!)'. --- --- >>> [10, 11, 12] !! 2 --- 12 --- + where + go i = \case + [] -> Nothing + x : xs -> if f x then Just i else go (Builtins.addInteger i 1) xs +{-# INLINEABLE findIndex #-} + +{-| Plutus Tx version of '(GHC.List.!!)'. + + >>> [10, 11, 12] !! 2 + 12 +-} infixl 9 !! + (!!) :: forall a. [a] -> Integer -> a -_ !! n0 | n0 < 0 = traceError negativeIndexError +_ !! n0 | n0 < 0 = traceError negativeIndexError xs0 !! n0 = go n0 xs0 - where - go :: Integer -> [a] -> a - go _ [] = traceError indexTooLargeError - go n (x : xs) = - if Builtins.equalsInteger n 0 - then x - else go (Builtins.subtractInteger n 1) xs -{-# INLINABLE (!!) #-} - --- | Cons each element of the first list to the second one in reverse order (i.e. the last element --- of the first list is the head of the result). --- --- > revAppend xs ys === reverse xs ++ ys --- --- >>> revAppend "abc" "de" --- "cbade" + where + go :: Integer -> [a] -> a + go _ [] = traceError indexTooLargeError + go n (x : xs) = + if Builtins.equalsInteger n 0 + then x + else go (Builtins.subtractInteger n 1) xs +{-# INLINEABLE (!!) #-} + +{-| Cons each element of the first list to the second one in reverse order (i.e. the last element +of the first list is the head of the result). + +> revAppend xs ys === reverse xs ++ ys + +>>> revAppend "abc" "de" +"cbade" +-} revAppend :: forall a. [a] -> [a] -> [a] -revAppend = rev where - rev :: [a] -> [a] -> [a] - rev [] a = a - rev (x:xs) a = rev xs (x:a) -{-# INLINABLE revAppend #-} +revAppend = rev + where + rev :: [a] -> [a] -> [a] + rev [] a = a + rev (x : xs) a = rev xs (x : a) +{-# INLINEABLE revAppend #-} -- | Plutus Tx version of 'Data.List.reverse'. reverse :: [a] -> [a] reverse l = revAppend l [] -{-# INLINABLE reverse #-} +{-# INLINEABLE reverse #-} -- | Plutus Tx version of 'Data.List.zip'. -zip :: forall a b. [a] -> [b] -> [(a,b)] +zip :: forall a b. [a] -> [b] -> [(a, b)] zip = go - where - go :: [a] -> [b] -> [(a,b)] - go [] _bs = [] - go _as [] = [] - go (a:as) (b:bs) = (a,b) : go as bs -{-# INLINABLE zip #-} + where + go :: [a] -> [b] -> [(a, b)] + go [] _bs = [] + go _as [] = [] + go (a : as) (b : bs) = (a, b) : go as bs +{-# INLINEABLE zip #-} -- | Plutus Tx version of 'Data.List.unzip'. -unzip :: forall a b. [(a,b)] -> ([a], [b]) +unzip :: forall a b. [(a, b)] -> ([a], [b]) unzip = go - where - go :: [(a,b)] -> ([a], [b]) - go [] = ([], []) - go ((x, y) : xys) = case go xys of - (xs, ys) -> (x : xs, y : ys) -{-# INLINABLE unzip #-} + where + go :: [(a, b)] -> ([a], [b]) + go [] = ([], []) + go ((x, y) : xys) = case go xys of + (xs, ys) -> (x : xs, y : ys) +{-# INLINEABLE unzip #-} -- | Plutus Tx version of 'Data.List.head'. head :: [a] -> a head [] = traceError headEmptyListError head (x : _) = x -{-# INLINABLE head #-} +{-# INLINEABLE head #-} -- | Plutus Tx version of 'Data.List.last'. last :: [a] -> a -last [] = traceError lastEmptyListError -last [x] = x -last (_:xs) = last xs -{-# INLINABLE last #-} +last [] = traceError lastEmptyListError +last [x] = x +last (_ : xs) = last xs +{-# INLINEABLE last #-} -- | Plutus Tx version of 'Data.List.tail'. tail :: [a] -> [a] -tail (_:as) = as -tail [] = traceError tailEmptyListError -{-# INLINABLE tail #-} +tail (_ : as) = as +tail [] = traceError tailEmptyListError +{-# INLINEABLE tail #-} -- | Plutus Tx version of 'Data.List.take'. take :: forall a. Integer -> [a] -> [a] take = go - where - go :: Integer -> [a] -> [a] - go n _ | n <= 0 = [] - go _ [] = [] - go n (x:xs) = x : go (Builtins.subtractInteger n 1) xs -{-# INLINABLE take #-} + where + go :: Integer -> [a] -> [a] + go n _ | n <= 0 = [] + go _ [] = [] + go n (x : xs) = x : go (Builtins.subtractInteger n 1) xs +{-# INLINEABLE take #-} -- | Plutus Tx version of 'Data.List.drop'. drop :: forall a. Integer -> [a] -> [a] drop = go - where - go :: Integer -> [a] -> [a] - go n xs | n <= 0 = xs - go _ [] = [] - go n (_:xs) = go (Builtins.subtractInteger n 1) xs -{-# INLINABLE drop #-} + where + go :: Integer -> [a] -> [a] + go n xs | n <= 0 = xs + go _ [] = [] + go n (_ : xs) = go (Builtins.subtractInteger n 1) xs +{-# INLINEABLE drop #-} -- | Plutus Tx version of 'Data.List.splitAt'. splitAt :: forall a. Integer -> [a] -> ([a], [a]) splitAt n xs - | n <= 0 = ([], xs) + | n <= 0 = ([], xs) | otherwise = go n xs - where - go :: Integer -> [a] -> ([a], [a]) - go _ [] = ([], []) - go m (y:ys) - | m == 1 = ([y], ys) - | otherwise = case go (Builtins.subtractInteger m 1) ys of - (zs, ws) -> (y:zs, ws) -{-# INLINABLE splitAt #-} + where + go :: Integer -> [a] -> ([a], [a]) + go _ [] = ([], []) + go m (y : ys) + | m == 1 = ([y], ys) + | otherwise = case go (Builtins.subtractInteger m 1) ys of + (zs, ws) -> (y : zs, ws) +{-# INLINEABLE splitAt #-} -- | Plutus Tx version of 'Data.List.nub'. nub :: (Eq a) => [a] -> [a] nub = nubBy (==) -{-# INLINABLE nub #-} +{-# INLINEABLE nub #-} elemBy :: forall a. (a -> a -> Bool) -> a -> [a] -> Bool elemBy eq y = go - where - go :: [a] -> Bool - go [] = False - go (x:xs) = x `eq` y || go xs -{-# INLINABLE elemBy #-} + where + go :: [a] -> Bool + go [] = False + go (x : xs) = x `eq` y || go xs +{-# INLINEABLE elemBy #-} -- | Plutus Tx version of 'Data.List.nubBy'. nubBy :: (a -> a -> Bool) -> [a] -> [a] nubBy eq l = nubBy' l [] - where - nubBy' [] _ = [] - nubBy' (y:ys) xs - | elemBy eq y xs = nubBy' ys xs - | otherwise = y : nubBy' ys (y:xs) -{-# INLINABLE nubBy #-} + where + nubBy' [] _ = [] + nubBy' (y : ys) xs + | elemBy eq y xs = nubBy' ys xs + | otherwise = y : nubBy' ys (y : xs) +{-# INLINEABLE nubBy #-} -- | Plutus Tx version of 'Data.List.zipWith'. zipWith :: forall a b c. (a -> b -> c) -> [a] -> [b] -> [c] zipWith f = go - where - go :: [a] -> [b] -> [c] - go [] _ = [] - go _ [] = [] - go (x:xs) (y:ys) = f x y : go xs ys -{-# INLINABLE zipWith #-} + where + go :: [a] -> [b] -> [c] + go [] _ = [] + go _ [] = [] + go (x : xs) (y : ys) = f x y : go xs ys +{-# INLINEABLE zipWith #-} -- | Plutus Tx version of 'Data.List.dropWhile'. dropWhile :: forall a. (a -> Bool) -> [a] -> [a] dropWhile p = go - where - go :: [a] -> [a] - go [] = [] - go xs@(x:xs') - | p x = go xs' - | otherwise = xs -{-# INLINABLE dropWhile #-} + where + go :: [a] -> [a] + go [] = [] + go xs@(x : xs') + | p x = go xs' + | otherwise = xs +{-# INLINEABLE dropWhile #-} -- | Plutus Tx version of 'Data.List.replicate'. replicate :: forall a. Integer -> a -> [a] -replicate n0 x = go n0 where - go n | n <= 0 = [] - go n = x : go (Builtins.subtractInteger n 1) -{-# INLINABLE replicate #-} +replicate n0 x = go n0 + where + go n | n <= 0 = [] + go n = x : go (Builtins.subtractInteger n 1) +{-# INLINEABLE replicate #-} -- | Plutus Tx version of 'Data.List.partition'. -partition :: (a -> Bool) -> [a] -> ([a],[a]) -partition p xs = foldr (select p) ([],[]) xs -{-# INLINABLE partition #-} +partition :: (a -> Bool) -> [a] -> ([a], [a]) +partition p xs = foldr (select p) ([], []) xs +{-# INLINEABLE partition #-} select :: (a -> Bool) -> a -> ([a], [a]) -> ([a], [a]) -select p x ~(ts,fs) | p x = (x:ts,fs) - | otherwise = (ts, x:fs) +select p x ~(ts, fs) + | p x = (x : ts, fs) + | otherwise = (ts, x : fs) -- | Plutus Tx version of 'Data.List.sort'. -sort :: Ord a => [a] -> [a] +sort :: (Ord a) => [a] -> [a] sort = sortBy compare -{-# INLINABLE sort #-} +{-# INLINEABLE sort #-} -- | Plutus Tx version of 'Data.List.sortBy'. sortBy :: (a -> a -> Ordering) -> [a] -> [a] sortBy cmp l = mergeAll (sequences l) - where - sequences (a:b:xs) - | a `cmp` b == GT = descending b [a] xs - | otherwise = ascending b (a:) xs - sequences xs = [xs] - - descending a as (b:bs) - | a `cmp` b == GT = descending b (a:as) bs - descending a as bs = (a:as): sequences bs - - ascending a as (b:bs) - | a `cmp` b /= GT = ascending b (\ys -> as (a:ys)) bs - ascending a as bs = let x = as [a] - in x : sequences bs - - mergeAll [x] = x - mergeAll xs = mergeAll (mergePairs xs) - - mergePairs (a:b:xs) = let x = merge a b - in x : mergePairs xs - mergePairs xs = xs - - merge as@(a:as') bs@(b:bs') - | a `cmp` b == GT = b:merge as bs' - | otherwise = a:merge as' bs - merge [] bs = bs - merge as [] = as -{-# INLINABLE sortBy #-} + where + sequences (a : b : xs) + | a `cmp` b == GT = descending b [a] xs + | otherwise = ascending b (a :) xs + sequences xs = [xs] + + descending a as (b : bs) + | a `cmp` b == GT = descending b (a : as) bs + descending a as bs = (a : as) : sequences bs + + ascending a as (b : bs) + | a `cmp` b /= GT = ascending b (\ys -> as (a : ys)) bs + ascending a as bs = + let x = as [a] + in x : sequences bs + + mergeAll [x] = x + mergeAll xs = mergeAll (mergePairs xs) + + mergePairs (a : b : xs) = + let x = merge a b + in x : mergePairs xs + mergePairs xs = xs + + merge as@(a : as') bs@(b : bs') + | a `cmp` b == GT = b : merge as bs' + | otherwise = a : merge as' bs + merge [] bs = bs + merge as [] = as +{-# INLINEABLE sortBy #-} diff --git a/plutus-tx/src/PlutusTx/Maybe.hs b/plutus-tx/src/PlutusTx/Maybe.hs index d241a0cf34b..1fb36f8ddf6 100644 --- a/plutus-tx/src/PlutusTx/Maybe.hs +++ b/plutus-tx/src/PlutusTx/Maybe.hs @@ -1,5 +1,6 @@ {-# OPTIONS_GHC -fno-omit-interface-pragmas #-} -module PlutusTx.Maybe (Maybe(..), isJust, isNothing, maybe, fromMaybe, mapMaybe) where + +module PlutusTx.Maybe (Maybe (..), isJust, isNothing, maybe, fromMaybe, mapMaybe) where {- We export off-chain Haskell's Maybe type as on-chain Plutus's Maybe type since they are the same. @@ -12,51 +13,51 @@ import Prelude (Maybe (..)) {- HLINT ignore -} --- | Check if a 'Maybe' @a@ is @Just a@ --- --- >>> isJust Nothing --- False --- >>> isJust (Just "plutus") --- True --- +{-| Check if a 'Maybe' @a@ is @Just a@ + + >>> isJust Nothing + False + >>> isJust (Just "plutus") + True +-} isJust :: Maybe a -> Bool -isJust m = case m of { Just _ -> True; _ -> False; } -{-# INLINABLE isJust #-} - --- | Check if a 'Maybe' @a@ is @Nothing@ --- --- >>> isNothing Nothing --- True --- >>> isNothing (Just "plutus") --- False --- +isJust m = case m of Just _ -> True; _ -> False +{-# INLINEABLE isJust #-} + +{-| Check if a 'Maybe' @a@ is @Nothing@ + + >>> isNothing Nothing + True + >>> isNothing (Just "plutus") + False +-} isNothing :: Maybe a -> Bool -isNothing m = case m of { Just _ -> False; _ -> True; } -{-# INLINABLE isNothing #-} - --- | Plutus Tx version of 'Prelude.maybe'. --- --- >>> maybe "platypus" (\s -> s) (Just "plutus") --- "plutus" --- >>> maybe "platypus" (\s -> s) Nothing --- "platypus" --- +isNothing m = case m of Just _ -> False; _ -> True +{-# INLINEABLE isNothing #-} + +{-| Plutus Tx version of 'Prelude.maybe'. + + >>> maybe "platypus" (\s -> s) (Just "plutus") + "plutus" + >>> maybe "platypus" (\s -> s) Nothing + "platypus" +-} maybe :: b -> (a -> b) -> Maybe a -> b maybe b f m = case m of - Nothing -> b - Just a -> f a -{-# INLINABLE maybe #-} + Nothing -> b + Just a -> f a +{-# INLINEABLE maybe #-} -- | Plutus Tx version of 'Data.Maybe.fromMaybe' fromMaybe :: a -> Maybe a -> a fromMaybe a = maybe a id -{-# INLINABLE fromMaybe #-} +{-# INLINEABLE fromMaybe #-} --- | Plutus Tx version of 'Data.Maybe.mapMaybe'. --- --- >>> mapMaybe (\i -> if i == 2 then Just '2' else Nothing) [1, 2, 3, 4] --- "2" --- +{-| Plutus Tx version of 'Data.Maybe.mapMaybe'. + + >>> mapMaybe (\i -> if i == 2 then Just '2' else Nothing) [1, 2, 3, 4] + "2" +-} mapMaybe :: (a -> Maybe b) -> [a] -> [b] -mapMaybe p = foldr (\e xs -> maybe xs (:xs) (p e)) [] -{-# INLINABLE mapMaybe #-} +mapMaybe p = foldr (\e xs -> maybe xs (: xs) (p e)) [] +{-# INLINEABLE mapMaybe #-} diff --git a/plutus-tx/src/PlutusTx/Monoid.hs b/plutus-tx/src/PlutusTx/Monoid.hs index 15979bcb303..273ca9d6dfb 100644 --- a/plutus-tx/src/PlutusTx/Monoid.hs +++ b/plutus-tx/src/PlutusTx/Monoid.hs @@ -1,6 +1,7 @@ -{-# OPTIONS_GHC -fno-specialise #-} {-# OPTIONS_GHC -fno-ignore-interface-pragmas #-} {-# OPTIONS_GHC -fno-omit-interface-pragmas #-} +{-# OPTIONS_GHC -fno-specialise #-} + module PlutusTx.Monoid (Monoid (..), mappend, mconcat, Group (..), gsub) where import Data.Monoid (First (..)) @@ -14,61 +15,62 @@ import PlutusTx.Semigroup {- HLINT ignore -} -- | Plutus Tx version of 'Data.Monoid.Monoid'. -class Semigroup a => Monoid a where - -- | Plutus Tx version of 'Data.Monoid.mempty'. - mempty :: a - -- mappend and mconcat deliberately omitted, to make this a one-method class which has a - -- simpler representation +class (Semigroup a) => Monoid a where + -- | Plutus Tx version of 'Data.Monoid.mempty'. + mempty :: a + +-- mappend and mconcat deliberately omitted, to make this a one-method class which has a +-- simpler representation -- | Plutus Tx version of 'Data.Monoid.mappend'. -mappend :: Monoid a => a -> a -> a +mappend :: (Monoid a) => a -> a -> a mappend = (<>) -{-# INLINABLE mappend #-} +{-# INLINEABLE mappend #-} -- | Plutus Tx version of 'Data.Monoid.mconcat'. -mconcat :: Monoid a => [a] -> a +mconcat :: (Monoid a) => [a] -> a mconcat = foldr mappend mempty -{-# INLINABLE mconcat #-} +{-# INLINEABLE mconcat #-} instance Monoid Builtins.BuiltinByteString where - {-# INLINABLE mempty #-} - mempty = Builtins.emptyByteString + {-# INLINEABLE mempty #-} + mempty = Builtins.emptyByteString instance Monoid Builtins.BuiltinString where - {-# INLINABLE mempty #-} - mempty = Builtins.emptyString + {-# INLINEABLE mempty #-} + mempty = Builtins.emptyString instance Monoid [a] where - {-# INLINABLE mempty #-} - mempty = [] + {-# INLINEABLE mempty #-} + mempty = [] -instance Semigroup a => Monoid (Maybe a) where - {-# INLINABLE mempty #-} - mempty = Nothing +instance (Semigroup a) => Monoid (Maybe a) where + {-# INLINEABLE mempty #-} + mempty = Nothing instance Monoid () where - {-# INLINABLE mempty #-} - mempty = () + {-# INLINEABLE mempty #-} + mempty = () instance (Monoid a, Monoid b) => Monoid (a, b) where - {-# INLINABLE mempty #-} - mempty = (mempty, mempty) + {-# INLINEABLE mempty #-} + mempty = (mempty, mempty) -instance Monoid a => Monoid (Dual a) where - {-# INLINABLE mempty #-} - mempty = Dual mempty +instance (Monoid a) => Monoid (Dual a) where + {-# INLINEABLE mempty #-} + mempty = Dual mempty instance Monoid (Endo a) where - {-# INLINABLE mempty #-} - mempty = Endo id + {-# INLINEABLE mempty #-} + mempty = Endo id instance Monoid (First a) where - {-# INLINABLE mempty #-} - mempty = First Nothing + {-# INLINEABLE mempty #-} + mempty = First Nothing -class Monoid a => Group a where - inv :: a -> a +class (Monoid a) => Group a where + inv :: a -> a -gsub :: Group a => a -> a -> a +gsub :: (Group a) => a -> a -> a gsub x y = x <> inv y -{-# INLINABLE gsub #-} +{-# INLINEABLE gsub #-} diff --git a/plutus-tx/src/PlutusTx/Numeric.hs b/plutus-tx/src/PlutusTx/Numeric.hs index 691b9036dd4..68452a781d3 100644 --- a/plutus-tx/src/PlutusTx/Numeric.hs +++ b/plutus-tx/src/PlutusTx/Numeric.hs @@ -1,8 +1,9 @@ -- editorconfig-checker-disable-file {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE FunctionalDependencies #-} -{-# OPTIONS_GHC -fno-omit-interface-pragmas #-} {-# OPTIONS_GHC -Wno-orphans #-} +{-# OPTIONS_GHC -fno-omit-interface-pragmas #-} + module PlutusTx.Numeric ( -- * Type classes AdditiveSemigroup (..), @@ -13,15 +14,17 @@ module PlutusTx.Numeric ( Semiring, Ring, Module (..), + -- * Helper newtypes Additive (..), Multiplicative (..), + -- * Helper functions negate, divMod, quotRem, abs, - ) where +) where import Data.Coerce (coerce) import Data.Semigroup (Product (Product), Sum (Sum)) @@ -37,42 +40,42 @@ infixl 6 +, - -- | A 'Semigroup' that it is sensible to describe using addition. class AdditiveSemigroup a where - (+) :: a -> a -> a + (+) :: a -> a -> a -- | A 'Monoid' that it is sensible to describe using addition and zero. -class AdditiveSemigroup a => AdditiveMonoid a where - zero :: a +class (AdditiveSemigroup a) => AdditiveMonoid a where + zero :: a -- | A 'Group' that it is sensible to describe using addition, zero, and subtraction. -class AdditiveMonoid a => AdditiveGroup a where - (-) :: a -> a -> a +class (AdditiveMonoid a) => AdditiveGroup a where + (-) :: a -> a -> a -negate :: AdditiveGroup a => a -> a +negate :: (AdditiveGroup a) => a -> a negate x = zero - x -{-# INLINABLE negate #-} +{-# INLINEABLE negate #-} -- | A newtype wrapper to derive 'Additive' classes via. newtype Additive a = Additive a -instance Semigroup a => AdditiveSemigroup (Additive a) where - {-# INLINABLE (+) #-} - (+) = coerce ((<>) :: a -> a -> a) +instance (Semigroup a) => AdditiveSemigroup (Additive a) where + {-# INLINEABLE (+) #-} + (+) = coerce ((<>) :: a -> a -> a) -instance Monoid a => AdditiveMonoid (Additive a) where - {-# INLINABLE zero #-} - zero = Additive mempty +instance (Monoid a) => AdditiveMonoid (Additive a) where + {-# INLINEABLE zero #-} + zero = Additive mempty -instance Group a => AdditiveGroup (Additive a) where - {-# INLINABLE (-) #-} - (-) = coerce (gsub :: a -> a -> a) +instance (Group a) => AdditiveGroup (Additive a) where + {-# INLINEABLE (-) #-} + (-) = coerce (gsub :: a -> a -> a) -- | A 'Semigroup' that it is sensible to describe using multiplication. class MultiplicativeSemigroup a where - (*) :: a -> a -> a + (*) :: a -> a -> a -- | A 'Semigroup' that it is sensible to describe using multiplication and one. -class MultiplicativeSemigroup a => MultiplicativeMonoid a where - one :: a +class (MultiplicativeSemigroup a) => MultiplicativeMonoid a where + one :: a -- TODO: multiplicative group? I haven't added any since for e.g. integers division -- is not a proper inverse, so it's of limited use. @@ -80,86 +83,87 @@ class MultiplicativeSemigroup a => MultiplicativeMonoid a where -- | A newtype wrapper to derive 'Multiplicative' classes via. newtype Multiplicative a = Multiplicative a -instance Semigroup a => MultiplicativeSemigroup (Multiplicative a) where - {-# INLINABLE (*) #-} - (*) = coerce ((<>) :: a -> a -> a) +instance (Semigroup a) => MultiplicativeSemigroup (Multiplicative a) where + {-# INLINEABLE (*) #-} + (*) = coerce ((<>) :: a -> a -> a) -instance Monoid a => MultiplicativeMonoid (Multiplicative a) where - {-# INLINABLE one #-} - one = Multiplicative mempty +instance (Monoid a) => MultiplicativeMonoid (Multiplicative a) where + {-# INLINEABLE one #-} + one = Multiplicative mempty -- | A semiring. type Semiring a = (AdditiveMonoid a, MultiplicativeMonoid a) + -- | A ring. type Ring a = (AdditiveGroup a, MultiplicativeMonoid a) instance AdditiveSemigroup Integer where - {-# INLINABLE (+) #-} - (+) = addInteger + {-# INLINEABLE (+) #-} + (+) = addInteger instance AdditiveMonoid Integer where - {-# INLINABLE zero #-} - zero = 0 + {-# INLINEABLE zero #-} + zero = 0 instance AdditiveGroup Integer where - {-# INLINABLE (-) #-} - (-) = subtractInteger + {-# INLINEABLE (-) #-} + (-) = subtractInteger instance MultiplicativeSemigroup Integer where - {-# INLINABLE (*) #-} - (*) = multiplyInteger + {-# INLINEABLE (*) #-} + (*) = multiplyInteger instance MultiplicativeMonoid Integer where - {-# INLINABLE one #-} - one = 1 + {-# INLINEABLE one #-} + one = 1 instance AdditiveSemigroup Bool where - {-# INLINABLE (+) #-} - (+) = (||) + {-# INLINEABLE (+) #-} + (+) = (||) instance AdditiveMonoid Bool where - {-# INLINABLE zero #-} - zero = False + {-# INLINEABLE zero #-} + zero = False instance MultiplicativeSemigroup Bool where - {-# INLINABLE (*) #-} - (*) = (&&) + {-# INLINEABLE (*) #-} + (*) = (&&) instance MultiplicativeMonoid Bool where - {-# INLINABLE one #-} - one = True + {-# INLINEABLE one #-} + one = True -- | A module, with a type of scalars which can be used to scale the values. class (Ring s, AdditiveGroup v) => Module s v | v -> s where - scale :: s -> v -> v + scale :: s -> v -> v -instance AdditiveSemigroup a => Semigroup (Sum a) where - {-# INLINABLE (<>) #-} - (<>) = coerce ((+) :: a -> a -> a) +instance (AdditiveSemigroup a) => Semigroup (Sum a) where + {-# INLINEABLE (<>) #-} + (<>) = coerce ((+) :: a -> a -> a) -instance AdditiveMonoid a => Monoid (Sum a) where - {-# INLINABLE mempty #-} - mempty = Sum zero +instance (AdditiveMonoid a) => Monoid (Sum a) where + {-# INLINEABLE mempty #-} + mempty = Sum zero -instance MultiplicativeSemigroup a => Semigroup (Product a) where - {-# INLINABLE (<>) #-} - (<>) = coerce ((*) :: a -> a -> a) +instance (MultiplicativeSemigroup a) => Semigroup (Product a) where + {-# INLINEABLE (<>) #-} + (<>) = coerce ((*) :: a -> a -> a) -instance MultiplicativeMonoid a => Monoid (Product a) where - {-# INLINABLE mempty #-} - mempty = Product one +instance (MultiplicativeMonoid a) => Monoid (Product a) where + {-# INLINEABLE mempty #-} + mempty = Product one -- | Simultaneous div and mod. divMod :: Integer -> Integer -> (Integer, Integer) -divMod x y = ( x `divideInteger` y, x `modInteger` y) -{-# INLINABLE divMod #-} +divMod x y = (x `divideInteger` y, x `modInteger` y) +{-# INLINEABLE divMod #-} -- | Simultaneous quot and rem. quotRem :: Integer -> Integer -> (Integer, Integer) -quotRem x y = ( x `quotientInteger` y, x `remainderInteger` y) -{-# INLINABLE quotRem #-} +quotRem x y = (x `quotientInteger` y, x `remainderInteger` y) +{-# INLINEABLE quotRem #-} -- | Absolute value for any 'AdditiveGroup'. abs :: (Ord n, AdditiveGroup n) => n -> n abs x = if x < zero then negate x else x -{-# INLINABLE abs #-} +{-# INLINEABLE abs #-} diff --git a/plutus-tx/src/PlutusTx/Optimize/Inline.hs b/plutus-tx/src/PlutusTx/Optimize/Inline.hs index b073949ad25..1a2421a3e54 100644 --- a/plutus-tx/src/PlutusTx/Optimize/Inline.hs +++ b/plutus-tx/src/PlutusTx/Optimize/Inline.hs @@ -2,10 +2,11 @@ module PlutusTx.Optimize.Inline (inline) where import Prelude --- | Like @GHC.Magic.Inline@, this function can be used to perform callsite inlining. --- --- @inline f@ or @inline (f x1 ... xn)@ inlines @f@, as long as @f@'s unfolding is available, --- and @f@ is not recursive. +{-| Like @GHC.Magic.Inline@, this function can be used to perform callsite inlining. + +@inline f@ or @inline (f x1 ... xn)@ inlines @f@, as long as @f@'s unfolding is available, +and @f@ is not recursive. +-} inline :: a -> a inline = id {-# OPAQUE inline #-} diff --git a/plutus-tx/src/PlutusTx/Ord.hs b/plutus-tx/src/PlutusTx/Ord.hs index 29554daa56f..7140d761ade 100644 --- a/plutus-tx/src/PlutusTx/Ord.hs +++ b/plutus-tx/src/PlutusTx/Ord.hs @@ -1,7 +1,8 @@ +{-# OPTIONS_GHC -fno-omit-interface-pragmas #-} -- editorconfig-checker-disable-file {-# OPTIONS_GHC -fno-warn-orphans #-} -{-# OPTIONS_GHC -fno-omit-interface-pragmas #-} -module PlutusTx.Ord (Ord(..), Ordering(..)) where + +module PlutusTx.Ord (Ord (..), Ordering (..)) where {- We export off-chain Haskell's Ordering type as on-chain Plutus's Ordering type since they are the same. @@ -19,123 +20,128 @@ import Prelude (Maybe (..), Ordering (..)) infix 4 <, <=, >, >= -- Copied from the GHC definition --- | The 'Ord' class is used for totally ordered datatypes. --- --- Minimal complete definition: either 'compare' or '<='. --- Using 'compare' can be more efficient for complex types. --- -class Eq a => Ord a where - compare :: a -> a -> Ordering - (<), (<=), (>), (>=) :: a -> a -> Bool - max, min :: a -> a -> a - - {-# INLINABLE compare #-} - compare x y = if x == y then EQ - -- NB: must be '<=' not '<' to validate the - -- above claim about the minimal things that - -- can be defined for an instance of Ord: - else if x <= y then LT - else GT - - {-# INLINABLE (<) #-} - x < y = case compare x y of { LT -> True; _ -> False } - {-# INLINABLE (<=) #-} - x <= y = case compare x y of { GT -> False; _ -> True } - {-# INLINABLE (>) #-} - x > y = case compare x y of { GT -> True; _ -> False } - {-# INLINABLE (>=) #-} - x >= y = case compare x y of { LT -> False; _ -> True } - - -- These two default methods use '<=' rather than 'compare' - -- because the latter is often more expensive - {-# INLINABLE max #-} - max x y = if x <= y then y else x - {-# INLINABLE min #-} - min x y = if x <= y then x else y - {-# MINIMAL compare | (<=) #-} + +{-| The 'Ord' class is used for totally ordered datatypes. + +Minimal complete definition: either 'compare' or '<='. +Using 'compare' can be more efficient for complex types. +-} +class (Eq a) => Ord a where + compare :: a -> a -> Ordering + (<), (<=), (>), (>=) :: a -> a -> Bool + max, min :: a -> a -> a + + {-# INLINEABLE compare #-} + compare x y = + if x == y + then EQ + -- NB: must be '<=' not '<' to validate the + -- above claim about the minimal things that + -- can be defined for an instance of Ord: + else + if x <= y + then LT + else GT + + {-# INLINEABLE (<) #-} + x < y = case compare x y of LT -> True; _ -> False + {-# INLINEABLE (<=) #-} + x <= y = case compare x y of GT -> False; _ -> True + {-# INLINEABLE (>) #-} + x > y = case compare x y of GT -> True; _ -> False + {-# INLINEABLE (>=) #-} + x >= y = case compare x y of LT -> False; _ -> True + + -- These two default methods use '<=' rather than 'compare' + -- because the latter is often more expensive + {-# INLINEABLE max #-} + max x y = if x <= y then y else x + {-# INLINEABLE min #-} + min x y = if x <= y then x else y + {-# MINIMAL compare | (<=) #-} instance Eq Ordering where - {-# INLINABLE (==) #-} - EQ == EQ = True - GT == GT = True - LT == LT = True - _ == _ = False + {-# INLINEABLE (==) #-} + EQ == EQ = True + GT == GT = True + LT == LT = True + _ == _ = False instance Ord Builtins.Integer where - {-# INLINABLE (<) #-} - (<) = Builtins.lessThanInteger - {-# INLINABLE (<=) #-} - (<=) = Builtins.lessThanEqualsInteger - {-# INLINABLE (>) #-} - (>) = Builtins.greaterThanInteger - {-# INLINABLE (>=) #-} - (>=) = Builtins.greaterThanEqualsInteger + {-# INLINEABLE (<) #-} + (<) = Builtins.lessThanInteger + {-# INLINEABLE (<=) #-} + (<=) = Builtins.lessThanEqualsInteger + {-# INLINEABLE (>) #-} + (>) = Builtins.greaterThanInteger + {-# INLINEABLE (>=) #-} + (>=) = Builtins.greaterThanEqualsInteger instance Ord Builtins.BuiltinByteString where - {-# INLINABLE (<) #-} - (<) = Builtins.lessThanByteString - {-# INLINABLE (<=) #-} - (<=) = Builtins.lessThanEqualsByteString - {-# INLINABLE (>) #-} - (>) = Builtins.greaterThanByteString - {-# INLINABLE (>=) #-} - (>=) = Builtins.greaterThanEqualsByteString - -instance Ord a => Ord [a] where - {-# INLINABLE compare #-} - compare [] [] = EQ - compare [] (_:_) = LT - compare (_:_) [] = GT - compare (x:xs) (y:ys) = - case compare x y of - EQ -> compare xs ys - c -> c + {-# INLINEABLE (<) #-} + (<) = Builtins.lessThanByteString + {-# INLINEABLE (<=) #-} + (<=) = Builtins.lessThanEqualsByteString + {-# INLINEABLE (>) #-} + (>) = Builtins.greaterThanByteString + {-# INLINEABLE (>=) #-} + (>=) = Builtins.greaterThanEqualsByteString + +instance (Ord a) => Ord [a] where + {-# INLINEABLE compare #-} + compare [] [] = EQ + compare [] (_ : _) = LT + compare (_ : _) [] = GT + compare (x : xs) (y : ys) = + case compare x y of + EQ -> compare xs ys + c -> c instance Ord Bool where - {-# INLINABLE compare #-} - compare b1 b2 = case b1 of - False -> case b2 of - False -> EQ - True -> LT - True -> case b2 of - False -> GT - True -> EQ - -instance Ord a => Ord (Maybe a) where - {-# INLINABLE compare #-} - compare (Just a1) (Just a2) = compare a1 a2 - compare Nothing (Just _) = LT - compare (Just _) Nothing = GT - compare Nothing Nothing = EQ + {-# INLINEABLE compare #-} + compare b1 b2 = case b1 of + False -> case b2 of + False -> EQ + True -> LT + True -> case b2 of + False -> GT + True -> EQ + +instance (Ord a) => Ord (Maybe a) where + {-# INLINEABLE compare #-} + compare (Just a1) (Just a2) = compare a1 a2 + compare Nothing (Just _) = LT + compare (Just _) Nothing = GT + compare Nothing Nothing = EQ instance (Ord a, Ord b) => Ord (Either a b) where - {-# INLINABLE compare #-} - compare (Left a1) (Left a2) = compare a1 a2 - compare (Left _) (Right _) = LT - compare (Right _) (Left _) = GT - compare (Right b1) (Right b2) = compare b1 b2 + {-# INLINEABLE compare #-} + compare (Left a1) (Left a2) = compare a1 a2 + compare (Left _) (Right _) = LT + compare (Right _) (Left _) = GT + compare (Right b1) (Right b2) = compare b1 b2 instance Ord () where - {-# INLINABLE compare #-} - compare _ _ = EQ + {-# INLINEABLE compare #-} + compare _ _ = EQ instance (Ord a, Ord b) => Ord (a, b) where - {-# INLINABLE compare #-} - compare (a, b) (a', b') = - case compare a a' of - EQ -> compare b b' - c -> c + {-# INLINEABLE compare #-} + compare (a, b) (a', b') = + case compare a a' of + EQ -> compare b b' + c -> c instance (Ord a, Ord b) => Ord (These a b) where - {-# INLINABLE compare #-} - compare (This a) (This a') = compare a a' - compare (That b) (That b') = compare b b' - compare (These a b) (These a' b') = - case compare a a' of - EQ -> compare b b' - c -> c - compare (This _) _ = LT - compare (That _) (This _) = GT - compare (That _) (These _ _) = LT - compare (These _ _) (This _) = GT - compare (These _ _) (That _) = GT + {-# INLINEABLE compare #-} + compare (This a) (This a') = compare a a' + compare (That b) (That b') = compare b b' + compare (These a b) (These a' b') = + case compare a a' of + EQ -> compare b b' + c -> c + compare (This _) _ = LT + compare (That _) (This _) = GT + compare (That _) (These _ _) = LT + compare (These _ _) (This _) = GT + compare (These _ _) (That _) = GT diff --git a/plutus-tx/src/PlutusTx/Plugin/Utils.hs b/plutus-tx/src/PlutusTx/Plugin/Utils.hs index 84f38746894..24ae14c57dc 100644 --- a/plutus-tx/src/PlutusTx/Plugin/Utils.hs +++ b/plutus-tx/src/PlutusTx/Plugin/Utils.hs @@ -3,7 +3,6 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE OverloadedStrings #-} - {-# OPTIONS_GHC -Wno-unused-foralls #-} {-# OPTIONS_GHC -fomit-interface-pragmas #-} @@ -26,8 +25,9 @@ a Proxy to avoid this. -- This needs to be defined here so we can reference it in the TH functions. -- If we inline this then we won't be able to find it later! + -- | Marks the given expression for compilation to PLC. -plc :: forall (loc::Symbol) a . Proxy loc -> a -> CompiledCode a +plc :: forall (loc :: Symbol) a. Proxy loc -> a -> CompiledCode a -- this constructor is only really there to get rid of the unused warning plc _ _ = SerializedCode (mustBeReplaced "plc") (mustBeReplaced "pir") (mustBeReplaced "covidx") {-# OPAQUE plc #-} diff --git a/plutus-tx/src/PlutusTx/Prelude.hs b/plutus-tx/src/PlutusTx/Prelude.hs index 02b3f5376c7..b0183311246 100644 --- a/plutus-tx/src/PlutusTx/Prelude.hs +++ b/plutus-tx/src/PlutusTx/Prelude.hs @@ -1,138 +1,156 @@ -- editorconfig-checker-disable-file {-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_GHC -Wno-unused-imports #-} -{-# OPTIONS_GHC -fno-omit-interface-pragmas #-} {-# OPTIONS_GHC -fmax-simplifier-iterations=0 #-} +{-# OPTIONS_GHC -fno-omit-interface-pragmas #-} module PlutusTx.Prelude ( - -- * Classes - module Eq, - module Enum, - module Ord, - module Semigroup, - module Monoid, - module Numeric, - module Function, - module Functor, - module Applicative, - module Lattice, - -- * Monad - (Haskell.>>=), - (Haskell.=<<), - (Haskell.>>), - Haskell.return, - -- * Standard functions, Tuples - module Base, - -- * Tracing functions - module Trace, - -- * Unit - BI.BuiltinUnit, - -- * String - BuiltinString, - appendString, - emptyString, - equalsString, - encodeUtf8, - -- * Error - error, - check, - -- * Booleans - module Bool, - -- * Integer numbers - Integer, - divide, - modulo, - quotient, - remainder, - even, - odd, - expMod, - -- * Maybe - module Maybe, - -- * Either - module Either, - -- * ByteStrings - BuiltinByteString, - appendByteString, - consByteString, - takeByteString, - dropByteString, - sliceByteString, - lengthOfByteString, - indexByteString, - emptyByteString, - decodeUtf8, - BuiltinByteStringUtf8 (..), - Builtins.andByteString, - Builtins.orByteString, - Builtins.xorByteString, - Builtins.complementByteString, - -- ** Bit operations - Builtins.readBit, - Builtins.writeBits, - Builtins.replicateByte, - Builtins.shiftByteString, - Builtins.rotateByteString, - Builtins.countSetBits, - Builtins.findFirstSetBit, - -- * Hashes and Signatures - sha2_256, - sha3_256, - blake2b_224, - blake2b_256, - keccak_256, - ripemd_160, - verifyEd25519Signature, - verifyEcdsaSecp256k1Signature, - verifySchnorrSecp256k1Signature, - -- * Rational numbers - Rational, - unsafeRatio, - ratio, - fromInteger, - round, - -- * Other builtin Types - BI.BuiltinBool, - BuiltinData, - BI.BuiltinList, - BI.BuiltinPair, - -- * To/from Data - ToData (..), - FromData (..), - UnsafeFromData (..), - -- * BLS12_381 - BuiltinBLS12_381_G1_Element, - bls12_381_G1_equals, - bls12_381_G1_add, - bls12_381_G1_neg, - bls12_381_G1_scalarMul, - bls12_381_G1_compress, - bls12_381_G1_uncompress, - bls12_381_G1_hashToGroup, - bls12_381_G1_compressed_zero, - bls12_381_G1_compressed_generator, - BuiltinBLS12_381_G2_Element, - bls12_381_G2_equals, - bls12_381_G2_add, - bls12_381_G2_neg, - bls12_381_G2_scalarMul, - bls12_381_G2_compress, - bls12_381_G2_uncompress, - bls12_381_G2_hashToGroup, - bls12_381_G2_compressed_zero, - bls12_381_G2_compressed_generator, - BuiltinBLS12_381_MlResult, - bls12_381_millerLoop, - bls12_381_mulMlResult, - bls12_381_finalVerify, - -- * Conversions - fromBuiltin, - toBuiltin, - fromOpaque, - toOpaque, - integerToByteString, - byteStringToInteger - ) where + -- * Classes + module Eq, + module Enum, + module Ord, + module Semigroup, + module Monoid, + module Numeric, + module Function, + module Functor, + module Applicative, + module Lattice, + + -- * Monad + (Haskell.>>=), + (Haskell.=<<), + (Haskell.>>), + Haskell.return, + + -- * Standard functions, Tuples + module Base, + + -- * Tracing functions + module Trace, + + -- * Unit + BI.BuiltinUnit, + + -- * String + BuiltinString, + appendString, + emptyString, + equalsString, + encodeUtf8, + + -- * Error + error, + check, + + -- * Booleans + module Bool, + + -- * Integer numbers + Integer, + divide, + modulo, + quotient, + remainder, + even, + odd, + expMod, + + -- * Maybe + module Maybe, + + -- * Either + module Either, + + -- * ByteStrings + BuiltinByteString, + appendByteString, + consByteString, + takeByteString, + dropByteString, + sliceByteString, + lengthOfByteString, + indexByteString, + emptyByteString, + decodeUtf8, + BuiltinByteStringUtf8 (..), + Builtins.andByteString, + Builtins.orByteString, + Builtins.xorByteString, + Builtins.complementByteString, + + -- ** Bit operations + Builtins.readBit, + Builtins.writeBits, + Builtins.replicateByte, + Builtins.shiftByteString, + Builtins.rotateByteString, + Builtins.countSetBits, + Builtins.findFirstSetBit, + + -- * Hashes and Signatures + sha2_256, + sha3_256, + blake2b_224, + blake2b_256, + keccak_256, + ripemd_160, + verifyEd25519Signature, + verifyEcdsaSecp256k1Signature, + verifySchnorrSecp256k1Signature, + + -- * Rational numbers + Rational, + unsafeRatio, + ratio, + fromInteger, + round, + + -- * Other builtin Types + BI.BuiltinBool, + BuiltinData, + BI.BuiltinList, + BI.BuiltinPair, + + -- * To/from Data + ToData (..), + FromData (..), + UnsafeFromData (..), + + -- * BLS12_381 + BuiltinBLS12_381_G1_Element, + bls12_381_G1_equals, + bls12_381_G1_add, + bls12_381_G1_neg, + bls12_381_G1_scalarMul, + bls12_381_G1_compress, + bls12_381_G1_uncompress, + bls12_381_G1_hashToGroup, + bls12_381_G1_compressed_zero, + bls12_381_G1_compressed_generator, + BuiltinBLS12_381_G2_Element, + bls12_381_G2_equals, + bls12_381_G2_add, + bls12_381_G2_neg, + bls12_381_G2_scalarMul, + bls12_381_G2_compress, + bls12_381_G2_uncompress, + bls12_381_G2_hashToGroup, + bls12_381_G2_compressed_zero, + bls12_381_G2_compressed_generator, + BuiltinBLS12_381_MlResult, + bls12_381_millerLoop, + bls12_381_mulMlResult, + bls12_381_finalVerify, + + -- * Conversions + fromBuiltin, + toBuiltin, + fromOpaque, + toOpaque, + integerToByteString, + byteStringToInteger, +) where import Data.String (IsString (..)) import PlutusCore.Data (Data (..)) @@ -184,80 +202,71 @@ import Prelude qualified as Haskell (return, (=<<), (>>), (>>=)) -- this module does lots of weird stuff deliberately {- HLINT ignore -} --- $prelude --- The PlutusTx Prelude is a replacement for the Haskell Prelude that works --- better with Plutus Tx. You should use it if you're writing code that --- will be compiled with the Plutus Tx compiler. --- @ --- {-# LANGUAGE NoImplicitPrelude #-} --- import PlutusTx.Prelude --- @ +{-# LANGUAGE NoImplicitPrelude #-} -- | Checks a 'Bool' and aborts if it is false. check :: Bool -> BI.BuiltinUnit check b = if b then BI.unitval else traceError checkHasFailedError -{-# INLINABLE check #-} +{-# INLINEABLE check #-} + +{-| Integer division, rounding downwards --- | Integer division, rounding downwards --- --- >>> divide (-41) 5 --- -9 --- + >>> divide (-41) 5 + -9 +-} divide :: Integer -> Integer -> Integer divide = Builtins.divideInteger -{-# INLINABLE divide #-} +{-# INLINEABLE divide #-} + +{-| Integer remainder, always positive for a positive divisor --- | Integer remainder, always positive for a positive divisor --- --- >>> modulo (-41) 5 --- 4 --- + >>> modulo (-41) 5 + 4 +-} modulo :: Integer -> Integer -> Integer modulo = Builtins.modInteger -{-# INLINABLE modulo #-} - +{-# INLINEABLE modulo #-} -- | FIXME expMod :: Integer -> Integer -> Integer -> Integer expMod = Builtins.expModInteger -{-# INLINABLE expMod #-} +{-# INLINEABLE expMod #-} --- | Integer division, rouding towards zero --- --- >>> quotient (-41) 5 --- -8 --- -{-# INLINABLE quotient #-} +{-| Integer division, rouding towards zero + >>> quotient (-41) 5 + -8 +-} +{-# INLINEABLE quotient #-} quotient :: Integer -> Integer -> Integer quotient = Builtins.quotientInteger --- | Integer remainder, same sign as dividend --- --- >>> remainder (-41) 5 --- -1 --- +{-| Integer remainder, same sign as dividend + + >>> remainder (-41) 5 + -1 +-} remainder :: Integer -> Integer -> Integer remainder = Builtins.remainderInteger -{-# INLINABLE remainder #-} +{-# INLINEABLE remainder #-} even :: Integer -> Bool even n = if modulo n 2 == 0 then True else False -{-# INLINABLE even #-} +{-# INLINEABLE even #-} odd :: Integer -> Bool odd n = if even n then False else True -{-# INLINABLE odd #-} +{-# INLINEABLE odd #-} -- | Returns the n length prefix of a 'ByteString'. takeByteString :: Integer -> BuiltinByteString -> BuiltinByteString takeByteString n bs = Builtins.sliceByteString 0 n bs -{-# INLINABLE takeByteString #-} +{-# INLINEABLE takeByteString #-} -- | Returns the suffix of a 'ByteString' after n elements. dropByteString :: Integer -> BuiltinByteString -> BuiltinByteString dropByteString n bs = Builtins.sliceByteString n (Builtins.lengthOfByteString bs - n) bs -{-# INLINABLE dropByteString #-} +{-# INLINEABLE dropByteString #-} {- Note [-fno-full-laziness in Plutus Tx] GHC's full-laziness optimization moves computations inside a lambda that don't depend on diff --git a/plutus-tx/src/PlutusTx/Ratio.hs b/plutus-tx/src/PlutusTx/Ratio.hs index 46646a167a4..7b648687c58 100644 --- a/plutus-tx/src/PlutusTx/Ratio.hs +++ b/plutus-tx/src/PlutusTx/Ratio.hs @@ -13,27 +13,29 @@ {-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -fplugin-opt PlutusTx.Plugin:context-level=3 #-} -module PlutusTx.Ratio( - -- * Type - Rational - -- * Construction - , unsafeRatio - , fromInteger - , ratio - -- * Other functionality - , numerator - , denominator - , round - , truncate - , properFraction - , recip - , abs - , negate - , half - , fromGHC - , toGHC - , gcd - ) where +module PlutusTx.Ratio ( + -- * Type + Rational, + + -- * Construction + unsafeRatio, + fromInteger, + ratio, + + -- * Other functionality + numerator, + denominator, + round, + truncate, + properFraction, + recip, + abs, + negate, + half, + fromGHC, + toGHC, + gcd, +) where import PlutusTx.Applicative qualified as P import PlutusTx.Base qualified as P @@ -60,12 +62,13 @@ import Prelude (Ord (..), Show, (*)) import Prelude qualified as Haskell import Prettyprinter (Pretty (..), (<+>)) --- | Represents an arbitrary-precision ratio. --- --- The following two invariants are maintained: --- --- 1. The denominator is greater than zero. --- 2. The numerator and denominator are coprime. +{-| Represents an arbitrary-precision ratio. + +The following two invariants are maintained: + +1. The denominator is greater than zero. +2. The numerator and denominator are coprime. +-} data Rational = Rational Integer Integer deriving stock (Haskell.Eq, Show, Generic) @@ -73,19 +76,19 @@ instance Pretty Rational where pretty (Rational a b) = "Rational:" <+> pretty a <+> pretty b instance P.Eq Rational where - {-# INLINABLE (==) #-} + {-# INLINEABLE (==) #-} Rational n d == Rational n' d' = n P.== n' P.&& d P.== d' instance P.Ord Rational where - {-# INLINABLE compare #-} + {-# INLINEABLE compare #-} compare (Rational n d) (Rational n' d') = P.compare (n P.* d') (n' P.* d) - {-# INLINABLE (<=) #-} + {-# INLINEABLE (<=) #-} Rational n d <= Rational n' d' = (n P.* d') P.<= (n' P.* d) - {-# INLINABLE (>=) #-} + {-# INLINEABLE (>=) #-} Rational n d >= Rational n' d' = (n P.* d') P.>= (n' P.* d) - {-# INLINABLE (<) #-} + {-# INLINEABLE (<) #-} Rational n d < Rational n' d' = (n P.* d') P.< (n' P.* d) - {-# INLINABLE (>) #-} + {-# INLINEABLE (>) #-} Rational n d > Rational n' d' = (n P.* d') P.> (n' P.* d) instance Ord Rational where @@ -96,58 +99,63 @@ instance Ord Rational where Rational n d > Rational n' d' = (n * d') > (n' * d) instance P.AdditiveSemigroup Rational where - {-# INLINABLE (+) #-} + {-# INLINEABLE (+) #-} Rational n d + Rational n' d' = let newNum = (n P.* d') P.+ (n' P.* d) newDen = d P.* d' gcd' = euclid newNum newDen - in Rational (newNum `Builtins.quotientInteger` gcd') - (newDen `Builtins.quotientInteger` gcd') + in Rational + (newNum `Builtins.quotientInteger` gcd') + (newDen `Builtins.quotientInteger` gcd') instance P.AdditiveMonoid Rational where - {-# INLINABLE zero #-} + {-# INLINEABLE zero #-} zero = Rational P.zero P.one instance P.AdditiveGroup Rational where - {-# INLINABLE (-) #-} + {-# INLINEABLE (-) #-} Rational n d - Rational n' d' = let newNum = (n P.* d') P.- (n' P.* d) newDen = d P.* d' gcd' = euclid newNum newDen - in Rational (newNum `Builtins.quotientInteger` gcd') - (newDen `Builtins.quotientInteger` gcd') + in Rational + (newNum `Builtins.quotientInteger` gcd') + (newDen `Builtins.quotientInteger` gcd') instance P.MultiplicativeSemigroup Rational where - {-# INLINABLE (*) #-} + {-# INLINEABLE (*) #-} Rational n d * Rational n' d' = let newNum = n P.* n' newDen = d P.* d' gcd' = euclid newNum newDen - in Rational (newNum `Builtins.quotientInteger` gcd') - (newDen `Builtins.quotientInteger` gcd') + in Rational + (newNum `Builtins.quotientInteger` gcd') + (newDen `Builtins.quotientInteger` gcd') instance P.MultiplicativeMonoid Rational where - {-# INLINABLE one #-} + {-# INLINEABLE one #-} one = Rational P.one P.one instance P.Module Integer Rational where - {-# INLINABLE scale #-} - scale i (Rational n d) = let newNum = i P.* n - gcd' = euclid newNum d in - Rational (newNum `Builtins.quotientInteger` gcd') - (d `Builtins.quotientInteger` gcd') + {-# INLINEABLE scale #-} + scale i (Rational n d) = + let newNum = i P.* n + gcd' = euclid newNum d + in Rational + (newNum `Builtins.quotientInteger` gcd') + (d `Builtins.quotientInteger` gcd') instance HasBlueprintDefinition Rational where type Unroll Rational = '[Rational, Integer] instance - (HasSchemaDefinition Integer referencedTypes) => - HasBlueprintSchema Rational referencedTypes + (HasSchemaDefinition Integer referencedTypes) + => HasBlueprintSchema Rational referencedTypes where schema = schema @(Integer, Integer) instance P.ToData Rational where - {-# INLINABLE toBuiltinData #-} + {-# INLINEABLE toBuiltinData #-} toBuiltinData (Rational n d) = P.toBuiltinData (n, d) -- These instances ensure that the following invariants don't break: @@ -160,14 +168,14 @@ instance P.ToData Rational where -- unsafeRatio. instance P.FromData Rational where - {-# INLINABLE fromBuiltinData #-} + {-# INLINEABLE fromBuiltinData #-} fromBuiltinData dat = do (n, d) <- P.fromBuiltinData dat guard (d P./= P.zero) P.pure P.. unsafeRatio n P.$ d instance P.UnsafeFromData Rational where - {-# INLINABLE unsafeFromBuiltinData #-} + {-# INLINEABLE unsafeFromBuiltinData #-} unsafeFromBuiltinData = P.uncurry unsafeRatio P.. P.unsafeFromBuiltinData -- | This mimics the behaviour of Aeson's instance for 'GHC.Rational'. @@ -187,158 +195,176 @@ instance FromJSON Rational where Haskell.Nothing -> Haskell.fail "Zero denominator is invalid." Haskell.Just r -> Haskell.pure r --- | Makes a 'Rational' from a numerator and a denominator. --- --- = Important note --- --- If given a zero denominator, this function will error. If you don't mind a --- size increase, and care about safety, use 'ratio' instead. +{-| Makes a 'Rational' from a numerator and a denominator. + += Important note + +If given a zero denominator, this function will error. If you don't mind a +size increase, and care about safety, use 'ratio' instead. +-} unsafeRatio :: Integer -> Integer -> Rational unsafeRatio n d | d P.== P.zero = P.traceError P.ratioHasZeroDenominatorError | d P.< P.zero = unsafeRatio (P.negate n) (P.negate d) | P.True = - let gcd' = euclid n d - in Rational (n `Builtins.quotientInteger` gcd') - (d `Builtins.quotientInteger` gcd') -{-# INLINABLE unsafeRatio #-} - --- | Safely constructs a 'Rational' from a numerator and a denominator. Returns --- 'Nothing' if given a zero denominator. + let gcd' = euclid n d + in Rational + (n `Builtins.quotientInteger` gcd') + (d `Builtins.quotientInteger` gcd') +{-# INLINEABLE unsafeRatio #-} + +{-| Safely constructs a 'Rational' from a numerator and a denominator. Returns +'Nothing' if given a zero denominator. +-} ratio :: Integer -> Integer -> P.Maybe Rational ratio n d | d P.== P.zero = P.Nothing | d P.< P.zero = P.Just (unsafeRatio (P.negate n) (P.negate d)) | P.True = - let gcd' = euclid n d - in P.Just P.$ - Rational (n `Builtins.quotientInteger` gcd') - (d `Builtins.quotientInteger` gcd') -{-# INLINABLE ratio #-} - --- | Converts a 'Rational' to a GHC 'Ratio.Rational', preserving value. Does not --- work on-chain. + let gcd' = euclid n d + in P.Just + P.$ Rational + (n `Builtins.quotientInteger` gcd') + (d `Builtins.quotientInteger` gcd') +{-# INLINEABLE ratio #-} + +{-| Converts a 'Rational' to a GHC 'Ratio.Rational', preserving value. Does not +work on-chain. +-} toGHC :: Rational -> Ratio.Rational toGHC (Rational n d) = n Ratio.% d --- | Returns the numerator of its argument. --- --- = Note --- --- It is /not/ true in general that @'numerator' '<$>' 'ratio' x y = x@; this --- will only hold if @x@ and @y@ are coprime. This is due to 'Rational' --- normalizing the numerator and denominator. +{-| Returns the numerator of its argument. + += Note + +It is /not/ true in general that @'numerator' '<$>' 'ratio' x y = x@; this +will only hold if @x@ and @y@ are coprime. This is due to 'Rational' +normalizing the numerator and denominator. +-} numerator :: Rational -> Integer numerator (Rational n _) = n -{-# INLINABLE numerator #-} +{-# INLINEABLE numerator #-} --- | Returns the denominator of its argument. This will always be greater than, --- or equal to, 1, although the type does not describe this. --- --- = Note --- --- It is /not/ true in general that @'denominator' '<$>' 'ratio' x y = y@; this --- will only hold if @x@ and @y@ are coprime. This is due to 'Rational' --- normalizing the numerator and denominator. +{-| Returns the denominator of its argument. This will always be greater than, +or equal to, 1, although the type does not describe this. + += Note + +It is /not/ true in general that @'denominator' '<$>' 'ratio' x y = y@; this +will only hold if @x@ and @y@ are coprime. This is due to 'Rational' +normalizing the numerator and denominator. +-} denominator :: Rational -> Integer denominator (Rational _ d) = d -{-# INLINABLE denominator #-} +{-# INLINEABLE denominator #-} -- | 0.5 half :: Rational half = Rational 1 2 -{-# INLINABLE half #-} +{-# INLINEABLE half #-} -- | Converts an 'Integer' into the equivalent 'Rational'. fromInteger :: Integer -> Rational fromInteger num = Rational num P.one -{-# INLINABLE fromInteger #-} +{-# INLINEABLE fromInteger #-} -- | Converts a GHC 'Ratio.Rational', preserving value. Does not work on-chain. fromGHC :: Ratio.Rational -> Rational fromGHC r = unsafeRatio (Ratio.numerator r) (Ratio.denominator r) --- | Produces the additive inverse of its argument. --- --- = Note --- --- This is specialized for 'Rational'; use this instead of the generic version --- of this function, as it is significantly smaller on-chain. +{-| Produces the additive inverse of its argument. + += Note + +This is specialized for 'Rational'; use this instead of the generic version +of this function, as it is significantly smaller on-chain. +-} negate :: Rational -> Rational negate (Rational n d) = Rational (P.negate n) d -{-# INLINABLE negate #-} +{-# INLINEABLE negate #-} --- | Returns the absolute value of its argument. --- --- = Note --- --- This is specialized for 'Rational'; use this instead of the generic version --- in @PlutusTx.Numeric@, as said generic version produces much larger on-chain --- code than the specialized version here. +{-| Returns the absolute value of its argument. + += Note + +This is specialized for 'Rational'; use this instead of the generic version +in @PlutusTx.Numeric@, as said generic version produces much larger on-chain +code than the specialized version here. +-} abs :: Rational -> Rational abs rat@(Rational n d) | n P.< P.zero = Rational (P.negate n) d | P.True = rat -{-# INLINABLE abs #-} +{-# INLINEABLE abs #-} --- | @'properFraction' r@ returns the pair @(n, f)@, such that all of the --- following hold: --- --- * @'fromInteger' n 'P.+' f = r@; --- * @n@ and @f@ both have the same sign as @r@; and --- * @'abs' f 'P.<' 'P.one'@. +{-| @'properFraction' r@ returns the pair @(n, f)@, such that all of the +following hold: + +* @'fromInteger' n 'P.+' f = r@; +* @n@ and @f@ both have the same sign as @r@; and +* @'abs' f 'P.<' 'P.one'@. +-} properFraction :: Rational -> (Integer, Rational) properFraction (Rational n d) = - (n `Builtins.quotientInteger` d, - Rational (n `Builtins.remainderInteger` d) d) -{-# INLINABLE properFraction #-} + ( n `Builtins.quotientInteger` d + , Rational (n `Builtins.remainderInteger` d) d + ) +{-# INLINEABLE properFraction #-} --- | Gives the reciprocal of the argument; specifically, for @r 'P./=' --- 'P.zero'@, @r 'P.*' 'recip' r = 'P.one'@. --- --- = Important note --- --- The reciprocal of zero is mathematically undefined; thus, @'recip' 'P.zero'@ --- will error. Use with care. +{-| Gives the reciprocal of the argument; specifically, for @r 'P./=' +'P.zero'@, @r 'P.*' 'recip' r = 'P.one'@. + += Important note + +The reciprocal of zero is mathematically undefined; thus, @'recip' 'P.zero'@ +will error. Use with care. +-} recip :: Rational -> Rational recip (Rational n d) | n P.== P.zero = P.traceError P.reciprocalOfZeroError | n P.< P.zero = Rational (P.negate d) (P.negate n) | P.True = Rational d n -{-# INLINABLE recip #-} +{-# INLINEABLE recip #-} --- | Returns the whole-number part of its argument, dropping any leftover --- fractional part. More precisely, @'truncate' r = n@ where @(n, _) = --- 'properFraction' r@, but is much more efficient. +{-| Returns the whole-number part of its argument, dropping any leftover +fractional part. More precisely, @'truncate' r = n@ where @(n, _) = +'properFraction' r@, but is much more efficient. +-} truncate :: Rational -> Integer truncate (Rational n d) = n `Builtins.quotientInteger` d -{-# INLINABLE truncate #-} +{-# INLINEABLE truncate #-} --- | @'round' r@ returns the nearest 'Integer' value to @r@. If @r@ is --- equidistant between two values, the even value will be given. +{-| @'round' r@ returns the nearest 'Integer' value to @r@. If @r@ is +equidistant between two values, the even value will be given. +-} round :: Rational -> Integer round x = let (n, r) = properFraction x m = if r P.< P.zero then n P.- P.one else n P.+ P.one flag = abs r P.- half in if - | flag P.< P.zero -> n - | flag P.== P.zero -> if Builtins.modInteger n 2 P.== P.zero - then n - else m - | P.True -> m -{-# INLINABLE round #-} + | flag P.< P.zero -> n + | flag P.== P.zero -> + if Builtins.modInteger n 2 P.== P.zero + then n + else m + | P.True -> m +{-# INLINEABLE round #-} -- From GHC.Real --- | @'gcd' x y@ is the non-negative factor of both @x@ and @y@ of which --- every common factor of @x@ and @y@ is also a factor; for example --- @'gcd' 4 2 = 2@, @'gcd' (-4) 6 = 2@, @'gcd' 0 4@ = @4@. @'gcd' 0 0@ = @0@. + +{-| @'gcd' x y@ is the non-negative factor of both @x@ and @y@ of which +every common factor of @x@ and @y@ is also a factor; for example +@'gcd' 4 2 = 2@, @'gcd' (-4) 6 = 2@, @'gcd' 0 4@ = @4@. @'gcd' 0 0@ = @0@. +-} gcd :: Integer -> Integer -> Integer -gcd a b = gcd' (P.abs a) (P.abs b) where - gcd' a' b' - | b' P.== P.zero = a' - | P.True = gcd' b' (a' `Builtins.remainderInteger` b') -{-# INLINABLE gcd #-} +gcd a b = gcd' (P.abs a) (P.abs b) + where + gcd' a' b' + | b' P.== P.zero = a' + | P.True = gcd' b' (a' `Builtins.remainderInteger` b') +{-# INLINEABLE gcd #-} -- Helpers @@ -347,7 +373,7 @@ euclid :: Integer -> Integer -> Integer euclid x y | y P.== P.zero = x | P.True = euclid y (x `Builtins.modInteger` y) -{-# INLINABLE euclid #-} +{-# INLINEABLE euclid #-} $(makeLift ''Rational) @@ -358,9 +384,9 @@ $(makeLift ''Rational) An important invariant is that the denominator is always positive. This is enforced by -* Construction of 'Rational' numbers with 'unsafeRatio' (the constructor +\* Construction of 'Rational' numbers with 'unsafeRatio' (the constructor of 'Rational' is not exposed) -* Normalizing after every numeric operation. +\* Normalizing after every numeric operation. The 'StdLib.Spec' module has some property tests that check the behaviour of 'round', 'truncate', '>=', etc. against that of their counterparts in @@ -395,12 +421,12 @@ also yield a negative result. Results for different combinations of signs are shown below. ------------------------------- -| n d | div mod | quot rem | -|-----------------------------| -| 41 5 | 8 1 | 8 1 | -| -41 5 | -9 4 | -8 -1 | -| 41 -5 | -9 -4 | -8 1 | -| -41 -5 | 8 -1 | 8 -1 | +\| n d | div mod | quot rem | +\|-----------------------------| +\| 41 5 | 8 1 | 8 1 | +\| -41 5 | -9 4 | -8 -1 | +\| 41 -5 | -9 -4 | -8 1 | +\| -41 -5 | 8 -1 | 8 -1 | ------------------------------- For many purposes (in particular if you're doing modular arithmetic), @@ -414,12 +440,12 @@ with b != 0, this returns numbers q and r with a = q*b+r and 0 <= r < |b|. For the numbers above this gives ------------------- -| n d | q r | -|-----------------| -| 41 5 | 8 1 | -| -41 5 | -9 4 | -| 41 -5 | -8 1 | -| -41 -5 | 9 4 | +\| n d | q r | +\|-----------------| +\| 41 5 | 8 1 | +\| -41 5 | -9 4 | +\| 41 -5 | -8 1 | +\| -41 -5 | 9 4 | ------------------- We get a positive remainder in all cases, but note for instance that the pairs diff --git a/plutus-tx/src/PlutusTx/Semigroup.hs b/plutus-tx/src/PlutusTx/Semigroup.hs index d0d5a77128b..680791e6438 100644 --- a/plutus-tx/src/PlutusTx/Semigroup.hs +++ b/plutus-tx/src/PlutusTx/Semigroup.hs @@ -1,5 +1,6 @@ {-# LANGUAGE InstanceSigs #-} {-# OPTIONS_GHC -fno-omit-interface-pragmas #-} + module PlutusTx.Semigroup (Semigroup (..), Max (..), Min (..)) where import Data.Coerce (coerce) @@ -18,70 +19,71 @@ infixr 6 <> -- | Plutus Tx version of 'Data.Semigroup.Semigroup'. class Semigroup a where - -- | Plutus Tx version of '(Data.Semigroup.<>)'. - (<>) :: a -> a -> a - -- sconcat and stimes deliberately omitted, to make this a one-method class which has a - -- simpler representation + -- | Plutus Tx version of '(Data.Semigroup.<>)'. + (<>) :: a -> a -> a + +-- sconcat and stimes deliberately omitted, to make this a one-method class which has a +-- simpler representation instance Semigroup Builtins.BuiltinByteString where - {-# INLINABLE (<>) #-} - (<>) = Builtins.appendByteString + {-# INLINEABLE (<>) #-} + (<>) = Builtins.appendByteString instance Semigroup Builtins.BuiltinString where - {-# INLINABLE (<>) #-} - (<>) = Builtins.appendString + {-# INLINEABLE (<>) #-} + (<>) = Builtins.appendString instance Semigroup [a] where - {-# INLINABLE (<>) #-} - (<>) = (++) + {-# INLINEABLE (<>) #-} + (<>) = (++) instance (Semigroup a, Semigroup b) => Semigroup (a, b) where - {-# INLINABLE (<>) #-} - (a1, b1) <> (a2, b2) = (a1 <> a2, b1 <> b2) + {-# INLINEABLE (<>) #-} + (a1, b1) <> (a2, b2) = (a1 <> a2, b1 <> b2) -instance Semigroup a => Semigroup (Maybe a) where - Just a1 <> Just a2 = Just (a1 <> a2) - Just a1 <> Nothing = Just a1 - Nothing <> Just a2 = Just a2 - Nothing <> Nothing = Nothing +instance (Semigroup a) => Semigroup (Maybe a) where + Just a1 <> Just a2 = Just (a1 <> a2) + Just a1 <> Nothing = Just a1 + Nothing <> Just a2 = Just a2 + Nothing <> Nothing = Nothing instance Semigroup Ordering where - LT <> _ = LT - EQ <> y = y - GT <> _ = GT + LT <> _ = LT + EQ <> y = y + GT <> _ = GT instance Semigroup () where - _ <> _ = () + _ <> _ = () -instance Semigroup a => Semigroup (Dual a) where - {-# INLINABLE (<>) #-} - Dual a1 <> Dual a2 = Dual (a2 <> a1) +instance (Semigroup a) => Semigroup (Dual a) where + {-# INLINEABLE (<>) #-} + Dual a1 <> Dual a2 = Dual (a2 <> a1) instance Semigroup (Endo a) where - {-# INLINABLE (<>) #-} - (<>) = coerce ((.) :: (a -> a) -> (a -> a) -> a -> a) + {-# INLINEABLE (<>) #-} + (<>) = coerce ((.) :: (a -> a) -> (a -> a) -> a -> a) instance Semigroup (First a) where - {-# INLINABLE (<>) #-} - First Nothing <> b = b - a <> _ = a + {-# INLINEABLE (<>) #-} + First Nothing <> b = b + a <> _ = a -newtype Max a = Max { getMax :: a } +newtype Max a = Max {getMax :: a} instance Functor Max where - {-# INLINABLE fmap #-} - fmap = coerce + {-# INLINEABLE fmap #-} + fmap = coerce -instance Ord a => Semigroup (Max a) where - {-# INLINABLE (<>) #-} - (<>) = coerce (max :: a -> a -> a) +instance (Ord a) => Semigroup (Max a) where + {-# INLINEABLE (<>) #-} + (<>) = coerce (max :: a -> a -> a) -newtype Min a = Min { getMin :: a } +newtype Min a = Min {getMin :: a} instance Functor Min where - {-# INLINABLE fmap #-} - fmap = coerce + {-# INLINEABLE fmap #-} + fmap = coerce -instance Ord a => Semigroup (Min a) where - {-# INLINABLE (<>) #-} - (<>) = coerce (min :: a -> a -> a) +instance (Ord a) => Semigroup (Min a) where + {-# INLINEABLE (<>) #-} + (<>) = coerce (min :: a -> a -> a) diff --git a/plutus-tx/src/PlutusTx/Show.hs b/plutus-tx/src/PlutusTx/Show.hs index 91778a4093a..4aa4fa214be 100644 --- a/plutus-tx/src/PlutusTx/Show.hs +++ b/plutus-tx/src/PlutusTx/Show.hs @@ -5,16 +5,16 @@ {-# OPTIONS_GHC -Wno-orphans #-} module PlutusTx.Show ( - Show (..), - ShowS, - toDigits, - showString, - showSpace, - showCommaSpace, - showParen, - appPrec, - appPrec1, - deriveShow, + Show (..), + ShowS, + toDigits, + showString, + showSpace, + showCommaSpace, + showParen, + appPrec, + appPrec1, + deriveShow, ) where import PlutusTx.Base @@ -28,85 +28,85 @@ import PlutusTx.Show.TH import PlutusTx.These instance Show Builtins.Integer where - {-# INLINEABLE showsPrec #-} - showsPrec p n = - if n < 0 - then showString "-" . showsPrec p (negate n) - else foldr alg id (toDigits n) - where - alg :: Builtins.Integer -> ShowS -> ShowS - alg digit acc = - showString - ( if - | digit == 0 -> "0" - | digit == 1 -> "1" - | digit == 2 -> "2" - | digit == 3 -> "3" - | digit == 4 -> "4" - | digit == 5 -> "5" - | digit == 6 -> "6" - | digit == 7 -> "7" - | digit == 8 -> "8" - | digit == 9 -> "9" - | otherwise -> "" - ) - . acc + {-# INLINEABLE showsPrec #-} + showsPrec p n = + if n < 0 + then showString "-" . showsPrec p (negate n) + else foldr alg id (toDigits n) + where + alg :: Builtins.Integer -> ShowS -> ShowS + alg digit acc = + showString + ( if + | digit == 0 -> "0" + | digit == 1 -> "1" + | digit == 2 -> "2" + | digit == 3 -> "3" + | digit == 4 -> "4" + | digit == 5 -> "5" + | digit == 6 -> "6" + | digit == 7 -> "7" + | digit == 8 -> "8" + | digit == 9 -> "9" + | otherwise -> "" + ) + . acc -- | Convert a non-negative integer to individual digits. toDigits :: Builtins.Integer -> [Builtins.Integer] toDigits = go [] - where - go acc n = case n `quotRem` 10 of - (q, r) -> - if q == 0 - then r : acc - else go (r : acc) q + where + go acc n = case n `quotRem` 10 of + (q, r) -> + if q == 0 + then r : acc + else go (r : acc) q {-# INLINEABLE toDigits #-} instance Show Builtins.BuiltinByteString where - {-# INLINEABLE showsPrec #-} - -- Base16-encode the ByteString and show the result. - showsPrec _ s = foldr alg id (enumFromTo 0 (len - 1)) - where - len = Builtins.lengthOfByteString s + {-# INLINEABLE showsPrec #-} + -- Base16-encode the ByteString and show the result. + showsPrec _ s = foldr alg id (enumFromTo 0 (len - 1)) + where + len = Builtins.lengthOfByteString s - showWord8 :: Builtins.Integer -> ShowS - showWord8 x = - toHex (x `Builtins.divideInteger` 16) - . toHex (x `Builtins.modInteger` 16) + showWord8 :: Builtins.Integer -> ShowS + showWord8 x = + toHex (x `Builtins.divideInteger` 16) + . toHex (x `Builtins.modInteger` 16) - toHex :: Integer -> ShowS - toHex x = - if - | x <= 9 -> showsPrec 0 x - | x == 10 -> showString "a" - | x == 11 -> showString "b" - | x == 12 -> showString "c" - | x == 13 -> showString "d" - | x == 14 -> showString "e" - | x == 15 -> showString "f" - | otherwise -> showString "" - alg :: Builtins.Integer -> ShowS -> ShowS - alg i acc = showWord8 (Builtins.indexByteString s i) . acc + toHex :: Integer -> ShowS + toHex x = + if + | x <= 9 -> showsPrec 0 x + | x == 10 -> showString "a" + | x == 11 -> showString "b" + | x == 12 -> showString "c" + | x == 13 -> showString "d" + | x == 14 -> showString "e" + | x == 15 -> showString "f" + | otherwise -> showString "" + alg :: Builtins.Integer -> ShowS -> ShowS + alg i acc = showWord8 (Builtins.indexByteString s i) . acc instance Show Builtins.BuiltinString where - {-# INLINEABLE showsPrec #-} - -- Add quotes to the given string. `Prelude.show @String` uses @showLitChar@ to process - -- non-ascii characters and escape characters, in additional to adding quotes. We have - -- no builtin that operates on `Char`, so we cannot implement the same behavior. - showsPrec _ s = showString "\"" . showString s . showString "\"" + {-# INLINEABLE showsPrec #-} + -- Add quotes to the given string. `Prelude.show @String` uses @showLitChar@ to process + -- non-ascii characters and escape characters, in additional to adding quotes. We have + -- no builtin that operates on `Char`, so we cannot implement the same behavior. + showsPrec _ s = showString "\"" . showString s . showString "\"" instance Show Builtins.BuiltinData where - {-# INLINEABLE showsPrec #-} - showsPrec p d = showsPrec p (Builtins.serialiseData d) + {-# INLINEABLE showsPrec #-} + showsPrec p d = showsPrec p (Builtins.serialiseData d) instance Show Bool where - {-# INLINEABLE show #-} - show b = if b then "True" else "False" + {-# INLINEABLE show #-} + show b = if b then "True" else "False" instance Show () where - {-# INLINEABLE show #-} - show () = "()" + {-# INLINEABLE show #-} + show () = "()" -- It is possible to make it so that when `a` is a builtin type, `show (xs :: [a])` -- is compiled into a single `showConstant` call, rathern than `length xs` calls. @@ -116,21 +116,21 @@ instance Show () where -- are often erased anyway. -- -- Same for the `Show (a, b)` instance. -instance Show a => Show [a] where - {-# INLINEABLE showsPrec #-} - showsPrec _ = showList (showsPrec 0) +instance (Show a) => Show [a] where + {-# INLINEABLE showsPrec #-} + showsPrec _ = showList (showsPrec 0) showList :: forall a. (a -> ShowS) -> [a] -> ShowS showList showElem = \case - [] -> showString "[]" - x : xs -> - showString "[" - . showElem x - . foldr alg id xs - . showString "]" - where - alg :: a -> ShowS -> ShowS - alg a acc = showString "," . showElem a . acc + [] -> showString "[]" + x : xs -> + showString "[" + . showElem x + . foldr alg id xs + . showString "]" + where + alg :: a -> ShowS -> ShowS + alg a acc = showString "," . showElem a . acc {-# INLINEABLE showList #-} deriveShow ''(,) diff --git a/plutus-tx/src/PlutusTx/Show/TH.hs b/plutus-tx/src/PlutusTx/Show/TH.hs index a8991f81edd..9350b1dfcfd 100644 --- a/plutus-tx/src/PlutusTx/Show/TH.hs +++ b/plutus-tx/src/PlutusTx/Show/TH.hs @@ -18,21 +18,21 @@ import Language.Haskell.TH.Datatype qualified as TH import Prelude (pure, (+), (<$>), (<>)) import Prelude qualified as Haskell -{- | Conversion of values to `BuiltinString`s. Unlike @GHC.Show.Show@, there is no +{-| Conversion of values to `BuiltinString`s. Unlike @GHC.Show.Show@, there is no @showList@ method, because there is no `Show` instance for `Data.String.String`. -} class Show a where - {-# MINIMAL showsPrec | show #-} + {-# MINIMAL showsPrec | show #-} - {-# INLINEABLE showsPrec #-} - showsPrec :: Integer -> a -> ShowS - showsPrec _ x ss = show x : ss + {-# INLINEABLE showsPrec #-} + showsPrec :: Integer -> a -> ShowS + showsPrec _ x ss = show x : ss - {-# INLINEABLE show #-} - show :: a -> BuiltinString - show x = concatBuiltinStrings (showsPrec 0 x []) + {-# INLINEABLE show #-} + show :: a -> BuiltinString + show x = concatBuiltinStrings (showsPrec 0 x []) -{- | Currently the only way to concatenate `BuiltinString`s is `appendString`, whose cost +{-| Currently the only way to concatenate `BuiltinString`s is `appendString`, whose cost is linear in the total length of the two strings. A naive concatenation of multiple `BuiltinString`s costs @O(n^2)@ in the worst case, where @n@ is the total length. By collecting the `BuiltinString`s in a list and concatenating them in the end, the cost @@ -70,231 +70,234 @@ appPrec1 = 11 concatBuiltinStrings :: [BuiltinString] -> BuiltinString concatBuiltinStrings = \case - [] -> "" - [x] -> x - xs -> - let (ys, zs) = splitAt (length xs `divideInteger` 2) xs - in concatBuiltinStrings ys `appendString` concatBuiltinStrings zs + [] -> "" + [x] -> x + xs -> + let (ys, zs) = splitAt (length xs `divideInteger` 2) xs + in concatBuiltinStrings ys `appendString` concatBuiltinStrings zs {-# INLINEABLE concatBuiltinStrings #-} -- | Derive `Show` instance. Adapted from @Text.Show.Deriving.deriveShow@. deriveShow :: TH.Name -> TH.Q [TH.Dec] deriveShow name = do - TH.DatatypeInfo - { TH.datatypeName = tyConName - , TH.datatypeInstTypes = tyVars0 - , TH.datatypeCons = cons - } <- - TH.reifyDatatype name - let -- The purpose of the `TH.VarT . varTToName` roundtrip is to remove the kind - -- signatures attached to the type variables in `tyVars0`. Otherwise, the - -- `KindSignatures` extension would be needed whenever `length tyVars0 > 0`. - tyVars = TH.VarT . varTToName <$> tyVars0 - instanceCxt :: TH.Cxt - instanceCxt = TH.AppT (TH.ConT ''Show) <$> tyVars - instanceType :: TH.Type - instanceType = TH.AppT (TH.ConT ''Show) $ foldl' TH.AppT (TH.ConT tyConName) tyVars - showsPrecDecs = deriveShowsPrec cons - pure <$> TH.instanceD (pure instanceCxt) (pure instanceType) showsPrecDecs + TH.DatatypeInfo + { TH.datatypeName = tyConName + , TH.datatypeInstTypes = tyVars0 + , TH.datatypeCons = cons + } <- + TH.reifyDatatype name + let + -- The purpose of the `TH.VarT . varTToName` roundtrip is to remove the kind + -- signatures attached to the type variables in `tyVars0`. Otherwise, the + -- `KindSignatures` extension would be needed whenever `length tyVars0 > 0`. + tyVars = TH.VarT . varTToName <$> tyVars0 + instanceCxt :: TH.Cxt + instanceCxt = TH.AppT (TH.ConT ''Show) <$> tyVars + instanceType :: TH.Type + instanceType = TH.AppT (TH.ConT ''Show) $ foldl' TH.AppT (TH.ConT tyConName) tyVars + showsPrecDecs = deriveShowsPrec cons + pure <$> TH.instanceD (pure instanceCxt) (pure instanceType) showsPrecDecs -- | Derive `showsPrec` definition for each data constructor. deriveShowsPrec :: [TH.ConstructorInfo] -> [TH.Q TH.Dec] deriveShowsPrec cons = - [ TH.funD 'showsPrec [clause] - , -- `showsPrec` must be inlinable for the plugin to inline it - TH.pragInlD 'showsPrec TH.Inlinable TH.FunLike TH.AllPhases - ] - where - clause = TH.clause [] body [] - body = TH.normalB $ deriveShowsPrecBody cons + [ TH.funD 'showsPrec [clause] + , -- `showsPrec` must be inlinable for the plugin to inline it + TH.pragInlD 'showsPrec TH.Inlinable TH.FunLike TH.AllPhases + ] + where + clause = TH.clause [] body [] + body = TH.normalB $ deriveShowsPrecBody cons deriveShowsPrecBody :: [TH.ConstructorInfo] -> TH.Q TH.Exp deriveShowsPrecBody cons = do - p <- TH.newName "_p" -- The precedence argument. It is not always used, hence the leading `_`. - value <- TH.newName "_value" -- The value to be shown - let pats = [TH.varP p, TH.varP value] - body = TH.caseE (TH.varE value) (deriveMatchForCon p <$> cons) - TH.lamE pats body + p <- TH.newName "_p" -- The precedence argument. It is not always used, hence the leading `_`. + value <- TH.newName "_value" -- The value to be shown + let pats = [TH.varP p, TH.varP value] + body = TH.caseE (TH.varE value) (deriveMatchForCon p <$> cons) + TH.lamE pats body -- | Derive `showsPrec` body for a single data constructor. deriveMatchForCon :: TH.Name -> TH.ConstructorInfo -> TH.Q TH.Match deriveMatchForCon p = \case - -- Need a special case for nullary constructors, because - -- @showParen (_p `greaterThanInteger` 10)@ is not needed for nullary constructors. - TH.ConstructorInfo - { TH.constructorName = conName - , TH.constructorFields = [] - } -> - TH.match - (TH.conP conName []) - (TH.normalB [| showString $(TH.stringE (parenInfixConName conName))|]) - [] - TH.ConstructorInfo - { TH.constructorName = conName - , TH.constructorVariant = TH.NormalConstructor - , TH.constructorFields = argTys@(_ : _) - } | isNonUnitTuple conName -> do - {- Derive `showsPrec` body for a tuple constructor. - Example: (,,) - Output: - case _value of (,,) arg1 arg2 arg3 -> - showString "(" - . showsPrec 0 arg1 . showString "," - . showsPrec 0 arg2 . showString "," - . showsPrec 0 arg3 . showString ")" - -} - args <- - for [1 .. length argTys] $ \i -> - TH.newName ("arg" <> Haskell.show i) + -- Need a special case for nullary constructors, because + -- @showParen (_p `greaterThanInteger` 10)@ is not needed for nullary constructors. + TH.ConstructorInfo + { TH.constructorName = conName + , TH.constructorFields = [] + } -> + TH.match + (TH.conP conName []) + (TH.normalB [|showString $(TH.stringE (parenInfixConName conName))|]) + [] + TH.ConstructorInfo + { TH.constructorName = conName + , TH.constructorVariant = TH.NormalConstructor + , TH.constructorFields = argTys@(_ : _) + } + | isNonUnitTuple conName -> do + {- Derive `showsPrec` body for a tuple constructor. + Example: (,,) + Output: + case _value of (,,) arg1 arg2 arg3 -> + showString "(" + . showsPrec 0 arg1 . showString "," + . showsPrec 0 arg2 . showString "," + . showsPrec 0 arg3 . showString ")" + -} + args <- + for [1 .. length argTys] $ \i -> + TH.newName ("arg" <> Haskell.show i) - let showArgExps :: [TH.Q TH.Exp] - showArgExps = deriveShowExpForArg 0 <$> args - parenCommaArgExps = - (TH.varE 'showString `TH.appE` TH.stringE "(") : - intersperse (TH.varE 'showString `TH.appE` TH.stringE ",") showArgExps - mappendArgs = - Haskell.foldr - (`TH.infixApp` TH.varE '(Haskell..)) - (TH.varE 'showString `TH.appE` TH.stringE ")") - parenCommaArgExps - pats = TH.conP conName (TH.varP <$> args) - body = TH.normalB mappendArgs - TH.match pats body [] - | otherwise -> do - {- Derive `showsPrec` body for a non-tuple constructor. - Example: C a b - Output: - case _value of C arg1 arg2 -> - showParen - (_p `greaterThanInteger` 10) - (showString "C " . showsPrec 11 arg1 . showSpace . showsPrec 11 arg2) - -} - args <- - for [1 .. length argTys] $ \i -> - TH.newName ("arg" <> Haskell.show i) - let showArgExps :: [TH.Q TH.Exp] - showArgExps = deriveShowExpForArg appPrec1 <$> args + let showArgExps :: [TH.Q TH.Exp] + showArgExps = deriveShowExpForArg 0 <$> args + parenCommaArgExps = + (TH.varE 'showString `TH.appE` TH.stringE "(") + : intersperse (TH.varE 'showString `TH.appE` TH.stringE ",") showArgExps + mappendArgs = + Haskell.foldr + (`TH.infixApp` TH.varE '(Haskell..)) + (TH.varE 'showString `TH.appE` TH.stringE ")") + parenCommaArgExps + pats = TH.conP conName (TH.varP <$> args) + body = TH.normalB mappendArgs + TH.match pats body [] + | otherwise -> do + {- Derive `showsPrec` body for a non-tuple constructor. + Example: C a b + Output: + case _value of C arg1 arg2 -> + showParen + (_p `greaterThanInteger` 10) + (showString "C " . showsPrec 11 arg1 . showSpace . showsPrec 11 arg2) + -} + args <- + for [1 .. length argTys] $ \i -> + TH.newName ("arg" <> Haskell.show i) + let showArgExps :: [TH.Q TH.Exp] + showArgExps = deriveShowExpForArg appPrec1 <$> args - mappendArgs, namedArgs :: TH.Q TH.Exp - mappendArgs = Haskell.foldr1 alg showArgExps - where - alg :: TH.Q TH.Exp -> TH.Q TH.Exp -> TH.Q TH.Exp - alg argExp acc = [|$argExp . showSpace . $acc|] - namedArgs = - [| - showString - $(TH.stringE (parenInfixConName conName <> " ")) - . $mappendArgs - |] - let pats = TH.conP conName (TH.varP <$> args) - body = - TH.normalB - [| - $(TH.varE 'showParen) - ( $(TH.varE p) - `greaterThanInteger` $(TH.litE (TH.integerL appPrec)) - ) - $namedArgs - |] - TH.match pats body [] - {- Derive `showsPrec` body for a tuple constructor. - Example: C {c1 ;: a, c2 :: b} - Output: - case _value of C arg1 arg2 -> - showParen - (_p `greaterThanInteger` 10) - (showString "C " . showString "{" - . showString "c1 = " . showsPrec 0 arg1 - . showCommaSpace - . showString "c2 = " . showsPrec 0 arg2 - . showString "}") - -} - TH.ConstructorInfo - { TH.constructorName = conName - , TH.constructorVariant = TH.RecordConstructor argNames - , TH.constructorFields = argTys@(_ : _) - } -> do - args <- - Haskell.traverse - (\i -> TH.newName ("arg" <> Haskell.show i)) - [1 .. length argTys] - let showArgExps :: [TH.Q TH.Exp] - -- The `dropEnd` drops the last comma - showArgExps = dropEnd 1 $ Haskell.foldMap (uncurry f) (Haskell.zip argNames args) - where - f :: TH.Name -> TH.Name -> [TH.Q TH.Exp] - f argName arg = - let argNameBase = TH.nameBase argName - infixRec = - Haskell.showParen - (isSym argNameBase) - (Haskell.showString argNameBase) - "" - in [ TH.varE 'showString `TH.appE` TH.stringE (infixRec <> " = ") - , deriveShowExpForArg 0 arg - , TH.varE 'showCommaSpace - ] - braceCommaArgExps = (TH.varE 'showString `TH.appE` TH.stringE "{") : showArgExps - mappendArgs = - Haskell.foldr - (`TH.infixApp` TH.varE '(Haskell..)) - (TH.varE 'showString `TH.appE` TH.stringE "}") - braceCommaArgExps - namedArgs = - [| - showString $(TH.stringE (parenInfixConName conName <> " ")) - . $mappendArgs - |] - pats = TH.conP conName (TH.varP <$> args) - body = - TH.normalB - [| - showParen - ($(TH.varE p) `greaterThanInteger` $(TH.litE (TH.integerL appPrec))) - $namedArgs - |] - TH.match pats body [] - {- Derive `showsPrec` body for an infix constructor. - Example: a :+: b, where (:+:) has fixity 9 - Output: - case _value of argL :+: argR -> - showParen - (_p `greaterThanInteger` 9) - (showsPrec 10 argL . showString " :+: " . showsPrec 10 argR) - -} - TH.ConstructorInfo - { TH.constructorName = conName - , TH.constructorVariant = TH.InfixConstructor - } -> do - al <- TH.newName "argL" - ar <- TH.newName "argR" - fi <- fromMaybe TH.defaultFixity <$> TH.reifyFixityCompat conName - let conPrec = case fi of TH.Fixity prec _ -> Haskell.fromIntegral prec - opName = TH.nameBase conName - infixOpE = - TH.appE (TH.varE 'showString) . TH.stringE $ - if isInfixDataCon opName - then " " <> opName <> " " - else " `" <> opName <> "` " - showArgLExp = deriveShowExpForArg (conPrec + 1) al - showArgRExp = deriveShowExpForArg (conPrec + 1) ar - pats = TH.infixP (TH.varP al) conName (TH.varP ar) - body = - TH.normalB - [| - showParen - ($(TH.varE p) `greaterThanInteger` $(TH.litE (TH.integerL conPrec))) - ($showArgLExp . $infixOpE . $showArgRExp) - |] - TH.match pats body [] + mappendArgs, namedArgs :: TH.Q TH.Exp + mappendArgs = Haskell.foldr1 alg showArgExps + where + alg :: TH.Q TH.Exp -> TH.Q TH.Exp -> TH.Q TH.Exp + alg argExp acc = [|$argExp . showSpace . $acc|] + namedArgs = + [| + showString + $(TH.stringE (parenInfixConName conName <> " ")) + . $mappendArgs + |] + let pats = TH.conP conName (TH.varP <$> args) + body = + TH.normalB + [| + $(TH.varE 'showParen) + ( $(TH.varE p) + `greaterThanInteger` $(TH.litE (TH.integerL appPrec)) + ) + $namedArgs + |] + TH.match pats body [] + {- Derive `showsPrec` body for a tuple constructor. + Example: C {c1 ;: a, c2 :: b} + Output: + case _value of C arg1 arg2 -> + showParen + (_p `greaterThanInteger` 10) + (showString "C " . showString "{" + . showString "c1 = " . showsPrec 0 arg1 + . showCommaSpace + . showString "c2 = " . showsPrec 0 arg2 + . showString "}") + -} + TH.ConstructorInfo + { TH.constructorName = conName + , TH.constructorVariant = TH.RecordConstructor argNames + , TH.constructorFields = argTys@(_ : _) + } -> do + args <- + Haskell.traverse + (\i -> TH.newName ("arg" <> Haskell.show i)) + [1 .. length argTys] + let showArgExps :: [TH.Q TH.Exp] + -- The `dropEnd` drops the last comma + showArgExps = dropEnd 1 $ Haskell.foldMap (uncurry f) (Haskell.zip argNames args) + where + f :: TH.Name -> TH.Name -> [TH.Q TH.Exp] + f argName arg = + let argNameBase = TH.nameBase argName + infixRec = + Haskell.showParen + (isSym argNameBase) + (Haskell.showString argNameBase) + "" + in [ TH.varE 'showString `TH.appE` TH.stringE (infixRec <> " = ") + , deriveShowExpForArg 0 arg + , TH.varE 'showCommaSpace + ] + braceCommaArgExps = (TH.varE 'showString `TH.appE` TH.stringE "{") : showArgExps + mappendArgs = + Haskell.foldr + (`TH.infixApp` TH.varE '(Haskell..)) + (TH.varE 'showString `TH.appE` TH.stringE "}") + braceCommaArgExps + namedArgs = + [| + showString $(TH.stringE (parenInfixConName conName <> " ")) + . $mappendArgs + |] + pats = TH.conP conName (TH.varP <$> args) + body = + TH.normalB + [| + showParen + ($(TH.varE p) `greaterThanInteger` $(TH.litE (TH.integerL appPrec))) + $namedArgs + |] + TH.match pats body [] + {- Derive `showsPrec` body for an infix constructor. + Example: a :+: b, where (:+:) has fixity 9 + Output: + case _value of argL :+: argR -> + showParen + (_p `greaterThanInteger` 9) + (showsPrec 10 argL . showString " :+: " . showsPrec 10 argR) + -} + TH.ConstructorInfo + { TH.constructorName = conName + , TH.constructorVariant = TH.InfixConstructor + } -> do + al <- TH.newName "argL" + ar <- TH.newName "argR" + fi <- fromMaybe TH.defaultFixity <$> TH.reifyFixityCompat conName + let conPrec = case fi of TH.Fixity prec _ -> Haskell.fromIntegral prec + opName = TH.nameBase conName + infixOpE = + TH.appE (TH.varE 'showString) + . TH.stringE + $ if isInfixDataCon opName + then " " <> opName <> " " + else " `" <> opName <> "` " + showArgLExp = deriveShowExpForArg (conPrec + 1) al + showArgRExp = deriveShowExpForArg (conPrec + 1) ar + pats = TH.infixP (TH.varP al) conName (TH.varP ar) + body = + TH.normalB + [| + showParen + ($(TH.varE p) `greaterThanInteger` $(TH.litE (TH.integerL conPrec))) + ($showArgLExp . $infixOpE . $showArgRExp) + |] + TH.match pats body [] -- | Derive the `showsPrec` expression for showing a single constructor argument. deriveShowExpForArg :: Integer -> TH.Name -> TH.Q TH.Exp deriveShowExpForArg p tyExpName = - [| showsPrec p $(TH.varE tyExpName)|] + [|showsPrec p $(TH.varE tyExpName)|] -- | Add parens if it is an infix data constructor. parenInfixConName :: TH.Name -> Haskell.String parenInfixConName conName = - let conNameBase = TH.nameBase conName - in Haskell.showParen (isInfixDataCon conNameBase) (Haskell.showString conNameBase) "" + let conNameBase = TH.nameBase conName + in Haskell.showParen (isInfixDataCon conNameBase) (Haskell.showString conNameBase) "" diff --git a/plutus-tx/src/PlutusTx/Sqrt.hs b/plutus-tx/src/PlutusTx/Sqrt.hs index 4839d0e4af9..4c1c4ef0e6d 100644 --- a/plutus-tx/src/PlutusTx/Sqrt.hs +++ b/plutus-tx/src/PlutusTx/Sqrt.hs @@ -6,14 +6,15 @@ {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE ViewPatterns #-} +{-# OPTIONS_GHC -fno-ignore-interface-pragmas #-} {-# OPTIONS_GHC -fno-omit-interface-pragmas #-} {-# OPTIONS_GHC -fplugin-opt PlutusTx.Plugin:context-level=3 #-} -{-# OPTIONS_GHC -fno-ignore-interface-pragmas #-} -module PlutusTx.Sqrt( - Sqrt (..) - , rsqrt - , isqrt - ) where + +module PlutusTx.Sqrt ( + Sqrt (..), + rsqrt, + isqrt, +) where import PlutusTx.IsData (makeIsDataIndexed) import PlutusTx.Lift (makeLift) @@ -23,48 +24,54 @@ import Prelude qualified as Haskell -- | Integer square-root representation, discarding imaginary integers. data Sqrt - -- | The number was negative, so we don't even attempt to compute it; - -- just note that the result would be imaginary. - = Imaginary - -- | An exact integer result. The 'rsqrt' of 4 is 'Exactly 2'. - | Exactly Integer - -- | The Integer component (i.e. the floor) of a non-integral result. The - -- 'rsqrt 2' is 'Approximately 1'. - | Approximately Integer + = {-| The number was negative, so we don't even attempt to compute it; + just note that the result would be imaginary. + -} + Imaginary + | -- | An exact integer result. The 'rsqrt' of 4 is 'Exactly 2'. + Exactly Integer + | {-| The Integer component (i.e. the floor) of a non-integral result. The + 'rsqrt 2' is 'Approximately 1'. + -} + Approximately Integer deriving stock (Haskell.Show, Haskell.Eq) --- | Calculates the sqrt of a ratio of integers. As x / 0 is undefined, --- calling this function with `d=0` results in an error. +{-| Calculates the sqrt of a ratio of integers. As x / 0 is undefined, +calling this function with `d=0` results in an error. +-} rsqrt :: Rational -> Sqrt rsqrt r - | n * d < 0 = Imaginary - | n == 0 = Exactly 0 - | n == d = Exactly 1 - | n < d = Approximately 0 - | n < 0 = rsqrt $ unsafeRatio (negate n) (negate d) - | otherwise = go 1 $ 1 + divide n d - where - n = numerator r - d = denominator r - go :: Integer -> Integer -> Sqrt - go l u - | l * l * d == n = Exactly l - | u == (l + 1) = Approximately l - | otherwise = - let - m = divide (l + u) 2 - in - if m * m * d <= n then go m u - else go l m -{-# INLINABLE rsqrt #-} + | n * d < 0 = Imaginary + | n == 0 = Exactly 0 + | n == d = Exactly 1 + | n < d = Approximately 0 + | n < 0 = rsqrt $ unsafeRatio (negate n) (negate d) + | otherwise = go 1 $ 1 + divide n d + where + n = numerator r + d = denominator r + go :: Integer -> Integer -> Sqrt + go l u + | l * l * d == n = Exactly l + | u == (l + 1) = Approximately l + | otherwise = + let + m = divide (l + u) 2 + in + if m * m * d <= n + then go m u + else go l m +{-# INLINEABLE rsqrt #-} -- | Calculates the integer-component of the sqrt of 'n'. isqrt :: Integer -> Sqrt isqrt n = rsqrt (unsafeRatio n 1) -{-# INLINABLE isqrt #-} +{-# INLINEABLE isqrt #-} makeLift ''Sqrt -makeIsDataIndexed ''Sqrt [ ('Imaginary, 0) - , ('Exactly, 1) - , ('Approximately, 2) - ] +makeIsDataIndexed + ''Sqrt + [ ('Imaginary, 0) + , ('Exactly, 1) + , ('Approximately, 2) + ] diff --git a/plutus-tx/src/PlutusTx/TH.hs b/plutus-tx/src/PlutusTx/TH.hs index 810d41c03b2..e5a5fde021c 100644 --- a/plutus-tx/src/PlutusTx/TH.hs +++ b/plutus-tx/src/PlutusTx/TH.hs @@ -1,10 +1,12 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeApplications #-} + module PlutusTx.TH ( - compile, - compileUntyped, - loadFromFile) where + compile, + compileUntyped, + loadFromFile, +) where import Data.Proxy import Language.Haskell.TH qualified as TH @@ -25,10 +27,10 @@ compile e = TH.unsafeCodeCoerce $ compileUntyped $ TH.unType <$> TH.examineCode -- | Load a 'CompiledCode' from a file. Drop-in replacement for 'compile'. loadFromFile :: FilePath -> TH.Code TH.Q (CompiledCode a) loadFromFile fp = TH.liftCode $ do - -- We don't have a 'Lift' instance for 'CompiledCode' (we could but it would be tedious), - -- so we lift the bytestring and construct the value in the quote. - bs <- liftIO $ BS.readFile fp - TH.examineCode [|| SerializedCode bs Nothing mempty ||] + -- We don't have a 'Lift' instance for 'CompiledCode' (we could but it would be tedious), + -- so we lift the bytestring and construct the value in the quote. + bs <- liftIO $ BS.readFile fp + TH.examineCode [||SerializedCode bs Nothing mempty||] {- Note [Typed TH] It's nice to use typed TH! However, we sadly can't *quite* use it thoroughly, because we @@ -45,8 +47,8 @@ going to typecheck, and the result is always a 'CompiledCode', so that's also fi -- | Compile a quoted Haskell expression into a corresponding Plutus Core program. compileUntyped :: TH.Q TH.Exp -> TH.Q TH.Exp compileUntyped e = do - TH.addCorePlugin "PlutusTx.Plugin" - loc <- TH.location - let locStr = TH.pprint loc - -- See Note [Typed TH] - [| plc (Proxy :: Proxy $(TH.litT $ TH.strTyLit locStr)) $(e) |] + TH.addCorePlugin "PlutusTx.Plugin" + loc <- TH.location + let locStr = TH.pprint loc + -- See Note [Typed TH] + [|plc (Proxy :: Proxy $(TH.litT $ TH.strTyLit locStr)) $(e)|] diff --git a/plutus-tx/src/PlutusTx/These.hs b/plutus-tx/src/PlutusTx/These.hs index 6589dea8fc9..40000283173 100644 --- a/plutus-tx/src/PlutusTx/These.hs +++ b/plutus-tx/src/PlutusTx/These.hs @@ -14,7 +14,7 @@ import GHC.Generics (Generic) import PlutusTx.Blueprint.Definition (HasBlueprintDefinition) import Prelude qualified as Haskell -{- | A 'These' @a@ @b@ is either an @a@, or a @b@ or an @a@ and a @b@. +{-| A 'These' @a@ @b@ is either an @a@, or a @b@ or an @a@ and a @b@. Plutus version of 'Data.These'. -} data These a b = This a | That b | These a b diff --git a/plutus-tx/src/PlutusTx/Trace.hs b/plutus-tx/src/PlutusTx/Trace.hs index 9179fb5d101..9116b8a2040 100644 --- a/plutus-tx/src/PlutusTx/Trace.hs +++ b/plutus-tx/src/PlutusTx/Trace.hs @@ -1,11 +1,12 @@ {-# OPTIONS_GHC -fno-omit-interface-pragmas #-} + module PlutusTx.Trace ( trace, traceError, traceIfFalse, traceIfTrue, - traceBool - ) where + traceBool, +) where import PlutusTx.Bool import PlutusTx.Builtins as Builtins @@ -13,20 +14,21 @@ import PlutusTx.Builtins as Builtins -- | Log a message and then terminate the evaluation with an error. traceError :: Builtins.BuiltinString -> a traceError str = error (trace str ()) -{-# INLINABLE traceError #-} +{-# INLINEABLE traceError #-} -- | Emit the given 'BuiltinString' only if the argument evaluates to 'False'. traceIfFalse :: Builtins.BuiltinString -> Bool -> Bool traceIfFalse str a = if a then True else trace str False -{-# INLINABLE traceIfFalse #-} +{-# INLINEABLE traceIfFalse #-} -- | Emit the given 'BuiltinString' only if the argument evaluates to 'True'. traceIfTrue :: Builtins.BuiltinString -> Bool -> Bool traceIfTrue str a = if a then trace str True else False -{-# INLINABLE traceIfTrue #-} +{-# INLINEABLE traceIfTrue #-} --- | Emit one of two 'BuiltinString' depending on whether or not the argument --- evaluates to 'True' or 'False'. +{-| Emit one of two 'BuiltinString' depending on whether or not the argument +evaluates to 'True' or 'False'. +-} traceBool :: BuiltinString -> BuiltinString -> Bool -> Bool traceBool trueLabel falseLabel c = if c then trace trueLabel True else trace falseLabel False -{-# INLINABLE traceBool #-} +{-# INLINEABLE traceBool #-} diff --git a/plutus-tx/src/PlutusTx/Traversable.hs b/plutus-tx/src/PlutusTx/Traversable.hs index 6d05d269ccd..ab2bc19a950 100644 --- a/plutus-tx/src/PlutusTx/Traversable.hs +++ b/plutus-tx/src/PlutusTx/Traversable.hs @@ -1,7 +1,8 @@ -- editorconfig-checker-disable-file {-# LANGUAGE TupleSections #-} {-# OPTIONS_GHC -fno-omit-interface-pragmas #-} -module PlutusTx.Traversable (Traversable(..), sequenceA, mapM, sequence, for, fmapDefault, foldMapDefault) where + +module PlutusTx.Traversable (Traversable (..), sequenceA, mapM, sequence, for, fmapDefault, foldMapDefault) where import Control.Applicative (Const (..)) import Data.Coerce (coerce) @@ -16,40 +17,40 @@ import PlutusTx.Monoid (Monoid) -- | Plutus Tx version of 'Data.Traversable.Traversable'. class (Functor t, Foldable t) => Traversable t where - -- | Plutus Tx version of 'Data.Traversable.traverse'. - traverse :: Applicative f => (a -> f b) -> t a -> f (t b) - - -- All the other methods are deliberately omitted, - -- to make this a one-method class which has a simpler representation + -- | Plutus Tx version of 'Data.Traversable.traverse'. + traverse :: (Applicative f) => (a -> f b) -> t a -> f (t b) +-- All the other methods are deliberately omitted, +-- to make this a one-method class which has a simpler representation instance Traversable [] where - {-# INLINABLE traverse #-} - traverse f = go where - go [] = pure [] - go (x:xs) = liftA2 (:) (f x) (go xs) + {-# INLINEABLE traverse #-} + traverse f = go + where + go [] = pure [] + go (x : xs) = liftA2 (:) (f x) (go xs) instance Traversable Maybe where - {-# INLINABLE traverse #-} - traverse _ Nothing = pure Nothing - traverse f (Just a) = Just <$> f a + {-# INLINEABLE traverse #-} + traverse _ Nothing = pure Nothing + traverse f (Just a) = Just <$> f a instance Traversable (Either c) where - {-# INLINABLE traverse #-} - traverse _ (Left a) = pure (Left a) - traverse f (Right a) = Right <$> f a + {-# INLINEABLE traverse #-} + traverse _ (Left a) = pure (Left a) + traverse f (Right a) = Right <$> f a instance Traversable ((,) c) where - {-# INLINABLE traverse #-} - traverse f (c, a) = (c,) <$> f a + {-# INLINEABLE traverse #-} + traverse f (c, a) = (c,) <$> f a instance Traversable Identity where - {-# INLINABLE traverse #-} - traverse f (Identity a) = Identity <$> f a + {-# INLINEABLE traverse #-} + traverse f (Identity a) = Identity <$> f a instance Traversable (Const c) where - {-# INLINABLE traverse #-} - traverse _ (Const c) = pure (Const c) + {-# INLINEABLE traverse #-} + traverse _ (Const c) = pure (Const c) -- | Plutus Tx version of 'Data.Traversable.sequenceA'. sequenceA :: (Traversable t, Applicative f) => t (f a) -> f (t a) @@ -72,13 +73,17 @@ for = flip traverse {-# INLINE for #-} -- | Plutus Tx version of 'Data.Traversable.fmapDefault'. -fmapDefault :: forall t a b . Traversable t - => (a -> b) -> t a -> t b +fmapDefault + :: forall t a b + . (Traversable t) + => (a -> b) -> t a -> t b fmapDefault = coerce (traverse :: (a -> Identity b) -> t a -> Identity (t b)) {-# INLINE fmapDefault #-} -- | Plutus Tx version of 'Data.Traversable.foldMapDefault'. -foldMapDefault :: forall t m a . (Traversable t, Monoid m) - => (a -> m) -> t a -> m +foldMapDefault + :: forall t m a + . (Traversable t, Monoid m) + => (a -> m) -> t a -> m foldMapDefault = coerce (traverse :: (a -> Const m ()) -> t a -> Const m (t ())) {-# INLINE foldMapDefault #-} diff --git a/plutus-tx/src/PlutusTx/Utils.hs b/plutus-tx/src/PlutusTx/Utils.hs index b9c8279d5be..682416bcebd 100644 --- a/plutus-tx/src/PlutusTx/Utils.hs +++ b/plutus-tx/src/PlutusTx/Utils.hs @@ -6,5 +6,7 @@ import Prelude as Haskell mustBeReplaced :: String -> a mustBeReplaced placeholder = error $ - "The " <> show placeholder <> " placeholder must have been replaced by the \ - \core-to-plc plugin during compilation." + "The " + <> show placeholder + <> " placeholder must have been replaced by the \ + \core-to-plc plugin during compilation." diff --git a/plutus-tx/test/Blueprint/Spec.hs b/plutus-tx/test/Blueprint/Spec.hs index 137e9f4c502..aa35ff74c58 100644 --- a/plutus-tx/test/Blueprint/Spec.hs +++ b/plutus-tx/test/Blueprint/Spec.hs @@ -76,11 +76,11 @@ instance (Typeable p) => HasBlueprintDefinition (Phantom (p :: k)) where <> definitionIdFromTypeK @k @p $( PlutusTx.asData - [d| - data Dat = MkDat {datInteger :: Integer, datBool :: Bool} - deriving stock (Generic) - deriving anyclass (HasBlueprintDefinition) - |] + [d| + data Dat = MkDat {datInteger :: Integer, datBool :: Bool} + deriving stock (Generic) + deriving anyclass (HasBlueprintDefinition) + |] ) ---------------------------------------------------------------------------------------------------- diff --git a/plutus-tx/test/List/Spec.hs b/plutus-tx/test/List/Spec.hs index 7f4356b9234..ad924b654b6 100644 --- a/plutus-tx/test/List/Spec.hs +++ b/plutus-tx/test/List/Spec.hs @@ -15,122 +15,122 @@ import Test.Tasty.HUnit listTests :: TestTree listTests = - testGroup - "PlutusTx.List tests" - [ testProperty "null" prop_null - , testProperty "and" prop_and - , testProperty "or" prop_or - , testProperty "any" prop_any - , testProperty "all" prop_all - , testProperty "elem" prop_elem - , testProperty "notElem" prop_notElem - , testProperty "find" prop_find - , testProperty "findIndex" prop_findIndex - , nubByTests - , nubTests - , partitionTests - , sortTests - , sortByTests - ] + testGroup + "PlutusTx.List tests" + [ testProperty "null" prop_null + , testProperty "and" prop_and + , testProperty "or" prop_or + , testProperty "any" prop_any + , testProperty "all" prop_all + , testProperty "elem" prop_elem + , testProperty "notElem" prop_notElem + , testProperty "find" prop_find + , testProperty "findIndex" prop_findIndex + , nubByTests + , nubTests + , partitionTests + , sortTests + , sortByTests + ] genList :: Gen [Integer] genList = Gen.list (Range.linear 0 10) (Gen.integral (Range.linear (-10000) 10000)) prop_null :: Property prop_null = property $ do - xs <- forAll genList - PlutusTx.null xs === Haskell.null xs + xs <- forAll genList + PlutusTx.null xs === Haskell.null xs prop_and :: Property prop_and = property $ do - xs <- fmap (fmap odd) $ forAll genList - PlutusTx.and xs === Haskell.and xs + xs <- fmap (fmap odd) $ forAll genList + PlutusTx.and xs === Haskell.and xs prop_or :: Property prop_or = property $ do - xs <- fmap (fmap odd) $ forAll genList - PlutusTx.or xs === Haskell.or xs + xs <- fmap (fmap odd) $ forAll genList + PlutusTx.or xs === Haskell.or xs prop_any :: Property prop_any = property $ do - xs <- forAll genList - PlutusTx.any odd xs === Haskell.any odd xs + xs <- forAll genList + PlutusTx.any odd xs === Haskell.any odd xs prop_all :: Property prop_all = property $ do - xs <- forAll genList - PlutusTx.all odd xs === Haskell.all odd xs + xs <- forAll genList + PlutusTx.all odd xs === Haskell.all odd xs prop_elem :: Property prop_elem = property $ do - xs <- forAll genList - PlutusTx.elem 0 xs === Haskell.elem 0 xs + xs <- forAll genList + PlutusTx.elem 0 xs === Haskell.elem 0 xs prop_notElem :: Property prop_notElem = property $ do - xs <- forAll genList - PlutusTx.notElem 0 xs === Haskell.notElem 0 xs + xs <- forAll genList + PlutusTx.notElem 0 xs === Haskell.notElem 0 xs prop_find :: Property prop_find = property $ do - xs <- forAll genList - PlutusTx.find (PlutusTx.> 42) xs === Haskell.find (Haskell.> 42) xs + xs <- forAll genList + PlutusTx.find (PlutusTx.> 42) xs === Haskell.find (Haskell.> 42) xs prop_findIndex :: Property prop_findIndex = property $ do - xs <- forAll genList - PlutusTx.findIndex (PlutusTx.> 42) xs === fmap toInteger (Haskell.findIndex (Haskell.> 42) xs) + xs <- forAll genList + PlutusTx.findIndex (PlutusTx.> 42) xs === fmap toInteger (Haskell.findIndex (Haskell.> 42) xs) nubByTests :: TestTree nubByTests = - testGroup - "nubBy" - [ testCase "equal up to mod 3" $ - PlutusTx.nubBy (\x y -> mod x 3 == mod y 3) [1 :: Integer, 2, 4, 5, 6] - @?= [1, 2, 6] - ] + testGroup + "nubBy" + [ testCase "equal up to mod 3" $ + PlutusTx.nubBy (\x y -> mod x 3 == mod y 3) [1 :: Integer, 2, 4, 5, 6] + @?= [1, 2, 6] + ] nubTests :: TestTree nubTests = - testGroup - "nub" - [ testCase "[] == []" $ PlutusTx.nub [] @?= ([] :: [Integer]) - , testCase "[1, 2, 2] == [1, 2]" $ PlutusTx.nub [1 :: Integer, 2, 2] @?= [1, 2] - , testCase "[2, 1, 1] == [2, 1]" $ PlutusTx.nub [2 :: Integer, 1, 1] @?= [2, 1] - , testCase "[1, 1, 1] == [1]" $ PlutusTx.nub [1 :: Integer, 1, 1] @?= [1] - , testCase "[1, 2, 3, 4, 5] == [1, 2, 3, 4, 5]" $ - PlutusTx.nub [1 :: Integer, 2, 3, 4, 5] @?= [1, 2, 3, 4, 5] - ] + testGroup + "nub" + [ testCase "[] == []" $ PlutusTx.nub [] @?= ([] :: [Integer]) + , testCase "[1, 2, 2] == [1, 2]" $ PlutusTx.nub [1 :: Integer, 2, 2] @?= [1, 2] + , testCase "[2, 1, 1] == [2, 1]" $ PlutusTx.nub [2 :: Integer, 1, 1] @?= [2, 1] + , testCase "[1, 1, 1] == [1]" $ PlutusTx.nub [1 :: Integer, 1, 1] @?= [1] + , testCase "[1, 2, 3, 4, 5] == [1, 2, 3, 4, 5]" $ + PlutusTx.nub [1 :: Integer, 2, 3, 4, 5] @?= [1, 2, 3, 4, 5] + ] partitionTests :: TestTree partitionTests = - testGroup - "partition" - [ testCase "partition \"aeiou\" \"Hello World!\"" $ - (PlutusTx.partition (`Haskell.elem` ("aeiou" :: String)) "Hello World!") - @?= ("eoo", "Hll Wrld!") - , testCase "partition even [1,2,3,4,5,6]" $ - (PlutusTx.partition even [1 :: Int, 2, 3, 4, 5, 6]) - @?= ([2, 4, 6], [1, 3, 5]) - ] + testGroup + "partition" + [ testCase "partition \"aeiou\" \"Hello World!\"" $ + (PlutusTx.partition (`Haskell.elem` ("aeiou" :: String)) "Hello World!") + @?= ("eoo", "Hll Wrld!") + , testCase "partition even [1,2,3,4,5,6]" $ + (PlutusTx.partition even [1 :: Int, 2, 3, 4, 5, 6]) + @?= ([2, 4, 6], [1, 3, 5]) + ] sortTests :: TestTree sortTests = - testGroup - "sort" - [ testCase "sort [1,6,4,3,2,5]" $ - (PlutusTx.sort [1 :: Integer, 6, 4, 3, 2, 5]) - @?= [1, 2, 3, 4, 5, 6] - ] + testGroup + "sort" + [ testCase "sort [1,6,4,3,2,5]" $ + (PlutusTx.sort [1 :: Integer, 6, 4, 3, 2, 5]) + @?= [1, 2, 3, 4, 5, 6] + ] sortByTests :: TestTree sortByTests = - testGroup - "sortBy" - [ testCase "sortBy second pairs" $ - ( PlutusTx.sortBy - (\(a, _) (b, _) -> PlutusTx.compare a b) - [(2 :: Integer, "world" :: String), (4, "!"), (1, "Hello")] - ) - @?= [(1, "Hello"), (2, "world"), (4, "!")] - ] + testGroup + "sortBy" + [ testCase "sortBy second pairs" $ + ( PlutusTx.sortBy + (\(a, _) (b, _) -> PlutusTx.compare a b) + [(2 :: Integer, "world" :: String), (4, "!"), (1, "Hello")] + ) + @?= [(1, "Hello"), (2, "world"), (4, "!")] + ] diff --git a/plutus-tx/test/Rational/Laws.hs b/plutus-tx/test/Rational/Laws.hs index 8b49f5e797a..c2ad79c3c09 100644 --- a/plutus-tx/test/Rational/Laws.hs +++ b/plutus-tx/test/Rational/Laws.hs @@ -12,14 +12,16 @@ import Rational.Laws.Serialization (serializationLaws) import Test.Tasty (TestTree, testGroup) lawsTests :: TestTree -lawsTests = testGroup "Rational laws" [ - testGroup "Eq" eqLaws, - testGroup "Ord" ordLaws, - testGroup "AdditiveGroup" additiveLaws, - testGroup "MultiplicativeMonoid" multiplicativeLaws, - testGroup "Ring" ringLaws, - testGroup "Module" moduleLaws, - testGroup "Serialization" serializationLaws, - testGroup "Construction" constructionLaws, - testGroup "Other" otherLaws - ] +lawsTests = + testGroup + "Rational laws" + [ testGroup "Eq" eqLaws + , testGroup "Ord" ordLaws + , testGroup "AdditiveGroup" additiveLaws + , testGroup "MultiplicativeMonoid" multiplicativeLaws + , testGroup "Ring" ringLaws + , testGroup "Module" moduleLaws + , testGroup "Serialization" serializationLaws + , testGroup "Construction" constructionLaws + , testGroup "Other" otherLaws + ] diff --git a/plutus-tx/test/Rational/Laws/Additive.hs b/plutus-tx/test/Rational/Laws/Additive.hs index 426a1f14c16..349f09258d4 100644 --- a/plutus-tx/test/Rational/Laws/Additive.hs +++ b/plutus-tx/test/Rational/Laws/Additive.hs @@ -10,12 +10,12 @@ import Test.Tasty (TestTree) import Test.Tasty.Hedgehog (testPropertyNamed) additiveLaws :: [TestTree] -additiveLaws = [ - testPropertyNamed "+ commutes" "propPlusComm" propPlusComm, - testPropertyNamed "+ associates" "propPlusAssoc" propPlusAssoc, - testPropertyNamed "zero is an identity" "propZeroId" propZeroId, - testPropertyNamed "x - x = zero" "propMinusCancel" propMinusCancel, - testPropertyNamed "negate . negate = id" "propDoubleNeg" propDoubleNeg +additiveLaws = + [ testPropertyNamed "+ commutes" "propPlusComm" propPlusComm + , testPropertyNamed "+ associates" "propPlusAssoc" propPlusAssoc + , testPropertyNamed "zero is an identity" "propZeroId" propZeroId + , testPropertyNamed "x - x = zero" "propMinusCancel" propMinusCancel + , testPropertyNamed "negate . negate = id" "propDoubleNeg" propDoubleNeg ] -- Helpers diff --git a/plutus-tx/test/Rational/Laws/Construction.hs b/plutus-tx/test/Rational/Laws/Construction.hs index 9683ea21795..f20ae784250 100644 --- a/plutus-tx/test/Rational/Laws/Construction.hs +++ b/plutus-tx/test/Rational/Laws/Construction.hs @@ -15,16 +15,28 @@ import Test.Tasty (TestTree) import Test.Tasty.Hedgehog (testPropertyNamed) constructionLaws :: [TestTree] -constructionLaws = [ - testPropertyNamed "ratio x 0 = Nothing" "propZeroDenom" propZeroDenom, - testPropertyNamed "ratio x 1 = Just . fromInteger $ x" "propOneDenom" propOneDenom, - testPropertyNamed "ratio x x = Just 1 for x /= 0" "propRatioSelf" propRatioSelf, - testCoverProperty "sign of result depends on signs of arguments" propRatioSign, - testPropertyNamed "if ratio x y = Just r, then unsafeRatio x y = r" "propConstructionAgreement" propConstructionAgreement, - testPropertyNamed "if r = fromInteger x, then numerator r = x" "propFromIntegerNum" propFromIntegerNum, - testPropertyNamed "if r = fromInteger x, then denominator r = 1" "propFromIntegerDen" propFromIntegerDen, - testPropertyNamed "ratio x y = ratio (x * z) (y * z) for z /= 0" "propRatioScale" propRatioScale, - testPropertyNamed "denominator (unsafeRatio x y) > 0" "propUnsafeRatioDenomPos" propUnsafeRatioDenomPos +constructionLaws = + [ testPropertyNamed "ratio x 0 = Nothing" "propZeroDenom" propZeroDenom + , testPropertyNamed "ratio x 1 = Just . fromInteger $ x" "propOneDenom" propOneDenom + , testPropertyNamed "ratio x x = Just 1 for x /= 0" "propRatioSelf" propRatioSelf + , testCoverProperty "sign of result depends on signs of arguments" propRatioSign + , testPropertyNamed + "if ratio x y = Just r, then unsafeRatio x y = r" + "propConstructionAgreement" + propConstructionAgreement + , testPropertyNamed + "if r = fromInteger x, then numerator r = x" + "propFromIntegerNum" + propFromIntegerNum + , testPropertyNamed + "if r = fromInteger x, then denominator r = 1" + "propFromIntegerDen" + propFromIntegerDen + , testPropertyNamed "ratio x y = ratio (x * z) (y * z) for z /= 0" "propRatioScale" propRatioScale + , testPropertyNamed + "denominator (unsafeRatio x y) > 0" + "propUnsafeRatioDenomPos" + propUnsafeRatioDenomPos ] propZeroDenom :: Property @@ -55,20 +67,23 @@ propRatioSign = property $ do (-1, -1) -> signIndicator === Just Plutus.GT (1, 1) -> signIndicator === Just Plutus.GT _ -> signIndicator === Just Plutus.LT - where - go :: Gen (Plutus.Integer, Plutus.Integer) - go = Gen.choice [zeroNum, sameSign, diffSign] - zeroNum :: Gen (Plutus.Integer, Plutus.Integer) - zeroNum = (0,) <$> Gen.filter (/= Plutus.zero) genInteger - sameSign :: Gen (Plutus.Integer, Plutus.Integer) - sameSign = do - gen <- Gen.element [genIntegerPos, negate <$> genIntegerPos] - (,) <$> gen <*> gen - diffSign :: Gen (Plutus.Integer, Plutus.Integer) - diffSign = do - (genN, genD) <- Gen.element [(genIntegerPos, negate <$> genIntegerPos), - (negate <$> genIntegerPos, genIntegerPos)] - (,) <$> genN <*> genD + where + go :: Gen (Plutus.Integer, Plutus.Integer) + go = Gen.choice [zeroNum, sameSign, diffSign] + zeroNum :: Gen (Plutus.Integer, Plutus.Integer) + zeroNum = (0,) <$> Gen.filter (/= Plutus.zero) genInteger + sameSign :: Gen (Plutus.Integer, Plutus.Integer) + sameSign = do + gen <- Gen.element [genIntegerPos, negate <$> genIntegerPos] + (,) <$> gen <*> gen + diffSign :: Gen (Plutus.Integer, Plutus.Integer) + diffSign = do + (genN, genD) <- + Gen.element + [ (genIntegerPos, negate <$> genIntegerPos) + , (negate <$> genIntegerPos, genIntegerPos) + ] + (,) <$> genN <*> genD propConstructionAgreement :: Property propConstructionAgreement = property $ do diff --git a/plutus-tx/test/Rational/Laws/Eq.hs b/plutus-tx/test/Rational/Laws/Eq.hs index 8af7fa5ad58..b0f1104161f 100644 --- a/plutus-tx/test/Rational/Laws/Eq.hs +++ b/plutus-tx/test/Rational/Laws/Eq.hs @@ -13,11 +13,11 @@ import Test.Tasty (TestTree) import Test.Tasty.Hedgehog (testPropertyNamed) eqLaws :: [TestTree] -eqLaws = [ - testPropertyNamed "== is reflexive" "propEqRefl" propEqRefl, - testEntangled "== is symmetric" genRational propEqSymm, - testEntangled3 "== is transitive" genRational propEqTrans, - testEntangled "== implies substitution" genRational propEqSub +eqLaws = + [ testPropertyNamed "== is reflexive" "propEqRefl" propEqRefl + , testEntangled "== is symmetric" genRational propEqSymm + , testEntangled3 "== is transitive" genRational propEqTrans + , testEntangled "== implies substitution" genRational propEqSub ] -- Helpers @@ -31,13 +31,14 @@ propEqSymm :: Plutus.Rational -> Plutus.Rational -> PropertyT IO () propEqSymm x y = if x Plutus.== y then (y Plutus.== x) === True else success propEqTrans :: Plutus.Rational -> Plutus.Rational -> Plutus.Rational -> PropertyT IO () -propEqTrans x y z = if x Plutus.== y && y Plutus.== z - then (x Plutus.== z) === True - else success +propEqTrans x y z = + if x Plutus.== y && y Plutus.== z + then (x Plutus.== z) === True + else success propEqSub :: Plutus.Rational -> Plutus.Rational -> PropertyT IO () propEqSub x y = do f <- forAllFn . fnWith varyRational $ genInteger if x Plutus.== y - then f x === f y - else success + then f x === f y + else success diff --git a/plutus-tx/test/Rational/Laws/Helpers.hs b/plutus-tx/test/Rational/Laws/Helpers.hs index 58a073da173..30bfb883a54 100644 --- a/plutus-tx/test/Rational/Laws/Helpers.hs +++ b/plutus-tx/test/Rational/Laws/Helpers.hs @@ -2,7 +2,8 @@ {-# LANGUAGE KindSignatures #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} -{-# OPTIONS_GHC -Wno-orphans #-} -- We need Arg Rational instance +-- We need Arg Rational instance +{-# OPTIONS_GHC -Wno-orphans #-} module Rational.Laws.Helpers ( genRational, @@ -15,7 +16,7 @@ module Rational.Laws.Helpers ( forAllWithPP, normalAndEquivalentTo, normalAndEquivalentToMaybe, - ) where +) where import Data.Functor.Contravariant (contramap) import Data.Kind (Type) @@ -55,20 +56,21 @@ import Text.Show.Pretty (ppShow) -- reflexive, and that the type of the generated values is either large or -- infinite. If one or both of these don't hold, use of this function will have -- the _opposite_ effect, as it will skew the test outcomes. -testEntangled :: forall (a :: Type) . - (Show a) => - String -> - Gen a -> - (a -> a -> PropertyT IO ()) -> - TestTree +testEntangled + :: forall (a :: Type) + . (Show a) + => String + -> Gen a + -> (a -> a -> PropertyT IO ()) + -> TestTree testEntangled name gen cb = localOption coverLimit . testPropertyNamed name (fromString name) . property $ do - (x, my) <- forAllWith ppEntangled ((,) <$> gen <*> maybe' gen) - cover 45 "identical" (isNothing my) - cover 45 "possibly different" (isJust my) - case my of - Nothing -> cb x x - Just y -> cb x y + (x, my) <- forAllWith ppEntangled ((,) <$> gen <*> maybe' gen) + cover 45 "identical" (isNothing my) + cover 45 "possibly different" (isJust my) + case my of + Nothing -> cb x x + Just y -> cb x y -- This is the same as 'testEntangled', but for three values instead of two. -- More precisely, this ensures that, given a generator and function argument, @@ -76,20 +78,21 @@ testEntangled name gen cb = -- of the same value, rather than three independently-generated values. -- -- All the caveats of 'testEntangled' also apply to this function. -testEntangled3 :: forall (a :: Type) . - (Show a) => - String -> - Gen a -> - (a -> a -> a -> PropertyT IO ()) -> - TestTree +testEntangled3 + :: forall (a :: Type) + . (Show a) + => String + -> Gen a + -> (a -> a -> a -> PropertyT IO ()) + -> TestTree testEntangled3 name gen cb = localOption coverLimit . testPropertyNamed name (fromString name) . property $ do - (x, myz) <- forAllWith ppEntangled3 ((,) <$> gen <*> maybe' ((,) <$> gen <*> gen)) - cover 45 "identical" (isNothing myz) - cover 45 "possibly different" (isJust myz) - case myz of - Nothing -> cb x x x - Just (y, z) -> cb x y z + (x, myz) <- forAllWith ppEntangled3 ((,) <$> gen <*> maybe' ((,) <$> gen <*> gen)) + cover 45 "identical" (isNothing myz) + cover 45 "possibly different" (isJust myz) + case myz of + Nothing -> cb x x x + Just (y, z) -> cb x y z -- Hedgehog treats coverage as an absolute minimum: more precisely, given N -- tests to run and a coverage target of M%, Hedgehog will run N tests, and @@ -137,9 +140,10 @@ genInteger = Gen.integral . Range.linearFrom 0 (-100) $ 100 genIntegerPos :: Gen Integer genIntegerPos = Gen.integral . Range.linearFrom 100 1 $ 200 -forAllWithPP :: forall (a :: Type) (m :: Type -> Type) . - (Show a, Monad m) => - Gen a-> PropertyT m a +forAllWithPP + :: forall (a :: Type) (m :: Type -> Type) + . (Show a, Monad m) + => Gen a -> PropertyT m a forAllWithPP = forAllWith ppShow -- Rationals are required to maintain several invariants. We could write code to @@ -147,9 +151,10 @@ forAllWithPP = forAllWith ppShow -- -- This function is thus equivalent to === for Rationals, but with the added -- check that the first argument maintains the invariants it's supposed to. -normalAndEquivalentTo :: forall (m :: Type -> Type) . - (MonadTest m) => - Plutus.Rational -> Plutus.Rational -> m () +normalAndEquivalentTo + :: forall (m :: Type -> Type) + . (MonadTest m) + => Plutus.Rational -> Plutus.Rational -> m () normalAndEquivalentTo actual expected = do let num = Ratio.numerator actual let den = Ratio.denominator actual @@ -158,9 +163,10 @@ normalAndEquivalentTo actual expected = do actual === expected -- 'normalAndEquivalentTo' lifted to 'Maybe'. -normalAndEquivalentToMaybe :: forall (m :: Type -> Type) . - (MonadTest m) => - Maybe Plutus.Rational -> Maybe Plutus.Rational -> m () +normalAndEquivalentToMaybe + :: forall (m :: Type -> Type) + . (MonadTest m) + => Maybe Plutus.Rational -> Maybe Plutus.Rational -> m () normalAndEquivalentToMaybe actual expected = case (actual, expected) of (Nothing, Nothing) -> success (Just actual', Just _) -> do @@ -180,15 +186,17 @@ normalAndEquivalentToMaybe actual expected = case (actual, expected) of coverLimit :: HedgehogTestLimit coverLimit = HedgehogTestLimit . Just $ 8000 -ppEntangled :: forall (a :: Type) . (Show a) => (a, Maybe a) -> String +ppEntangled :: forall (a :: Type). (Show a) => (a, Maybe a) -> String ppEntangled = \case (x, Nothing) -> ppShow (x, x) - (x, Just y) -> ppShow (x, y) + (x, Just y) -> ppShow (x, y) -ppEntangled3 :: forall (a :: Type) . (Show a) => - (a, Maybe (a, a)) -> String +ppEntangled3 + :: forall (a :: Type) + . (Show a) + => (a, Maybe (a, a)) -> String ppEntangled3 = \case - (x, Nothing) -> ppShow (x, x, x) + (x, Nothing) -> ppShow (x, x, x) (x, Just (y, z)) -> ppShow (x, y, z) separate :: Plutus.Rational -> (Integer, Integer) diff --git a/plutus-tx/test/Rational/Laws/Module.hs b/plutus-tx/test/Rational/Laws/Module.hs index e3561b636aa..e12d75777bb 100644 --- a/plutus-tx/test/Rational/Laws/Module.hs +++ b/plutus-tx/test/Rational/Laws/Module.hs @@ -10,11 +10,11 @@ import Test.Tasty (TestTree) import Test.Tasty.Hedgehog (testPropertyNamed) moduleLaws :: [TestTree] -moduleLaws = [ - testPropertyNamed "scale 0 = 0" "propScaleZero" propScaleZero, - testPropertyNamed "scale 1 = id" "propScaleOne" propScaleOne, - testPropertyNamed "scale distributes over +" "propScaleDistPlus" propScaleDistPlus, - testPropertyNamed "scale x (scale y r) = scale (x * y) r" "propScaleTimes" propScaleTimes +moduleLaws = + [ testPropertyNamed "scale 0 = 0" "propScaleZero" propScaleZero + , testPropertyNamed "scale 1 = id" "propScaleOne" propScaleOne + , testPropertyNamed "scale distributes over +" "propScaleDistPlus" propScaleDistPlus + , testPropertyNamed "scale x (scale y r) = scale (x * y) r" "propScaleTimes" propScaleTimes ] propScaleZero :: Property diff --git a/plutus-tx/test/Rational/Laws/Multiplicative.hs b/plutus-tx/test/Rational/Laws/Multiplicative.hs index e3433897d77..3ae70352e1b 100644 --- a/plutus-tx/test/Rational/Laws/Multiplicative.hs +++ b/plutus-tx/test/Rational/Laws/Multiplicative.hs @@ -10,10 +10,10 @@ import Test.Tasty (TestTree) import Test.Tasty.Hedgehog (testPropertyNamed) multiplicativeLaws :: [TestTree] -multiplicativeLaws = [ - testPropertyNamed "* associates" "propTimesAssoc" propTimesAssoc, - testPropertyNamed "one is a left identity" "propOneLeftId" propOneLeftId, - testPropertyNamed "one is a right identity" "propOneRightId" propOneRightId +multiplicativeLaws = + [ testPropertyNamed "* associates" "propTimesAssoc" propTimesAssoc + , testPropertyNamed "one is a left identity" "propOneLeftId" propOneLeftId + , testPropertyNamed "one is a right identity" "propOneRightId" propOneRightId ] -- Helpers diff --git a/plutus-tx/test/Rational/Laws/Ord.hs b/plutus-tx/test/Rational/Laws/Ord.hs index 0f31a445098..425769def5c 100644 --- a/plutus-tx/test/Rational/Laws/Ord.hs +++ b/plutus-tx/test/Rational/Laws/Ord.hs @@ -12,11 +12,11 @@ import Test.Tasty (TestTree) import Test.Tasty.Hedgehog (testPropertyNamed) ordLaws :: [TestTree] -ordLaws = [ - testPropertyNamed "<= is reflexive" "propOrdRefl" propOrdRefl, - testEntangled "<= is anti-symmetric" genRational propOrdAntiSymm, - testEntangled3 "<= is transitive" genRational propOrdTrans, - testEntangled "== implies EQ" genRational propOrdCompare +ordLaws = + [ testPropertyNamed "<= is reflexive" "propOrdRefl" propOrdRefl + , testEntangled "<= is anti-symmetric" genRational propOrdAntiSymm + , testEntangled3 "<= is transitive" genRational propOrdTrans + , testEntangled "== implies EQ" genRational propOrdCompare ] -- Helpers @@ -27,16 +27,19 @@ propOrdRefl = property $ do (x Plutus.<= x) === True propOrdAntiSymm :: Plutus.Rational -> Plutus.Rational -> PropertyT IO () -propOrdAntiSymm x y = if x Plutus.<= y && y Plutus.<= x - then x `normalAndEquivalentTo` y - else success +propOrdAntiSymm x y = + if x Plutus.<= y && y Plutus.<= x + then x `normalAndEquivalentTo` y + else success propOrdTrans :: Plutus.Rational -> Plutus.Rational -> Plutus.Rational -> PropertyT IO () -propOrdTrans x y z = if x Plutus.<= y && y Plutus.<= z - then (x Plutus.<= z) === True - else success +propOrdTrans x y z = + if x Plutus.<= y && y Plutus.<= z + then (x Plutus.<= z) === True + else success propOrdCompare :: Plutus.Rational -> Plutus.Rational -> PropertyT IO () -propOrdCompare x y = if x Plutus.== y - then Plutus.compare x y === Plutus.EQ - else Plutus.compare x y /== Plutus.EQ +propOrdCompare x y = + if x Plutus.== y + then Plutus.compare x y === Plutus.EQ + else Plutus.compare x y /== Plutus.EQ diff --git a/plutus-tx/test/Rational/Laws/Other.hs b/plutus-tx/test/Rational/Laws/Other.hs index 2c418286a62..b4e369f6276 100644 --- a/plutus-tx/test/Rational/Laws/Other.hs +++ b/plutus-tx/test/Rational/Laws/Other.hs @@ -16,21 +16,35 @@ import Test.Tasty (TestTree) import Test.Tasty.Hedgehog (testPropertyNamed) otherLaws :: [TestTree] -otherLaws = [ - testPropertyNamed "numerator r = numerator . scale (denominator r) $ r" "propNumeratorScale" propNumeratorScale, - testPropertyNamed "denominator r >= 1" "propPosDen" propPosDen, - testPropertyNamed "recip r * r = 1 for r /= 0" "propRecipSelf" propRecipSelf, - testPropertyNamed "abs r >= 0" "propAbs" propAbs, - testPropertyNamed "abs r * abs r' = abs (r * r')" "probAbsTimes" propAbsTimes, - testPropertyNamed "r = n + f, where (n, f) = properFraction r" "propProperFrac" propProperFrac, - testCoverProperty "signs of properFraction components match sign of input" propProperFracSigns, - testPropertyNamed "abs f < 1, where (_, f) = properFraction r" "propProperFracAbs" propProperFracAbs, - testPropertyNamed "abs (round r) >= abs n, where (n, _) = properFraction r" "propAbsRound" propAbsRound, - testPropertyNamed "halves round as expected" "propRoundHalf" propRoundHalf, - testPropertyNamed ("if abs f < half, then round r = truncate r, " <> - "where (_, f) = properFraction r") "propRoundLow" propRoundLow, - testPropertyNamed ("if abs f > half, then abs (round r) = abs (truncate r) + 1, " <> - "where (_, f) = properFraction r") "propRoundHigh" propRoundHigh +otherLaws = + [ testPropertyNamed + "numerator r = numerator . scale (denominator r) $ r" + "propNumeratorScale" + propNumeratorScale + , testPropertyNamed "denominator r >= 1" "propPosDen" propPosDen + , testPropertyNamed "recip r * r = 1 for r /= 0" "propRecipSelf" propRecipSelf + , testPropertyNamed "abs r >= 0" "propAbs" propAbs + , testPropertyNamed "abs r * abs r' = abs (r * r')" "probAbsTimes" propAbsTimes + , testPropertyNamed "r = n + f, where (n, f) = properFraction r" "propProperFrac" propProperFrac + , testCoverProperty "signs of properFraction components match sign of input" propProperFracSigns + , testPropertyNamed "abs f < 1, where (_, f) = properFraction r" "propProperFracAbs" propProperFracAbs + , testPropertyNamed + "abs (round r) >= abs n, where (n, _) = properFraction r" + "propAbsRound" + propAbsRound + , testPropertyNamed "halves round as expected" "propRoundHalf" propRoundHalf + , testPropertyNamed + ( "if abs f < half, then round r = truncate r, " + <> "where (_, f) = properFraction r" + ) + "propRoundLow" + propRoundLow + , testPropertyNamed + ( "if abs f > half, then abs (round r) = abs (truncate r) + 1, " + <> "where (_, f) = properFraction r" + ) + "propRoundHigh" + propRoundHigh ] -- Helpers @@ -84,20 +98,23 @@ propProperFracSigns = property $ do Plutus.LT -> do Plutus.compare n Plutus.zero /== Plutus.GT Plutus.compare n Plutus.zero /== Plutus.GT - where - go :: Gen Plutus.Rational - go = Gen.choice [zeroNum, sameSign, diffSign] - zeroNum :: Gen Plutus.Rational - zeroNum = Ratio.unsafeRatio Plutus.zero <$> Gen.filter (/= Plutus.zero) genInteger - sameSign :: Gen Plutus.Rational - sameSign = do - gen <- Gen.element [genIntegerPos, negate <$> genIntegerPos] - Ratio.unsafeRatio <$> gen <*> gen - diffSign :: Gen Plutus.Rational - diffSign = do - (genN, genD) <- Gen.element [(genIntegerPos, negate <$> genIntegerPos), - (negate <$> genIntegerPos, genIntegerPos)] - Ratio.unsafeRatio <$> genN <*> genD + where + go :: Gen Plutus.Rational + go = Gen.choice [zeroNum, sameSign, diffSign] + zeroNum :: Gen Plutus.Rational + zeroNum = Ratio.unsafeRatio Plutus.zero <$> Gen.filter (/= Plutus.zero) genInteger + sameSign :: Gen Plutus.Rational + sameSign = do + gen <- Gen.element [genIntegerPos, negate <$> genIntegerPos] + Ratio.unsafeRatio <$> gen <*> gen + diffSign :: Gen Plutus.Rational + diffSign = do + (genN, genD) <- + Gen.element + [ (genIntegerPos, negate <$> genIntegerPos) + , (negate <$> genIntegerPos, genIntegerPos) + ] + Ratio.unsafeRatio <$> genN <*> genD propProperFracAbs :: Property propProperFracAbs = property $ do @@ -123,15 +140,15 @@ propRoundHalf = property $ do (0, _) -> rounded === Plutus.zero (1, False) -> rounded === n Plutus.+ Plutus.one _ -> rounded === n - where - go :: Gen (Integer, Plutus.Rational) - go = do - n <- genInteger - f <- case signum n of - (-1) -> pure . Ratio.negate $ Ratio.half - 0 -> Gen.element [Ratio.half, Ratio.negate Ratio.half] - _ -> pure Ratio.half - pure (n, f) + where + go :: Gen (Integer, Plutus.Rational) + go = do + n <- genInteger + f <- case signum n of + (-1) -> pure . Ratio.negate $ Ratio.half + 0 -> Gen.element [Ratio.half, Ratio.negate Ratio.half] + _ -> pure Ratio.half + pure (n, f) propRoundLow :: Property propRoundLow = property $ do @@ -140,16 +157,16 @@ propRoundLow = property $ do let rounded = Ratio.round r let truncated = Ratio.truncate r rounded === truncated - where - go :: Gen (Integer, Plutus.Rational) - go = do - num <- Gen.integral . Range.constant 1 $ 135 - let f = Ratio.unsafeRatio num 271 - n <- genInteger - case signum n of - (-1) -> pure (n, Ratio.negate f) - 0 -> (n,) <$> Gen.element [f, Ratio.negate f] - _ -> pure (n, f) + where + go :: Gen (Integer, Plutus.Rational) + go = do + num <- Gen.integral . Range.constant 1 $ 135 + let f = Ratio.unsafeRatio num 271 + n <- genInteger + case signum n of + (-1) -> pure (n, Ratio.negate f) + 0 -> (n,) <$> Gen.element [f, Ratio.negate f] + _ -> pure (n, f) propRoundHigh :: Property propRoundHigh = property $ do @@ -158,14 +175,13 @@ propRoundHigh = property $ do let rounded = Ratio.round r let truncated = Ratio.truncate r Plutus.abs rounded === Plutus.abs truncated Plutus.+ Plutus.one - where - go :: Gen (Integer, Plutus.Rational) - go = do - num <- Gen.integral . Range.constant 136 $ 270 - let f = Ratio.unsafeRatio num 271 - n <- genInteger - case signum n of - (-1) -> pure (n, Ratio.negate f) - 0 -> (n,) <$> Gen.element [f, Ratio.negate f] - _ -> pure (n, f) - + where + go :: Gen (Integer, Plutus.Rational) + go = do + num <- Gen.integral . Range.constant 136 $ 270 + let f = Ratio.unsafeRatio num 271 + n <- genInteger + case signum n of + (-1) -> pure (n, Ratio.negate f) + 0 -> (n,) <$> Gen.element [f, Ratio.negate f] + _ -> pure (n, f) diff --git a/plutus-tx/test/Rational/Laws/Ring.hs b/plutus-tx/test/Rational/Laws/Ring.hs index 65746c5df7a..32a4df652a8 100644 --- a/plutus-tx/test/Rational/Laws/Ring.hs +++ b/plutus-tx/test/Rational/Laws/Ring.hs @@ -11,11 +11,11 @@ import Test.Tasty (TestTree) import Test.Tasty.Hedgehog (testPropertyNamed) ringLaws :: [TestTree] -ringLaws = [ - testPropertyNamed "zero is a left annihilator" "propZeroLeftAnnih" propZeroLeftAnnih, - testPropertyNamed "zero is a right annihilator" "propZeroRightAnnih" propZeroRightAnnih, - testPropertyNamed "* left-distributes over +" "propTimesLeftDistPlus" propTimesLeftDistPlus, - testPropertyNamed "* right-distributes over +" "propTimesRightDistPlus" propTimesRightDistPlus +ringLaws = + [ testPropertyNamed "zero is a left annihilator" "propZeroLeftAnnih" propZeroLeftAnnih + , testPropertyNamed "zero is a right annihilator" "propZeroRightAnnih" propZeroRightAnnih + , testPropertyNamed "* left-distributes over +" "propTimesLeftDistPlus" propTimesLeftDistPlus + , testPropertyNamed "* right-distributes over +" "propTimesRightDistPlus" propTimesRightDistPlus ] -- Helpers @@ -43,5 +43,3 @@ propTimesRightDistPlus = property $ do y <- forAllWithPP genRational z <- forAllWithPP genRational (x Plutus.+ y) Plutus.* z === (x Plutus.* z) Plutus.+ (y Plutus.* z) - - diff --git a/plutus-tx/test/Rational/Laws/Serialization.hs b/plutus-tx/test/Rational/Laws/Serialization.hs index 3bcec2eceba..fb6261f9498 100644 --- a/plutus-tx/test/Rational/Laws/Serialization.hs +++ b/plutus-tx/test/Rational/Laws/Serialization.hs @@ -12,10 +12,10 @@ import Test.Tasty (TestTree) import Test.Tasty.Hedgehog (testPropertyNamed) serializationLaws :: [TestTree] -serializationLaws = [ - testPropertyNamed "FromBuiltinData-ToBuiltinData roundtrip" "propIsDataRound" propIsDataRound, - testPropertyNamed "unsafeFromBuiltinData . toBuiltinData = id" "propUnsafeIsData" propUnsafeIsData, - testPropertyNamed "FromJSON-ToJSON roundtrip" "propIsJSONRound" propIsJSONRound +serializationLaws = + [ testPropertyNamed "FromBuiltinData-ToBuiltinData roundtrip" "propIsDataRound" propIsDataRound + , testPropertyNamed "unsafeFromBuiltinData . toBuiltinData = id" "propUnsafeIsData" propUnsafeIsData + , testPropertyNamed "FromJSON-ToJSON roundtrip" "propIsJSONRound" propIsJSONRound ] -- Helpers diff --git a/plutus-tx/test/Show/Spec.hs b/plutus-tx/test/Show/Spec.hs index f79086075b7..cdf1bc0e785 100644 --- a/plutus-tx/test/Show/Spec.hs +++ b/plutus-tx/test/Show/Spec.hs @@ -27,21 +27,21 @@ toHaskellString (BI.BuiltinString t) = Text.unpack t showIntegerRoundtrip :: Property showIntegerRoundtrip = property $ do - integer :: Integer <- forAll $ Gen.integral (Range.linear (-10000) 10000) - read (toHaskellString (show integer)) === integer + integer :: Integer <- forAll $ Gen.integral (Range.linear (-10000) 10000) + read (toHaskellString (show integer)) === integer showByteStringBase16 :: Property showByteStringBase16 = property $ do - bytestring <- forAll $ Gen.bytes (Range.linear 0 20) - let hex = Base16.encode bytestring - builtinBytestring = BI.BuiltinByteString bytestring - toHaskellString (show builtinBytestring) === Char8.unpack hex + bytestring <- forAll $ Gen.bytes (Range.linear 0 20) + let hex = Base16.encode bytestring + builtinBytestring = BI.BuiltinByteString bytestring + toHaskellString (show builtinBytestring) === Char8.unpack hex -goldenShow :: forall a. Show a => TestName -> a -> TestNested +goldenShow :: forall a. (Show a) => TestName -> a -> TestNested goldenShow name x = do - path <- ask - let fp = foldr () (name ++ ".show.golden") path - embed $ goldenVsText name fp . fromBuiltin $ show x + path <- ask + let fp = foldr () (name ++ ".show.golden") path + embed $ goldenVsText name fp . fromBuiltin $ show x data ProductD = ProductC Integer [Bool] deriveShow ''ProductD @@ -65,32 +65,34 @@ data PolyD a b = PolyC (a, b) [(a, b)] deriveShow ''PolyD data GadtD a where - GadtC :: Integer -> BuiltinString -> GadtD Bool + GadtC :: Integer -> BuiltinString -> GadtD Bool deriveShow ''GadtD propertyTests :: TestTree propertyTests = - testGroup "PlutusTx.Show property-based tests" - [ testPropertyNamed - "PlutusTx.Show @Integer" - "PlutusTx.Show @Integer" - showIntegerRoundtrip - , testPropertyNamed - "PlutusTx.Show @BuiltinByteString" - "PlutusTx.Show @BuiltinByteString" - showByteStringBase16 - ] + testGroup + "PlutusTx.Show property-based tests" + [ testPropertyNamed + "PlutusTx.Show @Integer" + "PlutusTx.Show @Integer" + showIntegerRoundtrip + , testPropertyNamed + "PlutusTx.Show @BuiltinByteString" + "PlutusTx.Show @BuiltinByteString" + showByteStringBase16 + ] goldenTests :: TestTree goldenTests = - runTestNested ["test", "Show", "Golden"] - [ goldenShow "product-type" (ProductC 3 [True, False]) - , goldenShow "product-type-2" ((:-:) [-300] False) - , goldenShow "sum-type-1" SumC1 - , goldenShow "sum-type-2" (SumC2 (1, "string", "bytestring")) - , goldenShow "record-type" (RecordC "string" ([0, 1, 2, 3], True)) - , goldenShow "infix-type" ((42, True) :+: ["foo", "bar"]) - , goldenShow "infix-type-2" ((-12345, True) `InfixC` "foo") - , goldenShow "gadt" (GadtC (-42) "string") - , goldenShow "poly" (PolyC (42 :: Integer, False) []) - ] + runTestNested + ["test", "Show", "Golden"] + [ goldenShow "product-type" (ProductC 3 [True, False]) + , goldenShow "product-type-2" ((:-:) [-300] False) + , goldenShow "sum-type-1" SumC1 + , goldenShow "sum-type-2" (SumC2 (1, "string", "bytestring")) + , goldenShow "record-type" (RecordC "string" ([0, 1, 2, 3], True)) + , goldenShow "infix-type" ((42, True) :+: ["foo", "bar"]) + , goldenShow "infix-type-2" ((-12345, True) `InfixC` "foo") + , goldenShow "gadt" (GadtC (-42) "string") + , goldenShow "poly" (PolyC (42 :: Integer, False) []) + ] diff --git a/plutus-tx/test/Spec.hs b/plutus-tx/test/Spec.hs index 00bd78c9f59..c96cbf08fca 100644 --- a/plutus-tx/test/Spec.hs +++ b/plutus-tx/test/Spec.hs @@ -2,7 +2,8 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeApplications #-} -module Main(main) where + +module Main (main) where import Blueprint.Definition.Spec qualified import Codec.CBOR.FlatTerm qualified as FlatTerm @@ -35,8 +36,10 @@ main :: IO () main = defaultMain tests tests :: TestTree -tests = testGroup "plutus-tx" [ - serdeTests +tests = + testGroup + "plutus-tx" + [ serdeTests , sqrtTests , ratioTests , bytestringTests @@ -49,15 +52,17 @@ tests = testGroup "plutus-tx" [ ] sqrtTests :: TestTree -sqrtTests = testGroup "isqrt/rsqrt tests" - [ testPropertyNamed "isqrt x^2 = x" "isqrtRoundTrip" isqrtRoundTrip - , testPropertyNamed "rsqrt (a/b)^2 = integer part of a/b" "rsqrtRoundTrip" rsqrtRoundTrip - , testPropertyNamed "rsqrt (-x/b) = Imaginary" "rsqrtRoundTripImaginary" rsqrtRoundTripImaginary - ] +sqrtTests = + testGroup + "isqrt/rsqrt tests" + [ testPropertyNamed "isqrt x^2 = x" "isqrtRoundTrip" isqrtRoundTrip + , testPropertyNamed "rsqrt (a/b)^2 = integer part of a/b" "rsqrtRoundTrip" rsqrtRoundTrip + , testPropertyNamed "rsqrt (-x/b) = Imaginary" "rsqrtRoundTripImaginary" rsqrtRoundTripImaginary + ] rsqrtRoundTripImaginary :: Property rsqrtRoundTripImaginary = property $ do - let numerators = Gen.integral (Range.linear (-100000) 0) + let numerators = Gen.integral (Range.linear (-100000) 0) let denominators = Gen.integral (Range.linear 1 100000) -- Note: We're using the fact that (a % -b) is reduced to (-a % b) @@ -66,16 +71,16 @@ rsqrtRoundTripImaginary = property $ do a <- forAll numerators b <- forAll denominators - let x = unsafeRatio a b + let x = unsafeRatio a b decode = \case - Imaginary -> True - _ -> False + Imaginary -> True + _ -> False assert $ decode (rsqrt x) rsqrtRoundTrip :: Property rsqrtRoundTrip = property $ do - let numerators = Gen.integral (Range.linear 0 100000) + let numerators = Gen.integral (Range.linear 0 100000) let denominators = Gen.integral (Range.linear 1 100000) a <- forAll numerators @@ -87,9 +92,9 @@ rsqrtRoundTrip = property $ do integerPart = a `div` b remainder = rem a b decode = \case - Exactly i -> i == integerPart && remainder == 0 - Approximately i -> i == integerPart && remainder > 0 - Imaginary -> False + Exactly i -> i == integerPart && remainder == 0 + Approximately i -> i == integerPart && remainder > 0 + Imaginary -> False assert $ g (f x) @@ -99,20 +104,23 @@ square r = n = numerator r d = denominator r two = 2 :: Integer - in unsafeRatio (n^two) (d^two) + in + unsafeRatio (n ^ two) (d ^ two) isqrtRoundTrip :: Property isqrtRoundTrip = property $ do let positiveInteger = Gen.integral (Range.linear 0 100000) x' <- forAll positiveInteger tripping x' sq (decodeExact . isqrt) - where - sq x = x ^ (2 :: Integer) - decodeExact (Exactly x) = Right x - decodeExact s = Left s + where + sq x = x ^ (2 :: Integer) + decodeExact (Exactly x) = Right x + decodeExact s = Left s serdeTests :: TestTree -serdeTests = testGroup "Data serialisation" +serdeTests = + testGroup + "Data serialisation" [ testPropertyNamed "data round-trip" "dataRoundTrip" dataRoundTrip , testPropertyNamed "no big bytestrings" "noBigByteStrings" noBigByteStrings , testPropertyNamed "no big integers" "noBigIntegers" noBigIntegers @@ -120,37 +128,38 @@ serdeTests = testGroup "Data serialisation" dataRoundTrip :: Property dataRoundTrip = property $ do - dt :: Data <- forAll genData - let res = deserialiseOrFail (serialise dt) - annotateShow res + dt :: Data <- forAll genData + let res = deserialiseOrFail (serialise dt) + annotateShow res - -- Debugging info - let ft = FlatTerm.toFlatTerm $ Serialise.encode dt - annotateShow ft - annotateShow $ FlatTerm.validFlatTerm ft - assert (res == Right dt) + -- Debugging info + let ft = FlatTerm.toFlatTerm $ Serialise.encode dt + annotateShow ft + annotateShow $ FlatTerm.validFlatTerm ft + assert (res == Right dt) sixtyFourByteInteger :: Integer -sixtyFourByteInteger = 2^((64 :: Integer) *8) +sixtyFourByteInteger = 2 ^ ((64 :: Integer) * 8) -genData :: MonadGen m => m Data +genData :: (MonadGen m) => m Data genData = - let st = Gen.subterm genData id - constrIndex = fromIntegral <$> Gen.integral @_ @Word64 Range.linearBounded - reasonableInteger = Gen.integral (Range.linear (-100000) 100000) - -- over 64 bytes - reallyBigInteger = Gen.integral (Range.linear sixtyFourByteInteger (sixtyFourByteInteger * 2)) - reallyBigNInteger = Gen.integral (Range.linear (-(sixtyFourByteInteger * 2)) (-sixtyFourByteInteger)) - -- includes > 64bytes - someBytes = Gen.bytes (Range.linear 0 256) - constructorArgList = Gen.list (Range.linear 0 50) st - kvMapList = Gen.list (Range.linear 0 50) ((,) <$> st <*> st) - in - Gen.recursive Gen.choice + let st = Gen.subterm genData id + constrIndex = fromIntegral <$> Gen.integral @_ @Word64 Range.linearBounded + reasonableInteger = Gen.integral (Range.linear (-100000) 100000) + -- over 64 bytes + reallyBigInteger = Gen.integral (Range.linear sixtyFourByteInteger (sixtyFourByteInteger * 2)) + reallyBigNInteger = Gen.integral (Range.linear (-(sixtyFourByteInteger * 2)) (-sixtyFourByteInteger)) + -- includes > 64bytes + someBytes = Gen.bytes (Range.linear 0 256) + constructorArgList = Gen.list (Range.linear 0 50) st + kvMapList = Gen.list (Range.linear 0 50) ((,) <$> st <*> st) + in Gen.recursive + Gen.choice [ I <$> reasonableInteger , I <$> reallyBigInteger , I <$> reallyBigNInteger - , B <$> someBytes ] + , B <$> someBytes + ] [ Constr <$> constrIndex <*> constructorArgList , List <$> constructorArgList , Map <$> kvMapList @@ -158,31 +167,34 @@ genData = noBigByteStrings :: Property noBigByteStrings = property $ do - -- Our serializer for Data is too clever to make big bytestrings, so we serialize a bytestring directly - -- and try to decode it as Data - dt :: BS.ByteString <- forAll $ Gen.bytes (Range.linear 65 256) - annotateShow dt - let res :: Either Serialise.DeserialiseFailure Data = deserialiseOrFail (serialise dt) - annotateShow res - assert (isLeft res) + -- Our serializer for Data is too clever to make big bytestrings, so we serialize a bytestring directly + -- and try to decode it as Data + dt :: BS.ByteString <- forAll $ Gen.bytes (Range.linear 65 256) + annotateShow dt + let res :: Either Serialise.DeserialiseFailure Data = deserialiseOrFail (serialise dt) + annotateShow res + assert (isLeft res) noBigIntegers :: Property noBigIntegers = property $ do - -- Our serializer for Data is too clever to make big integers, so we serialize a bytestring directly - -- and try to decode it as Data - dt :: Integer <- forAll $ Gen.integral (Range.linear sixtyFourByteInteger (sixtyFourByteInteger * 2)) - annotateShow dt - let res :: Either Serialise.DeserialiseFailure Data = deserialiseOrFail (serialise dt) - annotateShow res - assert (isLeft res) + -- Our serializer for Data is too clever to make big integers, so we serialize a bytestring directly + -- and try to decode it as Data + dt :: Integer <- + forAll $ Gen.integral (Range.linear sixtyFourByteInteger (sixtyFourByteInteger * 2)) + annotateShow dt + let res :: Either Serialise.DeserialiseFailure Data = deserialiseOrFail (serialise dt) + annotateShow res + assert (isLeft res) ratioTests :: TestTree -ratioTests = testGroup "Ratio" - [ testPropertyNamed "reciprocal ordering 1" "reciprocalOrdering1" reciprocalOrdering1 - , testPropertyNamed "reciprocal ordering 2" "reciprocalOrdering2" reciprocalOrdering2 - , testPropertyNamed "reciprocal ordering 3" "reciprocalOrdering3" reciprocalOrdering3 - , testCase "recip 0 % 2 fails" reciprocalFailsZeroNumerator - ] +ratioTests = + testGroup + "Ratio" + [ testPropertyNamed "reciprocal ordering 1" "reciprocalOrdering1" reciprocalOrdering1 + , testPropertyNamed "reciprocal ordering 2" "reciprocalOrdering2" reciprocalOrdering2 + , testPropertyNamed "reciprocal ordering 3" "reciprocalOrdering3" reciprocalOrdering3 + , testCase "recip 0 % 2 fails" reciprocalFailsZeroNumerator + ] -- We check that 'recip' throws an exception if the numerator is zero reciprocalFailsZeroNumerator :: Assertion @@ -192,13 +204,13 @@ reciprocalFailsZeroNumerator = do -- the result should be 1 if there was an exception res @?= one -genPositiveRational :: Monad m => PropertyT m Rational +genPositiveRational :: (Monad m) => PropertyT m Rational genPositiveRational = do a <- forAll . Gen.integral $ Range.linear 1 100000 b <- forAll . Gen.integral $ Range.linear 1 100000 return (unsafeRatio a b) -genNegativeRational :: Monad m => PropertyT m Rational +genNegativeRational :: (Monad m) => PropertyT m Rational genNegativeRational = negate <$> genPositiveRational -- If x and y are positive rational numbers and x < y then 1/y < 1/x @@ -207,10 +219,11 @@ reciprocalOrdering1 = property $ do x <- genPositiveRational y <- genPositiveRational if x < y - then assert (recip y < recip x) - else if y < x - then assert (recip x < recip y) - else return () + then assert (recip y < recip x) + else + if y < x + then assert (recip x < recip y) + else return () -- If x and y are negative rational numbers and x < y then 1/y < 1/x reciprocalOrdering2 :: Property @@ -218,10 +231,11 @@ reciprocalOrdering2 = property $ do x <- genNegativeRational y <- genNegativeRational if x < y - then assert (recip y < recip x) - else if y < x - then assert (recip x < recip y) - else return () + then assert (recip y < recip x) + else + if y < x + then assert (recip x < recip y) + else return () -- If x is a negative rational number and y is a positive rational number -- then 1/x < 1/y @@ -232,81 +246,117 @@ reciprocalOrdering3 = property $ do assert (recip x < recip y) bytestringTests :: TestTree -bytestringTests = testGroup "ByteString" - [ takeByteStringTests - , dropByteStringTests - ] +bytestringTests = + testGroup + "ByteString" + [ takeByteStringTests + , dropByteStringTests + ] takeByteStringTests :: TestTree -takeByteStringTests = testGroup "takeByteString" - [ testCase "take 0" $ takeByteString 0 "hello" @?= "" - , testCase "take 1" $ takeByteString 1 "hello" @?= "h" - , testCase "take 3" $ takeByteString 3 "hello" @?= "hel" - , testCase "take 10" $ takeByteString 10 "hello" @?= "hello" - ] +takeByteStringTests = + testGroup + "takeByteString" + [ testCase "take 0" $ takeByteString 0 "hello" @?= "" + , testCase "take 1" $ takeByteString 1 "hello" @?= "h" + , testCase "take 3" $ takeByteString 3 "hello" @?= "hel" + , testCase "take 10" $ takeByteString 10 "hello" @?= "hello" + ] dropByteStringTests :: TestTree -dropByteStringTests = testGroup "dropByteString" - [ testCase "drop 0" $ dropByteString 0 "hello" @?= "hello" - , testCase "drop 1" $ dropByteString 1 "hello" @?= "ello" - , testCase "drop 3" $ dropByteString 3 "hello" @?= "lo" - , testCase "drop 10" $ dropByteString 10 "hello" @?= "" - ] +dropByteStringTests = + testGroup + "dropByteString" + [ testCase "drop 0" $ dropByteString 0 "hello" @?= "hello" + , testCase "drop 1" $ dropByteString 1 "hello" @?= "ello" + , testCase "drop 3" $ dropByteString 3 "hello" @?= "lo" + , testCase "drop 10" $ dropByteString 10 "hello" @?= "" + ] enumTests :: TestTree -enumTests = testGroup "Enum" - [ enumFromToTests, enumFromThenToTests ] +enumTests = + testGroup + "Enum" + [enumFromToTests, enumFromThenToTests] enumFromToTests :: TestTree -enumFromToTests = testGroup "enumFromTo" - [ testCase "enumFromTo (-2) 2 == [-2..2]" $ enumFromTo @Integer (-2) 2 @?= [-2..2] - , testCase "enumFromTo 2 (-2) == []" $ enumFromTo @Integer 2 (-2) @?= [] - , testCase "enumFromTo 42 42 == [42]" $ enumFromTo @Integer 42 42 @?= [42] - ] +enumFromToTests = + testGroup + "enumFromTo" + [ testCase "enumFromTo (-2) 2 == [-2..2]" $ enumFromTo @Integer (-2) 2 @?= [-2 .. 2] + , testCase "enumFromTo 2 (-2) == []" $ enumFromTo @Integer 2 (-2) @?= [] + , testCase "enumFromTo 42 42 == [42]" $ enumFromTo @Integer 42 42 @?= [42] + ] enumFromThenToTests :: TestTree -enumFromThenToTests = testGroup "enumFromThenTo" - [ testCase "enumFromThenTo 1 2 100 == [1..100]" $ enumFromThenTo @Integer 1 2 100 @?=* [1..100] - , testCase "enumFromThenTo 1 2 100 == [1,2..100]" $ enumFromThenTo @Integer 1 2 100 @?=* [1,2..100] - , testCase "enumFromThenTo 100 99 1 == [100,99..1]" $ enumFromThenTo @Integer 100 99 1 @?=* [100,99..1] - , testCase "enumFromThenTo 100 17 (-700) == [100,17..(-700)]" $ enumFromThenTo @Integer 100 17 (-700) @?=* [100,17..(-700)] - , testCase "enumFromThenTo 0 5 99 == [0,5..99]" $ enumFromThenTo @Integer 0 5 99 @?=* [0,5..99] - , testCase "enumFromThenTo 0 5 100 == [0,5..100]" $ enumFromThenTo @Integer 0 5 100 @?=* [0,5..100] - , testCase "enumFromThenTo 0 5 101 == [0,5..101]" $ enumFromThenTo @Integer 0 5 101 @?=* [0,5..101] - , testCase "enumFromThenTo 100 95 0 == [100,95..0]" $ enumFromThenTo @Integer 100 95 0 @?=* [100,95..0] - , testCase "enumFromThenTo 100 95 (-9) == [100,95..(-9)]" $ enumFromThenTo @Integer 100 95 (-9) @?=* [100,95..(-9)] - , testCase "enumFromThenTo 100 95 (-10) == [100,95..(-10)]" $ enumFromThenTo @Integer 100 95 (-10) @?=* [100,95..(-10)] - , testCase "enumFromThenTo 100 95 (-11) == [100,95..(-11)]" $ enumFromThenTo @Integer 100 95 (-11) @?=* [100,95..(-11)] - , testCase "enumFromThenTo 42 42 41 == []" $ enumFromThenTo @Integer 42 42 41 @?=* [] - , testCase "enumFromThenTo 42 42 42 == [42*]" $ enumFromThenTo @Integer 42 42 42 @?=* [42,42..42] - , testCase "enumFromThenTo 42 42 43 == [42*]" $ enumFromThenTo @Integer 42 42 43 @?=* [42,42..43] - , testCase "enumFromThenTo False False False == [False*]" $ enumFromThenTo False False False @?=* [False, False .. False] - , testCase "enumFromThenTo False False True == [False*]" $ enumFromThenTo False False True @?=* [False, False .. True ] - , testCase "enumFromThenTo False True False == [False]" $ enumFromThenTo False True False @?=* [False, True .. False] - , testCase "enumFromThenTo False True True == [False,True]" $ enumFromThenTo False True True @?=* [False, True .. True ] - , testCase "enumFromThenTo True False False == [True,False]" $ enumFromThenTo True False False @?=* [True, False .. False] - , testCase "enumFromThenTo True False True == [True]" $ enumFromThenTo True False True @?=* [True, False .. True ] - , testCase "enumFromThenTo True True False == []" $ enumFromThenTo True True False @?=* [True, True .. False] - , testCase "enumFromThenTo True True True == [True*]" $ enumFromThenTo True True True @?=* [True, True .. True ] - , testCase "enumFromThenTo () () () == [()*]" $ enumFromThenTo () () () @?=* [(),()..()] - ] - {- Check (approximately) that two possibly infinite lists are equal. We can get infinite lists from - `enumFromThenTo`, both legitimately and because of implementation errors (which are exactly - what we're testing for here). If we just use @?= then (a) it won't terminate if we give it - two equal infinite lists, and (b) if it fails and one of the lists is infinite then it'll try - to generate an infinite error message, again leading to non-termination. To deal with this, - if an argument has more than 1000 elements then we assume it's infinite and just include an - initial segment in any error message, and when we're comparing two such "infinite" lists we - just compare the first 1000 elements. The only infinite lists that enumFromThenTo can - generate are of the form [x,x,x,...], so this is definitely a safe strategy in this context. - -} - where l1 @?=* l2 = - case (possiblyInfinite l1, possiblyInfinite l2) of - (False, False) -> l1 @?= l2 - (True, False) -> failWith (showInit l1) (show l2) - (False, True) -> failWith (show l1) (showInit l2) - (True, True) -> unless (take 1000 l1 == take 1000 l2) (failWith (showInit l1) (showInit l2)) - where possiblyInfinite l = drop 1000 l /= [] - showInit l = "[" ++ intercalate "," (fmap show (take 5 l)) ++ ",...]" - failWith expected actual = assertFailure ("expected: " ++ expected ++ "\n but got: " ++ actual) - +enumFromThenToTests = + testGroup + "enumFromThenTo" + [ testCase "enumFromThenTo 1 2 100 == [1..100]" $ + enumFromThenTo @Integer 1 2 100 @?=* [1 .. 100] + , testCase "enumFromThenTo 1 2 100 == [1,2..100]" $ + enumFromThenTo @Integer 1 2 100 @?=* [1, 2 .. 100] + , testCase "enumFromThenTo 100 99 1 == [100,99..1]" $ + enumFromThenTo @Integer 100 99 1 @?=* [100, 99 .. 1] + , testCase "enumFromThenTo 100 17 (-700) == [100,17..(-700)]" $ + enumFromThenTo @Integer 100 17 (-700) @?=* [100, 17 .. (-700)] + , testCase "enumFromThenTo 0 5 99 == [0,5..99]" $ + enumFromThenTo @Integer 0 5 99 @?=* [0, 5 .. 99] + , testCase "enumFromThenTo 0 5 100 == [0,5..100]" $ + enumFromThenTo @Integer 0 5 100 @?=* [0, 5 .. 100] + , testCase "enumFromThenTo 0 5 101 == [0,5..101]" $ + enumFromThenTo @Integer 0 5 101 @?=* [0, 5 .. 101] + , testCase "enumFromThenTo 100 95 0 == [100,95..0]" $ + enumFromThenTo @Integer 100 95 0 @?=* [100, 95 .. 0] + , testCase "enumFromThenTo 100 95 (-9) == [100,95..(-9)]" $ + enumFromThenTo @Integer 100 95 (-9) @?=* [100, 95 .. (-9)] + , testCase "enumFromThenTo 100 95 (-10) == [100,95..(-10)]" $ + enumFromThenTo @Integer 100 95 (-10) @?=* [100, 95 .. (-10)] + , testCase "enumFromThenTo 100 95 (-11) == [100,95..(-11)]" $ + enumFromThenTo @Integer 100 95 (-11) @?=* [100, 95 .. (-11)] + , testCase "enumFromThenTo 42 42 41 == []" $ + enumFromThenTo @Integer 42 42 41 @?=* [] + , testCase "enumFromThenTo 42 42 42 == [42*]" $ + enumFromThenTo @Integer 42 42 42 @?=* [42, 42 .. 42] + , testCase "enumFromThenTo 42 42 43 == [42*]" $ + enumFromThenTo @Integer 42 42 43 @?=* [42, 42 .. 43] + , testCase "enumFromThenTo False False False == [False*]" $ + enumFromThenTo False False False @?=* [False, False .. False] + , testCase "enumFromThenTo False False True == [False*]" $ + enumFromThenTo False False True @?=* [False, False .. True] + , testCase "enumFromThenTo False True False == [False]" $ + enumFromThenTo False True False @?=* [False, True .. False] + , testCase "enumFromThenTo False True True == [False,True]" $ + enumFromThenTo False True True @?=* [False, True .. True] + , testCase "enumFromThenTo True False False == [True,False]" $ + enumFromThenTo True False False @?=* [True, False .. False] + , testCase "enumFromThenTo True False True == [True]" $ + enumFromThenTo True False True @?=* [True, False .. True] + , testCase "enumFromThenTo True True False == []" $ + enumFromThenTo True True False @?=* [True, True .. False] + , testCase "enumFromThenTo True True True == [True*]" $ + enumFromThenTo True True True @?=* [True, True .. True] + , testCase "enumFromThenTo () () () == [()*]" $ + enumFromThenTo () () () @?=* [(), () .. ()] + ] + where + {- Check (approximately) that two possibly infinite lists are equal. We can get infinite lists from + `enumFromThenTo`, both legitimately and because of implementation errors (which are exactly + what we're testing for here). If we just use @?= then (a) it won't terminate if we give it + two equal infinite lists, and (b) if it fails and one of the lists is infinite then it'll try + to generate an infinite error message, again leading to non-termination. To deal with this, + if an argument has more than 1000 elements then we assume it's infinite and just include an + initial segment in any error message, and when we're comparing two such "infinite" lists we + just compare the first 1000 elements. The only infinite lists that enumFromThenTo can + generate are of the form [x,x,x,...], so this is definitely a safe strategy in this context. + -} + l1 @?=* l2 = + case (possiblyInfinite l1, possiblyInfinite l2) of + (False, False) -> l1 @?= l2 + (True, False) -> failWith (showInit l1) (show l2) + (False, True) -> failWith (show l1) (showInit l2) + (True, True) -> unless (take 1000 l1 == take 1000 l2) (failWith (showInit l1) (showInit l2)) + where + possiblyInfinite l = drop 1000 l /= [] + showInit l = "[" ++ intercalate "," (fmap show (take 5 l)) ++ ",...]" + failWith expected actual = assertFailure ("expected: " ++ expected ++ "\n but got: " ++ actual) diff --git a/plutus-tx/testlib/Hedgehog/Laws/Common.hs b/plutus-tx/testlib/Hedgehog/Laws/Common.hs index a195c060b6d..312ba00c2bc 100644 --- a/plutus-tx/testlib/Hedgehog/Laws/Common.hs +++ b/plutus-tx/testlib/Hedgehog/Laws/Common.hs @@ -1,4 +1,5 @@ {-# LANGUAGE OverloadedStrings #-} + module Hedgehog.Laws.Common where import Hedgehog (Property, cover, forAll, property) diff --git a/plutus-tx/testlib/Hedgehog/Laws/Eq.hs b/plutus-tx/testlib/Hedgehog/Laws/Eq.hs index 585ef525522..6b5fe4e4fcb 100644 --- a/plutus-tx/testlib/Hedgehog/Laws/Eq.hs +++ b/plutus-tx/testlib/Hedgehog/Laws/Eq.hs @@ -1,4 +1,5 @@ {-# LANGUAGE OverloadedStrings #-} + module Hedgehog.Laws.Eq where import Hedgehog qualified @@ -8,8 +9,10 @@ import Test.Tasty (TestTree, testGroup) import Test.Tasty.Hedgehog (testProperty) eqLaws :: (Show a, Eq a) => Hedgehog.Gen a -> TestTree -eqLaws g = testGroup "equivalence relation laws" - [ testProperty "reflexive" (prop_reflexive g (==)) - , testProperty "symmetric" (prop_symmetric g (==)) - , testProperty "transitive" (prop_transitive g (==)) - ] +eqLaws g = + testGroup + "equivalence relation laws" + [ testProperty "reflexive" (prop_reflexive g (==)) + , testProperty "symmetric" (prop_symmetric g (==)) + , testProperty "transitive" (prop_transitive g (==)) + ] diff --git a/plutus-tx/testlib/Hedgehog/Laws/Lattice.hs b/plutus-tx/testlib/Hedgehog/Laws/Lattice.hs index 37b263140e3..12ede170d4e 100644 --- a/plutus-tx/testlib/Hedgehog/Laws/Lattice.hs +++ b/plutus-tx/testlib/Hedgehog/Laws/Lattice.hs @@ -1,4 +1,5 @@ {-# LANGUAGE OverloadedStrings #-} + module Hedgehog.Laws.Lattice where import Hedgehog (Property, cover, forAll, property) @@ -10,30 +11,38 @@ import Test.Tasty (TestTree, testGroup) import Test.Tasty.Hedgehog (testProperty) joinLatticeLaws :: (Show a, Eq a, JoinSemiLattice a) => Hedgehog.Gen a -> TestTree -joinLatticeLaws g = testGroup "join semilattice laws" - [ testProperty "idempotent" (prop_idempotent g (\/)) - , testProperty "commutative" (prop_commutative g (\/)) - , testProperty "associative" (prop_associative g (\/)) - ] +joinLatticeLaws g = + testGroup + "join semilattice laws" + [ testProperty "idempotent" (prop_idempotent g (\/)) + , testProperty "commutative" (prop_commutative g (\/)) + , testProperty "associative" (prop_associative g (\/)) + ] boundedJoinLatticeLaws :: (Show a, Eq a, BoundedJoinSemiLattice a) => Hedgehog.Gen a -> TestTree -boundedJoinLatticeLaws g = testGroup "bounded join semilattice laws" - [ joinLatticeLaws g - , testProperty "unit" (prop_unit g (\/) bottom) - ] +boundedJoinLatticeLaws g = + testGroup + "bounded join semilattice laws" + [ joinLatticeLaws g + , testProperty "unit" (prop_unit g (\/) bottom) + ] meetLatticeLaws :: (Show a, Eq a, MeetSemiLattice a) => Hedgehog.Gen a -> TestTree -meetLatticeLaws g = testGroup "meet semilattice laws" - [ testProperty "idempotent" (prop_idempotent g (/\)) - , testProperty "commutative" (prop_commutative g (/\)) - , testProperty "associative" (prop_associative g (/\)) - ] +meetLatticeLaws g = + testGroup + "meet semilattice laws" + [ testProperty "idempotent" (prop_idempotent g (/\)) + , testProperty "commutative" (prop_commutative g (/\)) + , testProperty "associative" (prop_associative g (/\)) + ] boundedMeetLatticeLaws :: (Show a, Eq a, BoundedMeetSemiLattice a) => Hedgehog.Gen a -> TestTree -boundedMeetLatticeLaws g = testGroup "bounded meet semilattice laws" - [ meetLatticeLaws g - , testProperty "unit" (prop_unit g (/\) top) - ] +boundedMeetLatticeLaws g = + testGroup + "bounded meet semilattice laws" + [ meetLatticeLaws g + , testProperty "unit" (prop_unit g (/\) top) + ] prop_latticeAbsorb :: (Show a, Eq a, Lattice a) => Hedgehog.Gen a -> Property prop_latticeAbsorb g = property $ do @@ -44,15 +53,19 @@ prop_latticeAbsorb g = property $ do x /\ (x \/ y) Hedgehog.=== x latticeLaws :: (Show a, Eq a, Lattice a) => Hedgehog.Gen a -> TestTree -latticeLaws g = testGroup "lattice laws" - [ joinLatticeLaws g - , meetLatticeLaws g - , testProperty "absorption" (prop_latticeAbsorb g) - ] +latticeLaws g = + testGroup + "lattice laws" + [ joinLatticeLaws g + , meetLatticeLaws g + , testProperty "absorption" (prop_latticeAbsorb g) + ] boundedLatticeLaws :: (Show a, Eq a, BoundedLattice a) => Hedgehog.Gen a -> TestTree -boundedLatticeLaws g = testGroup "bounded lattice laws" - [ boundedJoinLatticeLaws g - , boundedMeetLatticeLaws g - , testProperty "absorption" (prop_latticeAbsorb g) - ] +boundedLatticeLaws g = + testGroup + "bounded lattice laws" + [ boundedJoinLatticeLaws g + , boundedMeetLatticeLaws g + , testProperty "absorption" (prop_latticeAbsorb g) + ] diff --git a/plutus-tx/testlib/Hedgehog/Laws/Ord.hs b/plutus-tx/testlib/Hedgehog/Laws/Ord.hs index 543fd22e284..2bc10d89b5b 100644 --- a/plutus-tx/testlib/Hedgehog/Laws/Ord.hs +++ b/plutus-tx/testlib/Hedgehog/Laws/Ord.hs @@ -1,4 +1,5 @@ {-# LANGUAGE OverloadedStrings #-} + module Hedgehog.Laws.Ord where import Hedgehog qualified @@ -9,15 +10,18 @@ import Test.Tasty.Hedgehog (testProperty) -- There is no typeclass for this, sadly partialOrderLaws :: (Show a, Eq a) => Hedgehog.Gen a -> (a -> a -> Bool) -> TestTree -partialOrderLaws g op = testGroup "partial ordering laws" - [ testProperty "reflexive" (prop_reflexive g op) - , testProperty "transitive" (prop_transitive g op) - , testProperty "antisymmetric" (prop_antisymmetric g op) - ] +partialOrderLaws g op = + testGroup + "partial ordering laws" + [ testProperty "reflexive" (prop_reflexive g op) + , testProperty "transitive" (prop_transitive g op) + , testProperty "antisymmetric" (prop_antisymmetric g op) + ] ordLaws :: (Show a, Ord a) => Hedgehog.Gen a -> TestTree -ordLaws g = testGroup "total ordering laws" - [ partialOrderLaws g (<=) - , testProperty "total" (prop_total g (<=)) - ] - +ordLaws g = + testGroup + "total ordering laws" + [ partialOrderLaws g (<=) + , testProperty "total" (prop_total g (<=)) + ] diff --git a/plutus-tx/testlib/PlutusTx/Test.hs b/plutus-tx/testlib/PlutusTx/Test.hs index 16eac340b76..ff6dfad9043 100644 --- a/plutus-tx/testlib/PlutusTx/Test.hs +++ b/plutus-tx/testlib/PlutusTx/Test.hs @@ -30,7 +30,7 @@ module PlutusTx.Test ( -- * Combined testing goldenBundle, - goldenBundle' + goldenBundle', ) where import Prelude @@ -70,13 +70,13 @@ import UntypedPlutusCore.Evaluation.Machine.Cek qualified as UPLC -- `PlutusCore.Size` comparison tests -fitsUnder :: - forall (a :: Type). - (Typeable a) => - TestName -> - (String, CompiledCode a) -> - (String, CompiledCode a) -> - TestTree +fitsUnder + :: forall (a :: Type) + . (Typeable a) + => TestName + -> (String, CompiledCode a) + -> (String, CompiledCode a) + -> TestTree fitsUnder name test target = singleTest name $ SizeComparisonTest test target data SizeComparisonTest (a :: Type) @@ -136,11 +136,11 @@ goldenBundle' name x = goldenBundle name x x -- Compilation testing -- | Does not print uniques. -goldenPir :: - (PrettyUni uni, Pretty fun, uni `PLC.Everywhere` Flat, Flat fun) => - TestName -> - CompiledCodeIn uni fun a -> - TestNested +goldenPir + :: (PrettyUni uni, Pretty fun, uni `PLC.Everywhere` Flat, Flat fun) + => TestName + -> CompiledCodeIn uni fun a + -> TestNested goldenPir name value = nestedGoldenVsDoc name ".pir" . maybe @@ -149,11 +149,11 @@ goldenPir name value = $ getPirNoAnn value -- | Does not print uniques. -goldenPirReadable :: - (PrettyUni uni, Pretty fun, uni `PLC.Everywhere` Flat, Flat fun) => - TestName -> - CompiledCodeIn uni fun a -> - TestNested +goldenPirReadable + :: (PrettyUni uni, Pretty fun, uni `PLC.Everywhere` Flat, Flat fun) + => TestName + -> CompiledCodeIn uni fun a + -> TestNested goldenPirReadable name value = nestedGoldenVsDoc name ".pir" . maybe @@ -161,25 +161,26 @@ goldenPirReadable name value = (prettyReadableSimple . view progTerm) $ getPirNoAnn value --- | Prints uniques. This should be used sparingly: a simple change to a script or a --- compiler pass may change all uniques, making it difficult to see the actual --- change if all uniques are printed. It is nonetheless useful sometimes. -goldenPirReadableU :: - (PrettyUni uni, Pretty fun, uni `PLC.Everywhere` Flat, Flat fun) => - TestName -> - CompiledCodeIn uni fun a -> - TestNested +{-| Prints uniques. This should be used sparingly: a simple change to a script or a +compiler pass may change all uniques, making it difficult to see the actual +change if all uniques are printed. It is nonetheless useful sometimes. +-} +goldenPirReadableU + :: (PrettyUni uni, Pretty fun, uni `PLC.Everywhere` Flat, Flat fun) + => TestName + -> CompiledCodeIn uni fun a + -> TestNested goldenPirReadableU name value = nestedGoldenVsDoc name ".pir" . maybe "PIR not found in CompiledCode" (prettyReadable . view progTerm) $ getPirNoAnn value -goldenPirBy :: - (PrettyUni uni, Pretty fun, uni `PLC.Everywhere` Flat, Flat fun) => - PrettyConfigClassic PrettyConfigName -> - TestName -> - CompiledCodeIn uni fun a -> - TestNested +goldenPirBy + :: (PrettyUni uni, Pretty fun, uni `PLC.Everywhere` Flat, Flat fun) + => PrettyConfigClassic PrettyConfigName + -> TestName + -> CompiledCodeIn uni fun a + -> TestNested goldenPirBy config name value = nestedGoldenVsDoc name ".pir" $ prettyBy config $ getPir value @@ -254,9 +255,9 @@ runPlcCek runPlcCek val = do term <- toUPlc val fromRightM (throwError . SomeException) $ - UPLC.evaluateCekNoEmit - PLC.defaultCekParametersForTesting - (term ^. UPLC.progTerm) + UPLC.evaluateCekNoEmit + PLC.defaultCekParametersForTesting + (term ^. UPLC.progTerm) runPlcCekBudget :: (ToUPlc a PLC.DefaultUni PLC.DefaultFun) @@ -271,11 +272,11 @@ runPlcCekBudget val = do let (evalRes, UPLC.CountingSt budget) = UPLC.runCekNoEmit - PLC.defaultCekParametersForTesting - UPLC.counting - (term ^. UPLC.progTerm) + PLC.defaultCekParametersForTesting + UPLC.counting + (term ^. UPLC.progTerm) - (, budget) <$> evalRes + (,budget) <$> evalRes runPlcCekTrace :: (ToUPlc a PLC.DefaultUni PLC.DefaultFun) From 7826ad0e275937f18549ac6e290552c0148f40fc Mon Sep 17 00:00:00 2001 From: effectfully Date: Sat, 31 May 2025 04:55:28 +0100 Subject: [PATCH 11/25] Remove redudant golden files --- plutus-benchmark/bitwise/test/9.6/8 queens.budget.golden | 3 --- plutus-benchmark/bitwise/test/9.6/8 queens.size.golden | 1 - plutus-benchmark/bitwise/test/9.6/Ed25519.budget.golden | 3 --- plutus-benchmark/bitwise/test/9.6/Ed25519.size.golden | 1 - .../test/Lookup/9.6/match-builtin-list-10.budget.golden | 3 --- .../test/Lookup/9.6/match-builtin-list-5.budget.golden | 3 --- .../test/Lookup/9.6/match-scott-list-10.budget.golden | 3 --- .../test/Lookup/9.6/match-scott-list-5.budget.golden | 3 --- .../lists/test/Sum/9.6/left-fold-data.budget.golden | 3 --- .../lists/test/Sum/9.6/right-fold-data.budget.golden | 3 --- plutus-benchmark/nofib/test/9.6/clausify-F5.budget.golden | 3 --- plutus-benchmark/nofib/test/9.6/clausify-F5.size.golden | 1 - .../nofib/test/9.6/knights10-4x4.budget.golden | 3 --- plutus-benchmark/nofib/test/9.6/knights10-4x4.size.golden | 1 - plutus-benchmark/nofib/test/9.6/queens4-bt.budget.golden | 3 --- plutus-benchmark/nofib/test/9.6/queens4-bt.size.golden | 1 - plutus-benchmark/nofib/test/9.6/queens5-fc.budget.golden | 3 --- plutus-benchmark/nofib/test/9.6/queens5-fc.size.golden | 1 - .../test/V1/9.6/checkScriptContext1-20.budget.golden | 3 --- .../test/V1/9.6/checkScriptContext1-4.budget.golden | 3 --- .../test/V1/9.6/checkScriptContext2-20.budget.golden | 3 --- .../test/V1/9.6/checkScriptContext2-4.budget.golden | 3 --- .../9.6/checkScriptContextEqualityData-20.budget.golden | 3 --- .../test/V1/Data/9.6/checkScriptContext1-20.budget.golden | 3 --- .../test/V1/Data/9.6/checkScriptContext1-4.budget.golden | 3 --- .../9.6/checkScriptContextEqualityData-20.budget.golden | 3 --- .../test/V2/9.6/checkScriptContext1-20.budget.golden | 3 --- .../test/V2/9.6/checkScriptContext1-4.budget.golden | 3 --- .../test/V2/9.6/checkScriptContext2-20.budget.golden | 3 --- .../test/V2/9.6/checkScriptContext2-4.budget.golden | 3 --- .../9.6/checkScriptContextEqualityData-20.budget.golden | 3 --- .../test/V2/9.6/dataFwdStakeTrick.budget.golden | 3 --- .../test/V2/9.6/dataFwdStakeTrick.size.golden | 1 - .../test/V2/9.6/dataFwdStakeTrickManual.budget.golden | 3 --- .../test/V2/9.6/dataFwdStakeTrickManual.size.golden | 1 - .../test/V2/9.6/sopFwdStakeTrick.budget.golden | 3 --- .../test/V2/9.6/sopFwdStakeTrick.size.golden | 1 - .../test/V2/Data/9.6/checkScriptContext1-20.budget.golden | 3 --- .../test/V2/Data/9.6/checkScriptContext1-4.budget.golden | 3 --- .../9.6/checkScriptContextEqualityData-20.budget.golden | 3 --- .../test/V3/9.6/checkScriptContext1-20.budget.golden | 3 --- .../test/V3/9.6/checkScriptContext1-4.budget.golden | 3 --- .../test/V3/9.6/checkScriptContext2-20.budget.golden | 3 --- .../test/V3/9.6/checkScriptContext2-4.budget.golden | 3 --- .../9.6/checkScriptContextEqualityData-20.budget.golden | 3 --- .../test/V3/Data/9.6/checkScriptContext1-20.budget.golden | 3 --- .../test/V3/Data/9.6/checkScriptContext1-4.budget.golden | 3 --- .../9.6/checkScriptContextEqualityData-20.budget.golden | 3 --- .../test/V3/Data/9.6/purposeIsWellFormed-4.budget.golden | 3 --- .../Golden/DefaultFun/LengthArray.plc.golden | 1 - .../Golden/DefaultFun/ReplicateByteString.plc.golden | 1 - .../Golden/Signatures/DefaultFun/LengthArray.sig.golden | 1 - .../Golden/StdLib/Data/Data/caseData.plc.golden | 8 -------- .../Golden/StdLib/Data/List/CaseList.plc.golden | 1 - .../test/Transform/inlineImpure5.uplc.golden | 1 - .../Spec/Budget/9.6/currencySymbolValueOf.budget.golden | 3 --- .../test-plugin/Spec/Budget/9.6/geq1.budget.golden | 3 --- .../test-plugin/Spec/Budget/9.6/geq2.budget.golden | 3 --- .../test-plugin/Spec/Budget/9.6/geq3.budget.golden | 3 --- .../test-plugin/Spec/Budget/9.6/geq4.budget.golden | 3 --- .../test-plugin/Spec/Budget/9.6/geq5.budget.golden | 3 --- .../test-plugin/Spec/Budget/9.6/gt1.budget.golden | 3 --- .../test-plugin/Spec/Budget/9.6/gt2.budget.golden | 3 --- .../test-plugin/Spec/Budget/9.6/gt3.budget.golden | 3 --- .../test-plugin/Spec/Budget/9.6/gt4.budget.golden | 3 --- .../test-plugin/Spec/Budget/9.6/gt5.budget.golden | 3 --- .../Data/Budget/9.6/currencySymbolValueOf.budget.golden | 3 --- .../test-plugin/Spec/Data/Budget/9.6/geq1.budget.golden | 3 --- .../test-plugin/Spec/Data/Budget/9.6/geq2.budget.golden | 3 --- .../test-plugin/Spec/Data/Budget/9.6/geq3.budget.golden | 3 --- .../test-plugin/Spec/Data/Budget/9.6/geq4.budget.golden | 3 --- .../test-plugin/Spec/Data/Budget/9.6/geq5.budget.golden | 3 --- .../test-plugin/Spec/Data/Budget/9.6/gt1.budget.golden | 3 --- .../test-plugin/Spec/Data/Budget/9.6/gt2.budget.golden | 3 --- .../test-plugin/Spec/Data/Budget/9.6/gt3.budget.golden | 3 --- .../test-plugin/Spec/Data/Budget/9.6/gt4.budget.golden | 3 --- .../test-plugin/Spec/Data/Budget/9.6/gt5.budget.golden | 3 --- .../AsData/Budget/9.6/destructSum-manual.budget.golden | 3 --- .../test/AsData/Budget/9.6/destructSum.budget.golden | 3 --- .../test/AsData/Budget/9.6/patternMatching.budget.golden | 3 --- .../test/AsData/Budget/9.6/recordFields.budget.golden | 3 --- plutus-tx-plugin/test/Budget/9.6/allCheap.budget.golden | 3 --- .../test/Budget/9.6/allEmptyList.budget.golden | 3 --- .../test/Budget/9.6/allExpensive.budget.golden | 3 --- .../test/Budget/9.6/andWithGHCOpts.budget.golden | 3 --- .../test/Budget/9.6/andWithLocal.budget.golden | 3 --- .../test/Budget/9.6/andWithoutGHCOpts.budget.golden | 3 --- plutus-tx-plugin/test/Budget/9.6/anyCheap.budget.golden | 3 --- .../test/Budget/9.6/anyEmptyList.budget.golden | 3 --- .../test/Budget/9.6/anyExpensive.budget.golden | 3 --- .../test/Budget/9.6/builtinListIndexing.budget.golden | 2 -- plutus-tx-plugin/test/Budget/9.6/constAccL.budget.golden | 3 --- plutus-tx-plugin/test/Budget/9.6/constAccR.budget.golden | 3 --- plutus-tx-plugin/test/Budget/9.6/constElL.budget.golden | 3 --- plutus-tx-plugin/test/Budget/9.6/constElR.budget.golden | 3 --- plutus-tx-plugin/test/Budget/9.6/elemCheap.budget.golden | 3 --- .../test/Budget/9.6/elemExpensive.budget.golden | 3 --- plutus-tx-plugin/test/Budget/9.6/filter.budget.golden | 3 --- plutus-tx-plugin/test/Budget/9.6/findCheap.budget.golden | 3 --- .../test/Budget/9.6/findEmptyList.budget.golden | 3 --- .../test/Budget/9.6/findExpensive.budget.golden | 3 --- .../test/Budget/9.6/findIndexCheap.budget.golden | 3 --- .../test/Budget/9.6/findIndexEmptyList.budget.golden | 3 --- .../test/Budget/9.6/findIndexExpensive.budget.golden | 3 --- plutus-tx-plugin/test/Budget/9.6/gte0.budget.golden | 3 --- .../test/Budget/9.6/listIndexing.budget.golden | 3 --- plutus-tx-plugin/test/Budget/9.6/lte0.budget.golden | 3 --- plutus-tx-plugin/test/Budget/9.6/map1.budget.golden | 3 --- plutus-tx-plugin/test/Budget/9.6/map2.budget.golden | 3 --- plutus-tx-plugin/test/Budget/9.6/map3.budget.golden | 3 --- .../test/Budget/9.6/matchAsDataE.budget.golden | 3 --- plutus-tx-plugin/test/Budget/9.6/not-not.budget.golden | 3 --- .../test/Budget/9.6/notElemCheap.budget.golden | 3 --- .../test/Budget/9.6/notElemExpensive.budget.golden | 3 --- .../test/Budget/9.6/recursiveGte0.budget.golden | 3 --- .../test/Budget/9.6/recursiveLte0.budget.golden | 3 --- plutus-tx-plugin/test/Budget/9.6/show.budget.golden | 3 --- plutus-tx-plugin/test/Budget/9.6/sumL.budget.golden | 3 --- plutus-tx-plugin/test/Budget/9.6/sumR.budget.golden | 3 --- plutus-tx-plugin/test/Budget/9.6/toFromData.budget.golden | 3 --- .../test/BuiltinList/Budget/9.6/all.budget.golden | 3 --- .../test/BuiltinList/Budget/9.6/any.budget.golden | 3 --- .../test/BuiltinList/Budget/9.6/elem.budget.golden | 3 --- .../test/BuiltinList/Budget/9.6/find.budget.golden | 3 --- .../test/BuiltinList/Budget/9.6/index.budget.golden | 3 --- .../test/DataList/Budget/9.6/any.budget.golden | 3 --- .../test/DataList/Budget/9.6/elem.budget.golden | 3 --- .../test/DataList/Budget/9.6/filter.budget.golden | 3 --- .../test/DataList/Budget/9.6/partition.budget.golden | 3 --- 129 files changed, 363 deletions(-) delete mode 100644 plutus-benchmark/bitwise/test/9.6/8 queens.budget.golden delete mode 100644 plutus-benchmark/bitwise/test/9.6/8 queens.size.golden delete mode 100644 plutus-benchmark/bitwise/test/9.6/Ed25519.budget.golden delete mode 100644 plutus-benchmark/bitwise/test/9.6/Ed25519.size.golden delete mode 100644 plutus-benchmark/lists/test/Lookup/9.6/match-builtin-list-10.budget.golden delete mode 100644 plutus-benchmark/lists/test/Lookup/9.6/match-builtin-list-5.budget.golden delete mode 100644 plutus-benchmark/lists/test/Lookup/9.6/match-scott-list-10.budget.golden delete mode 100644 plutus-benchmark/lists/test/Lookup/9.6/match-scott-list-5.budget.golden delete mode 100644 plutus-benchmark/lists/test/Sum/9.6/left-fold-data.budget.golden delete mode 100644 plutus-benchmark/lists/test/Sum/9.6/right-fold-data.budget.golden delete mode 100644 plutus-benchmark/nofib/test/9.6/clausify-F5.budget.golden delete mode 100644 plutus-benchmark/nofib/test/9.6/clausify-F5.size.golden delete mode 100644 plutus-benchmark/nofib/test/9.6/knights10-4x4.budget.golden delete mode 100644 plutus-benchmark/nofib/test/9.6/knights10-4x4.size.golden delete mode 100644 plutus-benchmark/nofib/test/9.6/queens4-bt.budget.golden delete mode 100644 plutus-benchmark/nofib/test/9.6/queens4-bt.size.golden delete mode 100644 plutus-benchmark/nofib/test/9.6/queens5-fc.budget.golden delete mode 100644 plutus-benchmark/nofib/test/9.6/queens5-fc.size.golden delete mode 100644 plutus-benchmark/script-contexts/test/V1/9.6/checkScriptContext1-20.budget.golden delete mode 100644 plutus-benchmark/script-contexts/test/V1/9.6/checkScriptContext1-4.budget.golden delete mode 100644 plutus-benchmark/script-contexts/test/V1/9.6/checkScriptContext2-20.budget.golden delete mode 100644 plutus-benchmark/script-contexts/test/V1/9.6/checkScriptContext2-4.budget.golden delete mode 100644 plutus-benchmark/script-contexts/test/V1/9.6/checkScriptContextEqualityData-20.budget.golden delete mode 100644 plutus-benchmark/script-contexts/test/V1/Data/9.6/checkScriptContext1-20.budget.golden delete mode 100644 plutus-benchmark/script-contexts/test/V1/Data/9.6/checkScriptContext1-4.budget.golden delete mode 100644 plutus-benchmark/script-contexts/test/V1/Data/9.6/checkScriptContextEqualityData-20.budget.golden delete mode 100644 plutus-benchmark/script-contexts/test/V2/9.6/checkScriptContext1-20.budget.golden delete mode 100644 plutus-benchmark/script-contexts/test/V2/9.6/checkScriptContext1-4.budget.golden delete mode 100644 plutus-benchmark/script-contexts/test/V2/9.6/checkScriptContext2-20.budget.golden delete mode 100644 plutus-benchmark/script-contexts/test/V2/9.6/checkScriptContext2-4.budget.golden delete mode 100644 plutus-benchmark/script-contexts/test/V2/9.6/checkScriptContextEqualityData-20.budget.golden delete mode 100644 plutus-benchmark/script-contexts/test/V2/9.6/dataFwdStakeTrick.budget.golden delete mode 100644 plutus-benchmark/script-contexts/test/V2/9.6/dataFwdStakeTrick.size.golden delete mode 100644 plutus-benchmark/script-contexts/test/V2/9.6/dataFwdStakeTrickManual.budget.golden delete mode 100644 plutus-benchmark/script-contexts/test/V2/9.6/dataFwdStakeTrickManual.size.golden delete mode 100644 plutus-benchmark/script-contexts/test/V2/9.6/sopFwdStakeTrick.budget.golden delete mode 100644 plutus-benchmark/script-contexts/test/V2/9.6/sopFwdStakeTrick.size.golden delete mode 100644 plutus-benchmark/script-contexts/test/V2/Data/9.6/checkScriptContext1-20.budget.golden delete mode 100644 plutus-benchmark/script-contexts/test/V2/Data/9.6/checkScriptContext1-4.budget.golden delete mode 100644 plutus-benchmark/script-contexts/test/V2/Data/9.6/checkScriptContextEqualityData-20.budget.golden delete mode 100644 plutus-benchmark/script-contexts/test/V3/9.6/checkScriptContext1-20.budget.golden delete mode 100644 plutus-benchmark/script-contexts/test/V3/9.6/checkScriptContext1-4.budget.golden delete mode 100644 plutus-benchmark/script-contexts/test/V3/9.6/checkScriptContext2-20.budget.golden delete mode 100644 plutus-benchmark/script-contexts/test/V3/9.6/checkScriptContext2-4.budget.golden delete mode 100644 plutus-benchmark/script-contexts/test/V3/9.6/checkScriptContextEqualityData-20.budget.golden delete mode 100644 plutus-benchmark/script-contexts/test/V3/Data/9.6/checkScriptContext1-20.budget.golden delete mode 100644 plutus-benchmark/script-contexts/test/V3/Data/9.6/checkScriptContext1-4.budget.golden delete mode 100644 plutus-benchmark/script-contexts/test/V3/Data/9.6/checkScriptContextEqualityData-20.budget.golden delete mode 100644 plutus-benchmark/script-contexts/test/V3/Data/9.6/purposeIsWellFormed-4.budget.golden delete mode 100644 plutus-core/plutus-core/test/TypeSynthesis/Golden/DefaultFun/LengthArray.plc.golden delete mode 100644 plutus-core/plutus-core/test/TypeSynthesis/Golden/DefaultFun/ReplicateByteString.plc.golden delete mode 100644 plutus-core/plutus-core/test/TypeSynthesis/Golden/Signatures/DefaultFun/LengthArray.sig.golden delete mode 100644 plutus-core/plutus-core/test/TypeSynthesis/Golden/StdLib/Data/Data/caseData.plc.golden delete mode 100644 plutus-core/plutus-core/test/TypeSynthesis/Golden/StdLib/Data/List/CaseList.plc.golden delete mode 100644 plutus-core/untyped-plutus-core/test/Transform/inlineImpure5.uplc.golden delete mode 100644 plutus-ledger-api/test-plugin/Spec/Budget/9.6/currencySymbolValueOf.budget.golden delete mode 100644 plutus-ledger-api/test-plugin/Spec/Budget/9.6/geq1.budget.golden delete mode 100644 plutus-ledger-api/test-plugin/Spec/Budget/9.6/geq2.budget.golden delete mode 100644 plutus-ledger-api/test-plugin/Spec/Budget/9.6/geq3.budget.golden delete mode 100644 plutus-ledger-api/test-plugin/Spec/Budget/9.6/geq4.budget.golden delete mode 100644 plutus-ledger-api/test-plugin/Spec/Budget/9.6/geq5.budget.golden delete mode 100644 plutus-ledger-api/test-plugin/Spec/Budget/9.6/gt1.budget.golden delete mode 100644 plutus-ledger-api/test-plugin/Spec/Budget/9.6/gt2.budget.golden delete mode 100644 plutus-ledger-api/test-plugin/Spec/Budget/9.6/gt3.budget.golden delete mode 100644 plutus-ledger-api/test-plugin/Spec/Budget/9.6/gt4.budget.golden delete mode 100644 plutus-ledger-api/test-plugin/Spec/Budget/9.6/gt5.budget.golden delete mode 100644 plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/currencySymbolValueOf.budget.golden delete mode 100644 plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/geq1.budget.golden delete mode 100644 plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/geq2.budget.golden delete mode 100644 plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/geq3.budget.golden delete mode 100644 plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/geq4.budget.golden delete mode 100644 plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/geq5.budget.golden delete mode 100644 plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/gt1.budget.golden delete mode 100644 plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/gt2.budget.golden delete mode 100644 plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/gt3.budget.golden delete mode 100644 plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/gt4.budget.golden delete mode 100644 plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/gt5.budget.golden delete mode 100644 plutus-tx-plugin/test/AsData/Budget/9.6/destructSum-manual.budget.golden delete mode 100644 plutus-tx-plugin/test/AsData/Budget/9.6/destructSum.budget.golden delete mode 100644 plutus-tx-plugin/test/AsData/Budget/9.6/patternMatching.budget.golden delete mode 100644 plutus-tx-plugin/test/AsData/Budget/9.6/recordFields.budget.golden delete mode 100644 plutus-tx-plugin/test/Budget/9.6/allCheap.budget.golden delete mode 100644 plutus-tx-plugin/test/Budget/9.6/allEmptyList.budget.golden delete mode 100644 plutus-tx-plugin/test/Budget/9.6/allExpensive.budget.golden delete mode 100644 plutus-tx-plugin/test/Budget/9.6/andWithGHCOpts.budget.golden delete mode 100644 plutus-tx-plugin/test/Budget/9.6/andWithLocal.budget.golden delete mode 100644 plutus-tx-plugin/test/Budget/9.6/andWithoutGHCOpts.budget.golden delete mode 100644 plutus-tx-plugin/test/Budget/9.6/anyCheap.budget.golden delete mode 100644 plutus-tx-plugin/test/Budget/9.6/anyEmptyList.budget.golden delete mode 100644 plutus-tx-plugin/test/Budget/9.6/anyExpensive.budget.golden delete mode 100644 plutus-tx-plugin/test/Budget/9.6/builtinListIndexing.budget.golden delete mode 100644 plutus-tx-plugin/test/Budget/9.6/constAccL.budget.golden delete mode 100644 plutus-tx-plugin/test/Budget/9.6/constAccR.budget.golden delete mode 100644 plutus-tx-plugin/test/Budget/9.6/constElL.budget.golden delete mode 100644 plutus-tx-plugin/test/Budget/9.6/constElR.budget.golden delete mode 100644 plutus-tx-plugin/test/Budget/9.6/elemCheap.budget.golden delete mode 100644 plutus-tx-plugin/test/Budget/9.6/elemExpensive.budget.golden delete mode 100644 plutus-tx-plugin/test/Budget/9.6/filter.budget.golden delete mode 100644 plutus-tx-plugin/test/Budget/9.6/findCheap.budget.golden delete mode 100644 plutus-tx-plugin/test/Budget/9.6/findEmptyList.budget.golden delete mode 100644 plutus-tx-plugin/test/Budget/9.6/findExpensive.budget.golden delete mode 100644 plutus-tx-plugin/test/Budget/9.6/findIndexCheap.budget.golden delete mode 100644 plutus-tx-plugin/test/Budget/9.6/findIndexEmptyList.budget.golden delete mode 100644 plutus-tx-plugin/test/Budget/9.6/findIndexExpensive.budget.golden delete mode 100644 plutus-tx-plugin/test/Budget/9.6/gte0.budget.golden delete mode 100644 plutus-tx-plugin/test/Budget/9.6/listIndexing.budget.golden delete mode 100644 plutus-tx-plugin/test/Budget/9.6/lte0.budget.golden delete mode 100644 plutus-tx-plugin/test/Budget/9.6/map1.budget.golden delete mode 100644 plutus-tx-plugin/test/Budget/9.6/map2.budget.golden delete mode 100644 plutus-tx-plugin/test/Budget/9.6/map3.budget.golden delete mode 100644 plutus-tx-plugin/test/Budget/9.6/matchAsDataE.budget.golden delete mode 100644 plutus-tx-plugin/test/Budget/9.6/not-not.budget.golden delete mode 100644 plutus-tx-plugin/test/Budget/9.6/notElemCheap.budget.golden delete mode 100644 plutus-tx-plugin/test/Budget/9.6/notElemExpensive.budget.golden delete mode 100644 plutus-tx-plugin/test/Budget/9.6/recursiveGte0.budget.golden delete mode 100644 plutus-tx-plugin/test/Budget/9.6/recursiveLte0.budget.golden delete mode 100644 plutus-tx-plugin/test/Budget/9.6/show.budget.golden delete mode 100644 plutus-tx-plugin/test/Budget/9.6/sumL.budget.golden delete mode 100644 plutus-tx-plugin/test/Budget/9.6/sumR.budget.golden delete mode 100644 plutus-tx-plugin/test/Budget/9.6/toFromData.budget.golden delete mode 100644 plutus-tx-plugin/test/BuiltinList/Budget/9.6/all.budget.golden delete mode 100644 plutus-tx-plugin/test/BuiltinList/Budget/9.6/any.budget.golden delete mode 100644 plutus-tx-plugin/test/BuiltinList/Budget/9.6/elem.budget.golden delete mode 100644 plutus-tx-plugin/test/BuiltinList/Budget/9.6/find.budget.golden delete mode 100644 plutus-tx-plugin/test/BuiltinList/Budget/9.6/index.budget.golden delete mode 100644 plutus-tx-plugin/test/DataList/Budget/9.6/any.budget.golden delete mode 100644 plutus-tx-plugin/test/DataList/Budget/9.6/elem.budget.golden delete mode 100644 plutus-tx-plugin/test/DataList/Budget/9.6/filter.budget.golden delete mode 100644 plutus-tx-plugin/test/DataList/Budget/9.6/partition.budget.golden diff --git a/plutus-benchmark/bitwise/test/9.6/8 queens.budget.golden b/plutus-benchmark/bitwise/test/9.6/8 queens.budget.golden deleted file mode 100644 index 5e3c82fffc5..00000000000 --- a/plutus-benchmark/bitwise/test/9.6/8 queens.budget.golden +++ /dev/null @@ -1,3 +0,0 @@ -cpu: 327658552839 -mem: 1230274574 -size: 352 \ No newline at end of file diff --git a/plutus-benchmark/bitwise/test/9.6/8 queens.size.golden b/plutus-benchmark/bitwise/test/9.6/8 queens.size.golden deleted file mode 100644 index 52f6c1a7a0e..00000000000 --- a/plutus-benchmark/bitwise/test/9.6/8 queens.size.golden +++ /dev/null @@ -1 +0,0 @@ -352 \ No newline at end of file diff --git a/plutus-benchmark/bitwise/test/9.6/Ed25519.budget.golden b/plutus-benchmark/bitwise/test/9.6/Ed25519.budget.golden deleted file mode 100644 index 8eb2a8fe76e..00000000000 --- a/plutus-benchmark/bitwise/test/9.6/Ed25519.budget.golden +++ /dev/null @@ -1,3 +0,0 @@ -cpu: 1754030727874 -mem: 5520417978 -size: 3371 \ No newline at end of file diff --git a/plutus-benchmark/bitwise/test/9.6/Ed25519.size.golden b/plutus-benchmark/bitwise/test/9.6/Ed25519.size.golden deleted file mode 100644 index 76ce2a5fd9e..00000000000 --- a/plutus-benchmark/bitwise/test/9.6/Ed25519.size.golden +++ /dev/null @@ -1 +0,0 @@ -3355 \ No newline at end of file diff --git a/plutus-benchmark/lists/test/Lookup/9.6/match-builtin-list-10.budget.golden b/plutus-benchmark/lists/test/Lookup/9.6/match-builtin-list-10.budget.golden deleted file mode 100644 index bf2279fbae9..00000000000 --- a/plutus-benchmark/lists/test/Lookup/9.6/match-builtin-list-10.budget.golden +++ /dev/null @@ -1,3 +0,0 @@ -cpu: 165673514 -mem: 700042 -size: 147 \ No newline at end of file diff --git a/plutus-benchmark/lists/test/Lookup/9.6/match-builtin-list-5.budget.golden b/plutus-benchmark/lists/test/Lookup/9.6/match-builtin-list-5.budget.golden deleted file mode 100644 index f1e1c8fb4a9..00000000000 --- a/plutus-benchmark/lists/test/Lookup/9.6/match-builtin-list-5.budget.golden +++ /dev/null @@ -1,3 +0,0 @@ -cpu: 50027604 -mem: 212662 -size: 147 \ No newline at end of file diff --git a/plutus-benchmark/lists/test/Lookup/9.6/match-scott-list-10.budget.golden b/plutus-benchmark/lists/test/Lookup/9.6/match-scott-list-10.budget.golden deleted file mode 100644 index 781cd394f1a..00000000000 --- a/plutus-benchmark/lists/test/Lookup/9.6/match-scott-list-10.budget.golden +++ /dev/null @@ -1,3 +0,0 @@ -cpu: 81203410 -mem: 396750 -size: 226 \ No newline at end of file diff --git a/plutus-benchmark/lists/test/Lookup/9.6/match-scott-list-5.budget.golden b/plutus-benchmark/lists/test/Lookup/9.6/match-scott-list-5.budget.golden deleted file mode 100644 index 89c9d586414..00000000000 --- a/plutus-benchmark/lists/test/Lookup/9.6/match-scott-list-5.budget.golden +++ /dev/null @@ -1,3 +0,0 @@ -cpu: 25027230 -mem: 125000 -size: 186 \ No newline at end of file diff --git a/plutus-benchmark/lists/test/Sum/9.6/left-fold-data.budget.golden b/plutus-benchmark/lists/test/Sum/9.6/left-fold-data.budget.golden deleted file mode 100644 index 2fa2f5e8620..00000000000 --- a/plutus-benchmark/lists/test/Sum/9.6/left-fold-data.budget.golden +++ /dev/null @@ -1,3 +0,0 @@ -cpu: 278601783 -mem: 1136329 -size: 165 \ No newline at end of file diff --git a/plutus-benchmark/lists/test/Sum/9.6/right-fold-data.budget.golden b/plutus-benchmark/lists/test/Sum/9.6/right-fold-data.budget.golden deleted file mode 100644 index e5137f7faa8..00000000000 --- a/plutus-benchmark/lists/test/Sum/9.6/right-fold-data.budget.golden +++ /dev/null @@ -1,3 +0,0 @@ -cpu: 283401783 -mem: 1166329 -size: 168 \ No newline at end of file diff --git a/plutus-benchmark/nofib/test/9.6/clausify-F5.budget.golden b/plutus-benchmark/nofib/test/9.6/clausify-F5.budget.golden deleted file mode 100644 index e94e181e52f..00000000000 --- a/plutus-benchmark/nofib/test/9.6/clausify-F5.budget.golden +++ /dev/null @@ -1,3 +0,0 @@ -cpu: 45969754450 -mem: 279787390 -size: 1584 \ No newline at end of file diff --git a/plutus-benchmark/nofib/test/9.6/clausify-F5.size.golden b/plutus-benchmark/nofib/test/9.6/clausify-F5.size.golden deleted file mode 100644 index f14fd467eb5..00000000000 --- a/plutus-benchmark/nofib/test/9.6/clausify-F5.size.golden +++ /dev/null @@ -1 +0,0 @@ -1560 \ No newline at end of file diff --git a/plutus-benchmark/nofib/test/9.6/knights10-4x4.budget.golden b/plutus-benchmark/nofib/test/9.6/knights10-4x4.budget.golden deleted file mode 100644 index 64dbda01640..00000000000 --- a/plutus-benchmark/nofib/test/9.6/knights10-4x4.budget.golden +++ /dev/null @@ -1,3 +0,0 @@ -cpu: 1168462754 -mem: 6301258 -size: 1934 \ No newline at end of file diff --git a/plutus-benchmark/nofib/test/9.6/knights10-4x4.size.golden b/plutus-benchmark/nofib/test/9.6/knights10-4x4.size.golden deleted file mode 100644 index bef933cfa1a..00000000000 --- a/plutus-benchmark/nofib/test/9.6/knights10-4x4.size.golden +++ /dev/null @@ -1 +0,0 @@ -1934 \ No newline at end of file diff --git a/plutus-benchmark/nofib/test/9.6/queens4-bt.budget.golden b/plutus-benchmark/nofib/test/9.6/queens4-bt.budget.golden deleted file mode 100644 index 076358b4f81..00000000000 --- a/plutus-benchmark/nofib/test/9.6/queens4-bt.budget.golden +++ /dev/null @@ -1,3 +0,0 @@ -cpu: 3857821578 -mem: 21795869 -size: 2036 \ No newline at end of file diff --git a/plutus-benchmark/nofib/test/9.6/queens4-bt.size.golden b/plutus-benchmark/nofib/test/9.6/queens4-bt.size.golden deleted file mode 100644 index 696ee7741d6..00000000000 --- a/plutus-benchmark/nofib/test/9.6/queens4-bt.size.golden +++ /dev/null @@ -1 +0,0 @@ -2030 \ No newline at end of file diff --git a/plutus-benchmark/nofib/test/9.6/queens5-fc.budget.golden b/plutus-benchmark/nofib/test/9.6/queens5-fc.budget.golden deleted file mode 100644 index 2006a9efac7..00000000000 --- a/plutus-benchmark/nofib/test/9.6/queens5-fc.budget.golden +++ /dev/null @@ -1,3 +0,0 @@ -cpu: 137974261782 -mem: 812282055 -size: 2036 \ No newline at end of file diff --git a/plutus-benchmark/nofib/test/9.6/queens5-fc.size.golden b/plutus-benchmark/nofib/test/9.6/queens5-fc.size.golden deleted file mode 100644 index 696ee7741d6..00000000000 --- a/plutus-benchmark/nofib/test/9.6/queens5-fc.size.golden +++ /dev/null @@ -1 +0,0 @@ -2030 \ No newline at end of file diff --git a/plutus-benchmark/script-contexts/test/V1/9.6/checkScriptContext1-20.budget.golden b/plutus-benchmark/script-contexts/test/V1/9.6/checkScriptContext1-20.budget.golden deleted file mode 100644 index cc4c603bc92..00000000000 --- a/plutus-benchmark/script-contexts/test/V1/9.6/checkScriptContext1-20.budget.golden +++ /dev/null @@ -1,3 +0,0 @@ -cpu: 243352808 -mem: 930200 -size: 1490 \ No newline at end of file diff --git a/plutus-benchmark/script-contexts/test/V1/9.6/checkScriptContext1-4.budget.golden b/plutus-benchmark/script-contexts/test/V1/9.6/checkScriptContext1-4.budget.golden deleted file mode 100644 index 7a7b5ca2e88..00000000000 --- a/plutus-benchmark/script-contexts/test/V1/9.6/checkScriptContext1-4.budget.golden +++ /dev/null @@ -1,3 +0,0 @@ -cpu: 68333032 -mem: 263848 -size: 1490 \ No newline at end of file diff --git a/plutus-benchmark/script-contexts/test/V1/9.6/checkScriptContext2-20.budget.golden b/plutus-benchmark/script-contexts/test/V1/9.6/checkScriptContext2-20.budget.golden deleted file mode 100644 index b8712671613..00000000000 --- a/plutus-benchmark/script-contexts/test/V1/9.6/checkScriptContext2-20.budget.golden +++ /dev/null @@ -1,3 +0,0 @@ -cpu: 235128385 -mem: 892558 -size: 1430 \ No newline at end of file diff --git a/plutus-benchmark/script-contexts/test/V1/9.6/checkScriptContext2-4.budget.golden b/plutus-benchmark/script-contexts/test/V1/9.6/checkScriptContext2-4.budget.golden deleted file mode 100644 index 64c46b815de..00000000000 --- a/plutus-benchmark/script-contexts/test/V1/9.6/checkScriptContext2-4.budget.golden +++ /dev/null @@ -1,3 +0,0 @@ -cpu: 66079937 -mem: 253438 -size: 1430 \ No newline at end of file diff --git a/plutus-benchmark/script-contexts/test/V1/9.6/checkScriptContextEqualityData-20.budget.golden b/plutus-benchmark/script-contexts/test/V1/9.6/checkScriptContextEqualityData-20.budget.golden deleted file mode 100644 index 42d714723dd..00000000000 --- a/plutus-benchmark/script-contexts/test/V1/9.6/checkScriptContextEqualityData-20.budget.golden +++ /dev/null @@ -1,3 +0,0 @@ -cpu: 34618709 -mem: 30301 -size: 312 \ No newline at end of file diff --git a/plutus-benchmark/script-contexts/test/V1/Data/9.6/checkScriptContext1-20.budget.golden b/plutus-benchmark/script-contexts/test/V1/Data/9.6/checkScriptContext1-20.budget.golden deleted file mode 100644 index dad9dffa043..00000000000 --- a/plutus-benchmark/script-contexts/test/V1/Data/9.6/checkScriptContext1-20.budget.golden +++ /dev/null @@ -1,3 +0,0 @@ -cpu: 20120713 -mem: 72450 -size: 92 \ No newline at end of file diff --git a/plutus-benchmark/script-contexts/test/V1/Data/9.6/checkScriptContext1-4.budget.golden b/plutus-benchmark/script-contexts/test/V1/Data/9.6/checkScriptContext1-4.budget.golden deleted file mode 100644 index f88b1d61d30..00000000000 --- a/plutus-benchmark/script-contexts/test/V1/Data/9.6/checkScriptContext1-4.budget.golden +++ /dev/null @@ -1,3 +0,0 @@ -cpu: 5544473 -mem: 19682 -size: 92 \ No newline at end of file diff --git a/plutus-benchmark/script-contexts/test/V1/Data/9.6/checkScriptContextEqualityData-20.budget.golden b/plutus-benchmark/script-contexts/test/V1/Data/9.6/checkScriptContextEqualityData-20.budget.golden deleted file mode 100644 index 961288703cc..00000000000 --- a/plutus-benchmark/script-contexts/test/V1/Data/9.6/checkScriptContextEqualityData-20.budget.golden +++ /dev/null @@ -1,3 +0,0 @@ -cpu: 30026709 -mem: 1601 -size: 25 \ No newline at end of file diff --git a/plutus-benchmark/script-contexts/test/V2/9.6/checkScriptContext1-20.budget.golden b/plutus-benchmark/script-contexts/test/V2/9.6/checkScriptContext1-20.budget.golden deleted file mode 100644 index 532fb1be9df..00000000000 --- a/plutus-benchmark/script-contexts/test/V2/9.6/checkScriptContext1-20.budget.golden +++ /dev/null @@ -1,3 +0,0 @@ -cpu: 268236778 -mem: 1019476 -size: 1539 \ No newline at end of file diff --git a/plutus-benchmark/script-contexts/test/V2/9.6/checkScriptContext1-4.budget.golden b/plutus-benchmark/script-contexts/test/V2/9.6/checkScriptContext1-4.budget.golden deleted file mode 100644 index ed6704c6aec..00000000000 --- a/plutus-benchmark/script-contexts/test/V2/9.6/checkScriptContext1-4.budget.golden +++ /dev/null @@ -1,3 +0,0 @@ -cpu: 75335066 -mem: 291348 -size: 1539 \ No newline at end of file diff --git a/plutus-benchmark/script-contexts/test/V2/9.6/checkScriptContext2-20.budget.golden b/plutus-benchmark/script-contexts/test/V2/9.6/checkScriptContext2-20.budget.golden deleted file mode 100644 index bde96196a60..00000000000 --- a/plutus-benchmark/script-contexts/test/V2/9.6/checkScriptContext2-20.budget.golden +++ /dev/null @@ -1,3 +0,0 @@ -cpu: 259980355 -mem: 981634 -size: 1477 \ No newline at end of file diff --git a/plutus-benchmark/script-contexts/test/V2/9.6/checkScriptContext2-4.budget.golden b/plutus-benchmark/script-contexts/test/V2/9.6/checkScriptContext2-4.budget.golden deleted file mode 100644 index fa6258640c8..00000000000 --- a/plutus-benchmark/script-contexts/test/V2/9.6/checkScriptContext2-4.budget.golden +++ /dev/null @@ -1,3 +0,0 @@ -cpu: 73049971 -mem: 280738 -size: 1477 \ No newline at end of file diff --git a/plutus-benchmark/script-contexts/test/V2/9.6/checkScriptContextEqualityData-20.budget.golden b/plutus-benchmark/script-contexts/test/V2/9.6/checkScriptContextEqualityData-20.budget.golden deleted file mode 100644 index 667bca96aa6..00000000000 --- a/plutus-benchmark/script-contexts/test/V2/9.6/checkScriptContextEqualityData-20.budget.golden +++ /dev/null @@ -1,3 +0,0 @@ -cpu: 37371261 -mem: 32501 -size: 334 \ No newline at end of file diff --git a/plutus-benchmark/script-contexts/test/V2/9.6/dataFwdStakeTrick.budget.golden b/plutus-benchmark/script-contexts/test/V2/9.6/dataFwdStakeTrick.budget.golden deleted file mode 100644 index 3117c73dd00..00000000000 --- a/plutus-benchmark/script-contexts/test/V2/9.6/dataFwdStakeTrick.budget.golden +++ /dev/null @@ -1,3 +0,0 @@ -cpu: 5578022 -mem: 9878 -size: 158 \ No newline at end of file diff --git a/plutus-benchmark/script-contexts/test/V2/9.6/dataFwdStakeTrick.size.golden b/plutus-benchmark/script-contexts/test/V2/9.6/dataFwdStakeTrick.size.golden deleted file mode 100644 index 147ea53ba1b..00000000000 --- a/plutus-benchmark/script-contexts/test/V2/9.6/dataFwdStakeTrick.size.golden +++ /dev/null @@ -1 +0,0 @@ -158 \ No newline at end of file diff --git a/plutus-benchmark/script-contexts/test/V2/9.6/dataFwdStakeTrickManual.budget.golden b/plutus-benchmark/script-contexts/test/V2/9.6/dataFwdStakeTrickManual.budget.golden deleted file mode 100644 index f1b2e95f661..00000000000 --- a/plutus-benchmark/script-contexts/test/V2/9.6/dataFwdStakeTrickManual.budget.golden +++ /dev/null @@ -1,3 +0,0 @@ -cpu: 5770022 -mem: 11078 -size: 174 \ No newline at end of file diff --git a/plutus-benchmark/script-contexts/test/V2/9.6/dataFwdStakeTrickManual.size.golden b/plutus-benchmark/script-contexts/test/V2/9.6/dataFwdStakeTrickManual.size.golden deleted file mode 100644 index 4a8d924028a..00000000000 --- a/plutus-benchmark/script-contexts/test/V2/9.6/dataFwdStakeTrickManual.size.golden +++ /dev/null @@ -1 +0,0 @@ -174 \ No newline at end of file diff --git a/plutus-benchmark/script-contexts/test/V2/9.6/sopFwdStakeTrick.budget.golden b/plutus-benchmark/script-contexts/test/V2/9.6/sopFwdStakeTrick.budget.golden deleted file mode 100644 index 75ba9f20c8f..00000000000 --- a/plutus-benchmark/script-contexts/test/V2/9.6/sopFwdStakeTrick.budget.golden +++ /dev/null @@ -1,3 +0,0 @@ -cpu: 335371977 -mem: 1258948 -size: 1699 \ No newline at end of file diff --git a/plutus-benchmark/script-contexts/test/V2/9.6/sopFwdStakeTrick.size.golden b/plutus-benchmark/script-contexts/test/V2/9.6/sopFwdStakeTrick.size.golden deleted file mode 100644 index 51474464464..00000000000 --- a/plutus-benchmark/script-contexts/test/V2/9.6/sopFwdStakeTrick.size.golden +++ /dev/null @@ -1 +0,0 @@ -1798 \ No newline at end of file diff --git a/plutus-benchmark/script-contexts/test/V2/Data/9.6/checkScriptContext1-20.budget.golden b/plutus-benchmark/script-contexts/test/V2/Data/9.6/checkScriptContext1-20.budget.golden deleted file mode 100644 index ab896947dc5..00000000000 --- a/plutus-benchmark/script-contexts/test/V2/Data/9.6/checkScriptContext1-20.budget.golden +++ /dev/null @@ -1,3 +0,0 @@ -cpu: 20250376 -mem: 72782 -size: 95 \ No newline at end of file diff --git a/plutus-benchmark/script-contexts/test/V2/Data/9.6/checkScriptContext1-4.budget.golden b/plutus-benchmark/script-contexts/test/V2/Data/9.6/checkScriptContext1-4.budget.golden deleted file mode 100644 index cad57334ccd..00000000000 --- a/plutus-benchmark/script-contexts/test/V2/Data/9.6/checkScriptContext1-4.budget.golden +++ /dev/null @@ -1,3 +0,0 @@ -cpu: 5674136 -mem: 20014 -size: 95 \ No newline at end of file diff --git a/plutus-benchmark/script-contexts/test/V2/Data/9.6/checkScriptContextEqualityData-20.budget.golden b/plutus-benchmark/script-contexts/test/V2/Data/9.6/checkScriptContextEqualityData-20.budget.golden deleted file mode 100644 index a9f33f8f356..00000000000 --- a/plutus-benchmark/script-contexts/test/V2/Data/9.6/checkScriptContextEqualityData-20.budget.golden +++ /dev/null @@ -1,3 +0,0 @@ -cpu: 32427261 -mem: 1601 -size: 25 \ No newline at end of file diff --git a/plutus-benchmark/script-contexts/test/V3/9.6/checkScriptContext1-20.budget.golden b/plutus-benchmark/script-contexts/test/V3/9.6/checkScriptContext1-20.budget.golden deleted file mode 100644 index 9be08c45c8d..00000000000 --- a/plutus-benchmark/script-contexts/test/V3/9.6/checkScriptContext1-20.budget.golden +++ /dev/null @@ -1,3 +0,0 @@ -cpu: 271439835 -mem: 1031489 -size: 2790 \ No newline at end of file diff --git a/plutus-benchmark/script-contexts/test/V3/9.6/checkScriptContext1-4.budget.golden b/plutus-benchmark/script-contexts/test/V3/9.6/checkScriptContext1-4.budget.golden deleted file mode 100644 index 129ce3cd43a..00000000000 --- a/plutus-benchmark/script-contexts/test/V3/9.6/checkScriptContext1-4.budget.golden +++ /dev/null @@ -1,3 +0,0 @@ -cpu: 79306123 -mem: 308161 -size: 2790 \ No newline at end of file diff --git a/plutus-benchmark/script-contexts/test/V3/9.6/checkScriptContext2-20.budget.golden b/plutus-benchmark/script-contexts/test/V3/9.6/checkScriptContext2-20.budget.golden deleted file mode 100644 index d2bd5cf27cc..00000000000 --- a/plutus-benchmark/script-contexts/test/V3/9.6/checkScriptContext2-20.budget.golden +++ /dev/null @@ -1,3 +0,0 @@ -cpu: 264015412 -mem: 998847 -size: 2723 \ No newline at end of file diff --git a/plutus-benchmark/script-contexts/test/V3/9.6/checkScriptContext2-4.budget.golden b/plutus-benchmark/script-contexts/test/V3/9.6/checkScriptContext2-4.budget.golden deleted file mode 100644 index 29418fdc622..00000000000 --- a/plutus-benchmark/script-contexts/test/V3/9.6/checkScriptContext2-4.budget.golden +++ /dev/null @@ -1,3 +0,0 @@ -cpu: 77085028 -mem: 297951 -size: 2723 \ No newline at end of file diff --git a/plutus-benchmark/script-contexts/test/V3/9.6/checkScriptContextEqualityData-20.budget.golden b/plutus-benchmark/script-contexts/test/V3/9.6/checkScriptContextEqualityData-20.budget.golden deleted file mode 100644 index 7e1e78872ce..00000000000 --- a/plutus-benchmark/script-contexts/test/V3/9.6/checkScriptContextEqualityData-20.budget.golden +++ /dev/null @@ -1,3 +0,0 @@ -cpu: 37958283 -mem: 33101 -size: 340 \ No newline at end of file diff --git a/plutus-benchmark/script-contexts/test/V3/Data/9.6/checkScriptContext1-20.budget.golden b/plutus-benchmark/script-contexts/test/V3/Data/9.6/checkScriptContext1-20.budget.golden deleted file mode 100644 index ab896947dc5..00000000000 --- a/plutus-benchmark/script-contexts/test/V3/Data/9.6/checkScriptContext1-20.budget.golden +++ /dev/null @@ -1,3 +0,0 @@ -cpu: 20250376 -mem: 72782 -size: 95 \ No newline at end of file diff --git a/plutus-benchmark/script-contexts/test/V3/Data/9.6/checkScriptContext1-4.budget.golden b/plutus-benchmark/script-contexts/test/V3/Data/9.6/checkScriptContext1-4.budget.golden deleted file mode 100644 index cad57334ccd..00000000000 --- a/plutus-benchmark/script-contexts/test/V3/Data/9.6/checkScriptContext1-4.budget.golden +++ /dev/null @@ -1,3 +0,0 @@ -cpu: 5674136 -mem: 20014 -size: 95 \ No newline at end of file diff --git a/plutus-benchmark/script-contexts/test/V3/Data/9.6/checkScriptContextEqualityData-20.budget.golden b/plutus-benchmark/script-contexts/test/V3/Data/9.6/checkScriptContextEqualityData-20.budget.golden deleted file mode 100644 index 025497bc7db..00000000000 --- a/plutus-benchmark/script-contexts/test/V3/Data/9.6/checkScriptContextEqualityData-20.budget.golden +++ /dev/null @@ -1,3 +0,0 @@ -cpu: 32918283 -mem: 1601 -size: 25 \ No newline at end of file diff --git a/plutus-benchmark/script-contexts/test/V3/Data/9.6/purposeIsWellFormed-4.budget.golden b/plutus-benchmark/script-contexts/test/V3/Data/9.6/purposeIsWellFormed-4.budget.golden deleted file mode 100644 index 9442a3b90d2..00000000000 --- a/plutus-benchmark/script-contexts/test/V3/Data/9.6/purposeIsWellFormed-4.budget.golden +++ /dev/null @@ -1,3 +0,0 @@ -cpu: 60455049 -mem: 281482 -size: 2317 \ No newline at end of file diff --git a/plutus-core/plutus-core/test/TypeSynthesis/Golden/DefaultFun/LengthArray.plc.golden b/plutus-core/plutus-core/test/TypeSynthesis/Golden/DefaultFun/LengthArray.plc.golden deleted file mode 100644 index b23049d3e57..00000000000 --- a/plutus-core/plutus-core/test/TypeSynthesis/Golden/DefaultFun/LengthArray.plc.golden +++ /dev/null @@ -1 +0,0 @@ -all a. array a -> integer \ No newline at end of file diff --git a/plutus-core/plutus-core/test/TypeSynthesis/Golden/DefaultFun/ReplicateByteString.plc.golden b/plutus-core/plutus-core/test/TypeSynthesis/Golden/DefaultFun/ReplicateByteString.plc.golden deleted file mode 100644 index fcb192a96ed..00000000000 --- a/plutus-core/plutus-core/test/TypeSynthesis/Golden/DefaultFun/ReplicateByteString.plc.golden +++ /dev/null @@ -1 +0,0 @@ -integer -> integer -> bytestring \ No newline at end of file diff --git a/plutus-core/plutus-core/test/TypeSynthesis/Golden/Signatures/DefaultFun/LengthArray.sig.golden b/plutus-core/plutus-core/test/TypeSynthesis/Golden/Signatures/DefaultFun/LengthArray.sig.golden deleted file mode 100644 index 20832479b51..00000000000 --- a/plutus-core/plutus-core/test/TypeSynthesis/Golden/Signatures/DefaultFun/LengthArray.sig.golden +++ /dev/null @@ -1 +0,0 @@ -forall a. SomeConstant DefaultUni (Vector (TyVarRep * ('TyNameRep * "a" 0))) -> BuiltinResult Int \ No newline at end of file diff --git a/plutus-core/plutus-core/test/TypeSynthesis/Golden/StdLib/Data/Data/caseData.plc.golden b/plutus-core/plutus-core/test/TypeSynthesis/Golden/StdLib/Data/Data/caseData.plc.golden deleted file mode 100644 index 5ce0b8a3b29..00000000000 --- a/plutus-core/plutus-core/test/TypeSynthesis/Golden/StdLib/Data/Data/caseData.plc.golden +++ /dev/null @@ -1,8 +0,0 @@ -data -> -(all r. - (integer -> list data -> r) -> - (list (pair data data) -> r) -> - (list data -> r) -> - (integer -> r) -> - (bytestring -> r) -> - r) \ No newline at end of file diff --git a/plutus-core/plutus-core/test/TypeSynthesis/Golden/StdLib/Data/List/CaseList.plc.golden b/plutus-core/plutus-core/test/TypeSynthesis/Golden/StdLib/Data/List/CaseList.plc.golden deleted file mode 100644 index 09576be9197..00000000000 --- a/plutus-core/plutus-core/test/TypeSynthesis/Golden/StdLib/Data/List/CaseList.plc.golden +++ /dev/null @@ -1 +0,0 @@ -all a. list a -> (all r. r -> (a -> list a -> r) -> r) \ No newline at end of file diff --git a/plutus-core/untyped-plutus-core/test/Transform/inlineImpure5.uplc.golden b/plutus-core/untyped-plutus-core/test/Transform/inlineImpure5.uplc.golden deleted file mode 100644 index 44a1d93663b..00000000000 --- a/plutus-core/untyped-plutus-core/test/Transform/inlineImpure5.uplc.golden +++ /dev/null @@ -1 +0,0 @@ -\a -> addInteger (addInteger 1 a) (addInteger 3 a) \ No newline at end of file diff --git a/plutus-ledger-api/test-plugin/Spec/Budget/9.6/currencySymbolValueOf.budget.golden b/plutus-ledger-api/test-plugin/Spec/Budget/9.6/currencySymbolValueOf.budget.golden deleted file mode 100644 index bd8c8a0491f..00000000000 --- a/plutus-ledger-api/test-plugin/Spec/Budget/9.6/currencySymbolValueOf.budget.golden +++ /dev/null @@ -1,3 +0,0 @@ -cpu: 7152564 -mem: 39918 -size: 182 \ No newline at end of file diff --git a/plutus-ledger-api/test-plugin/Spec/Budget/9.6/geq1.budget.golden b/plutus-ledger-api/test-plugin/Spec/Budget/9.6/geq1.budget.golden deleted file mode 100644 index 2567bb57643..00000000000 --- a/plutus-ledger-api/test-plugin/Spec/Budget/9.6/geq1.budget.golden +++ /dev/null @@ -1,3 +0,0 @@ -cpu: 98753050 -mem: 594715 -size: 600 \ No newline at end of file diff --git a/plutus-ledger-api/test-plugin/Spec/Budget/9.6/geq2.budget.golden b/plutus-ledger-api/test-plugin/Spec/Budget/9.6/geq2.budget.golden deleted file mode 100644 index 2113d8daff9..00000000000 --- a/plutus-ledger-api/test-plugin/Spec/Budget/9.6/geq2.budget.golden +++ /dev/null @@ -1,3 +0,0 @@ -cpu: 106098020 -mem: 639421 -size: 628 \ No newline at end of file diff --git a/plutus-ledger-api/test-plugin/Spec/Budget/9.6/geq3.budget.golden b/plutus-ledger-api/test-plugin/Spec/Budget/9.6/geq3.budget.golden deleted file mode 100644 index 24a50db2d63..00000000000 --- a/plutus-ledger-api/test-plugin/Spec/Budget/9.6/geq3.budget.golden +++ /dev/null @@ -1,3 +0,0 @@ -cpu: 108740470 -mem: 654526 -size: 628 \ No newline at end of file diff --git a/plutus-ledger-api/test-plugin/Spec/Budget/9.6/geq4.budget.golden b/plutus-ledger-api/test-plugin/Spec/Budget/9.6/geq4.budget.golden deleted file mode 100644 index f70e70b693b..00000000000 --- a/plutus-ledger-api/test-plugin/Spec/Budget/9.6/geq4.budget.golden +++ /dev/null @@ -1,3 +0,0 @@ -cpu: 95871338 -mem: 578410 -size: 604 \ No newline at end of file diff --git a/plutus-ledger-api/test-plugin/Spec/Budget/9.6/geq5.budget.golden b/plutus-ledger-api/test-plugin/Spec/Budget/9.6/geq5.budget.golden deleted file mode 100644 index 50a11da6203..00000000000 --- a/plutus-ledger-api/test-plugin/Spec/Budget/9.6/geq5.budget.golden +++ /dev/null @@ -1,3 +0,0 @@ -cpu: 101718948 -mem: 612419 -size: 604 \ No newline at end of file diff --git a/plutus-ledger-api/test-plugin/Spec/Budget/9.6/gt1.budget.golden b/plutus-ledger-api/test-plugin/Spec/Budget/9.6/gt1.budget.golden deleted file mode 100644 index 3df2f433865..00000000000 --- a/plutus-ledger-api/test-plugin/Spec/Budget/9.6/gt1.budget.golden +++ /dev/null @@ -1,3 +0,0 @@ -cpu: 122592765 -mem: 735150 -size: 951 \ No newline at end of file diff --git a/plutus-ledger-api/test-plugin/Spec/Budget/9.6/gt2.budget.golden b/plutus-ledger-api/test-plugin/Spec/Budget/9.6/gt2.budget.golden deleted file mode 100644 index 5c88f924470..00000000000 --- a/plutus-ledger-api/test-plugin/Spec/Budget/9.6/gt2.budget.golden +++ /dev/null @@ -1,3 +0,0 @@ -cpu: 106306020 -mem: 640721 -size: 979 \ No newline at end of file diff --git a/plutus-ledger-api/test-plugin/Spec/Budget/9.6/gt3.budget.golden b/plutus-ledger-api/test-plugin/Spec/Budget/9.6/gt3.budget.golden deleted file mode 100644 index c65546ece54..00000000000 --- a/plutus-ledger-api/test-plugin/Spec/Budget/9.6/gt3.budget.golden +++ /dev/null @@ -1,3 +0,0 @@ -cpu: 133272518 -mem: 798962 -size: 979 \ No newline at end of file diff --git a/plutus-ledger-api/test-plugin/Spec/Budget/9.6/gt4.budget.golden b/plutus-ledger-api/test-plugin/Spec/Budget/9.6/gt4.budget.golden deleted file mode 100644 index 1c87c6bd74d..00000000000 --- a/plutus-ledger-api/test-plugin/Spec/Budget/9.6/gt4.budget.golden +++ /dev/null @@ -1,3 +0,0 @@ -cpu: 96079338 -mem: 579710 -size: 955 \ No newline at end of file diff --git a/plutus-ledger-api/test-plugin/Spec/Budget/9.6/gt5.budget.golden b/plutus-ledger-api/test-plugin/Spec/Budget/9.6/gt5.budget.golden deleted file mode 100644 index efef65ee9a0..00000000000 --- a/plutus-ledger-api/test-plugin/Spec/Budget/9.6/gt5.budget.golden +++ /dev/null @@ -1,3 +0,0 @@ -cpu: 113631103 -mem: 682935 -size: 955 \ No newline at end of file diff --git a/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/currencySymbolValueOf.budget.golden b/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/currencySymbolValueOf.budget.golden deleted file mode 100644 index 126e220b233..00000000000 --- a/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/currencySymbolValueOf.budget.golden +++ /dev/null @@ -1,3 +0,0 @@ -cpu: 22014868 -mem: 61274 -size: 111 \ No newline at end of file diff --git a/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/geq1.budget.golden b/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/geq1.budget.golden deleted file mode 100644 index f13233716b0..00000000000 --- a/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/geq1.budget.golden +++ /dev/null @@ -1,3 +0,0 @@ -cpu: 581291535 -mem: 1732825 -size: 743 \ No newline at end of file diff --git a/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/geq2.budget.golden b/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/geq2.budget.golden deleted file mode 100644 index b380f1d7202..00000000000 --- a/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/geq2.budget.golden +++ /dev/null @@ -1,3 +0,0 @@ -cpu: 614410994 -mem: 1844735 -size: 743 \ No newline at end of file diff --git a/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/geq3.budget.golden b/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/geq3.budget.golden deleted file mode 100644 index e3a5ac5e3df..00000000000 --- a/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/geq3.budget.golden +++ /dev/null @@ -1,3 +0,0 @@ -cpu: 641372902 -mem: 1931808 -size: 743 \ No newline at end of file diff --git a/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/geq4.budget.golden b/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/geq4.budget.golden deleted file mode 100644 index f6ac0f1c6be..00000000000 --- a/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/geq4.budget.golden +++ /dev/null @@ -1,3 +0,0 @@ -cpu: 561120600 -mem: 1643047 -size: 743 \ No newline at end of file diff --git a/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/geq5.budget.golden b/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/geq5.budget.golden deleted file mode 100644 index 48c2e8c23ad..00000000000 --- a/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/geq5.budget.golden +++ /dev/null @@ -1,3 +0,0 @@ -cpu: 602663630 -mem: 1794825 -size: 743 \ No newline at end of file diff --git a/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/gt1.budget.golden b/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/gt1.budget.golden deleted file mode 100644 index 149d999dcd2..00000000000 --- a/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/gt1.budget.golden +++ /dev/null @@ -1,3 +0,0 @@ -cpu: 677763628 -mem: 2048824 -size: 1184 \ No newline at end of file diff --git a/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/gt2.budget.golden b/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/gt2.budget.golden deleted file mode 100644 index e4254ddff07..00000000000 --- a/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/gt2.budget.golden +++ /dev/null @@ -1,3 +0,0 @@ -cpu: 614666994 -mem: 1846335 -size: 1184 \ No newline at end of file diff --git a/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/gt3.budget.golden b/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/gt3.budget.golden deleted file mode 100644 index 085f965a1c2..00000000000 --- a/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/gt3.budget.golden +++ /dev/null @@ -1,3 +0,0 @@ -cpu: 740795106 -mem: 2259492 -size: 1184 \ No newline at end of file diff --git a/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/gt4.budget.golden b/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/gt4.budget.golden deleted file mode 100644 index 1fa1671c36c..00000000000 --- a/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/gt4.budget.golden +++ /dev/null @@ -1,3 +0,0 @@ -cpu: 561376600 -mem: 1644647 -size: 1184 \ No newline at end of file diff --git a/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/gt5.budget.golden b/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/gt5.budget.golden deleted file mode 100644 index ccd86d2d58b..00000000000 --- a/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/gt5.budget.golden +++ /dev/null @@ -1,3 +0,0 @@ -cpu: 648647326 -mem: 1948813 -size: 1184 \ No newline at end of file diff --git a/plutus-tx-plugin/test/AsData/Budget/9.6/destructSum-manual.budget.golden b/plutus-tx-plugin/test/AsData/Budget/9.6/destructSum-manual.budget.golden deleted file mode 100644 index 972d979fab0..00000000000 --- a/plutus-tx-plugin/test/AsData/Budget/9.6/destructSum-manual.budget.golden +++ /dev/null @@ -1,3 +0,0 @@ -cpu: 6917121 -mem: 25322 -size: 221 \ No newline at end of file diff --git a/plutus-tx-plugin/test/AsData/Budget/9.6/destructSum.budget.golden b/plutus-tx-plugin/test/AsData/Budget/9.6/destructSum.budget.golden deleted file mode 100644 index d2820736da1..00000000000 --- a/plutus-tx-plugin/test/AsData/Budget/9.6/destructSum.budget.golden +++ /dev/null @@ -1,3 +0,0 @@ -cpu: 6937454 -mem: 25123 -size: 219 \ No newline at end of file diff --git a/plutus-tx-plugin/test/AsData/Budget/9.6/patternMatching.budget.golden b/plutus-tx-plugin/test/AsData/Budget/9.6/patternMatching.budget.golden deleted file mode 100644 index 49ee0f3f3ef..00000000000 --- a/plutus-tx-plugin/test/AsData/Budget/9.6/patternMatching.budget.golden +++ /dev/null @@ -1,3 +0,0 @@ -cpu: 3951113 -mem: 12540 -size: 132 \ No newline at end of file diff --git a/plutus-tx-plugin/test/AsData/Budget/9.6/recordFields.budget.golden b/plutus-tx-plugin/test/AsData/Budget/9.6/recordFields.budget.golden deleted file mode 100644 index 7ef84cd6562..00000000000 --- a/plutus-tx-plugin/test/AsData/Budget/9.6/recordFields.budget.golden +++ /dev/null @@ -1,3 +0,0 @@ -cpu: 9744548 -mem: 34488 -size: 181 \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/allCheap.budget.golden b/plutus-tx-plugin/test/Budget/9.6/allCheap.budget.golden deleted file mode 100644 index 02a721aca40..00000000000 --- a/plutus-tx-plugin/test/Budget/9.6/allCheap.budget.golden +++ /dev/null @@ -1,3 +0,0 @@ -cpu: 747937 -mem: 4501 -size: 52 \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/allEmptyList.budget.golden b/plutus-tx-plugin/test/Budget/9.6/allEmptyList.budget.golden deleted file mode 100644 index d23afb2335a..00000000000 --- a/plutus-tx-plugin/test/Budget/9.6/allEmptyList.budget.golden +++ /dev/null @@ -1,3 +0,0 @@ -cpu: 224100 -mem: 1500 -size: 32 \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/allExpensive.budget.golden b/plutus-tx-plugin/test/Budget/9.6/allExpensive.budget.golden deleted file mode 100644 index 9b388836ea9..00000000000 --- a/plutus-tx-plugin/test/Budget/9.6/allExpensive.budget.golden +++ /dev/null @@ -1,3 +0,0 @@ -cpu: 4182470 -mem: 23510 -size: 52 \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/andWithGHCOpts.budget.golden b/plutus-tx-plugin/test/Budget/9.6/andWithGHCOpts.budget.golden deleted file mode 100644 index fcac83f24f9..00000000000 --- a/plutus-tx-plugin/test/Budget/9.6/andWithGHCOpts.budget.golden +++ /dev/null @@ -1,3 +0,0 @@ -cpu: 285390 -mem: 1601 -size: 24 \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/andWithLocal.budget.golden b/plutus-tx-plugin/test/Budget/9.6/andWithLocal.budget.golden deleted file mode 100644 index fcac83f24f9..00000000000 --- a/plutus-tx-plugin/test/Budget/9.6/andWithLocal.budget.golden +++ /dev/null @@ -1,3 +0,0 @@ -cpu: 285390 -mem: 1601 -size: 24 \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/andWithoutGHCOpts.budget.golden b/plutus-tx-plugin/test/Budget/9.6/andWithoutGHCOpts.budget.golden deleted file mode 100644 index bac5fa9cc99..00000000000 --- a/plutus-tx-plugin/test/Budget/9.6/andWithoutGHCOpts.budget.golden +++ /dev/null @@ -1,3 +0,0 @@ -cpu: 317390 -mem: 1801 -size: 27 \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/anyCheap.budget.golden b/plutus-tx-plugin/test/Budget/9.6/anyCheap.budget.golden deleted file mode 100644 index 02a721aca40..00000000000 --- a/plutus-tx-plugin/test/Budget/9.6/anyCheap.budget.golden +++ /dev/null @@ -1,3 +0,0 @@ -cpu: 747937 -mem: 4501 -size: 52 \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/anyEmptyList.budget.golden b/plutus-tx-plugin/test/Budget/9.6/anyEmptyList.budget.golden deleted file mode 100644 index d23afb2335a..00000000000 --- a/plutus-tx-plugin/test/Budget/9.6/anyEmptyList.budget.golden +++ /dev/null @@ -1,3 +0,0 @@ -cpu: 224100 -mem: 1500 -size: 32 \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/anyExpensive.budget.golden b/plutus-tx-plugin/test/Budget/9.6/anyExpensive.budget.golden deleted file mode 100644 index 9b388836ea9..00000000000 --- a/plutus-tx-plugin/test/Budget/9.6/anyExpensive.budget.golden +++ /dev/null @@ -1,3 +0,0 @@ -cpu: 4182470 -mem: 23510 -size: 52 \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/builtinListIndexing.budget.golden b/plutus-tx-plugin/test/Budget/9.6/builtinListIndexing.budget.golden deleted file mode 100644 index 5803b941e0b..00000000000 --- a/plutus-tx-plugin/test/Budget/9.6/builtinListIndexing.budget.golden +++ /dev/null @@ -1,2 +0,0 @@ -({cpu: 7464913 -| mem: 30924}) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/constAccL.budget.golden b/plutus-tx-plugin/test/Budget/9.6/constAccL.budget.golden deleted file mode 100644 index b955b5aa813..00000000000 --- a/plutus-tx-plugin/test/Budget/9.6/constAccL.budget.golden +++ /dev/null @@ -1,3 +0,0 @@ -cpu: 753728937 -mem: 3807101 -size: 65 \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/constAccR.budget.golden b/plutus-tx-plugin/test/Budget/9.6/constAccR.budget.golden deleted file mode 100644 index cf67582fdb3..00000000000 --- a/plutus-tx-plugin/test/Budget/9.6/constAccR.budget.golden +++ /dev/null @@ -1,3 +0,0 @@ -cpu: 705584937 -mem: 3506201 -size: 54 \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/constElL.budget.golden b/plutus-tx-plugin/test/Budget/9.6/constElL.budget.golden deleted file mode 100644 index b955b5aa813..00000000000 --- a/plutus-tx-plugin/test/Budget/9.6/constElL.budget.golden +++ /dev/null @@ -1,3 +0,0 @@ -cpu: 753728937 -mem: 3807101 -size: 65 \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/constElR.budget.golden b/plutus-tx-plugin/test/Budget/9.6/constElR.budget.golden deleted file mode 100644 index 997a58e2a52..00000000000 --- a/plutus-tx-plugin/test/Budget/9.6/constElR.budget.golden +++ /dev/null @@ -1,3 +0,0 @@ -cpu: 753584937 -mem: 3806201 -size: 57 \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/elemCheap.budget.golden b/plutus-tx-plugin/test/Budget/9.6/elemCheap.budget.golden deleted file mode 100644 index b524214960d..00000000000 --- a/plutus-tx-plugin/test/Budget/9.6/elemCheap.budget.golden +++ /dev/null @@ -1,3 +0,0 @@ -cpu: 756433 -mem: 4501 -size: 52 \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/elemExpensive.budget.golden b/plutus-tx-plugin/test/Budget/9.6/elemExpensive.budget.golden deleted file mode 100644 index 3b06cfd5129..00000000000 --- a/plutus-tx-plugin/test/Budget/9.6/elemExpensive.budget.golden +++ /dev/null @@ -1,3 +0,0 @@ -cpu: 4267430 -mem: 23510 -size: 52 \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/filter.budget.golden b/plutus-tx-plugin/test/Budget/9.6/filter.budget.golden deleted file mode 100644 index 59d58980ea0..00000000000 --- a/plutus-tx-plugin/test/Budget/9.6/filter.budget.golden +++ /dev/null @@ -1,3 +0,0 @@ -cpu: 6866730 -mem: 31520 -size: 61 \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/findCheap.budget.golden b/plutus-tx-plugin/test/Budget/9.6/findCheap.budget.golden deleted file mode 100644 index 6f260fe7c7b..00000000000 --- a/plutus-tx-plugin/test/Budget/9.6/findCheap.budget.golden +++ /dev/null @@ -1,3 +0,0 @@ -cpu: 763937 -mem: 4601 -size: 53 \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/findEmptyList.budget.golden b/plutus-tx-plugin/test/Budget/9.6/findEmptyList.budget.golden deleted file mode 100644 index 448bce0bcb1..00000000000 --- a/plutus-tx-plugin/test/Budget/9.6/findEmptyList.budget.golden +++ /dev/null @@ -1,3 +0,0 @@ -cpu: 224100 -mem: 1500 -size: 33 \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/findExpensive.budget.golden b/plutus-tx-plugin/test/Budget/9.6/findExpensive.budget.golden deleted file mode 100644 index 7837889275c..00000000000 --- a/plutus-tx-plugin/test/Budget/9.6/findExpensive.budget.golden +++ /dev/null @@ -1,3 +0,0 @@ -cpu: 4182470 -mem: 23510 -size: 53 \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/findIndexCheap.budget.golden b/plutus-tx-plugin/test/Budget/9.6/findIndexCheap.budget.golden deleted file mode 100644 index 3b32d47d92a..00000000000 --- a/plutus-tx-plugin/test/Budget/9.6/findIndexCheap.budget.golden +++ /dev/null @@ -1,3 +0,0 @@ -cpu: 811937 -mem: 4901 -size: 65 \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/findIndexEmptyList.budget.golden b/plutus-tx-plugin/test/Budget/9.6/findIndexEmptyList.budget.golden deleted file mode 100644 index 676dca50f93..00000000000 --- a/plutus-tx-plugin/test/Budget/9.6/findIndexEmptyList.budget.golden +++ /dev/null @@ -1,3 +0,0 @@ -cpu: 272100 -mem: 1800 -size: 45 \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/findIndexExpensive.budget.golden b/plutus-tx-plugin/test/Budget/9.6/findIndexExpensive.budget.golden deleted file mode 100644 index 8090729c711..00000000000 --- a/plutus-tx-plugin/test/Budget/9.6/findIndexExpensive.budget.golden +++ /dev/null @@ -1,3 +0,0 @@ -cpu: 6842550 -mem: 33830 -size: 65 \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/gte0.budget.golden b/plutus-tx-plugin/test/Budget/9.6/gte0.budget.golden deleted file mode 100644 index b4474c88614..00000000000 --- a/plutus-tx-plugin/test/Budget/9.6/gte0.budget.golden +++ /dev/null @@ -1,3 +0,0 @@ -cpu: 878874937 -mem: 4307201 -size: 64 \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/listIndexing.budget.golden b/plutus-tx-plugin/test/Budget/9.6/listIndexing.budget.golden deleted file mode 100644 index f66affeca48..00000000000 --- a/plutus-tx-plugin/test/Budget/9.6/listIndexing.budget.golden +++ /dev/null @@ -1,3 +0,0 @@ -cpu: 4068138 -mem: 20416 -size: 78 \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/lte0.budget.golden b/plutus-tx-plugin/test/Budget/9.6/lte0.budget.golden deleted file mode 100644 index 12684874709..00000000000 --- a/plutus-tx-plugin/test/Budget/9.6/lte0.budget.golden +++ /dev/null @@ -1,3 +0,0 @@ -cpu: 877421937 -mem: 4307201 -size: 64 \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/map1.budget.golden b/plutus-tx-plugin/test/Budget/9.6/map1.budget.golden deleted file mode 100644 index 661ad82c68b..00000000000 --- a/plutus-tx-plugin/test/Budget/9.6/map1.budget.golden +++ /dev/null @@ -1,3 +0,0 @@ -cpu: 240975571 -mem: 597654 -size: 374 \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/map2.budget.golden b/plutus-tx-plugin/test/Budget/9.6/map2.budget.golden deleted file mode 100644 index 86d2df31c5d..00000000000 --- a/plutus-tx-plugin/test/Budget/9.6/map2.budget.golden +++ /dev/null @@ -1,3 +0,0 @@ -cpu: 117670947 -mem: 355550 -size: 464 \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/map3.budget.golden b/plutus-tx-plugin/test/Budget/9.6/map3.budget.golden deleted file mode 100644 index 2d0bb794126..00000000000 --- a/plutus-tx-plugin/test/Budget/9.6/map3.budget.golden +++ /dev/null @@ -1,3 +0,0 @@ -cpu: 186059840 -mem: 563917 -size: 755 \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/matchAsDataE.budget.golden b/plutus-tx-plugin/test/Budget/9.6/matchAsDataE.budget.golden deleted file mode 100644 index 2c97206643f..00000000000 --- a/plutus-tx-plugin/test/Budget/9.6/matchAsDataE.budget.golden +++ /dev/null @@ -1,3 +0,0 @@ -cpu: 1040802 -mem: 3861 -size: 72 \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/not-not.budget.golden b/plutus-tx-plugin/test/Budget/9.6/not-not.budget.golden deleted file mode 100644 index c6e55da8aa7..00000000000 --- a/plutus-tx-plugin/test/Budget/9.6/not-not.budget.golden +++ /dev/null @@ -1,3 +0,0 @@ -cpu: 301390 -mem: 1701 -size: 20 \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/notElemCheap.budget.golden b/plutus-tx-plugin/test/Budget/9.6/notElemCheap.budget.golden deleted file mode 100644 index b524214960d..00000000000 --- a/plutus-tx-plugin/test/Budget/9.6/notElemCheap.budget.golden +++ /dev/null @@ -1,3 +0,0 @@ -cpu: 756433 -mem: 4501 -size: 52 \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/notElemExpensive.budget.golden b/plutus-tx-plugin/test/Budget/9.6/notElemExpensive.budget.golden deleted file mode 100644 index 3b06cfd5129..00000000000 --- a/plutus-tx-plugin/test/Budget/9.6/notElemExpensive.budget.golden +++ /dev/null @@ -1,3 +0,0 @@ -cpu: 4267430 -mem: 23510 -size: 52 \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/recursiveGte0.budget.golden b/plutus-tx-plugin/test/Budget/9.6/recursiveGte0.budget.golden deleted file mode 100644 index c334181adeb..00000000000 --- a/plutus-tx-plugin/test/Budget/9.6/recursiveGte0.budget.golden +++ /dev/null @@ -1,3 +0,0 @@ -cpu: 1087146937 -mem: 5608901 -size: 96 \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/recursiveLte0.budget.golden b/plutus-tx-plugin/test/Budget/9.6/recursiveLte0.budget.golden deleted file mode 100644 index 12790d28824..00000000000 --- a/plutus-tx-plugin/test/Budget/9.6/recursiveLte0.budget.golden +++ /dev/null @@ -1,3 +0,0 @@ -cpu: 1085693937 -mem: 5608901 -size: 96 \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/show.budget.golden b/plutus-tx-plugin/test/Budget/9.6/show.budget.golden deleted file mode 100644 index a4090ed0272..00000000000 --- a/plutus-tx-plugin/test/Budget/9.6/show.budget.golden +++ /dev/null @@ -1,3 +0,0 @@ -cpu: 1116089311 -mem: 5049568 -size: 767 \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/sumL.budget.golden b/plutus-tx-plugin/test/Budget/9.6/sumL.budget.golden deleted file mode 100644 index 28b8b23f96f..00000000000 --- a/plutus-tx-plugin/test/Budget/9.6/sumL.budget.golden +++ /dev/null @@ -1,3 +0,0 @@ -cpu: 1014984937 -mem: 4809401 -size: 77 \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/sumR.budget.golden b/plutus-tx-plugin/test/Budget/9.6/sumR.budget.golden deleted file mode 100644 index 1d33c88283e..00000000000 --- a/plutus-tx-plugin/test/Budget/9.6/sumR.budget.golden +++ /dev/null @@ -1,3 +0,0 @@ -cpu: 918840937 -mem: 4208501 -size: 63 \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/toFromData.budget.golden b/plutus-tx-plugin/test/Budget/9.6/toFromData.budget.golden deleted file mode 100644 index 8456ec417ce..00000000000 --- a/plutus-tx-plugin/test/Budget/9.6/toFromData.budget.golden +++ /dev/null @@ -1,3 +0,0 @@ -cpu: 6732521 -mem: 24432 -size: 284 \ No newline at end of file diff --git a/plutus-tx-plugin/test/BuiltinList/Budget/9.6/all.budget.golden b/plutus-tx-plugin/test/BuiltinList/Budget/9.6/all.budget.golden deleted file mode 100644 index 08e7a06bb98..00000000000 --- a/plutus-tx-plugin/test/BuiltinList/Budget/9.6/all.budget.golden +++ /dev/null @@ -1,3 +0,0 @@ -cpu: 11715161 -mem: 49999 -size: 76 \ No newline at end of file diff --git a/plutus-tx-plugin/test/BuiltinList/Budget/9.6/any.budget.golden b/plutus-tx-plugin/test/BuiltinList/Budget/9.6/any.budget.golden deleted file mode 100644 index b4e14a8e3a3..00000000000 --- a/plutus-tx-plugin/test/BuiltinList/Budget/9.6/any.budget.golden +++ /dev/null @@ -1,3 +0,0 @@ -cpu: 18708840 -mem: 79378 -size: 76 \ No newline at end of file diff --git a/plutus-tx-plugin/test/BuiltinList/Budget/9.6/elem.budget.golden b/plutus-tx-plugin/test/BuiltinList/Budget/9.6/elem.budget.golden deleted file mode 100644 index 68d8e6b498e..00000000000 --- a/plutus-tx-plugin/test/BuiltinList/Budget/9.6/elem.budget.golden +++ /dev/null @@ -1,3 +0,0 @@ -cpu: 19795614 -mem: 85378 -size: 85 \ No newline at end of file diff --git a/plutus-tx-plugin/test/BuiltinList/Budget/9.6/find.budget.golden b/plutus-tx-plugin/test/BuiltinList/Budget/9.6/find.budget.golden deleted file mode 100644 index d51a006c742..00000000000 --- a/plutus-tx-plugin/test/BuiltinList/Budget/9.6/find.budget.golden +++ /dev/null @@ -1,3 +0,0 @@ -cpu: 18724840 -mem: 79478 -size: 77 \ No newline at end of file diff --git a/plutus-tx-plugin/test/BuiltinList/Budget/9.6/index.budget.golden b/plutus-tx-plugin/test/BuiltinList/Budget/9.6/index.budget.golden deleted file mode 100644 index 54187455585..00000000000 --- a/plutus-tx-plugin/test/BuiltinList/Budget/9.6/index.budget.golden +++ /dev/null @@ -1,3 +0,0 @@ -cpu: 7406980 -mem: 30692 -size: 77 \ No newline at end of file diff --git a/plutus-tx-plugin/test/DataList/Budget/9.6/any.budget.golden b/plutus-tx-plugin/test/DataList/Budget/9.6/any.budget.golden deleted file mode 100644 index cc6c201a03d..00000000000 --- a/plutus-tx-plugin/test/DataList/Budget/9.6/any.budget.golden +++ /dev/null @@ -1,3 +0,0 @@ -cpu: 7934828 -mem: 32532 -size: 55 \ No newline at end of file diff --git a/plutus-tx-plugin/test/DataList/Budget/9.6/elem.budget.golden b/plutus-tx-plugin/test/DataList/Budget/9.6/elem.budget.golden deleted file mode 100644 index cb0ac910d2c..00000000000 --- a/plutus-tx-plugin/test/DataList/Budget/9.6/elem.budget.golden +++ /dev/null @@ -1,3 +0,0 @@ -cpu: 15426900 -mem: 30676 -size: 53 \ No newline at end of file diff --git a/plutus-tx-plugin/test/DataList/Budget/9.6/filter.budget.golden b/plutus-tx-plugin/test/DataList/Budget/9.6/filter.budget.golden deleted file mode 100644 index 8b33df5943d..00000000000 --- a/plutus-tx-plugin/test/DataList/Budget/9.6/filter.budget.golden +++ /dev/null @@ -1,3 +0,0 @@ -cpu: 11010487 -mem: 45214 -size: 69 \ No newline at end of file diff --git a/plutus-tx-plugin/test/DataList/Budget/9.6/partition.budget.golden b/plutus-tx-plugin/test/DataList/Budget/9.6/partition.budget.golden deleted file mode 100644 index bd579daa0eb..00000000000 --- a/plutus-tx-plugin/test/DataList/Budget/9.6/partition.budget.golden +++ /dev/null @@ -1,3 +0,0 @@ -cpu: 12735124 -mem: 53242 -size: 72 \ No newline at end of file From b5aff7195685216f520b87023d218bd10ea8ad1a Mon Sep 17 00:00:00 2001 From: effectfully Date: Mon, 2 Jun 2025 20:55:48 +0100 Subject: [PATCH 12/25] Remove 'term' from 'CaseBuiltin' --- .../src/PlutusCore/Builtin/Case.hs | 7 ++- .../src/PlutusCore/Compiler/Types.hs | 3 +- .../src/PlutusCore/Default/Universe.hs | 3 +- .../plutus-ir/src/PlutusIR/Compiler/Types.hs | 2 +- .../src/PlutusIR/Transform/CaseReduce.hs | 6 +-- plutus-core/testlib/PlutusCore/Test.hs | 2 +- plutus-core/testlib/PlutusIR/Test.hs | 8 ++- .../Evaluation/Machine/Cek.hs | 10 ++-- .../Evaluation/Machine/Cek/Internal.hs | 4 +- .../Evaluation/Machine/SteppableCek.hs | 10 ++-- .../Machine/SteppableCek/Internal.hs | 16 +++--- .../UntypedPlutusCore/Transform/CaseOfCase.hs | 6 +-- .../UntypedPlutusCore/Transform/CaseReduce.hs | 4 +- .../testlib/Evaluation/Builtins/Common.hs | 6 +-- plutus-tx/src/PlutusTx/Lift.hs | 50 +++++++------------ plutus-tx/testlib/PlutusTx/Test/Orphans.hs | 5 +- 16 files changed, 59 insertions(+), 83 deletions(-) diff --git a/plutus-core/plutus-core/src/PlutusCore/Builtin/Case.hs b/plutus-core/plutus-core/src/PlutusCore/Builtin/Case.hs index 50710c0a71c..13f9abbbb7c 100644 --- a/plutus-core/plutus-core/src/PlutusCore/Builtin/Case.hs +++ b/plutus-core/plutus-core/src/PlutusCore/Builtin/Case.hs @@ -1,5 +1,4 @@ -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE TypeOperators #-} module PlutusCore.Builtin.Case where @@ -19,8 +18,8 @@ class AnnotateCaseBuiltin uni where -> [term] -> Either Text [(term, [Type TyName uni ann])] -class UniOf term ~ uni => CaseBuiltin term uni where +class CaseBuiltin uni where -- | Given a constant with its type tag and a vector of branches, choose the appropriate branch -- or fail if the constant doesn't correspond to any of the branches (or casing on constants of -- this type isn't supported at all). - caseBuiltin :: Some (ValueOf uni) -> Vector term -> Either Text term + caseBuiltin :: UniOf term ~ uni => Some (ValueOf uni) -> Vector term -> Either Text term diff --git a/plutus-core/plutus-core/src/PlutusCore/Compiler/Types.hs b/plutus-core/plutus-core/src/PlutusCore/Compiler/Types.hs index dd2612a5255..aa05325ba61 100644 --- a/plutus-core/plutus-core/src/PlutusCore/Compiler/Types.hs +++ b/plutus-core/plutus-core/src/PlutusCore/Compiler/Types.hs @@ -6,12 +6,11 @@ import Data.Hashable import PlutusCore.Builtin import PlutusCore.Name.Unique import PlutusCore.Quote -import UntypedPlutusCore.Core.Type (Term) type Compiling m uni fun name a = ( ToBuiltinMeaning uni fun , MonadQuote m - , CaseBuiltin (Term name uni fun a) uni + , CaseBuiltin uni , HasUnique name TermUnique , Ord name , Typeable name diff --git a/plutus-core/plutus-core/src/PlutusCore/Default/Universe.hs b/plutus-core/plutus-core/src/PlutusCore/Default/Universe.hs index 2c7fe7b8462..25342ec1963 100644 --- a/plutus-core/plutus-core/src/PlutusCore/Default/Universe.hs +++ b/plutus-core/plutus-core/src/PlutusCore/Default/Universe.hs @@ -45,7 +45,6 @@ module PlutusCore.Default.Universe import PlutusCore.Builtin import PlutusPrelude -import PlutusCore.Core.Type (UniOf) import PlutusCore.Crypto.BLS12_381.G1 qualified as BLS12_381.G1 import PlutusCore.Crypto.BLS12_381.G2 qualified as BLS12_381.G2 import PlutusCore.Crypto.BLS12_381.Pairing qualified as BLS12_381.Pairing @@ -535,7 +534,7 @@ instance AnnotateCaseBuiltin DefaultUni where DefaultUniInteger -> Right $ map (, []) branches _ -> Left $ display uni <> " isn't supported in 'case'" -instance UniOf term ~ DefaultUni => CaseBuiltin term DefaultUni where +instance CaseBuiltin DefaultUni where caseBuiltin (Some (ValueOf uni x)) branches = case uni of DefaultUniBool -> case x of -- We allow there to be only one branch as long as the scrutinee is 'False'. diff --git a/plutus-core/plutus-ir/src/PlutusIR/Compiler/Types.hs b/plutus-core/plutus-ir/src/PlutusIR/Compiler/Types.hs index 44cafb40967..794d6297bed 100644 --- a/plutus-core/plutus-ir/src/PlutusIR/Compiler/Types.hs +++ b/plutus-core/plutus-ir/src/PlutusIR/Compiler/Types.hs @@ -219,7 +219,7 @@ type Compiling m uni fun a = , MonadReader (CompilationCtx uni fun a) m , MonadError (Error uni fun (Provenance a)) m , PLC.AnnotateCaseBuiltin uni - , PLC.CaseBuiltin (PIR.Term PIR.TyName PIR.Name uni fun (Provenance a)) uni + , PLC.CaseBuiltin uni , MonadQuote m , Ord a , AnnInline a diff --git a/plutus-core/plutus-ir/src/PlutusIR/Transform/CaseReduce.hs b/plutus-core/plutus-ir/src/PlutusIR/Transform/CaseReduce.hs index a7de96028b0..678c9db6759 100644 --- a/plutus-core/plutus-ir/src/PlutusIR/Transform/CaseReduce.hs +++ b/plutus-core/plutus-ir/src/PlutusIR/Transform/CaseReduce.hs @@ -18,7 +18,7 @@ import PlutusIR.Pass import PlutusIR.TypeCheck qualified as TC caseReducePass - :: ( PLC.Typecheckable uni fun, CaseBuiltin (Term TyName Name uni fun a) uni + :: ( PLC.Typecheckable uni fun, CaseBuiltin uni , PLC.GEq uni, Applicative m ) => TC.PirTCConfig uni fun @@ -26,12 +26,12 @@ caseReducePass caseReducePass tcconfig = simplePass "case reduce" tcconfig caseReduce caseReduce - :: CaseBuiltin (Term tyname name uni fun a) uni + :: CaseBuiltin uni => Term tyname name uni fun a -> Term tyname name uni fun a caseReduce = transformOf termSubterms processTerm processTerm - :: CaseBuiltin (Term tyname name uni fun a) uni + :: CaseBuiltin uni => Term tyname name uni fun a -> Term tyname name uni fun a processTerm = \case Case ann _ (Constr _ _ i args) cs | Just c <- cs ^? wix i -> mkIterApp c ((ann,) <$> args) diff --git a/plutus-core/testlib/PlutusCore/Test.hs b/plutus-core/testlib/PlutusCore/Test.hs index 369a3c706ee..163f2736d53 100644 --- a/plutus-core/testlib/PlutusCore/Test.hs +++ b/plutus-core/testlib/PlutusCore/Test.hs @@ -190,7 +190,7 @@ instance ToUPlc (UPLC.Program TPLC.Name uni fun ()) uni fun where instance ( TPLC.Typecheckable uni fun - , CaseBuiltin (UPLC.Term TPLC.Name uni fun ()) uni + , CaseBuiltin uni , Hashable fun ) => ToUPlc (TPLC.Program TPLC.TyName UPLC.Name uni fun ()) uni fun where diff --git a/plutus-core/testlib/PlutusIR/Test.hs b/plutus-core/testlib/PlutusIR/Test.hs index a9da6ff9871..c4f991ed734 100644 --- a/plutus-core/testlib/PlutusIR/Test.hs +++ b/plutus-core/testlib/PlutusIR/Test.hs @@ -43,7 +43,6 @@ import PlutusIR.Parser (Parser, pTerm, parse) import PlutusIR.Transform.RewriteRules import PlutusIR.TypeCheck import System.FilePath (joinPath, ()) -import UntypedPlutusCore qualified as UPLC import Data.Hashable import Data.Text qualified as T @@ -55,7 +54,7 @@ import Prettyprinter.Render.Text instance ( PLC.GEq uni , PLC.Typecheckable uni fun - , PLC.CaseBuiltin (Term PIR.TyName PIR.Name uni fun (Provenance a)) uni + , PLC.CaseBuiltin uni , PLC.PrettyUni uni , Pretty fun , Pretty a @@ -73,8 +72,7 @@ instance instance ( PLC.GEq uni , PLC.Typecheckable uni fun - , PLC.CaseBuiltin (Term PIR.TyName PIR.Name uni fun (Provenance a)) uni - , PLC.CaseBuiltin (UPLC.Term PIR.Name uni fun ()) uni + , PLC.CaseBuiltin uni , PLC.PrettyUni uni , Pretty fun , Hashable fun @@ -115,7 +113,7 @@ asIfThrown = withExceptT SomeException . hoist (pure . runIdentity) compileWithOpts :: ( PLC.GEq uni , PLC.Typecheckable uni fun - , PLC.CaseBuiltin (Term PIR.TyName PIR.Name uni fun (Provenance a)) uni + , PLC.CaseBuiltin uni , Ord a , PLC.AnnInline a , PLC.PrettyUni uni diff --git a/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Evaluation/Machine/Cek.hs b/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Evaluation/Machine/Cek.hs index 81f18b29899..10dd7c3f049 100644 --- a/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Evaluation/Machine/Cek.hs +++ b/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Evaluation/Machine/Cek.hs @@ -67,7 +67,7 @@ A wrapper around the internal runCek to debruijn input and undebruijn output. *THIS FUNCTION IS PARTIAL if the input term contains free variables* -} runCek - :: (ThrowableBuiltins uni fun, CaseBuiltin (NTerm uni fun ann) uni) + :: (ThrowableBuiltins uni fun, CaseBuiltin uni) => MachineParameters CekMachineCosts fun (CekValue uni fun ann) -> ExBudgetMode cost uni fun -> EmitterMode uni fun @@ -78,7 +78,7 @@ runCek = Common.runCek runCekDeBruijn -- | Evaluate a term using the CEK machine with logging disabled and keep track of costing. -- *THIS FUNCTION IS PARTIAL if the input term contains free variables* runCekNoEmit - :: (ThrowableBuiltins uni fun, CaseBuiltin (NTerm uni fun ann) uni) + :: (ThrowableBuiltins uni fun, CaseBuiltin uni) => MachineParameters CekMachineCosts fun (CekValue uni fun ann) -> ExBudgetMode cost uni fun -> Term Name uni fun ann @@ -88,7 +88,7 @@ runCekNoEmit = Common.runCekNoEmit runCekDeBruijn -- | Evaluate a term using the CEK machine with logging enabled. -- *THIS FUNCTION IS PARTIAL if the input term contains free variables* evaluateCek - :: (ThrowableBuiltins uni fun, CaseBuiltin (NTerm uni fun ann) uni) + :: (ThrowableBuiltins uni fun, CaseBuiltin uni) => EmitterMode uni fun -> MachineParameters CekMachineCosts fun (CekValue uni fun ann) -> Term Name uni fun ann @@ -98,7 +98,7 @@ evaluateCek = Common.evaluateCek runCekDeBruijn -- | Evaluate a term using the CEK machine with logging disabled. -- *THIS FUNCTION IS PARTIAL if the input term contains free variables* evaluateCekNoEmit - :: (ThrowableBuiltins uni fun, CaseBuiltin (NTerm uni fun ann) uni) + :: (ThrowableBuiltins uni fun, CaseBuiltin uni) => MachineParameters CekMachineCosts fun (CekValue uni fun ann) -> Term Name uni fun ann -> Either (CekEvaluationException Name uni fun) (Term Name uni fun ()) @@ -107,7 +107,7 @@ evaluateCekNoEmit = Common.evaluateCekNoEmit runCekDeBruijn -- | Unlift a value using the CEK machine. -- *THIS FUNCTION IS PARTIAL if the input term contains free variables* readKnownCek - :: ( ThrowableBuiltins uni fun, CaseBuiltin (NTerm uni fun ann) uni + :: ( ThrowableBuiltins uni fun, CaseBuiltin uni , ReadKnown (Term Name uni fun ()) a ) => MachineParameters CekMachineCosts fun (CekValue uni fun ann) diff --git a/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Evaluation/Machine/Cek/Internal.hs b/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Evaluation/Machine/Cek/Internal.hs index c3650b6939d..39acea6d840 100644 --- a/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Evaluation/Machine/Cek/Internal.hs +++ b/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Evaluation/Machine/Cek/Internal.hs @@ -679,7 +679,7 @@ runCekM (MachineParameters costs runtime) (ExBudgetMode getExBudgetInfo) (Emitte -- | The entering point to the CEK machine's engine. enterComputeCek :: forall uni fun ann s - . (ThrowableBuiltins uni fun, CaseBuiltin (NTerm uni fun ann) uni, GivenCekReqs uni fun ann s) + . (ThrowableBuiltins uni fun, CaseBuiltin uni, GivenCekReqs uni fun ann s) => Context uni fun ann -> CekValEnv uni fun ann -> NTerm uni fun ann @@ -945,7 +945,7 @@ enterComputeCek = computeCek -- See Note [Compilation peculiarities]. -- | Evaluate a term using the CEK machine and keep track of costing, logging is optional. runCekDeBruijn - :: (ThrowableBuiltins uni fun, CaseBuiltin (NTerm uni fun ann) uni) + :: (ThrowableBuiltins uni fun, CaseBuiltin uni) => MachineParameters CekMachineCosts fun (CekValue uni fun ann) -> ExBudgetMode cost uni fun -> EmitterMode uni fun diff --git a/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Evaluation/Machine/SteppableCek.hs b/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Evaluation/Machine/SteppableCek.hs index 9bb81ebb6e4..b5d746fda5d 100644 --- a/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Evaluation/Machine/SteppableCek.hs +++ b/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Evaluation/Machine/SteppableCek.hs @@ -64,7 +64,7 @@ A wrapper around the internal runCek to debruijn input and undebruijn output. *THIS FUNCTION IS PARTIAL if the input term contains free variables* -} runCek - :: (ThrowableBuiltins uni fun, CaseBuiltin (NTerm uni fun ann) uni) + :: (ThrowableBuiltins uni fun, CaseBuiltin uni) => MachineParameters CekMachineCosts fun (CekValue uni fun ann) -> ExBudgetMode cost uni fun -> EmitterMode uni fun @@ -76,7 +76,7 @@ runCek = Common.runCek S.runCekDeBruijn -- keep track of costing. -- *THIS FUNCTION IS PARTIAL if the input term contains free variables* runCekNoEmit - :: (ThrowableBuiltins uni fun, CaseBuiltin (NTerm uni fun ann) uni) + :: (ThrowableBuiltins uni fun, CaseBuiltin uni) => MachineParameters CekMachineCosts fun (CekValue uni fun ann) -> ExBudgetMode cost uni fun -> Term Name uni fun ann @@ -86,7 +86,7 @@ runCekNoEmit = Common.runCekNoEmit S.runCekDeBruijn -- | Evaluate a term using the Steppable CEK machine with logging enabled. -- *THIS FUNCTION IS PARTIAL if the input term contains free variables* evaluateCek - :: (ThrowableBuiltins uni fun, CaseBuiltin (NTerm uni fun ann) uni) + :: (ThrowableBuiltins uni fun, CaseBuiltin uni) => EmitterMode uni fun -> MachineParameters CekMachineCosts fun (CekValue uni fun ann) -> Term Name uni fun ann @@ -96,7 +96,7 @@ evaluateCek = Common.evaluateCek S.runCekDeBruijn -- | Evaluate a term using the Steppable CEK machine with logging disabled. -- *THIS FUNCTION IS PARTIAL if the input term contains free variables* evaluateCekNoEmit - :: (ThrowableBuiltins uni fun, CaseBuiltin (NTerm uni fun ann) uni) + :: (ThrowableBuiltins uni fun, CaseBuiltin uni) => MachineParameters CekMachineCosts fun (CekValue uni fun ann) -> Term Name uni fun ann -> Either (CekEvaluationException Name uni fun) (Term Name uni fun ()) @@ -105,7 +105,7 @@ evaluateCekNoEmit = Common.evaluateCekNoEmit S.runCekDeBruijn -- | Unlift a value using the Steppable CEK machine. -- *THIS FUNCTION IS PARTIAL if the input term contains free variables* readKnownCek - :: ( ThrowableBuiltins uni fun, CaseBuiltin (NTerm uni fun ann) uni + :: ( ThrowableBuiltins uni fun, CaseBuiltin uni , ReadKnown (Term Name uni fun ()) a ) => MachineParameters CekMachineCosts fun (CekValue uni fun ann) diff --git a/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Evaluation/Machine/SteppableCek/Internal.hs b/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Evaluation/Machine/SteppableCek/Internal.hs index 7a34330890c..5be87249285 100644 --- a/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Evaluation/Machine/SteppableCek/Internal.hs +++ b/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Evaluation/Machine/SteppableCek/Internal.hs @@ -170,7 +170,7 @@ computeCek !_ !_ (Error _) = returnCek :: forall uni fun ann s - . (ThrowableBuiltins uni fun, CaseBuiltin (NTerm uni fun ann) uni, GivenCekReqs uni fun ann s) + . (ThrowableBuiltins uni fun, CaseBuiltin uni, GivenCekReqs uni fun ann s) => Context uni fun ann -> CekValue uni fun ann -> CekM uni fun s (CekState uni fun ann) @@ -224,7 +224,7 @@ returnCek (FrameCases ann env cs ctx) e = case e of -- if v is anything else, fail. forceEvaluate :: forall uni fun ann s - . (ThrowableBuiltins uni fun, CaseBuiltin (NTerm uni fun ann) uni, GivenCekReqs uni fun ann s) + . (ThrowableBuiltins uni fun, CaseBuiltin uni, GivenCekReqs uni fun ann s) => ann -> Context uni fun ann -> CekValue uni fun ann @@ -256,7 +256,7 @@ forceEvaluate _ !_ val = -- If v is anything else, fail. applyEvaluate :: forall uni fun ann s - . (ThrowableBuiltins uni fun, CaseBuiltin (NTerm uni fun ann) uni, GivenCekReqs uni fun ann s) + . (ThrowableBuiltins uni fun, CaseBuiltin uni, GivenCekReqs uni fun ann s) => ann -> Context uni fun ann -> CekValue uni fun ann -- lhs of application @@ -282,7 +282,7 @@ applyEvaluate _ !_ val _ = -- MAYBE: runCekDeBruijn can be shared between original&debug ceks by passing a `enterComputeCek` func. runCekDeBruijn - :: (ThrowableBuiltins uni fun, CaseBuiltin (NTerm uni fun ann) uni) + :: (ThrowableBuiltins uni fun, CaseBuiltin uni) => MachineParameters CekMachineCosts fun (CekValue uni fun ann) -> ExBudgetMode cost uni fun -> EmitterMode uni fun @@ -297,7 +297,7 @@ runCekDeBruijn params mode emitMode term = -- | The entering point to the CEK machine's engine. enterComputeCek :: forall uni fun ann s - . (ThrowableBuiltins uni fun, CaseBuiltin (NTerm uni fun ann) uni, GivenCekReqs uni fun ann s) + . (ThrowableBuiltins uni fun, CaseBuiltin uni, GivenCekReqs uni fun ann s) => Context uni fun ann -> CekValEnv uni fun ann -> NTerm uni fun ann @@ -325,7 +325,7 @@ type CekTrans uni fun ann s = Trans (CekM uni fun s) (CekState uni fun ann) -- | The state transition function of the machine. cekTrans :: forall uni fun ann s - . (ThrowableBuiltins uni fun, CaseBuiltin (NTerm uni fun ann) uni, GivenCekReqs uni fun ann s) + . (ThrowableBuiltins uni fun, CaseBuiltin uni, GivenCekReqs uni fun ann s) => CekTrans uni fun ann s cekTrans = \case Starting term -> pure $ Computing NoFrame Env.empty term @@ -338,7 +338,7 @@ cekTrans = \case -- Returns the constructed transition function paired with the methods to live access the running budget. mkCekTrans :: forall cost uni fun ann m s - . ( ThrowableBuiltins uni fun, CaseBuiltin (NTerm uni fun ann) uni + . ( ThrowableBuiltins uni fun, CaseBuiltin uni , PrimMonad m, s ~ PrimState m) -- the outer monad that initializes the transition function => MachineParameters CekMachineCosts fun (CekValue uni fun ann) -> ExBudgetMode cost uni fun @@ -456,7 +456,7 @@ returnCekHeadSpine ann ctx (HeadSpine f xs) = pure $ Returning (transferSpine an -- -- and proceed with the returning phase of the CEK machine. evalBuiltinApp - :: (ThrowableBuiltins uni fun, CaseBuiltin (NTerm uni fun ann) uni, GivenCekReqs uni fun ann s) + :: (ThrowableBuiltins uni fun, CaseBuiltin uni, GivenCekReqs uni fun ann s) => ann -> Context uni fun ann -> fun diff --git a/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Transform/CaseOfCase.hs b/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Transform/CaseOfCase.hs index 20ba218fc5c..fa6f20b7517 100644 --- a/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Transform/CaseOfCase.hs +++ b/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Transform/CaseOfCase.hs @@ -50,7 +50,7 @@ import Control.Lens import Data.Set qualified as Set caseOfCase - :: (fun ~ PLC.DefaultFun, Monad m, CaseBuiltin (Term name uni fun a) uni) + :: (fun ~ PLC.DefaultFun, Monad m, CaseBuiltin uni) => Term name uni fun a -> SimplifierT name uni fun a m (Term name uni fun a) caseOfCase term = do @@ -59,8 +59,8 @@ caseOfCase term = do return result processTerm - :: fun ~ PLC.DefaultFun - => CaseBuiltin (Term name uni fun a) uni => Term name uni fun a -> Term name uni fun a + :: (fun ~ PLC.DefaultFun, CaseBuiltin uni) + => Term name uni fun a -> Term name uni fun a processTerm = \case Case ann scrut alts | ( ite@(Force a (Builtin _ PLC.IfThenElse)) diff --git a/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Transform/CaseReduce.hs b/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Transform/CaseReduce.hs index de0d99ff445..d348618bee5 100644 --- a/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Transform/CaseReduce.hs +++ b/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Transform/CaseReduce.hs @@ -15,7 +15,7 @@ import Control.Lens (transformOf) import Data.Vector qualified as V caseReduce - :: (Monad m, CaseBuiltin (Term name uni fun a) uni) + :: (Monad m, CaseBuiltin uni) => Term name uni fun a -> SimplifierT name uni fun a m (Term name uni fun a) caseReduce term = do @@ -23,7 +23,7 @@ caseReduce term = do recordSimplification term CaseReduce result return result -processTerm :: CaseBuiltin (Term name uni fun a) uni => Term name uni fun a -> Term name uni fun a +processTerm :: CaseBuiltin uni => Term name uni fun a -> Term name uni fun a processTerm = \case Case ann (Constr _ i args) cs | Just c <- (V.!?) cs (fromIntegral i) -> mkIterApp c ((ann,) <$> args) diff --git a/plutus-core/untyped-plutus-core/testlib/Evaluation/Builtins/Common.hs b/plutus-core/untyped-plutus-core/testlib/Evaluation/Builtins/Common.hs index 31ed5ceff71..2c269c391d3 100644 --- a/plutus-core/untyped-plutus-core/testlib/Evaluation/Builtins/Common.hs +++ b/plutus-core/untyped-plutus-core/testlib/Evaluation/Builtins/Common.hs @@ -79,7 +79,7 @@ typecheckAnd semvar action costingPart term = TPLC.runQuoteT $ do typecheckEvaluateCek :: ( MonadError (TypeErrorPlc uni fun ()) m, TPLC.Typecheckable uni fun, GEq uni , uni `Everywhere` ExMemoryUsage, PrettyUni uni, Pretty fun - , CaseBuiltin (UPLC.Term UPLC.NamedDeBruijn uni fun ()) uni + , CaseBuiltin uni ) => BuiltinSemanticsVariant fun -> CostingPart uni fun @@ -93,7 +93,7 @@ typecheckEvaluateCek semvar = typecheckEvaluateCekNoEmit :: ( MonadError (TypeErrorPlc uni fun ()) m, TPLC.Typecheckable uni fun, GEq uni , uni `Everywhere` ExMemoryUsage, PrettyUni uni, Pretty fun - , CaseBuiltin (UPLC.Term UPLC.NamedDeBruijn uni fun ()) uni + , CaseBuiltin uni ) => BuiltinSemanticsVariant fun -> CostingPart uni fun @@ -107,7 +107,7 @@ typecheckEvaluateCekNoEmit semvar = typecheckReadKnownCek :: ( MonadError (TypeErrorPlc uni fun ()) m, TPLC.Typecheckable uni fun, GEq uni , uni `Everywhere` ExMemoryUsage, PrettyUni uni, Pretty fun - , CaseBuiltin (UPLC.Term UPLC.NamedDeBruijn uni fun ()) uni + , CaseBuiltin uni , ReadKnown (UPLC.Term Name uni fun ()) a ) => BuiltinSemanticsVariant fun diff --git a/plutus-tx/src/PlutusTx/Lift.hs b/plutus-tx/src/PlutusTx/Lift.hs index f2546ca84e0..b01713cceb6 100644 --- a/plutus-tx/src/PlutusTx/Lift.hs +++ b/plutus-tx/src/PlutusTx/Lift.hs @@ -76,8 +76,7 @@ safeLiftWith , MonadError (PIR.Error uni fun (Provenance ())) m , MonadQuote m , PLC.Typecheckable uni fun - , PLC.CaseBuiltin (PIR.Term TyName Name uni fun (Provenance ())) uni - , PLC.CaseBuiltin (UPLC.Term Name uni fun (Provenance ())) uni + , PLC.CaseBuiltin uni , PrettyUni uni , Pretty fun , Default (PLC.CostingPart uni fun) @@ -121,8 +120,7 @@ safeLift , MonadError (PIR.Error uni fun (Provenance ())) m , MonadQuote m , PLC.Typecheckable uni fun - , PLC.CaseBuiltin (PIR.Term TyName Name uni fun (Provenance ())) uni - , PLC.CaseBuiltin (UPLC.Term Name uni fun (Provenance ())) uni + , PLC.CaseBuiltin uni , PrettyUni uni , Pretty fun , Default (PLC.CostingPart uni fun) @@ -145,8 +143,7 @@ safeLiftUnopt , MonadError (PIR.Error uni fun (Provenance ())) m , MonadQuote m , PLC.Typecheckable uni fun - , PLC.CaseBuiltin (UPLC.Term Name uni fun (Provenance ())) uni - , PLC.CaseBuiltin (PIR.Term TyName Name uni fun (Provenance ())) uni + , PLC.CaseBuiltin uni , PrettyUni uni , Pretty fun , Default (PLC.CostingPart uni fun) @@ -173,8 +170,7 @@ safeLiftProgram , MonadError (PIR.Error uni fun (Provenance ())) m , MonadQuote m , PLC.Typecheckable uni fun - , PLC.CaseBuiltin (PIR.Term TyName Name uni fun (Provenance ())) uni - , PLC.CaseBuiltin (UPLC.Term Name uni fun (Provenance ())) uni + , PLC.CaseBuiltin uni , PrettyUni uni , Pretty fun , Default (PLC.CostingPart uni fun) @@ -196,8 +192,7 @@ safeLiftProgramUnopt , MonadError (PIR.Error uni fun (Provenance ())) m , MonadQuote m , PLC.Typecheckable uni fun - , PLC.CaseBuiltin (PIR.Term TyName Name uni fun (Provenance ())) uni - , PLC.CaseBuiltin (UPLC.Term Name uni fun (Provenance ())) uni + , PLC.CaseBuiltin uni , PrettyUni uni , Pretty fun , Default (PLC.CostingPart uni fun) @@ -216,8 +211,7 @@ safeLiftCode , MonadError (PIR.Error uni fun (Provenance ())) m , MonadQuote m , PLC.Typecheckable uni fun - , PLC.CaseBuiltin (PIR.Term TyName Name uni fun (Provenance ())) uni - , PLC.CaseBuiltin (UPLC.Term Name uni fun (Provenance ())) uni + , PLC.CaseBuiltin uni , PrettyUni uni , Pretty fun , Default (PLC.CostingPart uni fun) @@ -242,8 +236,7 @@ safeLiftCodeUnopt , MonadError (PIR.Error uni fun (Provenance ())) m , MonadQuote m , PLC.Typecheckable uni fun - , PLC.CaseBuiltin (PIR.Term TyName Name uni fun (Provenance ())) uni - , PLC.CaseBuiltin (UPLC.Term Name uni fun (Provenance ())) uni + , PLC.CaseBuiltin uni , PrettyUni uni , Pretty fun , Default (PLC.CostingPart uni fun) @@ -277,8 +270,7 @@ lift , ThrowableBuiltins uni fun , PLC.Typecheckable uni fun , PLC.GEq uni - , PLC.CaseBuiltin (PIR.Term TyName Name uni fun (Provenance ())) uni - , PLC.CaseBuiltin (UPLC.Term Name uni fun (Provenance ())) uni + , PLC.CaseBuiltin uni , Default (PLC.CostingPart uni fun) , Default (PIR.BuiltinsInfo uni fun) , Default (PIR.RewriteRules uni fun) @@ -297,8 +289,7 @@ liftUnopt , ThrowableBuiltins uni fun , PLC.Typecheckable uni fun , PLC.GEq uni - , PLC.CaseBuiltin (PIR.Term TyName Name uni fun (Provenance ())) uni - , PLC.CaseBuiltin (UPLC.Term Name uni fun (Provenance ())) uni + , PLC.CaseBuiltin uni , Default (PLC.CostingPart uni fun) , Default (PIR.BuiltinsInfo uni fun) , Default (PIR.RewriteRules uni fun) @@ -315,8 +306,7 @@ liftProgram , ThrowableBuiltins uni fun , PLC.Typecheckable uni fun , PLC.GEq uni - , PLC.CaseBuiltin (PIR.Term TyName Name uni fun (Provenance ())) uni - , PLC.CaseBuiltin (UPLC.Term Name uni fun (Provenance ())) uni + , PLC.CaseBuiltin uni , Default (PLC.CostingPart uni fun) , Default (PIR.BuiltinsInfo uni fun) , Default (PIR.RewriteRules uni fun) @@ -335,8 +325,7 @@ liftProgramUnopt , ThrowableBuiltins uni fun , PLC.Typecheckable uni fun , PLC.GEq uni - , PLC.CaseBuiltin (PIR.Term TyName Name uni fun (Provenance ())) uni - , PLC.CaseBuiltin (UPLC.Term Name uni fun (Provenance ())) uni + , PLC.CaseBuiltin uni , Default (PLC.CostingPart uni fun) , Default (PIR.BuiltinsInfo uni fun) , Default (PIR.RewriteRules uni fun) @@ -373,8 +362,7 @@ liftCode , PLC.GEq uni , ThrowableBuiltins uni fun , PLC.Typecheckable uni fun - , PLC.CaseBuiltin (PIR.Term TyName Name uni fun (Provenance ())) uni - , PLC.CaseBuiltin (UPLC.Term Name uni fun (Provenance ())) uni + , PLC.CaseBuiltin uni , Default (PLC.CostingPart uni fun) , Default (PIR.BuiltinsInfo uni fun) , Default (PIR.RewriteRules uni fun) @@ -391,8 +379,7 @@ liftCodeUnopt , PLC.GEq uni , ThrowableBuiltins uni fun , PLC.Typecheckable uni fun - , PLC.CaseBuiltin (PIR.Term TyName Name uni fun (Provenance ())) uni - , PLC.CaseBuiltin (UPLC.Term Name uni fun (Provenance ())) uni + , PLC.CaseBuiltin uni , Default (PLC.CostingPart uni fun) , Default (PIR.BuiltinsInfo uni fun) , Default (PIR.RewriteRules uni fun) @@ -407,8 +394,7 @@ liftCodeDef , PLC.GEq uni , ThrowableBuiltins uni fun , PLC.Typecheckable uni fun - , PLC.CaseBuiltin (PIR.Term TyName Name uni fun (Provenance ())) uni - , PLC.CaseBuiltin (UPLC.Term Name uni fun (Provenance ())) uni + , PLC.CaseBuiltin uni , Default (PLC.CostingPart uni fun) , Default (PIR.BuiltinsInfo uni fun) , Default (PIR.RewriteRules uni fun) @@ -425,8 +411,7 @@ liftCodeDefUnopt , PLC.GEq uni , ThrowableBuiltins uni fun , PLC.Typecheckable uni fun - , PLC.CaseBuiltin (PIR.Term TyName Name uni fun (Provenance ())) uni - , PLC.CaseBuiltin (UPLC.Term Name uni fun (Provenance ())) uni + , PLC.CaseBuiltin uni , Default (PLC.CostingPart uni fun) , Default (PIR.BuiltinsInfo uni fun) , Default (PIR.RewriteRules uni fun) @@ -455,7 +440,7 @@ typeCheckAgainst , MonadQuote m , PLC.GEq uni , PLC.Typecheckable uni fun - , PLC.CaseBuiltin (PIR.Term TyName Name uni fun (Provenance ())) uni + , PLC.CaseBuiltin uni , PrettyUni uni , Pretty fun , Default (PLC.CostingPart uni fun) @@ -495,8 +480,7 @@ typeCode , MonadQuote m , PLC.GEq uni , PLC.Typecheckable uni fun - , PLC.CaseBuiltin (PIR.Term TyName Name uni fun (Provenance ())) uni - , PLC.CaseBuiltin (UPLC.Term Name uni fun ()) uni + , PLC.CaseBuiltin uni , PrettyUni uni , Pretty fun , Default (PLC.CostingPart uni fun) diff --git a/plutus-tx/testlib/PlutusTx/Test/Orphans.hs b/plutus-tx/testlib/PlutusTx/Test/Orphans.hs index 35eb25143a3..2e9fbff323b 100644 --- a/plutus-tx/testlib/PlutusTx/Test/Orphans.hs +++ b/plutus-tx/testlib/PlutusTx/Test/Orphans.hs @@ -12,13 +12,10 @@ import Prelude import PlutusCore qualified as PLC import PlutusCore.Builtin qualified as PLC -import PlutusCore.Name.Unique qualified as UPLC import PlutusCore.Pretty (Pretty, PrettyConst) import PlutusCore.Pretty qualified as PLC import PlutusCore.Test (ToTPlc (..), ToUPlc (..), catchAll) -import PlutusIR qualified as PIR import PlutusIR.Analysis.Builtins qualified as PIR -import PlutusIR.Compiler.Provenance qualified as PIR import PlutusIR.Test () import PlutusIR.Transform.RewriteRules qualified as PIR import PlutusPrelude (Default) @@ -37,7 +34,7 @@ instance ( PLC.PrettyParens (PLC.SomeTypeIn uni) , PLC.GEq uni , PLC.Typecheckable uni fun - , PLC.CaseBuiltin (PIR.Term UPLC.TyName UPLC.Name uni fun (PIR.Provenance PLC.SrcSpans)) uni + , PLC.CaseBuiltin uni , PLC.Closed uni , uni `PLC.Everywhere` PrettyConst , Pretty fun From d404be14defdda9cc13d898805ad42c24c8c02fd Mon Sep 17 00:00:00 2001 From: effectfully Date: Mon, 2 Jun 2025 21:57:30 +0100 Subject: [PATCH 13/25] Address comments --- plutus-core/plutus-core/src/PlutusCore/Builtin/Case.hs | 2 +- plutus-core/plutus-core/src/PlutusCore/Default/Universe.hs | 1 + plutus-core/plutus-ir/src/PlutusIR/Transform/CaseReduce.hs | 7 ++++--- .../src/UntypedPlutusCore/Transform/CaseReduce.hs | 7 ++++--- 4 files changed, 10 insertions(+), 7 deletions(-) diff --git a/plutus-core/plutus-core/src/PlutusCore/Builtin/Case.hs b/plutus-core/plutus-core/src/PlutusCore/Builtin/Case.hs index 13f9abbbb7c..5fb677dcf57 100644 --- a/plutus-core/plutus-core/src/PlutusCore/Builtin/Case.hs +++ b/plutus-core/plutus-core/src/PlutusCore/Builtin/Case.hs @@ -11,7 +11,7 @@ import Universe class AnnotateCaseBuiltin uni where -- | Given a tag for a built-in type and a list of branches, annotate each of the branches with - -- its expected type or fail if casing on values of the built-in type isn't supported. + -- its expected argument types or fail if casing on values of the built-in type isn't supported. annotateCaseBuiltin :: UniOf term ~ uni => SomeTypeIn uni diff --git a/plutus-core/plutus-core/src/PlutusCore/Default/Universe.hs b/plutus-core/plutus-core/src/PlutusCore/Default/Universe.hs index 25342ec1963..6994bea338a 100644 --- a/plutus-core/plutus-core/src/PlutusCore/Default/Universe.hs +++ b/plutus-core/plutus-core/src/PlutusCore/Default/Universe.hs @@ -549,6 +549,7 @@ instance CaseBuiltin DefaultUni where _ -> Left $ display uni <> " isn't supported in 'case'" where !len = Vector.length branches + {-# INLINE caseBuiltin #-} {- Note [Stable encoding of tags] 'encodeUni' and 'decodeUni' are used for serialisation and deserialisation of types from the diff --git a/plutus-core/plutus-ir/src/PlutusIR/Transform/CaseReduce.hs b/plutus-core/plutus-ir/src/PlutusIR/Transform/CaseReduce.hs index 678c9db6759..53ea27b770e 100644 --- a/plutus-core/plutus-ir/src/PlutusIR/Transform/CaseReduce.hs +++ b/plutus-core/plutus-ir/src/PlutusIR/Transform/CaseReduce.hs @@ -34,8 +34,9 @@ processTerm :: CaseBuiltin uni => Term tyname name uni fun a -> Term tyname name uni fun a processTerm = \case + -- We could've rewritten those patterns as 'Error' in the 'Nothing' cases, but that would turn a + -- structural error into an operational one, which would be unfortunate, so instead we decided + -- not to fully optimize such scripts, since they aren't valid anyway. Case ann _ (Constr _ _ i args) cs | Just c <- cs ^? wix i -> mkIterApp c ((ann,) <$> args) - Case ann resTy (Constant _ con) cs -> case caseBuiltin con $ fromList cs of - Left _ -> Error ann resTy - Right res -> res + Case _ _ (Constant _ con) cs | Right res <- caseBuiltin con (fromList cs) -> res t -> t diff --git a/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Transform/CaseReduce.hs b/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Transform/CaseReduce.hs index d348618bee5..bb083599643 100644 --- a/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Transform/CaseReduce.hs +++ b/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Transform/CaseReduce.hs @@ -25,9 +25,10 @@ caseReduce term = do processTerm :: CaseBuiltin uni => Term name uni fun a -> Term name uni fun a processTerm = \case + -- We could've rewritten those patterns as 'Error' in the 'Nothing' cases, but that would turn a + -- structural error into an operational one, which would be unfortunate, so instead we decided + -- not to fully optimize such scripts, since they aren't valid anyway. Case ann (Constr _ i args) cs | Just c <- (V.!?) cs (fromIntegral i) -> mkIterApp c ((ann,) <$> args) - Case ann (Constant _ con) cs -> case caseBuiltin con cs of - Left _ -> Error ann - Right res -> res + Case _ (Constant _ con) cs | Right res <- caseBuiltin con cs -> res t -> t From 81948ad6b26e8d49f0466e09e44a9882bd80d97e Mon Sep 17 00:00:00 2001 From: effectfully Date: Tue, 3 Jun 2025 22:24:30 +0100 Subject: [PATCH 14/25] Allow constants in case-of-case too --- .../src/PlutusCore/Compiler/Types.hs | 8 ++++++-- plutus-core/testlib/PlutusCore/Test.hs | 1 + plutus-core/testlib/PlutusIR/Test.hs | 1 + .../UntypedPlutusCore/Transform/CaseOfCase.hs | 17 +++++++++++------ plutus-tx/src/PlutusTx/Lift.hs | 16 ++++++++++++++++ 5 files changed, 35 insertions(+), 8 deletions(-) diff --git a/plutus-core/plutus-core/src/PlutusCore/Compiler/Types.hs b/plutus-core/plutus-core/src/PlutusCore/Compiler/Types.hs index aa05325ba61..6bbfdc07166 100644 --- a/plutus-core/plutus-core/src/PlutusCore/Compiler/Types.hs +++ b/plutus-core/plutus-core/src/PlutusCore/Compiler/Types.hs @@ -2,15 +2,19 @@ module PlutusCore.Compiler.Types where -import Data.Hashable +import PlutusCore import PlutusCore.Builtin import PlutusCore.Name.Unique -import PlutusCore.Quote + +import Data.Hashable type Compiling m uni fun name a = ( ToBuiltinMeaning uni fun , MonadQuote m , CaseBuiltin uni + , GEq uni + , Closed uni + , Everywhere uni Eq , HasUnique name TermUnique , Ord name , Typeable name diff --git a/plutus-core/testlib/PlutusCore/Test.hs b/plutus-core/testlib/PlutusCore/Test.hs index 163f2736d53..a7114ff4380 100644 --- a/plutus-core/testlib/PlutusCore/Test.hs +++ b/plutus-core/testlib/PlutusCore/Test.hs @@ -192,6 +192,7 @@ instance ( TPLC.Typecheckable uni fun , CaseBuiltin uni , Hashable fun + , TPLC.GEq uni, TPLC.Closed uni, TPLC.Everywhere uni Eq ) => ToUPlc (TPLC.Program TPLC.TyName UPLC.Name uni fun ()) uni fun where toUPlc = diff --git a/plutus-core/testlib/PlutusIR/Test.hs b/plutus-core/testlib/PlutusIR/Test.hs index c4f991ed734..51e851c9af3 100644 --- a/plutus-core/testlib/PlutusIR/Test.hs +++ b/plutus-core/testlib/PlutusIR/Test.hs @@ -71,6 +71,7 @@ instance instance ( PLC.GEq uni + , uni `PLC.Everywhere` Eq , PLC.Typecheckable uni fun , PLC.CaseBuiltin uni , PLC.PrettyUni uni diff --git a/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Transform/CaseOfCase.hs b/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Transform/CaseOfCase.hs index fa6f20b7517..b706de24482 100644 --- a/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Transform/CaseOfCase.hs +++ b/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Transform/CaseOfCase.hs @@ -47,10 +47,12 @@ import UntypedPlutusCore.Transform.Simplifier (SimplifierStage (CaseOfCase), Sim recordSimplification) import Control.Lens -import Data.Set qualified as Set +import Data.List (nub) caseOfCase - :: (fun ~ PLC.DefaultFun, Monad m, CaseBuiltin uni) + :: ( fun ~ PLC.DefaultFun, Monad m, CaseBuiltin uni + , PLC.GEq uni, PLC.Closed uni, uni `PLC.Everywhere` Eq + ) => Term name uni fun a -> SimplifierT name uni fun a m (Term name uni fun a) caseOfCase term = do @@ -59,7 +61,9 @@ caseOfCase term = do return result processTerm - :: (fun ~ PLC.DefaultFun, CaseBuiltin uni) + :: ( fun ~ PLC.DefaultFun, CaseBuiltin uni + , PLC.GEq uni, PLC.Closed uni, uni `PLC.Everywhere` Eq + ) => Term name uni fun a -> Term name uni fun a processTerm = \case Case ann scrut alts @@ -80,9 +84,10 @@ processTerm = \case (Case annInner scrut) (do constrs <- for altsInner $ \case - c@(Constr _ i _) -> Just (i, c) - _ -> Nothing + c@(Constr _ i _) -> Just (Left i, c) + c@(Constant _ val) -> Just (Right val, c) + _ -> Nothing -- See Note [Case-of-case and duplicating code]. - guard $ length (Set.fromList . toList $ fmap fst constrs) == length constrs + guard $ length (nub . toList $ fmap fst constrs) == length constrs pure $ constrs <&> \(_, c) -> CaseReduce.processTerm $ Case annOuter c altsOuter) other -> other diff --git a/plutus-tx/src/PlutusTx/Lift.hs b/plutus-tx/src/PlutusTx/Lift.hs index b01713cceb6..80e7d6d9409 100644 --- a/plutus-tx/src/PlutusTx/Lift.hs +++ b/plutus-tx/src/PlutusTx/Lift.hs @@ -73,6 +73,7 @@ safeLiftWith :: forall a uni fun m . ( Lift.Lift uni a , PLC.GEq uni + , PLC.Everywhere uni Eq , MonadError (PIR.Error uni fun (Provenance ())) m , MonadQuote m , PLC.Typecheckable uni fun @@ -117,6 +118,7 @@ safeLift :: forall a uni fun m . ( Lift.Lift uni a , PLC.GEq uni + , PLC.Everywhere uni Eq , MonadError (PIR.Error uni fun (Provenance ())) m , MonadQuote m , PLC.Typecheckable uni fun @@ -140,6 +142,7 @@ safeLiftUnopt :: forall a uni fun m . ( Lift.Lift uni a , PLC.GEq uni + , PLC.Everywhere uni Eq , MonadError (PIR.Error uni fun (Provenance ())) m , MonadQuote m , PLC.Typecheckable uni fun @@ -167,6 +170,7 @@ optimizations. safeLiftProgram :: ( Lift.Lift uni a , PLC.GEq uni + , PLC.Everywhere uni Eq , MonadError (PIR.Error uni fun (Provenance ())) m , MonadQuote m , PLC.Typecheckable uni fun @@ -189,6 +193,7 @@ where lifting speed is more important than optimal code. safeLiftProgramUnopt :: ( Lift.Lift uni a , PLC.GEq uni + , PLC.Everywhere uni Eq , MonadError (PIR.Error uni fun (Provenance ())) m , MonadQuote m , PLC.Typecheckable uni fun @@ -208,6 +213,7 @@ safeLiftProgramUnopt v x = bimap (PIR.Program () v) (UPLC.Program () v) <$> safe safeLiftCode :: ( Lift.Lift uni a , PLC.GEq uni + , PLC.Everywhere uni Eq , MonadError (PIR.Error uni fun (Provenance ())) m , MonadQuote m , PLC.Typecheckable uni fun @@ -233,6 +239,7 @@ where lifting speed is more important than optimal code. safeLiftCodeUnopt :: ( Lift.Lift uni a , PLC.GEq uni + , PLC.Everywhere uni Eq , MonadError (PIR.Error uni fun (Provenance ())) m , MonadQuote m , PLC.Typecheckable uni fun @@ -270,6 +277,7 @@ lift , ThrowableBuiltins uni fun , PLC.Typecheckable uni fun , PLC.GEq uni + , PLC.Everywhere uni Eq , PLC.CaseBuiltin uni , Default (PLC.CostingPart uni fun) , Default (PIR.BuiltinsInfo uni fun) @@ -289,6 +297,7 @@ liftUnopt , ThrowableBuiltins uni fun , PLC.Typecheckable uni fun , PLC.GEq uni + , PLC.Everywhere uni Eq , PLC.CaseBuiltin uni , Default (PLC.CostingPart uni fun) , Default (PIR.BuiltinsInfo uni fun) @@ -306,6 +315,7 @@ liftProgram , ThrowableBuiltins uni fun , PLC.Typecheckable uni fun , PLC.GEq uni + , PLC.Everywhere uni Eq , PLC.CaseBuiltin uni , Default (PLC.CostingPart uni fun) , Default (PIR.BuiltinsInfo uni fun) @@ -325,6 +335,7 @@ liftProgramUnopt , ThrowableBuiltins uni fun , PLC.Typecheckable uni fun , PLC.GEq uni + , PLC.Everywhere uni Eq , PLC.CaseBuiltin uni , Default (PLC.CostingPart uni fun) , Default (PIR.BuiltinsInfo uni fun) @@ -360,6 +371,7 @@ liftProgramDefUnopt = liftProgramUnopt PLC.latestVersion liftCode :: ( Lift.Lift uni a , PLC.GEq uni + , PLC.Everywhere uni Eq , ThrowableBuiltins uni fun , PLC.Typecheckable uni fun , PLC.CaseBuiltin uni @@ -377,6 +389,7 @@ where lifting speed is more important than optimal code. liftCodeUnopt :: ( Lift.Lift uni a , PLC.GEq uni + , PLC.Everywhere uni Eq , ThrowableBuiltins uni fun , PLC.Typecheckable uni fun , PLC.CaseBuiltin uni @@ -392,6 +405,7 @@ liftCodeUnopt v x = unsafely $ safeLiftCodeUnopt v x liftCodeDef :: ( Lift.Lift uni a , PLC.GEq uni + , PLC.Everywhere uni Eq , ThrowableBuiltins uni fun , PLC.Typecheckable uni fun , PLC.CaseBuiltin uni @@ -409,6 +423,7 @@ where lifting speed is more important than optimal code. liftCodeDefUnopt :: ( Lift.Lift uni a , PLC.GEq uni + , PLC.Everywhere uni Eq , ThrowableBuiltins uni fun , PLC.Typecheckable uni fun , PLC.CaseBuiltin uni @@ -479,6 +494,7 @@ typeCode , MonadError (PIR.Error uni fun (Provenance ())) m , MonadQuote m , PLC.GEq uni + , PLC.Everywhere uni Eq , PLC.Typecheckable uni fun , PLC.CaseBuiltin uni , PrettyUni uni From cabbbe3ee46c7a8610eb010e7eeced0435f5b46b Mon Sep 17 00:00:00 2001 From: effectfully Date: Wed, 4 Jun 2025 02:57:15 +0100 Subject: [PATCH 15/25] A failed experiment to add 'caserBuiltin' to 'MachineParameters' --- .../src/PlutusCore/Builtin/Case.hs | 24 ++++++++++++++++++- .../Evaluation/Machine/MachineParameters.hs | 9 ++++++- .../src/PlutusLedgerApi/Common/Eval.hs | 9 ++++--- .../PlutusLedgerApi/V1/EvaluationContext.hs | 9 ++++--- .../PlutusLedgerApi/V2/EvaluationContext.hs | 4 ++++ .../PlutusLedgerApi/V3/EvaluationContext.hs | 4 ++++ 6 files changed, 51 insertions(+), 8 deletions(-) diff --git a/plutus-core/plutus-core/src/PlutusCore/Builtin/Case.hs b/plutus-core/plutus-core/src/PlutusCore/Builtin/Case.hs index 5fb677dcf57..d64374aeb96 100644 --- a/plutus-core/plutus-core/src/PlutusCore/Builtin/Case.hs +++ b/plutus-core/plutus-core/src/PlutusCore/Builtin/Case.hs @@ -1,12 +1,18 @@ -{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE TypeOperators #-} module PlutusCore.Builtin.Case where import PlutusCore.Core.Type (Type, UniOf) import PlutusCore.Name.Unique +import Control.DeepSeq (NFData (..), rwhnf) import Data.Text (Text) import Data.Vector (Vector) +import NoThunks.Class +import Text.PrettyBy (display) import Universe class AnnotateCaseBuiltin uni where @@ -23,3 +29,19 @@ class CaseBuiltin uni where -- or fail if the constant doesn't correspond to any of the branches (or casing on constants of -- this type isn't supported at all). caseBuiltin :: UniOf term ~ uni => Some (ValueOf uni) -> Vector term -> Either Text term + +data CaserBuiltin uni = CaserBuiltin + { unCaserBuiltin + :: !(forall term. UniOf term ~ uni => Some (ValueOf uni) -> Vector term -> Either Text term) + } + +instance NFData (CaserBuiltin uni) where + rnf = rwhnf + +deriving via OnlyCheckWhnfNamed "PlutusCore.Builtin.Case.CaserBuiltin" (CaserBuiltin uni) + instance NoThunks (CaserBuiltin uni) + +unavailableCaserBuiltin :: Int -> CaserBuiltin uni +unavailableCaserBuiltin ver = + CaserBuiltin $ \_ _ -> Left $ + "'case' on values of built-in types is not supported in protocol version " <> display ver diff --git a/plutus-core/plutus-core/src/PlutusCore/Evaluation/Machine/MachineParameters.hs b/plutus-core/plutus-core/src/PlutusCore/Evaluation/Machine/MachineParameters.hs index f830cf1a24a..521f3177881 100644 --- a/plutus-core/plutus-core/src/PlutusCore/Evaluation/Machine/MachineParameters.hs +++ b/plutus-core/plutus-core/src/PlutusCore/Evaluation/Machine/MachineParameters.hs @@ -8,6 +8,7 @@ module PlutusCore.Evaluation.Machine.MachineParameters where +import PlutusCore (UniOf) import PlutusCore.Builtin import Control.DeepSeq @@ -40,6 +41,7 @@ data MachineParameters machinecosts fun val = MachineParameters { machineCosts :: machinecosts , builtinsRuntime :: BuiltinsRuntime fun val + , caserBuiltin :: CaserBuiltin (UniOf val) } deriving stock Generic deriving anyclass (NFData) @@ -47,7 +49,11 @@ data MachineParameters machinecosts fun val = -- For some reason the generic instance gives incorrect nothunk errors, -- see https://github.com/input-output-hk/nothunks/issues/24 instance (NoThunks machinecosts, Bounded fun, Enum fun) => NoThunks (MachineParameters machinecosts fun val) where - wNoThunks ctx (MachineParameters costs runtime) = allNoThunks [ noThunks ctx costs, noThunks ctx runtime ] + wNoThunks ctx (MachineParameters costs runtime caser) = allNoThunks + [ noThunks ctx costs + , noThunks ctx runtime + , noThunks ctx caser + ] {- Note [The CostingPart constraint in mkMachineParameters] Discharging the @CostingPart uni fun ~ builtincosts@ constraint in 'mkMachineParameters' causes GHC @@ -85,6 +91,7 @@ mkMachineParameters :: ) => BuiltinSemanticsVariant fun -> CostModel machinecosts builtincosts + -> CaserBuiltin uni -> MachineParameters machinecosts fun val mkMachineParameters semvar (CostModel mchnCosts builtinCosts) = MachineParameters mchnCosts (inline toBuiltinsRuntime semvar builtinCosts) diff --git a/plutus-ledger-api/src/PlutusLedgerApi/Common/Eval.hs b/plutus-ledger-api/src/PlutusLedgerApi/Common/Eval.hs index 180b136790a..1d138f4d2e1 100644 --- a/plutus-ledger-api/src/PlutusLedgerApi/Common/Eval.hs +++ b/plutus-ledger-api/src/PlutusLedgerApi/Common/Eval.hs @@ -21,7 +21,7 @@ module PlutusLedgerApi.Common.Eval ) where import PlutusCore -import PlutusCore.Builtin (readKnown) +import PlutusCore.Builtin (CaserBuiltin, readKnown) import PlutusCore.Data as Plutus import PlutusCore.Default import PlutusCore.Evaluation.Machine.CostModelInterface as Plutus @@ -154,6 +154,7 @@ data EvaluationContext = EvaluationContext , _evalCtxMachParsCache :: [(BuiltinSemanticsVariant DefaultFun, DefaultMachineParameters)] -- ^ The cache of 'DefaultMachineParameters' for each semantics variant supported by the -- current language version. + , _evalCtxCaserBuiltin :: MajorProtocolVersion -> CaserBuiltin DefaultUni } deriving stock Generic deriving anyclass (NFData, NoThunks) @@ -176,10 +177,12 @@ mkDynEvaluationContext => PlutusLedgerLanguage -> [BuiltinSemanticsVariant DefaultFun] -> (MajorProtocolVersion -> BuiltinSemanticsVariant DefaultFun) + -> (MajorProtocolVersion -> CaserBuiltin DefaultUni) -> Plutus.CostModelParams -> m EvaluationContext -mkDynEvaluationContext ll semVars toSemVar newCMP = - EvaluationContext ll toSemVar <$> mkMachineParametersFor semVars newCMP +mkDynEvaluationContext ll semVars toSemVar newCMP toCaser = do + machPars <- mkMachineParametersFor semVars newCMP + pure $ EvaluationContext ll toSemVar machPars toCaser -- FIXME: remove this function assertWellFormedCostModelParams :: MonadError CostModelApplyError m => Plutus.CostModelParams -> m () diff --git a/plutus-ledger-api/src/PlutusLedgerApi/V1/EvaluationContext.hs b/plutus-ledger-api/src/PlutusLedgerApi/V1/EvaluationContext.hs index d062cb06bba..153aaa89fb2 100644 --- a/plutus-ledger-api/src/PlutusLedgerApi/V1/EvaluationContext.hs +++ b/plutus-ledger-api/src/PlutusLedgerApi/V1/EvaluationContext.hs @@ -43,8 +43,11 @@ mkEvaluationContext = PlutusV1 [DefaultFunSemanticsVariantA, DefaultFunSemanticsVariantB] -- See Note [Mapping of protocol versions and ledger languages to semantics variants]. - ( \pv -> + (\pv -> if pv < changPV then DefaultFunSemanticsVariantA - else DefaultFunSemanticsVariantB - ) + else DefaultFunSemanticsVariantB) + (\pv -> + if pv < futurePV + then unavailableCaserBuiltin (getMajorProtocolVersion pv) + else CaserBuiltin caseBuiltin) diff --git a/plutus-ledger-api/src/PlutusLedgerApi/V2/EvaluationContext.hs b/plutus-ledger-api/src/PlutusLedgerApi/V2/EvaluationContext.hs index 8d7496b39bd..eb16a6ad075 100644 --- a/plutus-ledger-api/src/PlutusLedgerApi/V2/EvaluationContext.hs +++ b/plutus-ledger-api/src/PlutusLedgerApi/V2/EvaluationContext.hs @@ -43,3 +43,7 @@ mkEvaluationContext = (\pv -> if pv < changPV then DefaultFunSemanticsVariantA else DefaultFunSemanticsVariantB) + (\pv -> + if pv < futurePV + then unavailableCaserBuiltin (getMajorProtocolVersion pv) + else CaserBuiltin caseBuiltin) diff --git a/plutus-ledger-api/src/PlutusLedgerApi/V3/EvaluationContext.hs b/plutus-ledger-api/src/PlutusLedgerApi/V3/EvaluationContext.hs index 9f8b4b156e7..39395e1cf72 100644 --- a/plutus-ledger-api/src/PlutusLedgerApi/V3/EvaluationContext.hs +++ b/plutus-ledger-api/src/PlutusLedgerApi/V3/EvaluationContext.hs @@ -40,3 +40,7 @@ mkEvaluationContext = [DefaultFunSemanticsVariantC] -- See Note [Mapping of protocol versions and ledger languages to semantics variants]. (const DefaultFunSemanticsVariantC) + (\pv -> + if pv < futurePV + then unavailableCaserBuiltin (getMajorProtocolVersion pv) + else CaserBuiltin caseBuiltin) From 8d72e6cee984444a15b44b6879932ac319306c90 Mon Sep 17 00:00:00 2001 From: effectfully Date: Thu, 5 Jun 2025 02:06:22 +0100 Subject: [PATCH 16/25] Add versioning for casing --- .../common/PlutusBenchmark/Common.hs | 2 + plutus-conformance/haskell-steppable/Spec.hs | 5 ++- plutus-conformance/haskell/Spec.hs | 5 ++- .../src/PlutusCore/Builtin/Case.hs | 4 ++ .../Evaluation/Machine/ExBudgetingDefaults.hs | 14 ++++--- .../Evaluation/Machine/MachineParameters.hs | 41 +++++++++++-------- .../Machine/MachineParameters/Default.hs | 11 +++-- .../Transform/StrictLetRec/Tests/Lib.hs | 20 +++++---- .../Evaluation/Machine/Cek.hs | 12 +++--- .../Evaluation/Machine/Cek/Internal.hs | 28 +++++++++---- .../Evaluation/Machine/SteppableCek.hs | 12 +++--- .../Machine/SteppableCek/Internal.hs | 25 ++++++----- .../testlib/Evaluation/Builtins/Common.hs | 4 +- .../testlib/Evaluation/Builtins/Definition.hs | 4 +- .../testlib/Evaluation/Machines.hs | 3 +- .../testlib/Transform/CaseOfCase/Test.hs | 20 +++++---- .../src/PlutusLedgerApi/Common/Eval.hs | 23 +++++++---- .../src/PlutusLedgerApi/MachineParameters.hs | 14 +++++-- .../PlutusLedgerApi/V1/EvaluationContext.hs | 10 +++-- .../PlutusLedgerApi/V2/EvaluationContext.hs | 12 +++--- .../PlutusLedgerApi/V3/EvaluationContext.hs | 10 +++-- 21 files changed, 174 insertions(+), 105 deletions(-) diff --git a/plutus-benchmark/common/PlutusBenchmark/Common.hs b/plutus-benchmark/common/PlutusBenchmark/Common.hs index fb754701187..a832514f391 100644 --- a/plutus-benchmark/common/PlutusBenchmark/Common.hs +++ b/plutus-benchmark/common/PlutusBenchmark/Common.hs @@ -33,6 +33,7 @@ import PlutusBenchmark.ProtocolParameters as PP import PlutusLedgerApi.Common qualified as LedgerApi import PlutusCore qualified as PLC +import PlutusCore.Builtin qualified as PLC import PlutusCore.Default import PlutusCore.Evaluation.Machine.ExBudget (ExBudget (..)) import PlutusCore.Evaluation.Machine.ExBudgetingDefaults qualified as PLC @@ -97,6 +98,7 @@ mkEvalCtx ll semvar = let errOrCtx = LedgerApi.mkDynEvaluationContext ll + (\_ -> PLC.CaserBuiltin PLC.caseBuiltin) [semvar] (const semvar) p diff --git a/plutus-conformance/haskell-steppable/Spec.hs b/plutus-conformance/haskell-steppable/Spec.hs index c023dba64f7..5be979a008f 100644 --- a/plutus-conformance/haskell-steppable/Spec.hs +++ b/plutus-conformance/haskell-steppable/Spec.hs @@ -4,6 +4,7 @@ module Main (main) where import PlutusConformance.Common +import PlutusCore.Evaluation.Machine.MachineParameters qualified as UPLC import PlutusCore.Evaluation.Machine.MachineParameters.Default import PlutusPrelude import UntypedPlutusCore as UPLC @@ -31,9 +32,9 @@ failingBudgetTests = [] evalSteppableUplcProg :: UplcEvaluator evalSteppableUplcProg = UplcEvaluatorWithCosting $ \modelParams (UPLC.Program a v t) -> do - params <- case mkMachineParametersFor [def] modelParams of + params <- case mkMachineVariantParametersFor [def] modelParams of Left _ -> Nothing - Right machParamsList -> lookup def machParamsList + Right machParamsList -> UPLC.MachineParameters def <$> lookup def machParamsList -- runCek-like functions (e.g. evaluateCekNoEmit) are partial on term's with -- free variables, that is why we manually check first for any free vars case UPLC.deBruijnTerm t of diff --git a/plutus-conformance/haskell/Spec.hs b/plutus-conformance/haskell/Spec.hs index c15b923c1db..1ab98cb52bc 100644 --- a/plutus-conformance/haskell/Spec.hs +++ b/plutus-conformance/haskell/Spec.hs @@ -4,6 +4,7 @@ module Main (main) where import PlutusConformance.Common (UplcEvaluator (..), runUplcEvalTests) +import PlutusCore.Evaluation.Machine.MachineParameters qualified as UPLC import PlutusCore.Evaluation.Machine.MachineParameters.Default import PlutusPrelude (def) import UntypedPlutusCore qualified as UPLC @@ -13,9 +14,9 @@ import UntypedPlutusCore.Evaluation.Machine.Cek (CountingSt (..), counting, runC evalUplcProg :: UplcEvaluator evalUplcProg = UplcEvaluatorWithCosting $ \modelParams (UPLC.Program a v t) -> do - params <- case mkMachineParametersFor [def] modelParams of + params <- case mkMachineVariantParametersFor [def] modelParams of Left _ -> Nothing - Right machParamsList -> lookup def machParamsList + Right machParamsList -> UPLC.MachineParameters def <$> lookup def machParamsList -- runCek-like functions (e.g. evaluateCekNoEmit) are partial on term's with -- free variables, that is why we manually check first for any free vars case UPLC.deBruijnTerm t of diff --git a/plutus-core/plutus-core/src/PlutusCore/Builtin/Case.hs b/plutus-core/plutus-core/src/PlutusCore/Builtin/Case.hs index d64374aeb96..c9049722a6a 100644 --- a/plutus-core/plutus-core/src/PlutusCore/Builtin/Case.hs +++ b/plutus-core/plutus-core/src/PlutusCore/Builtin/Case.hs @@ -9,6 +9,7 @@ import PlutusCore.Core.Type (Type, UniOf) import PlutusCore.Name.Unique import Control.DeepSeq (NFData (..), rwhnf) +import Data.Default.Class (Default (..)) import Data.Text (Text) import Data.Vector (Vector) import NoThunks.Class @@ -41,6 +42,9 @@ instance NFData (CaserBuiltin uni) where deriving via OnlyCheckWhnfNamed "PlutusCore.Builtin.Case.CaserBuiltin" (CaserBuiltin uni) instance NoThunks (CaserBuiltin uni) +instance CaseBuiltin uni => Default (CaserBuiltin uni) where + def = CaserBuiltin caseBuiltin + unavailableCaserBuiltin :: Int -> CaserBuiltin uni unavailableCaserBuiltin ver = CaserBuiltin $ \_ _ -> Left $ diff --git a/plutus-core/plutus-core/src/PlutusCore/Evaluation/Machine/ExBudgetingDefaults.hs b/plutus-core/plutus-core/src/PlutusCore/Evaluation/Machine/ExBudgetingDefaults.hs index ae19d52e3ba..fee952fc5b4 100644 --- a/plutus-core/plutus-core/src/PlutusCore/Evaluation/Machine/ExBudgetingDefaults.hs +++ b/plutus-core/plutus-core/src/PlutusCore/Evaluation/Machine/ExBudgetingDefaults.hs @@ -149,17 +149,20 @@ faster than the used in production. Also see Note [noinline for saving on ticks]. -} defaultCekParametersA :: Typeable ann => MachineParameters CekMachineCosts DefaultFun (CekValue DefaultUni DefaultFun ann) defaultCekParametersA = - noinline mkMachineParameters DefaultFunSemanticsVariantA cekCostModelVariantA + MachineParameters def $ + noinline mkMachineVariantParameters DefaultFunSemanticsVariantA cekCostModelVariantA -- See Note [No inlining for MachineParameters] defaultCekParametersB :: Typeable ann => MachineParameters CekMachineCosts DefaultFun (CekValue DefaultUni DefaultFun ann) defaultCekParametersB = - noinline mkMachineParameters DefaultFunSemanticsVariantB cekCostModelVariantB + MachineParameters def $ + noinline mkMachineVariantParameters DefaultFunSemanticsVariantB cekCostModelVariantB -- See Note [No inlining for MachineParameters] defaultCekParametersC :: Typeable ann => MachineParameters CekMachineCosts DefaultFun (CekValue DefaultUni DefaultFun ann) defaultCekParametersC = - noinline mkMachineParameters DefaultFunSemanticsVariantC cekCostModelVariantC + MachineParameters def $ + noinline mkMachineVariantParameters DefaultFunSemanticsVariantC cekCostModelVariantC {- Note [noinline for saving on ticks] We use 'noinline' purely for saving on simplifier ticks for definitions, whose performance doesn't @@ -357,5 +360,6 @@ unitCostBuiltinCostModel = BuiltinCostModelBase unitCekParameters :: Typeable ann => MachineParameters CekMachineCosts DefaultFun (CekValue DefaultUni DefaultFun ann) unitCekParameters = -- See Note [noinline for saving on ticks]. - noinline mkMachineParameters def $ - CostModel unitCekMachineCosts unitCostBuiltinCostModel + MachineParameters def $ + noinline mkMachineVariantParameters def $ + CostModel unitCekMachineCosts unitCostBuiltinCostModel diff --git a/plutus-core/plutus-core/src/PlutusCore/Evaluation/Machine/MachineParameters.hs b/plutus-core/plutus-core/src/PlutusCore/Evaluation/Machine/MachineParameters.hs index 521f3177881..1b2fefcc2d1 100644 --- a/plutus-core/plutus-core/src/PlutusCore/Evaluation/Machine/MachineParameters.hs +++ b/plutus-core/plutus-core/src/PlutusCore/Evaluation/Machine/MachineParameters.hs @@ -37,25 +37,33 @@ makeLenses ''CostModel cost model for builtins and their denotations. This bundles one of those together with the cost model for evaluator steps. The 'term' type will be CekValue when we're using this with the CEK machine. -} -data MachineParameters machinecosts fun val = - MachineParameters { - machineCosts :: machinecosts +data MachineVariantParameters machineCosts fun val = + MachineVariantParameters { + machineCosts :: machineCosts , builtinsRuntime :: BuiltinsRuntime fun val - , caserBuiltin :: CaserBuiltin (UniOf val) + } + deriving stock Generic + deriving anyclass (NFData) + +data MachineParameters machineCosts fun val = + MachineParameters { + machineCaserBuiltin :: CaserBuiltin (UniOf val) + , machineVariantParameters :: MachineVariantParameters machineCosts fun val } deriving stock Generic deriving anyclass (NFData) -- For some reason the generic instance gives incorrect nothunk errors, -- see https://github.com/input-output-hk/nothunks/issues/24 +instance (NoThunks machinecosts, Bounded fun, Enum fun) => NoThunks (MachineVariantParameters machinecosts fun val) where + wNoThunks ctx (MachineVariantParameters costs runtime) = + allNoThunks [ noThunks ctx costs, noThunks ctx runtime ] + instance (NoThunks machinecosts, Bounded fun, Enum fun) => NoThunks (MachineParameters machinecosts fun val) where - wNoThunks ctx (MachineParameters costs runtime caser) = allNoThunks - [ noThunks ctx costs - , noThunks ctx runtime - , noThunks ctx caser - ] + wNoThunks ctx (MachineParameters caser varPars) = + allNoThunks [ noThunks ctx caser, noThunks ctx varPars ] -{- Note [The CostingPart constraint in mkMachineParameters] +{- Note [The CostingPart constraint in mkMachineVariantParameters] Discharging the @CostingPart uni fun ~ builtincosts@ constraint in 'mkMachineParameters' causes GHC to fail to inline the function at its call site regardless of the @INLINE@ pragma and an explicit 'inline' call. @@ -82,7 +90,7 @@ which makes sense: if @f@ receives all its type and term args then there's less -- See Note [Inlining meanings of builtins]. {-| This just uses 'toBuiltinsRuntime' function to convert a BuiltinCostModel to a BuiltinsRuntime. -} -mkMachineParameters :: +mkMachineVariantParameters :: ( -- WARNING: do not discharge the equality constraint as that causes GHC to fail to inline the -- function at its call site, see Note [The CostingPart constraint in mkMachineParameters]. CostingPart uni fun ~ builtincosts @@ -90,9 +98,8 @@ mkMachineParameters :: , ToBuiltinMeaning uni fun ) => BuiltinSemanticsVariant fun - -> CostModel machinecosts builtincosts - -> CaserBuiltin uni - -> MachineParameters machinecosts fun val -mkMachineParameters semvar (CostModel mchnCosts builtinCosts) = - MachineParameters mchnCosts (inline toBuiltinsRuntime semvar builtinCosts) -{-# INLINE mkMachineParameters #-} + -> CostModel machineCosts builtincosts + -> MachineVariantParameters machineCosts fun val +mkMachineVariantParameters semvar (CostModel mchnCosts builtinCosts) = + MachineVariantParameters mchnCosts $ inline toBuiltinsRuntime semvar builtinCosts +{-# INLINE mkMachineVariantParameters #-} diff --git a/plutus-core/plutus-core/src/PlutusCore/Evaluation/Machine/MachineParameters/Default.hs b/plutus-core/plutus-core/src/PlutusCore/Evaluation/Machine/MachineParameters/Default.hs index b7eca92f7bd..f806ee13b35 100644 --- a/plutus-core/plutus-core/src/PlutusCore/Evaluation/Machine/MachineParameters/Default.hs +++ b/plutus-core/plutus-core/src/PlutusCore/Evaluation/Machine/MachineParameters/Default.hs @@ -19,6 +19,9 @@ import GHC.Exts (inline) -- | 'MachineParameters' instantiated at CEK-machine-specific types and default builtins. -- Encompasses everything we need for evaluating a UPLC program with default builtins using the CEK -- machine. +type DefaultMachineVariantParameters = + MachineVariantParameters CekMachineCosts DefaultFun (CekValue DefaultUni DefaultFun ()) + type DefaultMachineParameters = MachineParameters CekMachineCosts DefaultFun (CekValue DefaultUni DefaultFun ()) @@ -59,15 +62,15 @@ inlining). -- -- This function is very expensive, so its result needs to be cached if it's going to be used -- multiple times. -mkMachineParametersFor +mkMachineVariantParametersFor :: MonadError CostModelApplyError m => [BuiltinSemanticsVariant DefaultFun] -> CostModelParams - -> m [(BuiltinSemanticsVariant DefaultFun, DefaultMachineParameters)] -mkMachineParametersFor semVars newCMP = do + -> m [(BuiltinSemanticsVariant DefaultFun, DefaultMachineVariantParameters)] +mkMachineVariantParametersFor semVars newCMP = do res <- for semVars $ \semVar -> -- See Note [Inlining meanings of builtins]. - (,) semVar . inline mkMachineParameters semVar <$> + (,) semVar . inline mkMachineVariantParameters semVar <$> applyCostModelParams (cekCostModelForVariant semVar) newCMP -- Force all thunks to pay the cost of creating machine parameters upfront. Doing it here saves -- us from doing that in every single benchmark runner. diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/StrictLetRec/Tests/Lib.hs b/plutus-core/plutus-ir/test/PlutusIR/Transform/StrictLetRec/Tests/Lib.hs index 1f994bbba18..b786a8498b7 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/StrictLetRec/Tests/Lib.hs +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/StrictLetRec/Tests/Lib.hs @@ -20,7 +20,8 @@ import PlutusCore.Evaluation.Machine.BuiltinCostModel (BuiltinCostModel) import PlutusCore.Evaluation.Machine.ExBudgetingDefaults (defaultBuiltinCostModelForTesting, defaultCekMachineCostsForTesting) import PlutusCore.Evaluation.Machine.MachineParameters (CostModel (..), MachineParameters (..), - mkMachineParameters) + mkMachineVariantParameters) +import PlutusCore.Evaluation.Machine.MachineParameters.Default (DefaultMachineParameters) import PlutusCore.Parser qualified as PC import PlutusCore.Quote (runQuoteT) import PlutusCore.TypeCheck qualified as PLC @@ -30,8 +31,8 @@ import PlutusIR.Compiler qualified as PIR import PlutusIR.Core qualified as PIR import PlutusIR.Parser (pTerm) import UntypedPlutusCore.Core qualified as UPLC -import UntypedPlutusCore.Evaluation.Machine.Cek (CekValue, EvaluationResult (..), evaluateCek, - logEmitter, unsafeSplitStructuralOperational) +import UntypedPlutusCore.Evaluation.Machine.Cek (EvaluationResult (..), evaluateCek, logEmitter, + unsafeSplitStructuralOperational) import UntypedPlutusCore.Evaluation.Machine.Cek.CekMachineCosts (CekMachineCosts) pirTermFromFile @@ -87,11 +88,14 @@ evaluateUplcProgramWithTraces uplcProg = first unsafeSplitStructuralOperational $ evaluateCek logEmitter machineParameters (uplcProg ^. UPLC.progTerm) where - costModel :: CostModel CekMachineCosts BuiltinCostModel = - CostModel defaultCekMachineCostsForTesting defaultBuiltinCostModelForTesting - machineParameters - :: MachineParameters CekMachineCosts DefaultFun (CekValue DefaultUni DefaultFun ()) = - mkMachineParameters def costModel + costModel :: CostModel CekMachineCosts BuiltinCostModel + costModel = + CostModel defaultCekMachineCostsForTesting defaultBuiltinCostModelForTesting + + machineParameters :: DefaultMachineParameters + machineParameters = + -- TODO: proper semantic variant. What should def be? + MachineParameters def $ mkMachineVariantParameters def costModel defaultCompilationCtx :: Either diff --git a/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Evaluation/Machine/Cek.hs b/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Evaluation/Machine/Cek.hs index 10dd7c3f049..480ccdf8950 100644 --- a/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Evaluation/Machine/Cek.hs +++ b/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Evaluation/Machine/Cek.hs @@ -67,7 +67,7 @@ A wrapper around the internal runCek to debruijn input and undebruijn output. *THIS FUNCTION IS PARTIAL if the input term contains free variables* -} runCek - :: (ThrowableBuiltins uni fun, CaseBuiltin uni) + :: ThrowableBuiltins uni fun => MachineParameters CekMachineCosts fun (CekValue uni fun ann) -> ExBudgetMode cost uni fun -> EmitterMode uni fun @@ -78,7 +78,7 @@ runCek = Common.runCek runCekDeBruijn -- | Evaluate a term using the CEK machine with logging disabled and keep track of costing. -- *THIS FUNCTION IS PARTIAL if the input term contains free variables* runCekNoEmit - :: (ThrowableBuiltins uni fun, CaseBuiltin uni) + :: ThrowableBuiltins uni fun => MachineParameters CekMachineCosts fun (CekValue uni fun ann) -> ExBudgetMode cost uni fun -> Term Name uni fun ann @@ -88,7 +88,7 @@ runCekNoEmit = Common.runCekNoEmit runCekDeBruijn -- | Evaluate a term using the CEK machine with logging enabled. -- *THIS FUNCTION IS PARTIAL if the input term contains free variables* evaluateCek - :: (ThrowableBuiltins uni fun, CaseBuiltin uni) + :: ThrowableBuiltins uni fun => EmitterMode uni fun -> MachineParameters CekMachineCosts fun (CekValue uni fun ann) -> Term Name uni fun ann @@ -98,7 +98,7 @@ evaluateCek = Common.evaluateCek runCekDeBruijn -- | Evaluate a term using the CEK machine with logging disabled. -- *THIS FUNCTION IS PARTIAL if the input term contains free variables* evaluateCekNoEmit - :: (ThrowableBuiltins uni fun, CaseBuiltin uni) + :: ThrowableBuiltins uni fun => MachineParameters CekMachineCosts fun (CekValue uni fun ann) -> Term Name uni fun ann -> Either (CekEvaluationException Name uni fun) (Term Name uni fun ()) @@ -107,9 +107,7 @@ evaluateCekNoEmit = Common.evaluateCekNoEmit runCekDeBruijn -- | Unlift a value using the CEK machine. -- *THIS FUNCTION IS PARTIAL if the input term contains free variables* readKnownCek - :: ( ThrowableBuiltins uni fun, CaseBuiltin uni - , ReadKnown (Term Name uni fun ()) a - ) + :: (ThrowableBuiltins uni fun, ReadKnown (Term Name uni fun ()) a) => MachineParameters CekMachineCosts fun (CekValue uni fun ann) -> Term Name uni fun ann -> Either (CekEvaluationException Name uni fun) a diff --git a/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Evaluation/Machine/Cek/Internal.hs b/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Evaluation/Machine/Cek/Internal.hs index f77f2ae7695..b86f2c06aea 100644 --- a/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Evaluation/Machine/Cek/Internal.hs +++ b/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Evaluation/Machine/Cek/Internal.hs @@ -395,17 +395,26 @@ they don't actually take the context as an argument even at the source level. -} -- | Implicit parameter for the builtin runtime. -type GivenCekRuntime uni fun ann = (?cekRuntime :: (BuiltinsRuntime fun (CekValue uni fun ann))) +type GivenCekRuntime uni fun ann = (?cekRuntime :: BuiltinsRuntime fun (CekValue uni fun ann)) +type GivenCekCaserBuiltin uni = (?cekCaserBuiltin :: CaserBuiltin uni) -- | Implicit parameter for the log emitter reference. type GivenCekEmitter uni fun s = (?cekEmitter :: CekEmitter uni fun s) -- | Implicit parameter for budget spender. -type GivenCekSpender uni fun s = (?cekBudgetSpender :: (CekBudgetSpender uni fun s)) +type GivenCekSpender uni fun s = (?cekBudgetSpender :: CekBudgetSpender uni fun s) type GivenCekSlippage = (?cekSlippage :: Slippage) type GivenCekStepCounter s = (?cekStepCounter :: StepCounter CounterSize s) type GivenCekCosts = (?cekCosts :: CekMachineCosts) -- | Constraint requiring all of the machine's implicit parameters. -type GivenCekReqs uni fun ann s = (GivenCekRuntime uni fun ann, GivenCekEmitter uni fun s, GivenCekSpender uni fun s, GivenCekSlippage, GivenCekStepCounter s, GivenCekCosts) +type GivenCekReqs uni fun ann s = + ( GivenCekRuntime uni fun ann + , GivenCekCaserBuiltin uni + , GivenCekEmitter uni fun s + , GivenCekSpender uni fun s + , GivenCekSlippage + , GivenCekStepCounter s + , GivenCekCosts + ) data CekUserError = CaseBuiltinError Text -- ^ 'Case' over a value of a built-in type failed. @@ -659,11 +668,16 @@ runCekM -> EmitterMode uni fun -> (forall s. GivenCekReqs uni fun ann s => CekM uni fun s a) -> (Either (CekEvaluationException NamedDeBruijn uni fun) a, cost, [Text]) -runCekM (MachineParameters costs runtime) (ExBudgetMode getExBudgetInfo) (EmitterMode getEmitterMode) a = runST $ do +runCekM + (MachineParameters caser (MachineVariantParameters costs runtime)) + (ExBudgetMode getExBudgetInfo) + (EmitterMode getEmitterMode) + a = runST $ do ExBudgetInfo{_exBudgetModeSpender, _exBudgetModeGetFinal, _exBudgetModeGetCumulative} <- getExBudgetInfo CekEmitterInfo{_cekEmitterInfoEmit, _cekEmitterInfoGetFinal} <- getEmitterMode _exBudgetModeGetCumulative ctr <- newCounter (Proxy @CounterSize) let ?cekRuntime = runtime + ?cekCaserBuiltin = caser ?cekEmitter = _cekEmitterInfoEmit ?cekBudgetSpender = _exBudgetModeSpender ?cekCosts = costs @@ -679,7 +693,7 @@ runCekM (MachineParameters costs runtime) (ExBudgetMode getExBudgetInfo) (Emitte -- | The entering point to the CEK machine's engine. enterComputeCek :: forall uni fun ann s - . (ThrowableBuiltins uni fun, CaseBuiltin uni, GivenCekReqs uni fun ann s) + . (ThrowableBuiltins uni fun, GivenCekReqs uni fun ann s) => Context uni fun ann -> CekValEnv uni fun ann -> NTerm uni fun ann @@ -790,7 +804,7 @@ enterComputeCek = computeCek (VConstr i args) -> case (V.!?) cs (fromIntegral i) of Just t -> computeCek (transferArgStack args ctx) env t Nothing -> throwErrorDischarged (StructuralError $ MissingCaseBranchMachineError i) e - VCon val -> case caseBuiltin val cs of + VCon val -> case unCaserBuiltin ?cekCaserBuiltin val cs of Left err -> throwErrorDischarged (OperationalError $ CaseBuiltinError err) e Right res -> computeCek ctx env res _ -> throwErrorDischarged (StructuralError NonConstrScrutinizedMachineError) e @@ -945,7 +959,7 @@ enterComputeCek = computeCek -- See Note [Compilation peculiarities]. -- | Evaluate a term using the CEK machine and keep track of costing, logging is optional. runCekDeBruijn - :: (ThrowableBuiltins uni fun, CaseBuiltin uni) + :: ThrowableBuiltins uni fun => MachineParameters CekMachineCosts fun (CekValue uni fun ann) -> ExBudgetMode cost uni fun -> EmitterMode uni fun diff --git a/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Evaluation/Machine/SteppableCek.hs b/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Evaluation/Machine/SteppableCek.hs index b5d746fda5d..5f68a18e624 100644 --- a/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Evaluation/Machine/SteppableCek.hs +++ b/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Evaluation/Machine/SteppableCek.hs @@ -64,7 +64,7 @@ A wrapper around the internal runCek to debruijn input and undebruijn output. *THIS FUNCTION IS PARTIAL if the input term contains free variables* -} runCek - :: (ThrowableBuiltins uni fun, CaseBuiltin uni) + :: ThrowableBuiltins uni fun => MachineParameters CekMachineCosts fun (CekValue uni fun ann) -> ExBudgetMode cost uni fun -> EmitterMode uni fun @@ -76,7 +76,7 @@ runCek = Common.runCek S.runCekDeBruijn -- keep track of costing. -- *THIS FUNCTION IS PARTIAL if the input term contains free variables* runCekNoEmit - :: (ThrowableBuiltins uni fun, CaseBuiltin uni) + :: ThrowableBuiltins uni fun => MachineParameters CekMachineCosts fun (CekValue uni fun ann) -> ExBudgetMode cost uni fun -> Term Name uni fun ann @@ -86,7 +86,7 @@ runCekNoEmit = Common.runCekNoEmit S.runCekDeBruijn -- | Evaluate a term using the Steppable CEK machine with logging enabled. -- *THIS FUNCTION IS PARTIAL if the input term contains free variables* evaluateCek - :: (ThrowableBuiltins uni fun, CaseBuiltin uni) + :: ThrowableBuiltins uni fun => EmitterMode uni fun -> MachineParameters CekMachineCosts fun (CekValue uni fun ann) -> Term Name uni fun ann @@ -96,7 +96,7 @@ evaluateCek = Common.evaluateCek S.runCekDeBruijn -- | Evaluate a term using the Steppable CEK machine with logging disabled. -- *THIS FUNCTION IS PARTIAL if the input term contains free variables* evaluateCekNoEmit - :: (ThrowableBuiltins uni fun, CaseBuiltin uni) + :: ThrowableBuiltins uni fun => MachineParameters CekMachineCosts fun (CekValue uni fun ann) -> Term Name uni fun ann -> Either (CekEvaluationException Name uni fun) (Term Name uni fun ()) @@ -105,9 +105,7 @@ evaluateCekNoEmit = Common.evaluateCekNoEmit S.runCekDeBruijn -- | Unlift a value using the Steppable CEK machine. -- *THIS FUNCTION IS PARTIAL if the input term contains free variables* readKnownCek - :: ( ThrowableBuiltins uni fun, CaseBuiltin uni - , ReadKnown (Term Name uni fun ()) a - ) + :: (ThrowableBuiltins uni fun, ReadKnown (Term Name uni fun ()) a) => MachineParameters CekMachineCosts fun (CekValue uni fun ann) -> Term Name uni fun ann -> Either (CekEvaluationException Name uni fun) a diff --git a/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Evaluation/Machine/SteppableCek/Internal.hs b/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Evaluation/Machine/SteppableCek/Internal.hs index 1d978a315cd..cdb3085a1a8 100644 --- a/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Evaluation/Machine/SteppableCek/Internal.hs +++ b/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Evaluation/Machine/SteppableCek/Internal.hs @@ -170,7 +170,7 @@ computeCek !_ !_ (Error _) = returnCek :: forall uni fun ann s - . (ThrowableBuiltins uni fun, CaseBuiltin uni, GivenCekReqs uni fun ann s) + . (ThrowableBuiltins uni fun, GivenCekReqs uni fun ann s) => Context uni fun ann -> CekValue uni fun ann -> CekM uni fun s (CekState uni fun ann) @@ -211,7 +211,7 @@ returnCek (FrameCases ann env cs ctx) e = case e of let ctx' = transferArgStack ann args ctx in computeCek ctx' env t Nothing -> throwErrorDischarged (StructuralError $ MissingCaseBranchMachineError i) e - VCon val -> case caseBuiltin val cs of + VCon val -> case unCaserBuiltin ?cekCaserBuiltin val cs of Left err -> throwErrorDischarged (OperationalError $ CaseBuiltinError err) e Right res -> pure $ Computing ctx env res _ -> throwErrorDischarged (StructuralError NonConstrScrutinizedMachineError) e @@ -224,7 +224,7 @@ returnCek (FrameCases ann env cs ctx) e = case e of -- if v is anything else, fail. forceEvaluate :: forall uni fun ann s - . (ThrowableBuiltins uni fun, CaseBuiltin uni, GivenCekReqs uni fun ann s) + . (ThrowableBuiltins uni fun, GivenCekReqs uni fun ann s) => ann -> Context uni fun ann -> CekValue uni fun ann @@ -256,7 +256,7 @@ forceEvaluate _ !_ val = -- If v is anything else, fail. applyEvaluate :: forall uni fun ann s - . (ThrowableBuiltins uni fun, CaseBuiltin uni, GivenCekReqs uni fun ann s) + . (ThrowableBuiltins uni fun, GivenCekReqs uni fun ann s) => ann -> Context uni fun ann -> CekValue uni fun ann -- lhs of application @@ -282,7 +282,7 @@ applyEvaluate _ !_ val _ = -- MAYBE: runCekDeBruijn can be shared between original&debug ceks by passing a `enterComputeCek` func. runCekDeBruijn - :: (ThrowableBuiltins uni fun, CaseBuiltin uni) + :: ThrowableBuiltins uni fun => MachineParameters CekMachineCosts fun (CekValue uni fun ann) -> ExBudgetMode cost uni fun -> EmitterMode uni fun @@ -297,7 +297,7 @@ runCekDeBruijn params mode emitMode term = -- | The entering point to the CEK machine's engine. enterComputeCek :: forall uni fun ann s - . (ThrowableBuiltins uni fun, CaseBuiltin uni, GivenCekReqs uni fun ann s) + . (ThrowableBuiltins uni fun, GivenCekReqs uni fun ann s) => Context uni fun ann -> CekValEnv uni fun ann -> NTerm uni fun ann @@ -325,7 +325,7 @@ type CekTrans uni fun ann s = Trans (CekM uni fun s) (CekState uni fun ann) -- | The state transition function of the machine. cekTrans :: forall uni fun ann s - . (ThrowableBuiltins uni fun, CaseBuiltin uni, GivenCekReqs uni fun ann s) + . (ThrowableBuiltins uni fun, GivenCekReqs uni fun ann s) => CekTrans uni fun ann s cekTrans = \case Starting term -> pure $ Computing NoFrame Env.empty term @@ -338,18 +338,23 @@ cekTrans = \case -- Returns the constructed transition function paired with the methods to live access the running budget. mkCekTrans :: forall cost uni fun ann m s - . ( ThrowableBuiltins uni fun, CaseBuiltin uni + . ( ThrowableBuiltins uni fun , PrimMonad m, s ~ PrimState m) -- the outer monad that initializes the transition function => MachineParameters CekMachineCosts fun (CekValue uni fun ann) -> ExBudgetMode cost uni fun -> EmitterMode uni fun -> Slippage -> m (CekTrans uni fun ann s, ExBudgetInfo cost uni fun s) -mkCekTrans (MachineParameters costs runtime) (ExBudgetMode getExBudgetInfo) (EmitterMode getEmitterMode) slippage = do +mkCekTrans + (MachineParameters caser (MachineVariantParameters costs runtime)) + (ExBudgetMode getExBudgetInfo) + (EmitterMode getEmitterMode) + slippage = do exBudgetInfo@ExBudgetInfo{_exBudgetModeSpender, _exBudgetModeGetCumulative} <- liftPrim getExBudgetInfo CekEmitterInfo{_cekEmitterInfoEmit} <- liftPrim $ getEmitterMode _exBudgetModeGetCumulative ctr <- newCounter (Proxy @CounterSize) let ?cekRuntime = runtime + ?cekCaserBuiltin = caser ?cekEmitter = _cekEmitterInfoEmit ?cekBudgetSpender = _exBudgetModeSpender ?cekCosts = costs @@ -456,7 +461,7 @@ returnCekHeadSpine ann ctx (HeadSpine f xs) = pure $ Returning (transferSpine an -- -- and proceed with the returning phase of the CEK machine. evalBuiltinApp - :: (ThrowableBuiltins uni fun, CaseBuiltin uni, GivenCekReqs uni fun ann s) + :: (ThrowableBuiltins uni fun, GivenCekReqs uni fun ann s) => ann -> Context uni fun ann -> fun diff --git a/plutus-core/untyped-plutus-core/testlib/Evaluation/Builtins/Common.hs b/plutus-core/untyped-plutus-core/testlib/Evaluation/Builtins/Common.hs index 2c269c391d3..de800b64d07 100644 --- a/plutus-core/untyped-plutus-core/testlib/Evaluation/Builtins/Common.hs +++ b/plutus-core/untyped-plutus-core/testlib/Evaluation/Builtins/Common.hs @@ -58,7 +58,7 @@ import Test.Tasty.QuickCheck (Property, property, (===)) -- | Type check and evaluate a term. typecheckAnd :: ( MonadError (TypeErrorPlc uni fun ()) m, TPLC.Typecheckable uni fun, GEq uni - , Closed uni, uni `Everywhere` ExMemoryUsage + , CaseBuiltin uni, Closed uni, uni `Everywhere` ExMemoryUsage ) => BuiltinSemanticsVariant fun -> (MachineParameters CekMachineCosts fun (CekValue uni fun ()) -> @@ -71,7 +71,7 @@ typecheckAnd semvar action costingPart term = TPLC.runQuoteT $ do _ <- TPLC.inferType tcConfig term return . action runtime $ TPLC.eraseTerm term where - runtime = mkMachineParameters semvar $ + runtime = MachineParameters def . mkMachineVariantParameters semvar $ -- FIXME: make sure we have the the correct cost model for the semantics variant. CostModel defaultCekMachineCostsForTesting costingPart diff --git a/plutus-core/untyped-plutus-core/testlib/Evaluation/Builtins/Definition.hs b/plutus-core/untyped-plutus-core/testlib/Evaluation/Builtins/Definition.hs index d22b615f039..42a6849e18d 100644 --- a/plutus-core/untyped-plutus-core/testlib/Evaluation/Builtins/Definition.hs +++ b/plutus-core/untyped-plutus-core/testlib/Evaluation/Builtins/Definition.hs @@ -268,7 +268,9 @@ test_ScottToMetaUnit = applyTerm = apply () (builtin () ScottToMetaUnit) -- @scottToMetaUnit Scott.unitval@ is well-typed and runs successfully. typecheckEvaluateCekNoEmit def () (applyTerm Scott.unitval) @?= Right res - let runtime = mkMachineParameters def $ CostModel defaultCekMachineCostsForTesting () + let runtime + = MachineParameters def . mkMachineVariantParameters def + $ CostModel defaultCekMachineCostsForTesting () -- @scottToMetaUnit Scott.map@ is ill-typed, but still runs successfully, since the builtin -- doesn't look at the argument. unsafeSplitStructuralOperational (evaluateCekNoEmit runtime (eraseTerm $ applyTerm Scott.map)) @?= diff --git a/plutus-core/untyped-plutus-core/testlib/Evaluation/Machines.hs b/plutus-core/untyped-plutus-core/testlib/Evaluation/Machines.hs index 2e766036076..1898d740735 100644 --- a/plutus-core/untyped-plutus-core/testlib/Evaluation/Machines.hs +++ b/plutus-core/untyped-plutus-core/testlib/Evaluation/Machines.hs @@ -81,7 +81,8 @@ testBudget runtime name term = (render $ prettyPlcReadable $ runCekNoEmit - (MachineParameters Plc.defaultCekMachineCostsForTesting runtime) + (MachineParameters def $ + MachineVariantParameters Plc.defaultCekMachineCostsForTesting runtime) Cek.tallying term) bunchOfFibs :: PlcFolderContents DefaultUni DefaultFun diff --git a/plutus-core/untyped-plutus-core/testlib/Transform/CaseOfCase/Test.hs b/plutus-core/untyped-plutus-core/testlib/Transform/CaseOfCase/Test.hs index f942dd431f7..03281341691 100644 --- a/plutus-core/untyped-plutus-core/testlib/Transform/CaseOfCase/Test.hs +++ b/plutus-core/untyped-plutus-core/testlib/Transform/CaseOfCase/Test.hs @@ -11,8 +11,9 @@ import PlutusCore qualified as PLC import PlutusCore.Evaluation.Machine.BuiltinCostModel (BuiltinCostModel) import PlutusCore.Evaluation.Machine.ExBudgetingDefaults (defaultBuiltinCostModelForTesting, defaultCekMachineCostsForTesting) -import PlutusCore.Evaluation.Machine.MachineParameters (CostModel (..), MachineParameters, - mkMachineParameters) +import PlutusCore.Evaluation.Machine.MachineParameters (CostModel (..), MachineParameters (..), + mkMachineVariantParameters) +import PlutusCore.Evaluation.Machine.MachineParameters.Default (DefaultMachineParameters) import PlutusCore.MkPlc (mkConstant, mkIterApp) import PlutusCore.Pretty import PlutusCore.Quote (freshName, runQuote) @@ -22,7 +23,7 @@ import Test.Tasty.Golden (goldenVsString) import Test.Tasty.HUnit (testCase, (@?=)) import UntypedPlutusCore (DefaultFun, DefaultUni, Name, Term (..)) import UntypedPlutusCore.Core qualified as UPLC -import UntypedPlutusCore.Evaluation.Machine.Cek (CekMachineCosts, CekValue, EvaluationResult (..), +import UntypedPlutusCore.Evaluation.Machine.Cek (CekMachineCosts, EvaluationResult (..), evaluateCek, noEmitter, unsafeSplitStructuralOperational) import UntypedPlutusCore.Transform.CaseOfCase (caseOfCase) @@ -128,11 +129,14 @@ evaluateUplc -> EvaluationResult (UPLC.Term Name DefaultUni DefaultFun ()) evaluateUplc = unsafeSplitStructuralOperational . fst <$> evaluateCek noEmitter machineParameters where - costModel :: CostModel CekMachineCosts BuiltinCostModel = - CostModel defaultCekMachineCostsForTesting defaultBuiltinCostModelForTesting - machineParameters - :: MachineParameters CekMachineCosts DefaultFun (CekValue DefaultUni DefaultFun ()) = - mkMachineParameters def costModel -- TODO: proper semantic variant. What should def be? + costModel :: CostModel CekMachineCosts BuiltinCostModel + costModel = + CostModel defaultCekMachineCostsForTesting defaultBuiltinCostModelForTesting + + machineParameters :: DefaultMachineParameters + machineParameters = + -- TODO: proper semantic variant. What should def be? + MachineParameters def $ mkMachineVariantParameters def costModel goldenVsSimplified :: String -> Term Name PLC.DefaultUni PLC.DefaultFun () -> TestTree goldenVsSimplified name = diff --git a/plutus-ledger-api/src/PlutusLedgerApi/Common/Eval.hs b/plutus-ledger-api/src/PlutusLedgerApi/Common/Eval.hs index 1d138f4d2e1..615789e39d8 100644 --- a/plutus-ledger-api/src/PlutusLedgerApi/Common/Eval.hs +++ b/plutus-ledger-api/src/PlutusLedgerApi/Common/Eval.hs @@ -27,6 +27,7 @@ import PlutusCore.Default import PlutusCore.Evaluation.Machine.CostModelInterface as Plutus import PlutusCore.Evaluation.Machine.ExBudget as Plutus import PlutusCore.Evaluation.Machine.ExBudgetingDefaults qualified as Plutus +import PlutusCore.Evaluation.Machine.MachineParameters (MachineParameters (..)) import PlutusCore.Evaluation.Machine.MachineParameters.Default import PlutusCore.MkPlc qualified as UPLC import PlutusCore.Pretty @@ -111,11 +112,11 @@ mkTermToEvaluate ll pv script args = do through (liftEither . first DeBruijnError . UPLC.checkScope) appliedT toMachineParameters :: MajorProtocolVersion -> EvaluationContext -> DefaultMachineParameters -toMachineParameters pv (EvaluationContext ll toSemVar machParsList) = +toMachineParameters pv (EvaluationContext ll toCaser toSemVar machParsList) = case lookup (toSemVar pv) machParsList of Nothing -> error $ Prelude.concat ["Internal error: ", show ll, " does not support protocol version ", show pv] - Just machPars -> machPars + Just machVarPars -> MachineParameters (toCaser pv) machVarPars {-| An opaque type that contains all the static parameters that the evaluator needs to evaluate a script. This is so that they can be computed once and cached, rather than being recomputed on every @@ -148,13 +149,19 @@ protocol version are data EvaluationContext = EvaluationContext { _evalCtxLedgerLang :: PlutusLedgerLanguage -- ^ Specifies what language versions the 'EvaluationContext' is for. + , _evalCtxCaserBuiltin :: MajorProtocolVersion -> CaserBuiltin DefaultUni + -- ^ Specifies how 'case' on values of built-in types works: fails evaluation for older + -- protocol versions and defers to 'caseBuiltin' for newer ones. Note that this function + -- doesn't depend on the 'PlutusLedgerLanguage' or the AST version: deserialisation of a 1.0.0 + -- AST fails upon encountering a 'Case' node anyway, so we can safely assume here that 'case' + -- is available. , _evalCtxToSemVar :: MajorProtocolVersion -> BuiltinSemanticsVariant DefaultFun -- ^ Specifies how to get a semantics variant for this ledger language given a -- 'MajorProtocolVersion'. - , _evalCtxMachParsCache :: [(BuiltinSemanticsVariant DefaultFun, DefaultMachineParameters)] + , _evalCtxMachParsCache :: + [(BuiltinSemanticsVariant DefaultFun, DefaultMachineVariantParameters)] -- ^ The cache of 'DefaultMachineParameters' for each semantics variant supported by the -- current language version. - , _evalCtxCaserBuiltin :: MajorProtocolVersion -> CaserBuiltin DefaultUni } deriving stock Generic deriving anyclass (NFData, NoThunks) @@ -175,14 +182,14 @@ with the updated cost model parameters. mkDynEvaluationContext :: MonadError CostModelApplyError m => PlutusLedgerLanguage + -> (MajorProtocolVersion -> CaserBuiltin DefaultUni) -> [BuiltinSemanticsVariant DefaultFun] -> (MajorProtocolVersion -> BuiltinSemanticsVariant DefaultFun) - -> (MajorProtocolVersion -> CaserBuiltin DefaultUni) -> Plutus.CostModelParams -> m EvaluationContext -mkDynEvaluationContext ll semVars toSemVar newCMP toCaser = do - machPars <- mkMachineParametersFor semVars newCMP - pure $ EvaluationContext ll toSemVar machPars toCaser +mkDynEvaluationContext ll toCaser semVars toSemVar newCMP = do + machPars <- mkMachineVariantParametersFor semVars newCMP + pure $ EvaluationContext ll toCaser toSemVar machPars -- FIXME: remove this function assertWellFormedCostModelParams :: MonadError CostModelApplyError m => Plutus.CostModelParams -> m () diff --git a/plutus-ledger-api/src/PlutusLedgerApi/MachineParameters.hs b/plutus-ledger-api/src/PlutusLedgerApi/MachineParameters.hs index b2989420e69..306288df644 100644 --- a/plutus-ledger-api/src/PlutusLedgerApi/MachineParameters.hs +++ b/plutus-ledger-api/src/PlutusLedgerApi/MachineParameters.hs @@ -1,17 +1,25 @@ module PlutusLedgerApi.MachineParameters where +import PlutusLedgerApi.Common +import PlutusLedgerApi.Common.ProtocolVersions (futurePV) + +import PlutusCore.Builtin (CaserBuiltin (..), caseBuiltin, unavailableCaserBuiltin) import PlutusCore.Default (BuiltinSemanticsVariant (..)) import PlutusCore.Evaluation.Machine.ExBudgetingDefaults (cekCostModelForVariant) -import PlutusCore.Evaluation.Machine.MachineParameters (mkMachineParameters) +import PlutusCore.Evaluation.Machine.MachineParameters (MachineParameters (..), + mkMachineVariantParameters) import PlutusCore.Evaluation.Machine.MachineParameters.Default (DefaultMachineParameters) -import PlutusLedgerApi.Common machineParametersFor :: PlutusLedgerLanguage -> MajorProtocolVersion -> DefaultMachineParameters machineParametersFor ledgerLang majorPV = - mkMachineParameters builtinSemVar (cekCostModelForVariant builtinSemVar) + MachineParameters + (if majorPV < futurePV + then unavailableCaserBuiltin $ getMajorProtocolVersion majorPV + else CaserBuiltin caseBuiltin) + (mkMachineVariantParameters builtinSemVar $ cekCostModelForVariant builtinSemVar) where builtinSemVar = case ledgerLang of diff --git a/plutus-ledger-api/src/PlutusLedgerApi/V1/EvaluationContext.hs b/plutus-ledger-api/src/PlutusLedgerApi/V1/EvaluationContext.hs index 153aaa89fb2..cf0e2582afd 100644 --- a/plutus-ledger-api/src/PlutusLedgerApi/V1/EvaluationContext.hs +++ b/plutus-ledger-api/src/PlutusLedgerApi/V1/EvaluationContext.hs @@ -11,8 +11,10 @@ module PlutusLedgerApi.V1.EvaluationContext ( ) where import PlutusLedgerApi.Common +import PlutusLedgerApi.Common.ProtocolVersions (futurePV) import PlutusLedgerApi.V1.ParamName as V1 +import PlutusCore.Builtin (CaserBuiltin (..), caseBuiltin, unavailableCaserBuiltin) import PlutusCore.Default (BuiltinSemanticsVariant (DefaultFunSemanticsVariantA, DefaultFunSemanticsVariantB)) import Control.Monad @@ -41,13 +43,13 @@ mkEvaluationContext = >=> pure . toCostModelParams >=> mkDynEvaluationContext PlutusV1 + (\pv -> + if pv < futurePV + then unavailableCaserBuiltin $ getMajorProtocolVersion pv + else CaserBuiltin caseBuiltin) [DefaultFunSemanticsVariantA, DefaultFunSemanticsVariantB] -- See Note [Mapping of protocol versions and ledger languages to semantics variants]. (\pv -> if pv < changPV then DefaultFunSemanticsVariantA else DefaultFunSemanticsVariantB) - (\pv -> - if pv < futurePV - then unavailableCaserBuiltin (getMajorProtocolVersion pv) - else CaserBuiltin caseBuiltin) diff --git a/plutus-ledger-api/src/PlutusLedgerApi/V2/EvaluationContext.hs b/plutus-ledger-api/src/PlutusLedgerApi/V2/EvaluationContext.hs index eb16a6ad075..097a8840b37 100644 --- a/plutus-ledger-api/src/PlutusLedgerApi/V2/EvaluationContext.hs +++ b/plutus-ledger-api/src/PlutusLedgerApi/V2/EvaluationContext.hs @@ -10,8 +10,10 @@ module PlutusLedgerApi.V2.EvaluationContext ) where import PlutusLedgerApi.Common +import PlutusLedgerApi.Common.ProtocolVersions (futurePV) import PlutusLedgerApi.V2.ParamName as V2 +import PlutusCore.Builtin (CaserBuiltin (..), caseBuiltin, unavailableCaserBuiltin) import PlutusCore.Default (BuiltinSemanticsVariant (DefaultFunSemanticsVariantA, DefaultFunSemanticsVariantB)) import Control.Monad @@ -38,12 +40,12 @@ mkEvaluationContext = >=> pure . toCostModelParams >=> mkDynEvaluationContext PlutusV2 - [DefaultFunSemanticsVariantA, DefaultFunSemanticsVariantB] + (\pv -> + if pv < futurePV + then unavailableCaserBuiltin $ getMajorProtocolVersion pv + else CaserBuiltin caseBuiltin) + [DefaultFunSemanticsVariantA, DefaultFunSemanticsVariantB] -- See Note [Mapping of protocol versions and ledger languages to semantics variants]. (\pv -> if pv < changPV then DefaultFunSemanticsVariantA else DefaultFunSemanticsVariantB) - (\pv -> - if pv < futurePV - then unavailableCaserBuiltin (getMajorProtocolVersion pv) - else CaserBuiltin caseBuiltin) diff --git a/plutus-ledger-api/src/PlutusLedgerApi/V3/EvaluationContext.hs b/plutus-ledger-api/src/PlutusLedgerApi/V3/EvaluationContext.hs index 39395e1cf72..6f0992088d7 100644 --- a/plutus-ledger-api/src/PlutusLedgerApi/V3/EvaluationContext.hs +++ b/plutus-ledger-api/src/PlutusLedgerApi/V3/EvaluationContext.hs @@ -9,8 +9,10 @@ module PlutusLedgerApi.V3.EvaluationContext ) where import PlutusLedgerApi.Common +import PlutusLedgerApi.Common.ProtocolVersions (futurePV) import PlutusLedgerApi.V3.ParamName as V3 +import PlutusCore.Builtin (CaserBuiltin (..), caseBuiltin, unavailableCaserBuiltin) import PlutusCore.Default (BuiltinSemanticsVariant (DefaultFunSemanticsVariantC)) import Control.Monad @@ -37,10 +39,10 @@ mkEvaluationContext = >=> pure . toCostModelParams >=> mkDynEvaluationContext PlutusV3 - [DefaultFunSemanticsVariantC] - -- See Note [Mapping of protocol versions and ledger languages to semantics variants]. - (const DefaultFunSemanticsVariantC) (\pv -> if pv < futurePV - then unavailableCaserBuiltin (getMajorProtocolVersion pv) + then unavailableCaserBuiltin $ getMajorProtocolVersion pv else CaserBuiltin caseBuiltin) + [DefaultFunSemanticsVariantC] + -- See Note [Mapping of protocol versions and ledger languages to semantics variants]. + (const DefaultFunSemanticsVariantC) From 2748dbb2f6f38a63c26616601f8a65b2adfea274 Mon Sep 17 00:00:00 2001 From: effectfully Date: Tue, 10 Jun 2025 08:29:01 +0100 Subject: [PATCH 17/25] Add 'BuiltinCasing' to fix 'plutus-ledger-api' tests --- .../src/PlutusIR/Compiler/Datatype.hs | 9 +-- .../plutus-ir/src/PlutusIR/Compiler/Types.hs | 15 +++-- .../9.6/currencySymbolValueOf.eval.golden | 6 +- .../9.6/currencySymbolValueOf.pir.golden | 2 +- .../Spec/Budget/9.6/geq1.eval.golden | 6 +- .../Spec/Budget/9.6/geq2.eval.golden | 6 +- .../Spec/Budget/9.6/geq3.eval.golden | 6 +- .../Spec/Budget/9.6/geq4.eval.golden | 6 +- .../Spec/Budget/9.6/geq5.eval.golden | 6 +- .../test-plugin/Spec/Budget/9.6/gt.pir.golden | 11 ++-- .../Spec/Budget/9.6/gt1.eval.golden | 6 +- .../Spec/Budget/9.6/gt2.eval.golden | 6 +- .../Spec/Budget/9.6/gt3.eval.golden | 6 +- .../Spec/Budget/9.6/gt4.eval.golden | 6 +- .../Spec/Budget/9.6/gt5.eval.golden | 6 +- .../9.6/currencySymbolValueOf.eval.golden | 6 +- .../9.6/currencySymbolValueOf.pir.golden | 7 +- .../Spec/Data/Budget/9.6/geq1.eval.golden | 6 +- .../Spec/Data/Budget/9.6/geq2.eval.golden | 6 +- .../Spec/Data/Budget/9.6/geq3.eval.golden | 6 +- .../Spec/Data/Budget/9.6/geq4.eval.golden | 6 +- .../Spec/Data/Budget/9.6/geq5.eval.golden | 6 +- .../Spec/Data/Budget/9.6/gt.pir.golden | 52 ++++++++------- .../Spec/Data/Budget/9.6/gt1.eval.golden | 6 +- .../Spec/Data/Budget/9.6/gt2.eval.golden | 6 +- .../Spec/Data/Budget/9.6/gt3.eval.golden | 6 +- .../Spec/Data/Budget/9.6/gt4.eval.golden | 6 +- .../Spec/Data/Budget/9.6/gt5.eval.golden | 6 +- .../9.6/succeedsIfHasDatum.pir.golden | 11 ++-- .../9.6/succeedsIfHasDatum.uplc.golden | 65 +++++++++---------- .../Spec/Data/Value/9.6/Long.stat.golden | 30 ++++----- .../Spec/Data/Value/9.6/Short.stat.golden | 38 +++++------ .../test-plugin/Spec/ReturnUnit/V3.hs | 2 + .../Spec/Value/9.6/Long.stat.golden | 30 ++++----- .../Spec/Value/9.6/Short.stat.golden | 42 ++++++------ .../src/PlutusTx/Compiler/Builtins.hs | 3 +- plutus-tx-plugin/src/PlutusTx/Options.hs | 6 ++ 37 files changed, 237 insertions(+), 218 deletions(-) diff --git a/plutus-core/plutus-ir/src/PlutusIR/Compiler/Datatype.hs b/plutus-core/plutus-ir/src/PlutusIR/Compiler/Datatype.hs index dec6312d2fa..122411e07f9 100644 --- a/plutus-core/plutus-ir/src/PlutusIR/Compiler/Datatype.hs +++ b/plutus-core/plutus-ir/src/PlutusIR/Compiler/Datatype.hs @@ -344,6 +344,7 @@ mkPatternFunctorBody :: MonadQuote m => DatatypeCompilationOpts -> ann -> Dataty mkPatternFunctorBody opts ann d = case _dcoStyle opts of ScottEncoding -> mkScottTy ann d SumsOfProducts -> pure $ mkDatatypeSOPTy ann d + BuiltinCasing -> pure $ mkDatatypeSOPTy ann d {- | Make the real PLC type corresponding to a 'Datatype' with the given pattern functor body. @@ -427,7 +428,7 @@ mkConstructor opts dty d@(Datatype ann _ tvs _ constrs) index = do pure $ zipWith (VarDecl ann) argNames argTypes constrBody <- case _dcoStyle opts of - SumsOfProducts -> do + style | style == SumsOfProducts || style == BuiltinCasing -> do -- We have to be a bit careful annotating the type of the constr. It is inside the 'wrap' so it -- needs to be one level "unrolled". @@ -437,7 +438,7 @@ mkConstructor opts dty d@(Datatype ann _ tvs _ constrs) index = do let unrolled = unveilDatatype (getType dty) d pf pure $ Constr ann unrolled index (fmap PIR.mkVar argsAndTypes) - ScottEncoding -> do + _ScottEncoding -> do resultType <- resultTypeName d -- case arguments and their types @@ -499,7 +500,7 @@ mkDestructor opts dty d@(Datatype ann _ tvs _ constrs) = do xn <- safeFreshName "x" destrBody <- case _dcoStyle opts of - SumsOfProducts -> do + style | style == SumsOfProducts || style == BuiltinCasing -> do resultType <- resultTypeName d -- Variables for case arguments, and the bodies to be used as the actual cases caseVars <- for constrs $ \c -> do @@ -518,7 +519,7 @@ mkDestructor opts dty d@(Datatype ann _ tvs _ constrs) = do -- See Note [Recursive datatypes] -- case (unwrap x) case_1 .. case_j Case ann (TyVar ann resultType) (unwrap ann dty $ Var ann xn) (fmap PIR.mkVar caseVars) - ScottEncoding -> + _ScottEncoding -> pure $ -- See Note [Recursive datatypes] -- unwrap diff --git a/plutus-core/plutus-ir/src/PlutusIR/Compiler/Types.hs b/plutus-core/plutus-ir/src/PlutusIR/Compiler/Types.hs index 794d6297bed..20aa5c21a73 100644 --- a/plutus-core/plutus-ir/src/PlutusIR/Compiler/Types.hs +++ b/plutus-core/plutus-ir/src/PlutusIR/Compiler/Types.hs @@ -58,7 +58,14 @@ instance PLC.HasTypeCheckConfig (PirTCConfig uni fun) uni fun where -- old Plutus Core language version. -- -- See Note [Encoding of datatypes] -data DatatypeStyle = ScottEncoding | SumsOfProducts +data DatatypeStyle + = ScottEncoding + | SumsOfProducts + | BuiltinCasing + -- ^ A temporary data type style used to make a couple of V3 ledger-api-test tests pass + -- before we can support casing on values of built-in types in newer protocol versions and + -- merge this into 'SumsOfProducts' (which is what controls whether 'Case' is available or + -- not). deriving stock (Show, Read, Eq) instance Pretty DatatypeStyle where @@ -66,12 +73,12 @@ instance Pretty DatatypeStyle where newtype DatatypeCompilationOpts = DatatypeCompilationOpts { _dcoStyle :: DatatypeStyle - } deriving stock (Show) + } deriving newtype (Show, Read, Pretty) makeLenses ''DatatypeCompilationOpts defaultDatatypeCompilationOpts :: DatatypeCompilationOpts -defaultDatatypeCompilationOpts = DatatypeCompilationOpts SumsOfProducts +defaultDatatypeCompilationOpts = DatatypeCompilationOpts BuiltinCasing data CompilationOpts a = CompilationOpts { _coOptimize :: Bool @@ -163,7 +170,7 @@ toDefaultCompilationCtx configPlc = CompilationCtx validateOpts :: Compiling m uni fun a => PLC.Version -> m () validateOpts v = do datatypes <- view (ccOpts . coDatatypes . dcoStyle) - when (datatypes == SumsOfProducts && v < PLC.plcVersion110) $ + when ((datatypes == SumsOfProducts || datatypes == BuiltinCasing) && v < PLC.plcVersion110) $ throwError $ OptionsError $ T.pack $ "Cannot use sums-of-products to compile a program with version less than 1.10. Program version is:" ++ show v getEnclosing :: MonadReader (CompilationCtx uni fun a) m => m (Provenance a) diff --git a/plutus-ledger-api/test-plugin/Spec/Budget/9.6/currencySymbolValueOf.eval.golden b/plutus-ledger-api/test-plugin/Spec/Budget/9.6/currencySymbolValueOf.eval.golden index 0002a35289e..d211db54239 100644 --- a/plutus-ledger-api/test-plugin/Spec/Budget/9.6/currencySymbolValueOf.eval.golden +++ b/plutus-ledger-api/test-plugin/Spec/Budget/9.6/currencySymbolValueOf.eval.golden @@ -1,5 +1,5 @@ -CPU: 7_152_564 -Memory: 39_918 -Size: 182 +CPU: 8_088_858 +Memory: 42_924 +Size: 186 (con integer 3636) \ No newline at end of file diff --git a/plutus-ledger-api/test-plugin/Spec/Budget/9.6/currencySymbolValueOf.pir.golden b/plutus-ledger-api/test-plugin/Spec/Budget/9.6/currencySymbolValueOf.pir.golden index a5119220bf7..8da8925e8d2 100644 --- a/plutus-ledger-api/test-plugin/Spec/Budget/9.6/currencySymbolValueOf.pir.golden +++ b/plutus-ledger-api/test-plugin/Spec/Budget/9.6/currencySymbolValueOf.pir.golden @@ -69,7 +69,7 @@ in (\(c' : bytestring) (i : (\k v -> List (Tuple2 k v)) bytestring integer) -> Bool_match - (case Bool (equalsByteString c' cur) [False, True]) + (ifThenElse {Bool} (equalsByteString c' cur) True False) {all dead. integer} (/\dead -> go i) (/\dead -> go xs') diff --git a/plutus-ledger-api/test-plugin/Spec/Budget/9.6/geq1.eval.golden b/plutus-ledger-api/test-plugin/Spec/Budget/9.6/geq1.eval.golden index f066a6106a1..45b496415c8 100644 --- a/plutus-ledger-api/test-plugin/Spec/Budget/9.6/geq1.eval.golden +++ b/plutus-ledger-api/test-plugin/Spec/Budget/9.6/geq1.eval.golden @@ -1,5 +1,5 @@ -CPU: 98_753_050 -Memory: 594_715 -Size: 600 +CPU: 118_186_685 +Memory: 661_630 +Size: 611 (constr 0) \ No newline at end of file diff --git a/plutus-ledger-api/test-plugin/Spec/Budget/9.6/geq2.eval.golden b/plutus-ledger-api/test-plugin/Spec/Budget/9.6/geq2.eval.golden index bf3dcb6e596..8baddbd59b3 100644 --- a/plutus-ledger-api/test-plugin/Spec/Budget/9.6/geq2.eval.golden +++ b/plutus-ledger-api/test-plugin/Spec/Budget/9.6/geq2.eval.golden @@ -1,5 +1,5 @@ -CPU: 106_098_020 -Memory: 639_421 -Size: 628 +CPU: 126_563_949 +Memory: 709_942 +Size: 639 (constr 1) \ No newline at end of file diff --git a/plutus-ledger-api/test-plugin/Spec/Budget/9.6/geq3.eval.golden b/plutus-ledger-api/test-plugin/Spec/Budget/9.6/geq3.eval.golden index 7a1b2aaab46..b428644f626 100644 --- a/plutus-ledger-api/test-plugin/Spec/Budget/9.6/geq3.eval.golden +++ b/plutus-ledger-api/test-plugin/Spec/Budget/9.6/geq3.eval.golden @@ -1,5 +1,5 @@ -CPU: 108_740_470 -Memory: 654_526 -Size: 628 +CPU: 130_466_644 +Memory: 730_552 +Size: 639 (constr 0) \ No newline at end of file diff --git a/plutus-ledger-api/test-plugin/Spec/Budget/9.6/geq4.eval.golden b/plutus-ledger-api/test-plugin/Spec/Budget/9.6/geq4.eval.golden index bdd26196c7f..72a15b839e7 100644 --- a/plutus-ledger-api/test-plugin/Spec/Budget/9.6/geq4.eval.golden +++ b/plutus-ledger-api/test-plugin/Spec/Budget/9.6/geq4.eval.golden @@ -1,5 +1,5 @@ -CPU: 95_871_338 -Memory: 578_410 -Size: 604 +CPU: 113_756_728 +Memory: 638_020 +Size: 615 (constr 1) \ No newline at end of file diff --git a/plutus-ledger-api/test-plugin/Spec/Budget/9.6/geq5.eval.golden b/plutus-ledger-api/test-plugin/Spec/Budget/9.6/geq5.eval.golden index 51a606cfd85..7ecd04286e6 100644 --- a/plutus-ledger-api/test-plugin/Spec/Budget/9.6/geq5.eval.golden +++ b/plutus-ledger-api/test-plugin/Spec/Budget/9.6/geq5.eval.golden @@ -1,5 +1,5 @@ -CPU: 101_718_948 -Memory: 612_419 -Size: 604 +CPU: 121_872_779 +Memory: 681_938 +Size: 615 (constr 0) \ No newline at end of file diff --git a/plutus-ledger-api/test-plugin/Spec/Budget/9.6/gt.pir.golden b/plutus-ledger-api/test-plugin/Spec/Budget/9.6/gt.pir.golden index 47612889de1..249f98ee29d 100644 --- a/plutus-ledger-api/test-plugin/Spec/Budget/9.6/gt.pir.golden +++ b/plutus-ledger-api/test-plugin/Spec/Budget/9.6/gt.pir.golden @@ -28,7 +28,7 @@ letrec {Bool} (\(ds : bytestring) (x : integer) -> Bool_match - (case Bool (equalsInteger 0 x) [False, True]) + (ifThenElse {Bool} (equalsInteger 0 x) True False) {all dead. Bool} (/\dead -> go xs) (/\dead -> False) @@ -36,8 +36,6 @@ letrec {all dead. dead} in let - !ifThenElse : all a. bool -> a -> a -> a - = /\a -> \(b : bool) (x : a) (y : a) -> case a b [y, x] data (These :: * -> * -> *) a b | These_match where That : b -> These a b These : a -> b -> These a b @@ -202,7 +200,7 @@ in let !equalsByteString : bytestring -> bytestring -> Bool = \(x : bytestring) (y : bytestring) -> - case Bool (equalsByteString x y) [False, True] + ifThenElse {Bool} (equalsByteString x y) True False !union : all k v r. (\a -> a -> a -> Bool) k -> @@ -798,9 +796,10 @@ in {bytestring} {integer} equalsByteString - (\(v : integer) -> case Bool (equalsInteger 0 v) [False, True]) + (\(v : integer) -> + ifThenElse {Bool} (equalsInteger 0 v) True False) (\(x : integer) (y : integer) -> - case Bool (equalsInteger x y) [False, True])) + ifThenElse {Bool} (equalsInteger x y) True False)) l r) {all dead. Bool} diff --git a/plutus-ledger-api/test-plugin/Spec/Budget/9.6/gt1.eval.golden b/plutus-ledger-api/test-plugin/Spec/Budget/9.6/gt1.eval.golden index f697920e5aa..918e447b8b9 100644 --- a/plutus-ledger-api/test-plugin/Spec/Budget/9.6/gt1.eval.golden +++ b/plutus-ledger-api/test-plugin/Spec/Budget/9.6/gt1.eval.golden @@ -1,5 +1,5 @@ -CPU: 122_592_765 -Memory: 735_150 -Size: 951 +CPU: 148_560_115 +Memory: 826_300 +Size: 979 (constr 1) \ No newline at end of file diff --git a/plutus-ledger-api/test-plugin/Spec/Budget/9.6/gt2.eval.golden b/plutus-ledger-api/test-plugin/Spec/Budget/9.6/gt2.eval.golden index 95846877b65..d4d7125e056 100644 --- a/plutus-ledger-api/test-plugin/Spec/Budget/9.6/gt2.eval.golden +++ b/plutus-ledger-api/test-plugin/Spec/Budget/9.6/gt2.eval.golden @@ -1,5 +1,5 @@ -CPU: 106_306_020 -Memory: 640_721 -Size: 979 +CPU: 125_187_949 +Memory: 701_342 +Size: 1_007 (constr 1) \ No newline at end of file diff --git a/plutus-ledger-api/test-plugin/Spec/Budget/9.6/gt3.eval.golden b/plutus-ledger-api/test-plugin/Spec/Budget/9.6/gt3.eval.golden index 12ae590015f..669024f4cd1 100644 --- a/plutus-ledger-api/test-plugin/Spec/Budget/9.6/gt3.eval.golden +++ b/plutus-ledger-api/test-plugin/Spec/Budget/9.6/gt3.eval.golden @@ -1,5 +1,5 @@ -CPU: 133_272_518 -Memory: 798_962 -Size: 979 +CPU: 161_112_456 +Memory: 896_124 +Size: 1_007 (constr 0) \ No newline at end of file diff --git a/plutus-ledger-api/test-plugin/Spec/Budget/9.6/gt4.eval.golden b/plutus-ledger-api/test-plugin/Spec/Budget/9.6/gt4.eval.golden index 38efebc6e5f..d762e2b0213 100644 --- a/plutus-ledger-api/test-plugin/Spec/Budget/9.6/gt4.eval.golden +++ b/plutus-ledger-api/test-plugin/Spec/Budget/9.6/gt4.eval.golden @@ -1,5 +1,5 @@ -CPU: 96_079_338 -Memory: 579_710 -Size: 955 +CPU: 113_244_728 +Memory: 634_820 +Size: 983 (constr 1) \ No newline at end of file diff --git a/plutus-ledger-api/test-plugin/Spec/Budget/9.6/gt5.eval.golden b/plutus-ledger-api/test-plugin/Spec/Budget/9.6/gt5.eval.golden index 6307bab5266..6cd4788ffcf 100644 --- a/plutus-ledger-api/test-plugin/Spec/Budget/9.6/gt5.eval.golden +++ b/plutus-ledger-api/test-plugin/Spec/Budget/9.6/gt5.eval.golden @@ -1,5 +1,5 @@ -CPU: 113_631_103 -Memory: 682_935 -Size: 955 +CPU: 135_849_718 +Memory: 757_770 +Size: 983 (constr 0) \ No newline at end of file diff --git a/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/currencySymbolValueOf.eval.golden b/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/currencySymbolValueOf.eval.golden index 2b76cb4c649..4626ad3c710 100644 --- a/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/currencySymbolValueOf.eval.golden +++ b/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/currencySymbolValueOf.eval.golden @@ -1,5 +1,5 @@ -CPU: 22_014_868 -Memory: 61_274 -Size: 111 +CPU: 22_759_162 +Memory: 63_080 +Size: 112 (con integer 3636) \ No newline at end of file diff --git a/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/currencySymbolValueOf.pir.golden b/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/currencySymbolValueOf.pir.golden index 432a9f19aa5..c333ff8a270 100644 --- a/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/currencySymbolValueOf.pir.golden +++ b/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/currencySymbolValueOf.pir.golden @@ -34,10 +34,11 @@ in (Nothing {data}) (\(hd : pair data data) -> Bool_match - (case - Bool + (ifThenElse + {Bool} (equalsData k (fstPair {data} {data} hd)) - [False, True]) + True + False) {all dead. list (pair data data) -> Maybe data} (/\dead -> \(ds : list (pair data data)) -> diff --git a/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/geq1.eval.golden b/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/geq1.eval.golden index 4a052d9564d..27595412342 100644 --- a/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/geq1.eval.golden +++ b/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/geq1.eval.golden @@ -1,5 +1,5 @@ -CPU: 581_291_535 -Memory: 1_732_825 -Size: 743 +CPU: 613_090_560 +Memory: 1_824_850 +Size: 764 (constr 0) \ No newline at end of file diff --git a/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/geq2.eval.golden b/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/geq2.eval.golden index 92760a88086..8f88401ada9 100644 --- a/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/geq2.eval.golden +++ b/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/geq2.eval.golden @@ -1,5 +1,5 @@ -CPU: 614_410_994 -Memory: 1_844_735 -Size: 743 +CPU: 647_706_509 +Memory: 1_941_370 +Size: 764 (constr 1) \ No newline at end of file diff --git a/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/geq3.eval.golden b/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/geq3.eval.golden index 8cf590eb892..3dfaf98e0a7 100644 --- a/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/geq3.eval.golden +++ b/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/geq3.eval.golden @@ -1,5 +1,5 @@ -CPU: 641_372_902 -Memory: 1_931_808 -Size: 743 +CPU: 677_017_054 +Memory: 2_036_956 +Size: 764 (constr 0) \ No newline at end of file diff --git a/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/geq4.eval.golden b/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/geq4.eval.golden index 8b136c7a431..9d916c1608d 100644 --- a/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/geq4.eval.golden +++ b/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/geq4.eval.golden @@ -1,5 +1,5 @@ -CPU: 561_120_600 -Memory: 1_643_047 -Size: 743 +CPU: 587_374_155 +Memory: 1_714_642 +Size: 764 (constr 1) \ No newline at end of file diff --git a/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/geq5.eval.golden b/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/geq5.eval.golden index 53e713ef5a1..ac1b6b75b50 100644 --- a/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/geq5.eval.golden +++ b/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/geq5.eval.golden @@ -1,5 +1,5 @@ -CPU: 602_663_630 -Memory: 1_794_825 -Size: 743 +CPU: 635_615_047 +Memory: 1_890_258 +Size: 764 (constr 0) \ No newline at end of file diff --git a/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/gt.pir.golden b/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/gt.pir.golden index 10436aa49d6..4fab3774cbd 100644 --- a/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/gt.pir.golden +++ b/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/gt.pir.golden @@ -48,18 +48,18 @@ let !args : list data = sndPair {integer} {list data} tup in Bool_match - (case Bool (equalsInteger 0 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 0 index) True False) {all dead. These a b} (/\dead -> This {a} {b} (`$dUnsafeFromData` (headList {data} args))) (/\dead -> Bool_match - (case Bool (equalsInteger 1 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 1 index) True False) {all dead. These a b} (/\dead -> That {a} {b} (`$dUnsafeFromData` (headList {data} args))) (/\dead -> Bool_match - (case Bool (equalsInteger 2 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 2 index) True False) {all dead. These a b} (/\dead -> These @@ -143,10 +143,11 @@ letrec nilCase (\(hd : pair data data) -> Bool_match - (case - Bool + (ifThenElse + {Bool} (equalsData k (fstPair {data} {data} hd)) - [False, True]) + True + False) {all dead. list (pair data data) -> list (pair data data)} (/\dead -> mkCons {pair data data} (mkPairData k v)) @@ -172,10 +173,11 @@ let (Nothing {data}) (\(hd : pair data data) -> Bool_match - (case - Bool + (ifThenElse + {Bool} (equalsData k (fstPair {data} {data} hd)) - [False, True]) + True + False) {all dead. list (pair data data) -> Maybe data} (/\dead -> \(ds : list (pair data data)) -> @@ -405,12 +407,13 @@ let (/\dead -> goRight acc xs) (/\dead -> Bool_match - (case - Bool + (ifThenElse + {Bool} (equalsData (fstPair {data} {data} x) d) - [False, True]) + True + False) {all dead. Bool} (/\dead -> Bool_match @@ -438,10 +441,11 @@ let Unit in Bool_match - (case - Bool + (ifThenElse + {Bool} (equalsData d (fstPair {data} {data} x)) - [False, True]) + True + False) {all dead. Bool} (/\dead -> Bool_match @@ -474,8 +478,6 @@ let in \(eta : list (pair data data)) (eta : list (pair data data)) -> goBoth eta eta - !ifThenElse : all a. bool -> a -> a -> a - = /\a -> \(b : bool) (x : a) (y : a) -> case a b [y, x] in \(l : (\k a -> list (pair data data)) @@ -610,12 +612,13 @@ in True (\(hd : pair data data) -> Bool_match - (case - Bool + (ifThenElse + {Bool} (equalsInteger 0 (unIData (sndPair {data} {data} hd))) - [False, True]) + True + False) {all dead. list (pair data data) -> Bool} (/\dead -> go) (/\dead -> \(ds : list (pair data data)) -> False) @@ -626,12 +629,13 @@ in (\(v : data) (v : data) -> unordEqWith (\(v : data) -> - case Bool (equalsInteger 0 (unIData v)) [False, True]) + ifThenElse {Bool} (equalsInteger 0 (unIData v)) True False) (\(v : data) (v : data) -> - case - Bool + ifThenElse + {Bool} (equalsInteger (unIData v) (unIData v)) - [False, True]) + True + False) (unMapData v) (unMapData v)) l diff --git a/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/gt1.eval.golden b/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/gt1.eval.golden index 14be1808662..b089c70480f 100644 --- a/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/gt1.eval.golden +++ b/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/gt1.eval.golden @@ -1,5 +1,5 @@ -CPU: 677_763_628 -Memory: 2_048_824 -Size: 1_184 +CPU: 713_536_368 +Memory: 2_149_084 +Size: 1_227 (constr 1) \ No newline at end of file diff --git a/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/gt2.eval.golden b/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/gt2.eval.golden index 2fecb4b3510..15e73780ffe 100644 --- a/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/gt2.eval.golden +++ b/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/gt2.eval.golden @@ -1,5 +1,5 @@ -CPU: 614_666_994 -Memory: 1_846_335 -Size: 1_184 +CPU: 646_378_509 +Memory: 1_933_070 +Size: 1_227 (constr 1) \ No newline at end of file diff --git a/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/gt3.eval.golden b/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/gt3.eval.golden index 8a635ddbaf9..204457dd015 100644 --- a/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/gt3.eval.golden +++ b/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/gt3.eval.golden @@ -1,5 +1,5 @@ -CPU: 740_795_106 -Memory: 2_259_492 -Size: 1_184 +CPU: 779_961_022 +Memory: 2_369_576 +Size: 1_227 (constr 0) \ No newline at end of file diff --git a/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/gt4.eval.golden b/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/gt4.eval.golden index a0eff4a4cbc..026ad4b91c4 100644 --- a/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/gt4.eval.golden +++ b/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/gt4.eval.golden @@ -1,5 +1,5 @@ -CPU: 561_376_600 -Memory: 1_644_647 -Size: 1_184 +CPU: 586_910_155 +Memory: 1_711_742 +Size: 1_227 (constr 1) \ No newline at end of file diff --git a/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/gt5.eval.golden b/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/gt5.eval.golden index 6729b8adfc1..003437e21f8 100644 --- a/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/gt5.eval.golden +++ b/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/gt5.eval.golden @@ -1,5 +1,5 @@ -CPU: 648_647_326 -Memory: 1_948_813 -Size: 1_184 +CPU: 682_511_527 +Memory: 2_042_362 +Size: 1_227 (constr 0) \ No newline at end of file diff --git a/plutus-ledger-api/test-plugin/Spec/Data/ScriptContext/9.6/succeedsIfHasDatum.pir.golden b/plutus-ledger-api/test-plugin/Spec/Data/ScriptContext/9.6/succeedsIfHasDatum.pir.golden index 10175783576..77342b99c62 100644 --- a/plutus-ledger-api/test-plugin/Spec/Data/ScriptContext/9.6/succeedsIfHasDatum.pir.golden +++ b/plutus-ledger-api/test-plugin/Spec/Data/ScriptContext/9.6/succeedsIfHasDatum.pir.golden @@ -25,10 +25,11 @@ in (sndPair {integer} {list data} (unConstrData d))))) in Bool_match - (case - Bool + (ifThenElse + {Bool} (equalsInteger 1 (fstPair {integer} {list data} tup)) - [False, True]) + True + False) {all dead. Bool} (/\dead -> let @@ -43,12 +44,12 @@ in !args : list data = sndPair {integer} {list data} tup in Bool_match - (case Bool (equalsInteger 1 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 1 index) True False) {all dead. Maybe data} (/\dead -> Nothing {data}) (/\dead -> Bool_match - (case Bool (equalsInteger 0 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 0 index) True False) {all dead. Maybe data} (/\dead -> Just {data} (headList {data} args)) (/\dead -> traceError {Maybe data} "PT1") diff --git a/plutus-ledger-api/test-plugin/Spec/Data/ScriptContext/9.6/succeedsIfHasDatum.uplc.golden b/plutus-ledger-api/test-plugin/Spec/Data/ScriptContext/9.6/succeedsIfHasDatum.uplc.golden index b45d679ea4f..e8561618329 100644 --- a/plutus-ledger-api/test-plugin/Spec/Data/ScriptContext/9.6/succeedsIfHasDatum.uplc.golden +++ b/plutus-ledger-api/test-plugin/Spec/Data/ScriptContext/9.6/succeedsIfHasDatum.uplc.golden @@ -6,41 +6,38 @@ case ((\tup -> force - (case + (force ifThenElse (equalsInteger 1 (force (force fstPair) tup)) - [ (delay (constr 1 [])) - , (delay - (force - (case - ((\tup -> - (\index -> - (\args -> - force - (case - (equalsInteger 1 index) - [ (delay - (force - (case - (equalsInteger - 0 - index) - [ (delay - (traceError - "PT1")) - , (delay - (constr 0 - [ (force - headList - args) ])) ]))) - , (delay (constr 1 [])) ])) - (force (force sndPair) tup)) - (force (force fstPair) tup)) - (unConstrData - (force headList - (force tailList - (force (force sndPair) tup))))) - [ (\ds -> delay (constr 0 [])) - , (delay (constr 1 [])) ]))) ])) + (delay + (force + (case + ((\tup -> + (\index -> + (\args -> + force + (force ifThenElse + (equalsInteger 1 index) + (delay (constr 1 [])) + (delay + (force + (force ifThenElse + (equalsInteger 0 index) + (delay + (constr 0 + [ (force headList + args) ])) + (delay + (traceError + "PT1"))))))) + (force (force sndPair) tup)) + (force (force fstPair) tup)) + (unConstrData + (force headList + (force tailList + (force (force sndPair) tup))))) + [ (\ds -> delay (constr 0 [])) + , (delay (constr 1 [])) ]))) + (delay (constr 1 [])))) (unConstrData (force headList (force tailList diff --git a/plutus-ledger-api/test-plugin/Spec/Data/Value/9.6/Long.stat.golden b/plutus-ledger-api/test-plugin/Spec/Data/Value/9.6/Long.stat.golden index abbabe1df3f..6e5cf8e5562 100644 --- a/plutus-ledger-api/test-plugin/Spec/Data/Value/9.6/Long.stat.golden +++ b/plutus-ledger-api/test-plugin/Spec/Data/Value/9.6/Long.stat.golden @@ -1,15 +1,15 @@ -({cpu: 8196924510 | mem: 12020087}) -({cpu: 8198954 | mem: 32074}) -({cpu: 5833838389 | mem: 8391931}) -({cpu: 8198954 | mem: 32074}) -({cpu: 5833838389 | mem: 8391931}) -({cpu: 8198954 | mem: 32074}) -({cpu: 3470752268 | mem: 4763775}) -({cpu: 8198954 | mem: 32074}) -({cpu: 5833838389 | mem: 8391931}) -({cpu: 8198954 | mem: 32074}) -({cpu: 3470752268 | mem: 4763775}) -({cpu: 8198954 | mem: 32074}) -({cpu: 3470752268 | mem: 4763775}) -({cpu: 8198954 | mem: 32074}) -({cpu: 1107666147 | mem: 1135619}) \ No newline at end of file +({cpu: 8426472589 | mem: 12757058}) +({cpu: 8511052 | mem: 33076}) +({cpu: 5994100712 | mem: 8906458}) +({cpu: 8511052 | mem: 33076}) +({cpu: 5994100712 | mem: 8906458}) +({cpu: 8511052 | mem: 33076}) +({cpu: 3561728835 | mem: 5055858}) +({cpu: 8511052 | mem: 33076}) +({cpu: 5994100712 | mem: 8906458}) +({cpu: 8511052 | mem: 33076}) +({cpu: 3561728835 | mem: 5055858}) +({cpu: 8511052 | mem: 33076}) +({cpu: 3561728835 | mem: 5055858}) +({cpu: 8511052 | mem: 33076}) +({cpu: 1129356958 | mem: 1205258}) \ No newline at end of file diff --git a/plutus-ledger-api/test-plugin/Spec/Data/Value/9.6/Short.stat.golden b/plutus-ledger-api/test-plugin/Spec/Data/Value/9.6/Short.stat.golden index f815ea339c9..ee2c0b0d112 100644 --- a/plutus-ledger-api/test-plugin/Spec/Data/Value/9.6/Short.stat.golden +++ b/plutus-ledger-api/test-plugin/Spec/Data/Value/9.6/Short.stat.golden @@ -1,21 +1,21 @@ ({cpu: 1866088 | mem: 10164}) ({cpu: 4505311 | mem: 21352}) -({cpu: 7547253 | mem: 30413}) -({cpu: 9797936 | mem: 39670}) -({cpu: 11967005 | mem: 44099}) -({cpu: 14917116 | mem: 55784}) -({cpu: 22258875 | mem: 78034}) -({cpu: 24009905 | mem: 89754}) -({cpu: 27940040 | mem: 98283}) -({cpu: 17311215 | mem: 60413}) -({cpu: 42842615 | mem: 145904}) -({cpu: 12809659 | mem: 45760}) -({cpu: 62164942 | mem: 207211}) -({cpu: 72791524 | mem: 248561}) -({cpu: 88389410 | mem: 282204}) -({cpu: 99015992 | mem: 323554}) -({cpu: 119224583 | mem: 370883}) -({cpu: 122174694 | mem: 382568}) -({cpu: 154670461 | mem: 473248}) -({cpu: 57593121 | mem: 200572}) -({cpu: 1107666147 | mem: 1135619}) \ No newline at end of file +({cpu: 7703302 | mem: 30914}) +({cpu: 10110034 | mem: 40672}) +({cpu: 12435152 | mem: 45602}) +({cpu: 15509312 | mem: 57588}) +({cpu: 23195169 | mem: 81040}) +({cpu: 24914199 | mem: 92560}) +({cpu: 29032383 | mem: 101790}) +({cpu: 18091460 | mem: 62918}) +({cpu: 44715203 | mem: 151916}) +({cpu: 13433855 | mem: 47764}) +({cpu: 65129873 | mem: 216730}) +({cpu: 76468749 | mem: 259686}) +({cpu: 92758782 | mem: 296232}) +({cpu: 104097658 | mem: 339188}) +({cpu: 125310494 | mem: 390422}) +({cpu: 128384654 | mem: 402408}) +({cpu: 162785009 | mem: 499300}) +({cpu: 60490101 | mem: 209192}) +({cpu: 1129356958 | mem: 1205258}) \ No newline at end of file diff --git a/plutus-ledger-api/test-plugin/Spec/ReturnUnit/V3.hs b/plutus-ledger-api/test-plugin/Spec/ReturnUnit/V3.hs index 3c221560c28..00ce0535c9e 100644 --- a/plutus-ledger-api/test-plugin/Spec/ReturnUnit/V3.hs +++ b/plutus-ledger-api/test-plugin/Spec/ReturnUnit/V3.hs @@ -9,6 +9,8 @@ {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE ViewPatterns #-} +{-# OPTIONS_GHC -fplugin-opt PlutusTx.Plugin:datatypes=SumsOfProducts #-} + module Spec.ReturnUnit.V3 where import PlutusLedgerApi.Common.Versions diff --git a/plutus-ledger-api/test-plugin/Spec/Value/9.6/Long.stat.golden b/plutus-ledger-api/test-plugin/Spec/Value/9.6/Long.stat.golden index 1b75a818d08..8332fcf76b2 100644 --- a/plutus-ledger-api/test-plugin/Spec/Value/9.6/Long.stat.golden +++ b/plutus-ledger-api/test-plugin/Spec/Value/9.6/Long.stat.golden @@ -1,15 +1,15 @@ -({cpu: 915324329 | mem: 5317671}) -({cpu: 23345969 | mem: 145502}) -({cpu: 643330703 | mem: 3738427}) -({cpu: 22033969 | mem: 137302}) -({cpu: 643330703 | mem: 3738427}) -({cpu: 18945969 | mem: 118002}) -({cpu: 368169077 | mem: 2139383}) -({cpu: 19041969 | mem: 118602}) -({cpu: 643330703 | mem: 3738427}) -({cpu: 18945969 | mem: 118002}) -({cpu: 368169077 | mem: 2139383}) -({cpu: 16049969 | mem: 99902}) -({cpu: 368169077 | mem: 2139383}) -({cpu: 12625969 | mem: 78502}) -({cpu: 92335451 | mem: 536139}) \ No newline at end of file +({cpu: 1248344408 | mem: 6701342}) +({cpu: 23834067 | mem: 147604}) +({cpu: 875833026 | mem: 4704454}) +({cpu: 22522067 | mem: 139404}) +({cpu: 875833026 | mem: 4704454}) +({cpu: 19434067 | mem: 120104}) +({cpu: 500153644 | mem: 2687766}) +({cpu: 19530067 | mem: 120704}) +({cpu: 875833026 | mem: 4704454}) +({cpu: 19434067 | mem: 120104}) +({cpu: 500153644 | mem: 2687766}) +({cpu: 16538067 | mem: 102004}) +({cpu: 500153644 | mem: 2687766}) +({cpu: 13114067 | mem: 80604}) +({cpu: 123802262 | mem: 666878}) \ No newline at end of file diff --git a/plutus-ledger-api/test-plugin/Spec/Value/9.6/Short.stat.golden b/plutus-ledger-api/test-plugin/Spec/Value/9.6/Short.stat.golden index 0a302a98523..599846e2664 100644 --- a/plutus-ledger-api/test-plugin/Spec/Value/9.6/Short.stat.golden +++ b/plutus-ledger-api/test-plugin/Spec/Value/9.6/Short.stat.golden @@ -1,21 +1,21 @@ -({cpu: 1792100 | mem: 11300}) -({cpu: 2336100 | mem: 14700}) -({cpu: 3117636 | mem: 19401}) -({cpu: 3697969 | mem: 22702}) -({cpu: 4319505 | mem: 26403}) -({cpu: 5043838 | mem: 30604}) -({cpu: 6847176 | mem: 41506}) -({cpu: 7365973 | mem: 44606}) -({cpu: 8172712 | mem: 49607}) -({cpu: 5932652 | mem: 36005}) -({cpu: 11934518 | mem: 71912}) -({cpu: 5524104 | mem: 33604}) -({cpu: 16898193 | mem: 101219}) -({cpu: 20162215 | mem: 119725}) -({cpu: 22747195 | mem: 135528}) -({cpu: 26107217 | mem: 154634}) -({cpu: 29862332 | mem: 177239}) -({cpu: 30730665 | mem: 182340}) -({cpu: 38051604 | mem: 225152}) -({cpu: 19499421 | mem: 116820}) -({cpu: 92335451 | mem: 536139}) \ No newline at end of file +({cpu: 1840100 | mem: 11600}) +({cpu: 2384100 | mem: 15000}) +({cpu: 3449685 | mem: 21002}) +({cpu: 4186067 | mem: 24804}) +({cpu: 5091652 | mem: 29806}) +({cpu: 5972034 | mem: 34508}) +({cpu: 8343470 | mem: 48012}) +({cpu: 8734267 | mem: 50312}) +({cpu: 9953055 | mem: 57414}) +({cpu: 7144897 | mem: 41210}) +({cpu: 14879106 | mem: 84624}) +({cpu: 6452300 | mem: 37508}) +({cpu: 21447124 | mem: 120638}) +({cpu: 25647440 | mem: 142150}) +({cpu: 29340567 | mem: 163456}) +({cpu: 33636883 | mem: 185568}) +({cpu: 38940243 | mem: 215478}) +({cpu: 39964625 | mem: 221080}) +({cpu: 50054152 | mem: 275504}) +({cpu: 23820401 | mem: 134340}) +({cpu: 123802262 | mem: 666878}) \ No newline at end of file diff --git a/plutus-tx-plugin/src/PlutusTx/Compiler/Builtins.hs b/plutus-tx-plugin/src/PlutusTx/Compiler/Builtins.hs index 59b0546afd3..59b2f0129da 100644 --- a/plutus-tx-plugin/src/PlutusTx/Compiler/Builtins.hs +++ b/plutus-tx-plugin/src/PlutusTx/Compiler/Builtins.hs @@ -352,7 +352,8 @@ defineBuiltinTerms = do in case fun of PLC.IfThenElse -> case datatypeStyle of PIR.ScottEncoding -> defineBuiltinInl 'Builtins.ifThenElse - PIR.SumsOfProducts -> defineBuiltinTerm annMayInline 'Builtins.ifThenElse $ + PIR.SumsOfProducts -> defineBuiltinInl 'Builtins.ifThenElse + PIR.BuiltinCasing -> defineBuiltinTerm annMayInline 'Builtins.ifThenElse $ fmap (const annMayInline) . runQuote $ do a <- freshTyName "a" b <- freshName "b" diff --git a/plutus-tx-plugin/src/PlutusTx/Options.hs b/plutus-tx-plugin/src/PlutusTx/Options.hs index dfa9d775fa4..1dfff648b79 100644 --- a/plutus-tx-plugin/src/PlutusTx/Options.hs +++ b/plutus-tx-plugin/src/PlutusTx/Options.hs @@ -15,6 +15,7 @@ import PlutusCore.Parser as PLC import PlutusCore.Quote as PLC import PlutusCore.Version qualified as PLC import PlutusIR.Compiler qualified as PIR +import PlutusIR.Compiler.Types qualified as PIR import PlutusTx.Compiler.Types import UntypedPlutusCore qualified as UPLC @@ -51,6 +52,7 @@ data PluginOptions = PluginOptions , _posOptimize :: Bool , _posPedantic :: Bool , _posVerbosity :: Verbosity + , _posDatatypes :: PIR.DatatypeCompilationOpts , _posMaxSimplifierIterationsPir :: Int , _posMaxSimplifierIterationsUPlc :: Int , _posMaxCseIterations :: Int @@ -239,6 +241,9 @@ pluginOptions = desc [] ) + , let k = "datatypes" + desc = "Set datatype encoding style" + in (k, PluginOption typeRep (readOption k) posDatatypes desc []) , let k = "max-simplifier-iterations-pir" desc = "Set the max iterations for the PIR simplifier" in (k, PluginOption typeRep (readOption k) posMaxSimplifierIterationsPir desc []) @@ -359,6 +364,7 @@ defaultPluginOptions = , _posOptimize = True , _posPedantic = False , _posVerbosity = Quiet + , _posDatatypes = PIR.defaultDatatypeCompilationOpts , _posMaxSimplifierIterationsPir = view PIR.coMaxSimplifierIterations PIR.defaultCompilationOpts , _posMaxSimplifierIterationsUPlc = view UPLC.soMaxSimplifierIterations UPLC.defaultSimplifyOpts , _posMaxCseIterations = view UPLC.soMaxCseIterations UPLC.defaultSimplifyOpts From 7901ba590c46e58bd94d92699ce9a31eb70aa3d5 Mon Sep 17 00:00:00 2001 From: effectfully Date: Wed, 11 Jun 2025 17:45:02 +0200 Subject: [PATCH 18/25] Fix constitution tests --- .../Data/GoldenTests/sorted.cbor.size.golden | 2 +- .../GoldenTests/sorted.large.budget.golden | 2 +- .../Data/GoldenTests/sorted.pir.golden | 105 +- .../GoldenTests/sorted.small.budget.golden | 2 +- .../Data/GoldenTests/sorted.uplc.golden | 1759 ++++++------ .../GoldenTests/unsorted.cbor.size.golden | 2 +- .../GoldenTests/unsorted.large.budget.golden | 2 +- .../Data/GoldenTests/unsorted.pir.golden | 114 +- .../GoldenTests/unsorted.small.budget.golden | 2 +- .../Data/GoldenTests/unsorted.uplc.golden | 2439 +++++++++-------- .../GoldenTests/sorted.cbor.size.golden | 2 +- .../GoldenTests/sorted.large.budget.golden | 2 +- .../Validator/GoldenTests/sorted.pir.golden | 91 +- .../GoldenTests/sorted.small.budget.golden | 2 +- .../Validator/GoldenTests/sorted.uplc.golden | 1747 ++++++------ .../GoldenTests/unsorted.cbor.size.golden | 2 +- .../GoldenTests/unsorted.large.budget.golden | 2 +- .../Validator/GoldenTests/unsorted.pir.golden | 100 +- .../GoldenTests/unsorted.small.budget.golden | 2 +- .../GoldenTests/unsorted.uplc.golden | 2439 +++++++++-------- 20 files changed, 4461 insertions(+), 4357 deletions(-) diff --git a/cardano-constitution/test/Cardano/Constitution/Validator/Data/GoldenTests/sorted.cbor.size.golden b/cardano-constitution/test/Cardano/Constitution/Validator/Data/GoldenTests/sorted.cbor.size.golden index 9aba31b86d4..1bf1dcc81bd 100644 --- a/cardano-constitution/test/Cardano/Constitution/Validator/Data/GoldenTests/sorted.cbor.size.golden +++ b/cardano-constitution/test/Cardano/Constitution/Validator/Data/GoldenTests/sorted.cbor.size.golden @@ -1 +1 @@ -2090 \ No newline at end of file +2140 \ No newline at end of file diff --git a/cardano-constitution/test/Cardano/Constitution/Validator/Data/GoldenTests/sorted.large.budget.golden b/cardano-constitution/test/Cardano/Constitution/Validator/Data/GoldenTests/sorted.large.budget.golden index 66007bb088e..70b0c33905b 100644 --- a/cardano-constitution/test/Cardano/Constitution/Validator/Data/GoldenTests/sorted.large.budget.golden +++ b/cardano-constitution/test/Cardano/Constitution/Validator/Data/GoldenTests/sorted.large.budget.golden @@ -1 +1 @@ -ExBudget {exBudgetCPU = ExCPU 472550709, exBudgetMemory = ExMemory 2373780} \ No newline at end of file +ExBudget {exBudgetCPU = ExCPU 540852171, exBudgetMemory = ExMemory 2592918} \ No newline at end of file diff --git a/cardano-constitution/test/Cardano/Constitution/Validator/Data/GoldenTests/sorted.pir.golden b/cardano-constitution/test/Cardano/Constitution/Validator/Data/GoldenTests/sorted.pir.golden index c2dcaf79fdb..b6339aab48a 100644 --- a/cardano-constitution/test/Cardano/Constitution/Validator/Data/GoldenTests/sorted.pir.golden +++ b/cardano-constitution/test/Cardano/Constitution/Validator/Data/GoldenTests/sorted.pir.golden @@ -139,12 +139,12 @@ program !`$fOrdInteger_$ccompare` : integer -> integer -> Ordering = \(eta : integer) (eta : integer) -> Bool_match - (case Bool (equalsInteger eta eta) [False, True]) + (ifThenElse {Bool} (equalsInteger eta eta) True False) {all dead. Ordering} (/\dead -> EQ) (/\dead -> Bool_match - (case Bool (lessThanEqualsInteger eta eta) [False, True]) + (ifThenElse {Bool} (lessThanEqualsInteger eta eta) True False) {all dead. Ordering} (/\dead -> LT) (/\dead -> GT) @@ -162,18 +162,19 @@ program ds {Bool} (\(n' : integer) (d' : integer) -> - case - Bool + ifThenElse + {Bool} (lessThanEqualsInteger (multiplyInteger n d') (multiplyInteger n' d)) - [False, True])) + True + False)) in letrec !euclid : integer -> integer -> integer = \(x : integer) (y : integer) -> Bool_match - (case Bool (equalsInteger 0 y) [False, True]) + (ifThenElse {Bool} (equalsInteger 0 y) True False) {all dead. integer} (/\dead -> x) (/\dead -> euclid y (modInteger x y)) @@ -183,12 +184,12 @@ program !unsafeRatio : integer -> integer -> Rational = \(n : integer) (d : integer) -> Bool_match - (case Bool (equalsInteger 0 d) [False, True]) + (ifThenElse {Bool} (equalsInteger 0 d) True False) {all dead. Rational} (/\dead -> error {Rational}) (/\dead -> Bool_match - (case Bool (lessThanInteger d 0) [False, True]) + (ifThenElse {Bool} (lessThanInteger d 0) True False) {all dead. Rational} (/\dead -> unsafeRatio (subtractInteger 0 n) (subtractInteger 0 d)) @@ -210,8 +211,6 @@ program (\v -> List (Tuple2 PredKey (List v))) Rational -> ParamValue in let - !ifThenElse : all a. bool -> a -> a -> a - = /\a -> \(b : bool) (x : a) (y : a) -> case a b [y, x] data Unit | Unit_match where Unit : Unit in @@ -229,12 +228,16 @@ program (CConsOrd {integer} (\(x : integer) (y : integer) -> - case Bool (equalsInteger x y) [False, True]) + ifThenElse {Bool} (equalsInteger x y) True False) `$fOrdInteger_$ccompare` (\(x : integer) (y : integer) -> - case Bool (lessThanInteger x y) [False, True]) + ifThenElse {Bool} (lessThanInteger x y) True False) (\(x : integer) (y : integer) -> - case Bool (lessThanEqualsInteger x y) [False, True]) + ifThenElse + {Bool} + (lessThanEqualsInteger x y) + True + False) (\(x : integer) (y : integer) -> ifThenElse {Bool} @@ -245,14 +248,22 @@ program ifThenElse {Bool} (lessThanInteger x y) False True) (\(x : integer) (y : integer) -> Bool_match - (case Bool (lessThanEqualsInteger x y) [False, True]) + (ifThenElse + {Bool} + (lessThanEqualsInteger x y) + True + False) {all dead. integer} (/\dead -> y) (/\dead -> x) {all dead. dead}) (\(x : integer) (y : integer) -> Bool_match - (case Bool (lessThanEqualsInteger x y) [False, True]) + (ifThenElse + {Bool} + (lessThanEqualsInteger x y) + True + False) {all dead. integer} (/\dead -> x) (/\dead -> y) @@ -277,16 +288,18 @@ program {Bool} (\(n' : integer) (d' : integer) -> Bool_match - (case - Bool + (ifThenElse + {Bool} (equalsInteger n n') - [False, True]) + True + False) {all dead. Bool} (/\dead -> - case - Bool + ifThenElse + {Bool} (equalsInteger d d') - [False, True]) + True + False) (/\dead -> False) {all dead. dead}))) (\(ds : Rational) (ds : Rational) -> @@ -310,12 +323,13 @@ program ds {Bool} (\(n' : integer) (d' : integer) -> - case - Bool + ifThenElse + {Bool} (lessThanInteger (multiplyInteger n d') (multiplyInteger n' d)) - [False, True]))) + True + False))) `$fOrdRational0_$c<=` (\(ds : Rational) (ds : Rational) -> Rational_match @@ -326,13 +340,11 @@ program ds {Bool} (\(n' : integer) (d' : integer) -> - let - !x : integer = multiplyInteger n d' - !y : integer = multiplyInteger n' d - in ifThenElse {Bool} - (lessThanEqualsInteger x y) + (lessThanEqualsInteger + (multiplyInteger n d') + (multiplyInteger n' d)) False True))) (\(ds : Rational) (ds : Rational) -> @@ -344,13 +356,11 @@ program ds {Bool} (\(n' : integer) (d' : integer) -> - let - !x : integer = multiplyInteger n d' - !y : integer = multiplyInteger n' d - in ifThenElse {Bool} - (lessThanInteger x y) + (lessThanInteger + (multiplyInteger n d') + (multiplyInteger n' d)) False True))) (\(x : Rational) (y : Rational) -> @@ -389,7 +399,7 @@ program ds {list data -> Bool} (\(eta : list data) -> - case Bool (nullList {data} eta) [False, True]) + ifThenElse {Bool} (nullList {data} eta) True False) (\(paramValueHd : ParamValue) (paramValueTl : List ParamValue) (actualValueData : list data) -> @@ -489,12 +499,12 @@ program !args : list data = sndPair {integer} {list data} tup in Bool_match - (case Bool (equalsInteger 1 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 1 index) True False) {all dead. Maybe a} (/\dead -> Nothing {a}) (/\dead -> Bool_match - (case Bool (equalsInteger 0 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 0 index) True False) {all dead. Maybe a} (/\dead -> Just {a} (`$dUnsafeFromData` (headList {data} args))) @@ -5320,12 +5330,13 @@ program (unConstrData ds))))) in Bool_match - (case - Bool + (ifThenElse + {Bool} (equalsInteger 5 (fstPair {integer} {list data} tup)) - [False, True]) + True + False) {all dead. data} (/\dead -> headList @@ -5346,10 +5357,11 @@ program !tup : pair integer (list data) = unConstrData scrut in Bool_match - (case - Bool + (ifThenElse + {Bool} (equalsInteger 0 (fstPair {integer} {list data} tup)) - [False, True]) + True + False) {all dead. r} (/\dead -> let @@ -5385,10 +5397,11 @@ program !tup : pair integer (list data) = unConstrData scrut in Bool_match - (case - Bool + (ifThenElse + {Bool} (equalsInteger 2 (fstPair {integer} {list data} tup)) - [False, True]) + True + False) {all dead. r} (/\dead -> let diff --git a/cardano-constitution/test/Cardano/Constitution/Validator/Data/GoldenTests/sorted.small.budget.golden b/cardano-constitution/test/Cardano/Constitution/Validator/Data/GoldenTests/sorted.small.budget.golden index 76e2f4791d6..cb93543f47a 100644 --- a/cardano-constitution/test/Cardano/Constitution/Validator/Data/GoldenTests/sorted.small.budget.golden +++ b/cardano-constitution/test/Cardano/Constitution/Validator/Data/GoldenTests/sorted.small.budget.golden @@ -1 +1 @@ -ExBudget {exBudgetCPU = ExCPU 66876110, exBudgetMemory = ExMemory 308402} \ No newline at end of file +ExBudget {exBudgetCPU = ExCPU 82805157, exBudgetMemory = ExMemory 359105} \ No newline at end of file diff --git a/cardano-constitution/test/Cardano/Constitution/Validator/Data/GoldenTests/sorted.uplc.golden b/cardano-constitution/test/Cardano/Constitution/Validator/Data/GoldenTests/sorted.uplc.golden index e15c9f28d7b..57877825cd6 100644 --- a/cardano-constitution/test/Cardano/Constitution/Validator/Data/GoldenTests/sorted.uplc.golden +++ b/cardano-constitution/test/Cardano/Constitution/Validator/Data/GoldenTests/sorted.uplc.golden @@ -39,719 +39,706 @@ program (\cse -> (\cse -> (\cse -> - (\cse -> - (\fun - ds -> - force - (case - ((\cse -> - (\cse -> - force - (case - (equalsInteger - 0 - cse) - [ (delay - (force - (case - (equalsInteger - 2 - cse) - [ (delay - error) - , (delay - ((\l -> - constr 1 - [ ]) - (force - (force - sndPair) - cse))) ]))) - , (delay - (constr 0 - [ (force - caseData_go - (unMapData - (force - headList - (force - tailList - (force - (force - sndPair) - cse))))) ])) ])) + (\fun + ds -> + force + (case + ((\cse -> + (\cse -> + force (force - (force - fstPair) - cse)) - (unConstrData + ifThenElse + (equalsInteger + 0 + cse) + (delay + (constr 0 + [ (force + caseData_go + (unMapData + (force + headList + (force + tailList + (force + (force + sndPair) + cse))))) ])) + (delay + (force + (force + ifThenElse + (equalsInteger + 2 + cse) + (delay + ((\l -> + constr 1 + [ ]) + (force + (force + sndPair) + cse))) + (delay + error)))))) + (force + (force + fstPair) + cse)) + (unConstrData + (force + headList (force - headList + tailList (force tailList (force - tailList (force - (force - sndPair) - (unConstrData - ((\tup -> - force - (case - (equalsInteger - 5 + sndPair) + (unConstrData + ((\tup -> + force + (force + ifThenElse + (equalsInteger + 5 + (force (force - (force - fstPair) - tup)) - [ (delay - error) - , (delay - (force - headList - (force - tailList - (force - (force - sndPair) - tup)))) ])) - (unConstrData - (force - headList + fstPair) + tup)) + (delay (force - tailList + headList (force tailList (force (force sndPair) - (unConstrData - ds)))))))))))))) - [ (\cparams -> - delay - (force - (case - (fun - cparams) - [ (delay - ()) - , (delay - error) ]))) - , (delay - ()) ])) - (runRules - (constr 1 - [ (constr 0 - [ 0 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 30 - , cse ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 1000 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 1 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 100000 - , cse ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 10000000 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 2 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 24576 - , (constr 0 - [ ]) ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 122880 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 3 - , (constr 1 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 32768 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 4 - , (constr 1 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 5000 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 5 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 1000000 - , cse ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 5000000 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 6 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 250000000 - , cse ]) ]) - , cse ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 7 - , (constr 1 - [ (constr 1 - [ cse - , (constr 0 - [ ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 8 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 250 - , cse ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 2000 - , (constr 0 - [ ]) ]) ]) - , cse ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 9 - , (constr 3 - [ (constr 1 - [ cse - , cse ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 10 - , (constr 3 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ (cse - 1000) - , cse ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ (cse - 200) - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 11 - , (constr 3 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ (cse - 10) - , cse ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 16 - , (constr 1 - [ (constr 1 - [ cse - , cse ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 17 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 3000 - , cse ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 6500 - , (constr 0 - [ ]) ]) ]) - , cse ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 18 - , (constr 0 - [ ]) ]) - , (constr 1 - [ (constr 0 - [ 19 - , (constr 2 - [ (constr 1 - [ (constr 3 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ (cse - 25) - , (constr 0 - [ ]) ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ (cse - 5) - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) - , (constr 1 - [ (constr 3 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ (cse - 20000) - , (constr 0 - [ ]) ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ (cse - 5000) - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 20 - , (constr 2 - [ (constr 1 - [ (constr 1 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 40000000 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) - , (constr 1 - [ (constr 1 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 15000000000 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 21 - , (constr 2 - [ (constr 1 - [ (constr 1 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 120000000 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) - , (constr 1 - [ (constr 1 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 40000000000 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 22 - , (constr 1 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 12288 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 23 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 100 - , cse ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 200 - , (constr 0 - [ ]) ]) ]) - , cse ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 24 - , (constr 1 - [ (constr 1 - [ cse - , (constr 0 - [ ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 25 - , (constr 2 - [ (constr 1 - [ cse - , (constr 1 - [ cse - , (constr 1 - [ cse - , (constr 1 - [ cse - , cse ]) ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 26 - , (constr 2 - [ (constr 1 - [ cse - , (constr 1 - [ cse - , (constr 1 - [ cse - , (constr 1 - [ (constr 3 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ cse - , (constr 1 - [ (unsafeRatio - 13 - 20) - , (constr 0 - [ ]) ]) ]) ]) - , cse ]) ]) - , (constr 1 - [ cse - , (constr 1 - [ cse - , (constr 1 - [ cse - , (constr 1 - [ cse - , (constr 1 - [ (constr 3 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ cse - , cse ]) ]) - , cse ]) ]) - , cse ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 27 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 0 - , (constr 1 - [ 3 - , (constr 0 - [ ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 10 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 28 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 0 - , (constr 1 - [ 18 - , (constr 0 - [ ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 293 - , (constr 0 - [ ]) ]) ]) - , cse ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 29 - , (constr 1 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 15 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 30 - , (constr 1 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 10000000000000 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 31 - , (constr 1 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 100000000000 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 32 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 13 - , cse ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 37 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 33 - , (constr 3 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , cse ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ (unsafeRatio - 1000 - 1) - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]))) - (constr 3 - [ (constr 1 - [ cse - , cse ]) ])) + tup)))) + (delay + error))) + (unConstrData + (force + headList + (force + tailList + (force + tailList + (force + (force + sndPair) + (unConstrData + ds)))))))))))))) + [ (\cparams -> + delay + (force + (case + (fun + cparams) + [ (delay + ()) + , (delay + error) ]))) + , (delay + ()) ])) + (runRules + (constr 1 + [ (constr 0 + [ 0 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 30 + , cse ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 1000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 1 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 100000 + , cse ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 10000000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 2 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 24576 + , (constr 0 + [ ]) ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 122880 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 3 + , (constr 1 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 32768 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 4 + , (constr 1 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 5000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 5 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 1000000 + , cse ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 5000000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 6 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 250000000 + , cse ]) ]) + , cse ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 7 + , (constr 1 + [ (constr 1 + [ cse + , (constr 0 + [ ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 8 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 250 + , cse ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 2000 + , (constr 0 + [ ]) ]) ]) + , cse ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 9 + , (constr 3 + [ (constr 1 + [ cse + , cse ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 10 + , (constr 3 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ (cse + 1000) + , cse ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ (cse + 200) + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 11 + , (constr 3 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ (cse + 10) + , cse ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 16 + , (constr 1 + [ (constr 1 + [ cse + , cse ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 17 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 3000 + , cse ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 6500 + , (constr 0 + [ ]) ]) ]) + , cse ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 18 + , (constr 0 + [ ]) ]) + , (constr 1 + [ (constr 0 + [ 19 + , (constr 2 + [ (constr 1 + [ (constr 3 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ (cse + 25) + , (constr 0 + [ ]) ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ (cse + 5) + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) + , (constr 1 + [ (constr 3 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ (cse + 20000) + , (constr 0 + [ ]) ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ (cse + 5000) + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 20 + , (constr 2 + [ (constr 1 + [ (constr 1 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 40000000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) + , (constr 1 + [ (constr 1 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 15000000000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 21 + , (constr 2 + [ (constr 1 + [ (constr 1 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 120000000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) + , (constr 1 + [ (constr 1 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 40000000000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 22 + , (constr 1 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 12288 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 23 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 100 + , cse ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 200 + , (constr 0 + [ ]) ]) ]) + , cse ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 24 + , (constr 1 + [ (constr 1 + [ cse + , (constr 0 + [ ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 25 + , (constr 2 + [ (constr 1 + [ cse + , (constr 1 + [ cse + , (constr 1 + [ cse + , (constr 1 + [ cse + , cse ]) ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 26 + , (constr 2 + [ (constr 1 + [ cse + , (constr 1 + [ cse + , (constr 1 + [ cse + , (constr 1 + [ (constr 3 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ cse + , (constr 1 + [ (unsafeRatio + 13 + 20) + , (constr 0 + [ ]) ]) ]) ]) + , cse ]) ]) + , (constr 1 + [ cse + , (constr 1 + [ cse + , (constr 1 + [ cse + , (constr 1 + [ cse + , (constr 1 + [ (constr 3 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ cse + , cse ]) ]) + , cse ]) ]) + , cse ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 27 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 0 + , (constr 1 + [ 3 + , (constr 0 + [ ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 10 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 28 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 0 + , (constr 1 + [ 18 + , (constr 0 + [ ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 293 + , (constr 0 + [ ]) ]) ]) + , cse ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 29 + , (constr 1 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 15 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 30 + , (constr 1 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 10000000000000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 31 + , (constr 1 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 100000000000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 32 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 13 + , cse ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 37 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 33 + , (constr 3 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , cse ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ (unsafeRatio + 1000 + 1) + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]))) (constr 3 [ (constr 1 [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ cse - , (constr 1 - [ cse - , (constr 0 - [ ]) ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ])) + , cse ]) ])) (constr 3 [ (constr 1 [ cse @@ -764,38 +751,46 @@ program , cse ]) ]) , (constr 0 [ ]) ]) ]) ])) - (constr 1 - [ (constr 3 - [ (constr 1 + (constr 3 + [ (constr 1 + [ cse + , (constr 1 [ (constr 0 - [ (constr 1 + [ (constr 0 [ ]) , (constr 1 [ cse - , (constr 0 - [ ]) ]) ]) - , cse ]) ]) - , (constr 0 - [ ]) ])) + , (constr 1 + [ cse + , (constr 0 + [ ]) ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ])) (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ cse - , (constr 1 - [ (cse - 10) - , (constr 0 - [ ]) ]) ]) ]) + [ (constr 3 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ cse + , (constr 0 + [ ]) ]) ]) + , cse ]) ]) , (constr 0 [ ]) ])) - (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ cse - , cse ]) ])) + (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ cse + , (constr 1 + [ cse + , (constr 0 + [ ]) ]) ]) ]) + , (constr 0 + [ ]) ])) (constr 0 [ (constr 1 [ ]) @@ -805,41 +800,39 @@ program [ cse , (constr 0 [ ]) ]) ]) ])) - (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , cse ]) - , (constr 0 - [ ]) ])) - (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 0 - , (constr 1 - [ 1000000 - , (constr 0 - [ ]) ]) ]) ])) - (constr 1 - [ (constr 0 - [ (constr 2 - [ ]) - , cse ]) - , (constr 0 - [ ]) ])) + (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ (cse + 10) + , cse ]) ])) + (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , cse ]) + , (constr 0 + [ ]) ])) + (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 0 + , (constr 1 + [ 1000000 + , (constr 0 + [ ]) ]) ]) ])) (constr 1 [ (constr 0 - [ (constr 0 + [ (constr 2 [ ]) - , (constr 1 - [ 500000000 - , (constr 0 - [ ]) ]) ]) + , cse ]) , (constr 0 [ ]) ])) (constr 1 - [ cse + [ (cse + 4) , (constr 0 [ ]) ])) (constr 1 @@ -847,36 +840,45 @@ program , (constr 0 [ ]) ])) (constr 1 - [ cse + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 500000000 + , (constr 0 + [ ]) ]) ]) , (constr 0 [ ]) ])) - (cse - 2)) + (constr 1 + [ cse + , (constr 0 + [ ]) ])) (cse - 4)) - (constr 0 - [ (constr 1 - [ ]) - , cse ])) - (cse - 100)) - (cse 1)) - (cse 1)) - (constr 0 - [ (constr 1 []) - , (constr 1 - [ 1 - , (constr 0 - [ ]) ]) ])) - (cse 10)) - (cse 5)) - (unsafeRatio 51)) + 1)) + (cse + 10)) + (constr 0 + [ (constr 1 + [ ]) + , cse ])) + (constr 0 + [ (constr 1 + []) + , (constr 1 + [ 1 + , (constr 0 + [ ]) ]) ])) + (cse 2)) + (cse 1)) + (cse 5)) + (cse 100)) + (unsafeRatio 3)) (unsafeRatio 4)) - (constr 1 [0, (constr 0 [])])) - (unsafeRatio 3)) - (unsafeRatio 0)) - (unsafeRatio 9)) - (unsafeRatio 1)) + (unsafeRatio 9)) + (unsafeRatio 51)) + (constr 1 [0, (constr 0 [])])) + (unsafeRatio 1)) + (unsafeRatio 0)) ((\s -> s s) (\s arg -> delay @@ -992,58 +994,55 @@ program (validatePreds (constr 0 [ (\x y -> - case + force ifThenElse (equalsInteger x y) - [ (constr 1 []) - , (constr 0 []) ]) + (constr 0 []) + (constr 1 [])) , `$fOrdInteger_$ccompare` , (\x y -> - case + force ifThenElse (lessThanInteger x y) - [ (constr 1 []) - , (constr 0 []) ]) + (constr 0 []) + (constr 1 [])) , (\x y -> - case + force ifThenElse (lessThanEqualsInteger x y) - [ (constr 1 []) - , (constr 0 []) ]) + (constr 0 []) + (constr 1 [])) , (\x y -> - case + force ifThenElse (lessThanEqualsInteger x y) - [ (constr 0 []) - , (constr 1 []) ]) + (constr 1 []) + (constr 0 [])) , (\x y -> - case + force ifThenElse (lessThanInteger x y) - [ (constr 0 []) - , (constr 1 []) ]) + (constr 1 []) + (constr 0 [])) , (\x y -> - force - (case - (lessThanEqualsInteger - x - y) - [ (delay x) - , (delay y) ])) + force ifThenElse + (lessThanEqualsInteger + x + y) + y + x) , (\x y -> - force - (case - (lessThanEqualsInteger - x - y) - [ (delay y) - , (delay - x) ])) ]) + force ifThenElse + (lessThanEqualsInteger + x + y) + x + y) ]) preds (unIData eta))) , (\paramValues -> @@ -1064,22 +1063,24 @@ program [ (\n' d' -> force - (case + (force + ifThenElse (equalsInteger n n') - [ (delay - (constr 1 - [ ])) - , (delay - (case - (equalsInteger - d - d') - [ (constr 1 - [ ]) - , (constr 0 - [ ]) ])) ])) ]) ]) + (delay + (force + ifThenElse + (equalsInteger + d + d') + (constr 0 + [ ]) + (constr 1 + [ ]))) + (delay + (constr 1 + [ ])))) ]) ]) , (\ds ds -> case ds @@ -1103,7 +1104,8 @@ program ds [ (\n' d' -> - case + force + ifThenElse (lessThanInteger (multiplyInteger n @@ -1111,10 +1113,10 @@ program (multiplyInteger n' d)) - [ (constr 1 - [ ]) - , (constr 0 - [ ]) ]) ]) ]) + (constr 0 + [ ]) + (constr 1 + [ ])) ]) ]) , `$fOrdRational0_$c<=` , (\ds ds -> case @@ -1124,7 +1126,8 @@ program ds [ (\n' d' -> - case + force + ifThenElse (lessThanEqualsInteger (multiplyInteger n @@ -1132,10 +1135,10 @@ program (multiplyInteger n' d)) - [ (constr 0 - [ ]) - , (constr 1 - [ ]) ]) ]) ]) + (constr 1 + [ ]) + (constr 0 + [ ])) ]) ]) , (\ds ds -> case ds @@ -1144,7 +1147,8 @@ program ds [ (\n' d' -> - case + force + ifThenElse (lessThanInteger (multiplyInteger n @@ -1152,10 +1156,10 @@ program (multiplyInteger n' d)) - [ (constr 0 - [ ]) - , (constr 1 - [ ]) ]) ]) ]) + (constr 1 + [ ]) + (constr 0 + [ ])) ]) ]) , (\x y -> force (case @@ -1176,21 +1180,21 @@ program preds ((\bl -> (\bl' -> - case + force ifThenElse (force nullList (force tailList bl')) - [ (\ds -> error) - , (\ds -> - unsafeRatio - (unIData - (force - headList - bl)) - (unIData - (force - headList - bl'))) ] + (\ds -> + unsafeRatio + (unIData + (force + headList + bl)) + (unIData + (force + headList + bl'))) + (\ds -> error) (constr 0 [])) (force tailList bl)) (unListData eta)))) ])) @@ -1198,9 +1202,10 @@ program case ds [ (\eta -> - case + force ifThenElse (force nullList eta) - [(constr 1 []), (constr 0 [])]) + (constr 0 []) + (constr 1 [])) , (\paramValueHd paramValueTl actualValueData -> @@ -1220,29 +1225,30 @@ program ((\s -> s s) (\s n d -> force - (case + (force ifThenElse (equalsInteger 0 d) - [ (delay - (force - (case - (lessThanInteger d 0) - [ (delay - ((\gcd' -> - constr 0 - [ (quotientInteger n gcd') - , (quotientInteger d gcd') ]) - (euclid n d))) - , (delay - ((\x -> s s x) - (subtractInteger 0 n) - (subtractInteger 0 d))) ]))) - , (delay error) ])))) + (delay error) + (delay + (force + (force ifThenElse + (lessThanInteger d 0) + (delay + ((\x -> s s x) + (subtractInteger 0 n) + (subtractInteger 0 d))) + (delay + ((\gcd' -> + constr 0 + [ (quotientInteger n gcd') + , (quotientInteger d gcd') ]) + (euclid n d)))))))))) ((\s -> s s) (\s x y -> force - (case + (force ifThenElse (equalsInteger 0 y) - [(delay (s s y (modInteger x y))), (delay x)])))) + (delay x) + (delay (s s y (modInteger x y))))))) (\`$dOrd` ds ds -> (\s -> s s) (\s ds -> @@ -1311,14 +1317,14 @@ program ds)) (\eta eta -> force - (case + (force ifThenElse (equalsInteger eta eta) - [ (delay - (force - (case - (lessThanEqualsInteger eta eta) - [(delay (constr 1 [])), (delay (constr 2 []))]))) - , (delay (constr 0 [])) ]))) + (delay (constr 0 [])) + (delay + (force ifThenElse + (lessThanEqualsInteger eta eta) + (constr 2 []) + (constr 1 [])))))) (\ds ds -> case ds @@ -1326,8 +1332,9 @@ program case ds [ (\n' d' -> - case + force ifThenElse (lessThanEqualsInteger (multiplyInteger n d') (multiplyInteger n' d)) - [(constr 1 []), (constr 0 [])]) ]) ])) \ No newline at end of file + (constr 0 []) + (constr 1 [])) ]) ])) \ No newline at end of file diff --git a/cardano-constitution/test/Cardano/Constitution/Validator/Data/GoldenTests/unsorted.cbor.size.golden b/cardano-constitution/test/Cardano/Constitution/Validator/Data/GoldenTests/unsorted.cbor.size.golden index 1c412146757..7dd861da92d 100644 --- a/cardano-constitution/test/Cardano/Constitution/Validator/Data/GoldenTests/unsorted.cbor.size.golden +++ b/cardano-constitution/test/Cardano/Constitution/Validator/Data/GoldenTests/unsorted.cbor.size.golden @@ -1 +1 @@ -2082 \ No newline at end of file +2138 \ No newline at end of file diff --git a/cardano-constitution/test/Cardano/Constitution/Validator/Data/GoldenTests/unsorted.large.budget.golden b/cardano-constitution/test/Cardano/Constitution/Validator/Data/GoldenTests/unsorted.large.budget.golden index e9b04a5dfe4..0043e5123e4 100644 --- a/cardano-constitution/test/Cardano/Constitution/Validator/Data/GoldenTests/unsorted.large.budget.golden +++ b/cardano-constitution/test/Cardano/Constitution/Validator/Data/GoldenTests/unsorted.large.budget.golden @@ -1 +1 @@ -ExBudget {exBudgetCPU = ExCPU 660323564, exBudgetMemory = ExMemory 3405515} \ No newline at end of file +ExBudget {exBudgetCPU = ExCPU 856122341, exBudgetMemory = ExMemory 4215188} \ No newline at end of file diff --git a/cardano-constitution/test/Cardano/Constitution/Validator/Data/GoldenTests/unsorted.pir.golden b/cardano-constitution/test/Cardano/Constitution/Validator/Data/GoldenTests/unsorted.pir.golden index 6a6e6307dc0..6423e8518a8 100644 --- a/cardano-constitution/test/Cardano/Constitution/Validator/Data/GoldenTests/unsorted.pir.golden +++ b/cardano-constitution/test/Cardano/Constitution/Validator/Data/GoldenTests/unsorted.pir.golden @@ -136,15 +136,18 @@ program {all dead. dead} in go ds + !equalsInteger : integer -> integer -> Bool + = \(x : integer) (y : integer) -> + ifThenElse {Bool} (equalsInteger x y) True False !`$fOrdInteger_$ccompare` : integer -> integer -> Ordering = \(eta : integer) (eta : integer) -> Bool_match - (case Bool (equalsInteger eta eta) [False, True]) + (ifThenElse {Bool} (equalsInteger eta eta) True False) {all dead. Ordering} (/\dead -> EQ) (/\dead -> Bool_match - (case Bool (lessThanEqualsInteger eta eta) [False, True]) + (ifThenElse {Bool} (lessThanEqualsInteger eta eta) True False) {all dead. Ordering} (/\dead -> LT) (/\dead -> GT) @@ -162,18 +165,19 @@ program ds {Bool} (\(n' : integer) (d' : integer) -> - case - Bool + ifThenElse + {Bool} (lessThanEqualsInteger (multiplyInteger n d') (multiplyInteger n' d)) - [False, True])) + True + False)) in letrec !euclid : integer -> integer -> integer = \(x : integer) (y : integer) -> Bool_match - (case Bool (equalsInteger 0 y) [False, True]) + (ifThenElse {Bool} (equalsInteger 0 y) True False) {all dead. integer} (/\dead -> x) (/\dead -> euclid y (modInteger x y)) @@ -183,12 +187,12 @@ program !unsafeRatio : integer -> integer -> Rational = \(n : integer) (d : integer) -> Bool_match - (case Bool (equalsInteger 0 d) [False, True]) + (ifThenElse {Bool} (equalsInteger 0 d) True False) {all dead. Rational} (/\dead -> error {Rational}) (/\dead -> Bool_match - (case Bool (lessThanInteger d 0) [False, True]) + (ifThenElse {Bool} (lessThanInteger d 0) True False) {all dead. Rational} (/\dead -> unsafeRatio (subtractInteger 0 n) (subtractInteger 0 d)) @@ -210,8 +214,6 @@ program (\v -> List (Tuple2 PredKey (List v))) Rational -> ParamValue in let - !ifThenElse : all a. bool -> a -> a -> a - = /\a -> \(b : bool) (x : a) (y : a) -> case a b [y, x] data Unit | Unit_match where Unit : Unit in @@ -228,13 +230,16 @@ program {integer} (CConsOrd {integer} - (\(x : integer) (y : integer) -> - case Bool (equalsInteger x y) [False, True]) + equalsInteger `$fOrdInteger_$ccompare` (\(x : integer) (y : integer) -> - case Bool (lessThanInteger x y) [False, True]) + ifThenElse {Bool} (lessThanInteger x y) True False) (\(x : integer) (y : integer) -> - case Bool (lessThanEqualsInteger x y) [False, True]) + ifThenElse + {Bool} + (lessThanEqualsInteger x y) + True + False) (\(x : integer) (y : integer) -> ifThenElse {Bool} @@ -245,14 +250,22 @@ program ifThenElse {Bool} (lessThanInteger x y) False True) (\(x : integer) (y : integer) -> Bool_match - (case Bool (lessThanEqualsInteger x y) [False, True]) + (ifThenElse + {Bool} + (lessThanEqualsInteger x y) + True + False) {all dead. integer} (/\dead -> y) (/\dead -> x) {all dead. dead}) (\(x : integer) (y : integer) -> Bool_match - (case Bool (lessThanEqualsInteger x y) [False, True]) + (ifThenElse + {Bool} + (lessThanEqualsInteger x y) + True + False) {all dead. integer} (/\dead -> x) (/\dead -> y) @@ -277,16 +290,18 @@ program {Bool} (\(n' : integer) (d' : integer) -> Bool_match - (case - Bool + (ifThenElse + {Bool} (equalsInteger n n') - [False, True]) + True + False) {all dead. Bool} (/\dead -> - case - Bool + ifThenElse + {Bool} (equalsInteger d d') - [False, True]) + True + False) (/\dead -> False) {all dead. dead}))) (\(ds : Rational) (ds : Rational) -> @@ -310,12 +325,13 @@ program ds {Bool} (\(n' : integer) (d' : integer) -> - case - Bool + ifThenElse + {Bool} (lessThanInteger (multiplyInteger n d') (multiplyInteger n' d)) - [False, True]))) + True + False))) `$fOrdRational0_$c<=` (\(ds : Rational) (ds : Rational) -> Rational_match @@ -326,13 +342,11 @@ program ds {Bool} (\(n' : integer) (d' : integer) -> - let - !x : integer = multiplyInteger n d' - !y : integer = multiplyInteger n' d - in ifThenElse {Bool} - (lessThanEqualsInteger x y) + (lessThanEqualsInteger + (multiplyInteger n d') + (multiplyInteger n' d)) False True))) (\(ds : Rational) (ds : Rational) -> @@ -344,13 +358,11 @@ program ds {Bool} (\(n' : integer) (d' : integer) -> - let - !x : integer = multiplyInteger n d' - !y : integer = multiplyInteger n' d - in ifThenElse {Bool} - (lessThanInteger x y) + (lessThanInteger + (multiplyInteger n d') + (multiplyInteger n' d)) False True))) (\(x : Rational) (y : Rational) -> @@ -389,7 +401,7 @@ program ds {list data -> Bool} (\(eta : list data) -> - case Bool (nullList {data} eta) [False, True]) + ifThenElse {Bool} (nullList {data} eta) True False) (\(paramValueHd : ParamValue) (paramValueTl : List ParamValue) (actualValueData : list data) -> @@ -419,12 +431,12 @@ program !args : list data = sndPair {integer} {list data} tup in Bool_match - (case Bool (equalsInteger 1 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 1 index) True False) {all dead. Maybe a} (/\dead -> Nothing {a}) (/\dead -> Bool_match - (case Bool (equalsInteger 0 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 0 index) True False) {all dead. Maybe a} (/\dead -> Just {a} (`$dUnsafeFromData` (headList {data} args))) @@ -5211,10 +5223,7 @@ program {ParamValue} (\(k' : integer) (i : ParamValue) -> Bool_match - (case - Bool - (equalsInteger k k') - [False, True]) + (equalsInteger k k') {all dead. ParamValue} (/\dead -> i) (/\dead -> go xs') @@ -5255,12 +5264,13 @@ program (unConstrData ds))))) in Bool_match - (case - Bool + (ifThenElse + {Bool} (equalsInteger 5 (fstPair {integer} {list data} tup)) - [False, True]) + True + False) {all dead. data} (/\dead -> headList @@ -5281,10 +5291,11 @@ program !tup : pair integer (list data) = unConstrData scrut in Bool_match - (case - Bool + (ifThenElse + {Bool} (equalsInteger 0 (fstPair {integer} {list data} tup)) - [False, True]) + True + False) {all dead. r} (/\dead -> let @@ -5320,10 +5331,11 @@ program !tup : pair integer (list data) = unConstrData scrut in Bool_match - (case - Bool + (ifThenElse + {Bool} (equalsInteger 2 (fstPair {integer} {list data} tup)) - [False, True]) + True + False) {all dead. r} (/\dead -> let diff --git a/cardano-constitution/test/Cardano/Constitution/Validator/Data/GoldenTests/unsorted.small.budget.golden b/cardano-constitution/test/Cardano/Constitution/Validator/Data/GoldenTests/unsorted.small.budget.golden index cc35217a63c..3910e76ff57 100644 --- a/cardano-constitution/test/Cardano/Constitution/Validator/Data/GoldenTests/unsorted.small.budget.golden +++ b/cardano-constitution/test/Cardano/Constitution/Validator/Data/GoldenTests/unsorted.small.budget.golden @@ -1 +1 @@ -ExBudget {exBudgetCPU = ExCPU 64618367, exBudgetMemory = ExMemory 295403} \ No newline at end of file +ExBudget {exBudgetCPU = ExCPU 80783267, exBudgetMemory = ExMemory 349003} \ No newline at end of file diff --git a/cardano-constitution/test/Cardano/Constitution/Validator/Data/GoldenTests/unsorted.uplc.golden b/cardano-constitution/test/Cardano/Constitution/Validator/Data/GoldenTests/unsorted.uplc.golden index 52f57192ece..b9142a5739c 100644 --- a/cardano-constitution/test/Cardano/Constitution/Validator/Data/GoldenTests/unsorted.uplc.golden +++ b/cardano-constitution/test/Cardano/Constitution/Validator/Data/GoldenTests/unsorted.uplc.golden @@ -2,14 +2,14 @@ program 1.1.0 ((\`$fOrdRational0_$c<=` -> (\`$fOrdInteger_$ccompare` -> - (\validatePreds -> - (\euclid -> - (\unsafeRatio -> - (\cse -> - (\validateParamValue -> - (\validateParamValues -> - (\caseData_go -> - (\cse -> + (\equalsInteger -> + (\validatePreds -> + (\euclid -> + (\unsafeRatio -> + (\cse -> + (\validateParamValue -> + (\validateParamValues -> + (\caseData_go -> (\cse -> (\cse -> (\cse -> @@ -39,779 +39,784 @@ program (\cse -> (\cse -> (\cse -> - (\cfg -> - (\fun - ds -> - force - (case - ((\cse -> - (\cse -> - force - (case - (equalsInteger - 0 - cse) - [ (delay - (force - (case - (equalsInteger - 2 - cse) - [ (delay - error) - , (delay - ((\l -> - constr 1 - [ ]) - (force - (force - sndPair) - cse))) ]))) - , (delay - (constr 0 - [ (force - caseData_go - (unMapData - (force - headList - (force - tailList - (force - (force - sndPair) - cse))))) ])) ])) - (force + (\cse -> + (\cfg -> + (\fun + ds -> + force + (case + ((\cse -> + (\cse -> + force + (force + ifThenElse + (equalsInteger + 0 + cse) + (delay + (constr 0 + [ (force + caseData_go + (unMapData + (force + headList + (force + tailList + (force + (force + sndPair) + cse))))) ])) + (delay + (force + (force + ifThenElse + (equalsInteger + 2 + cse) + (delay + ((\l -> + constr 1 + [ ]) + (force + (force + sndPair) + cse))) + (delay + error)))))) (force - fstPair) - cse)) - (unConstrData - (force - headList + (force + fstPair) + cse)) + (unConstrData (force - tailList + headList (force tailList (force + tailList (force - sndPair) - (unConstrData - ((\tup -> - force - (case - (equalsInteger - 5 - (force + (force + sndPair) + (unConstrData + ((\tup -> + force + (force + ifThenElse + (equalsInteger + 5 (force - fstPair) - tup)) - [ (delay - error) - , (delay - (force - headList - (force - tailList - (force - (force - sndPair) - tup)))) ])) - (unConstrData - (force - headList + (force + fstPair) + tup)) + (delay + (force + headList + (force + tailList + (force + (force + sndPair) + tup)))) + (delay + error))) + (unConstrData (force - tailList + headList (force tailList (force + tailList (force - sndPair) - (unConstrData - ds)))))))))))))) - [ (\cparams -> - delay - (force - (case - (fun - cparams) - [ (delay - ()) - , (delay - error) ]))) - , (delay - ()) ])) - ((\go - eta -> - go - eta) - ((\s -> - s - s) - (\s - ds -> - force - (case - ds - [ (delay - (constr 0 - [ ])) - , (\x - xs -> - delay - (force - (case + (force + sndPair) + (unConstrData + ds)))))))))))))) + [ (\cparams -> + delay + (force + (case + (fun + cparams) + [ (delay + ()) + , (delay + error) ]))) + , (delay + ()) ])) + ((\go + eta -> + go + eta) + ((\s -> + s + s) + (\s + ds -> + force + (case + ds + [ (delay + (constr 0 + [ ])) + , (\x + xs -> + delay + (force (case - x - [ (\ds - actualValueData -> - validateParamValue - ((\k -> - (\s -> - s - s) - (\s - ds -> - force - (case - ds - [ (delay - error) - , (\ds - xs' -> - delay - (case - ds - [ (\k' - i -> - force - (case - (equalsInteger - k - k') - [ (delay - (s - s - xs')) - , (delay - i) ])) ])) ]))) - (unIData - ds) - cfg) - actualValueData) ]) - [ (delay - (s - s - xs)) - , (delay - (constr 1 - [ ])) ]))) ]))))) - (constr 1 - [ (constr 0 - [ 0 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 30 - , cse ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 1000 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 1 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 100000 - , cse ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 10000000 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) + (case + x + [ (\ds + actualValueData -> + validateParamValue + ((\k -> + (\s -> + s + s) + (\s + ds -> + force + (case + ds + [ (delay + error) + , (\ds + xs' -> + delay + (case + ds + [ (\k' + i -> + force + (case + (equalsInteger + k + k') + [ (delay + i) + , (delay + (s + s + xs')) ])) ])) ]))) + (unIData + ds) + cfg) + actualValueData) ]) + [ (delay + (s + s + xs)) + , (delay + (constr 1 + [ ])) ]))) ]))))) + (constr 1 + [ (constr 0 + [ 0 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 30 + , cse ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 1000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 1 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 100000 + , cse ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 10000000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 2 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 24576 + , (constr 0 + [ ]) ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 122880 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 3 + , (constr 1 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 32768 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 4 + , (constr 1 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 5000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 5 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 1000000 + , cse ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 5000000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 6 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 250000000 + , cse ]) ]) + , cse ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 7 + , (constr 1 + [ (constr 1 + [ cse + , (constr 0 + [ ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 8 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 250 + , cse ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 2000 + , (constr 0 + [ ]) ]) ]) + , cse ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 9 + , (constr 3 + [ (constr 1 + [ cse + , cse ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 10 + , (constr 3 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ (cse + 1000) + , cse ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ (cse + 200) + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 11 + , (constr 3 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ (cse + 10) + , cse ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 16 + , (constr 1 + [ (constr 1 + [ cse + , cse ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 17 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 3000 + , cse ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 6500 + , (constr 0 + [ ]) ]) ]) + , cse ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 18 + , (constr 0 + [ ]) ]) + , (constr 1 + [ (constr 0 + [ 19 + , (constr 2 + [ (constr 1 + [ (constr 3 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ (cse + 25) + , (constr 0 + [ ]) ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ (cse + 5) + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) + , (constr 1 + [ (constr 3 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ (cse + 20000) + , (constr 0 + [ ]) ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ (cse + 5000) + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 20 + , (constr 2 + [ (constr 1 + [ (constr 1 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 40000000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) + , (constr 1 + [ (constr 1 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 15000000000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 21 + , (constr 2 + [ (constr 1 + [ (constr 1 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 120000000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) + , (constr 1 + [ (constr 1 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 40000000000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 22 + , (constr 1 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 12288 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 23 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 100 + , cse ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 200 + , (constr 0 + [ ]) ]) ]) + , cse ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 24 + , (constr 1 + [ (constr 1 + [ cse + , (constr 0 + [ ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 25 + , (constr 2 + [ (constr 1 + [ cse + , (constr 1 + [ cse + , (constr 1 + [ cse + , (constr 1 + [ cse + , cse ]) ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 26 + , (constr 2 + [ (constr 1 + [ cse + , (constr 1 + [ cse + , (constr 1 + [ cse + , (constr 1 + [ (constr 3 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ cse + , (constr 1 + [ (unsafeRatio + 13 + 20) + , (constr 0 + [ ]) ]) ]) ]) + , cse ]) ]) + , (constr 1 + [ cse + , (constr 1 + [ cse + , (constr 1 + [ cse + , (constr 1 + [ cse + , (constr 1 + [ (constr 3 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ cse + , cse ]) ]) + , cse ]) ]) + , cse ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 27 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 0 + , (constr 1 + [ 3 + , (constr 0 + [ ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 10 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 28 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 0 + , (constr 1 + [ 18 + , (constr 0 + [ ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 293 + , (constr 0 + [ ]) ]) ]) + , cse ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 29 + , (constr 1 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 15 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 30 + , (constr 1 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 10000000000000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 31 + , (constr 1 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 100000000000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 32 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 13 + , cse ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 37 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 33 + , (constr 3 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , cse ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ (unsafeRatio + 1000 + 1) + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ])) + (constr 3 + [ (constr 1 + [ cse , (constr 1 [ (constr 0 - [ 2 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 24576 - , (constr 0 - [ ]) ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 122880 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 [ (constr 0 - [ 3 - , (constr 1 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 32768 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) + [ ]) , (constr 1 - [ (constr 0 - [ 4 - , (constr 1 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 5000 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 5 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 1000000 - , cse ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 5000000 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 6 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 250000000 - , cse ]) ]) - , cse ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 7 - , (constr 1 - [ (constr 1 - [ cse - , (constr 0 - [ ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 8 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 250 - , cse ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 2000 - , (constr 0 - [ ]) ]) ]) - , cse ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 9 - , (constr 3 - [ (constr 1 - [ cse - , cse ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 10 - , (constr 3 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ (cse - 1000) - , cse ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ (cse - 200) - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 11 - , (constr 3 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ (cse - 10) - , cse ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 16 - , (constr 1 - [ (constr 1 - [ cse - , cse ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 17 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 3000 - , cse ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 6500 - , (constr 0 - [ ]) ]) ]) - , cse ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 18 - , (constr 0 - [ ]) ]) - , (constr 1 - [ (constr 0 - [ 19 - , (constr 2 - [ (constr 1 - [ (constr 3 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ (cse - 25) - , (constr 0 - [ ]) ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ (cse - 5) - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) - , (constr 1 - [ (constr 3 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ (cse - 20000) - , (constr 0 - [ ]) ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ (cse - 5000) - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 20 - , (constr 2 - [ (constr 1 - [ (constr 1 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 40000000 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) - , (constr 1 - [ (constr 1 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 15000000000 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 21 - , (constr 2 - [ (constr 1 - [ (constr 1 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 120000000 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) - , (constr 1 - [ (constr 1 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 40000000000 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 22 - , (constr 1 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 12288 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 23 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 100 - , cse ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 200 - , (constr 0 - [ ]) ]) ]) - , cse ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 24 - , (constr 1 - [ (constr 1 - [ cse - , (constr 0 - [ ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 25 - , (constr 2 - [ (constr 1 - [ cse - , (constr 1 - [ cse - , (constr 1 - [ cse - , (constr 1 - [ cse - , cse ]) ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 26 - , (constr 2 - [ (constr 1 - [ cse - , (constr 1 - [ cse - , (constr 1 - [ cse - , (constr 1 - [ (constr 3 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ cse - , (constr 1 - [ (unsafeRatio - 13 - 20) - , (constr 0 - [ ]) ]) ]) ]) - , cse ]) ]) - , (constr 1 - [ cse - , (constr 1 - [ cse - , (constr 1 - [ cse - , (constr 1 - [ cse - , (constr 1 - [ (constr 3 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ cse - , cse ]) ]) - , cse ]) ]) - , cse ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 27 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 0 - , (constr 1 - [ 3 - , (constr 0 - [ ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 10 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 28 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 0 - , (constr 1 - [ 18 - , (constr 0 - [ ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 293 - , (constr 0 - [ ]) ]) ]) - , cse ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 29 - , (constr 1 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 15 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 30 - , (constr 1 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 10000000000000 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 31 - , (constr 1 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 100000000000 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 32 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 13 - , cse ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 37 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 33 - , (constr 3 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , cse ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ (unsafeRatio - 1000 - 1) - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ])) + [ cse + , cse ]) ]) + , (constr 0 + [ ]) ]) ]) ])) (constr 3 [ (constr 1 [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ cse - , (constr 1 - [ cse - , (constr 0 - [ ]) ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ])) + , cse ]) ])) (constr 3 [ (constr 1 [ cse @@ -821,38 +826,43 @@ program [ ]) , (constr 1 [ cse - , cse ]) ]) + , (constr 1 + [ cse + , (constr 0 + [ ]) ]) ]) ]) , (constr 0 [ ]) ]) ]) ])) - (constr 3 - [ (constr 1 - [ cse - , cse ]) ])) + (constr 1 + [ (constr 3 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ cse + , (constr 0 + [ ]) ]) ]) + , cse ]) ]) + , (constr 0 + [ ]) ])) (constr 1 - [ (constr 3 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ cse - , (constr 0 - [ ]) ]) ]) - , cse ]) ]) + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ cse + , (constr 1 + [ cse + , (constr 0 + [ ]) ]) ]) ]) , (constr 0 [ ]) ])) - (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ cse - , (constr 1 - [ cse - , (constr 0 - [ ]) ]) ]) ]) - , (constr 0 - [ ]) ])) + (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ cse + , cse ]) ])) (constr 0 [ (constr 1 [ ]) @@ -862,462 +872,472 @@ program [ cse , (constr 0 [ ]) ]) ]) ])) - (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ (cse - 10) - , cse ]) ])) - (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , cse ]) - , (constr 0 - [ ]) ])) - (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 0 - , (constr 1 - [ 1000000 - , (constr 0 - [ ]) ]) ]) ])) + (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , cse ]) + , (constr 0 + [ ]) ])) + (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 0 + , (constr 1 + [ 1000000 + , (constr 0 + [ ]) ]) ]) ])) + (constr 1 + [ (constr 0 + [ (constr 2 + [ ]) + , cse ]) + , (constr 0 + [ ]) ])) (constr 1 [ (constr 0 - [ (constr 2 + [ (constr 0 [ ]) - , cse ]) + , (constr 1 + [ 500000000 + , (constr 0 + [ ]) ]) ]) , (constr 0 [ ]) ])) (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 500000000 - , (constr 0 - [ ]) ]) ]) + [ cse , (constr 0 [ ]) ])) (constr 1 - [ cse + [ (cse + 4) , (constr 0 [ ]) ])) (constr 1 [ cse , (constr 0 [ ]) ])) - (constr 1 - [ cse - , (constr 0 - [ ]) ])) - (cse - 100)) + (cse + 1)) + (constr 0 + [ (constr 1 + [ ]) + , cse ])) (cse 1)) - (cse 10)) - (constr 0 - [ (constr 1 - []) - , cse ])) - (cse 1)) - (cse 2)) - (constr 0 - [ (constr 1 []) - , (constr 1 - [ 1 - , (constr 0 - [ ]) ]) ])) - (cse 4)) - (cse 5)) - (unsafeRatio 9)) - (unsafeRatio 1)) - (unsafeRatio 0)) + (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 1 + , (constr 0 + [ ]) ]) ])) + (cse 2)) + (cse 10)) + (cse 5)) + (cse 100)) + (cse 10)) + (unsafeRatio 3)) + (unsafeRatio 1)) + (unsafeRatio 0)) + (unsafeRatio 9)) (constr 1 [0, (constr 0 [])])) - (unsafeRatio 4)) - (unsafeRatio 3)) - (unsafeRatio 51)) - ((\s -> s s) - (\s arg -> - delay - (\xs -> + (unsafeRatio 51)) + (unsafeRatio 4)) + ((\s -> s s) + (\s arg -> + delay + (\xs -> + force + (force (force chooseList) + xs + (delay (constr 0 [])) + (delay + ((\x -> + constr 1 + [ (constr 0 + [ (force + (force + fstPair) + x) + , (force + (force + sndPair) + x) ]) + , (force + (s + s + (delay + (\x -> x))) + (force tailList + xs)) ]) + (force headList xs)))))) + (delay (\x -> x)))) + (cse (\arg_0 arg_1 -> arg_1))) + (cse (\arg_0 arg_1 -> arg_0))) + (force + ((\s -> s s) + (\s h -> + delay + (\fr -> + (\k -> + fr + (\x -> k (\f_0 f_1 -> f_0 x)) + (\x -> k (\f_0 f_1 -> f_1 x))) + (\fq -> force (s s h) (force h fq)))) + (delay + (\choose + validateParamValue + validateParamValues -> + choose + (\eta eta -> force - (force (force chooseList) - xs - (delay (constr 0 [])) - (delay - ((\x -> - constr 1 - [ (constr 0 - [ (force - (force fstPair) - x) - , (force - (force sndPair) - x) ]) - , (force - (s - s - (delay (\x -> x))) - (force tailList - xs)) ]) - (force headList xs)))))) - (delay (\x -> x)))) - (cse (\arg_0 arg_1 -> arg_1))) - (cse (\arg_0 arg_1 -> arg_0))) - (force - ((\s -> s s) - (\s h -> - delay - (\fr -> - (\k -> - fr - (\x -> k (\f_0 f_1 -> f_0 x)) - (\x -> k (\f_0 f_1 -> f_1 x))) - (\fq -> force (s s h) (force h fq)))) - (delay - (\choose validateParamValue validateParamValues -> - choose - (\eta eta -> - force - (case - eta - [ (delay (constr 0 [])) - , (\preds -> - delay - (validatePreds - (constr 0 - [ (\x y -> - case - (equalsInteger - x - y) - [ (constr 1 []) - , (constr 0 []) ]) - , `$fOrdInteger_$ccompare` - , (\x y -> - case - (lessThanInteger - x - y) - [ (constr 1 []) - , (constr 0 []) ]) - , (\x y -> - case - (lessThanEqualsInteger - x - y) - [ (constr 1 []) - , (constr 0 []) ]) - , (\x y -> - case - (lessThanEqualsInteger - x - y) - [ (constr 0 []) - , (constr 1 []) ]) - , (\x y -> - case - (lessThanInteger - x - y) - [ (constr 0 []) - , (constr 1 []) ]) - , (\x y -> - force - (case + (case + eta + [ (delay (constr 0 [])) + , (\preds -> + delay + (validatePreds + (constr 0 + [ equalsInteger + , `$fOrdInteger_$ccompare` + , (\x y -> + force ifThenElse + (lessThanInteger + x + y) + (constr 0 []) + (constr 1 [])) + , (\x y -> + force ifThenElse (lessThanEqualsInteger x y) - [ (delay x) - , (delay y) ])) - , (\x y -> - force - (case + (constr 0 []) + (constr 1 [])) + , (\x y -> + force ifThenElse (lessThanEqualsInteger x y) - [ (delay y) - , (delay - x) ])) ]) - preds - (unIData eta))) - , (\paramValues -> - delay - (validateParamValues - paramValues - (unListData eta))) - , (\preds -> - delay - (validatePreds - (constr 0 - [ (\ds ds -> - case - ds - [ (\n d -> - case - ds - [ (\n' - d' -> - force - (case - (equalsInteger - n - n') - [ (delay - (constr 1 - [ ])) - , (delay - (case - (equalsInteger - d - d') - [ (constr 1 - [ ]) - , (constr 0 - [ ]) ])) ])) ]) ]) - , (\ds ds -> - case - ds - [ (\n d -> - case - ds - [ (\n' - d' -> - `$fOrdInteger_$ccompare` - (multiplyInteger - n - d') - (multiplyInteger - n' - d)) ]) ]) - , (\ds ds -> - case - ds - [ (\n d -> - case - ds - [ (\n' - d' -> - case - (lessThanInteger - (multiplyInteger - n - d') - (multiplyInteger - n' - d)) - [ (constr 1 - [ ]) - , (constr 0 - [ ]) ]) ]) ]) - , `$fOrdRational0_$c<=` - , (\ds ds -> - case - ds - [ (\n d -> - case - ds - [ (\n' - d' -> - case - (lessThanEqualsInteger - (multiplyInteger - n - d') - (multiplyInteger - n' - d)) - [ (constr 0 - [ ]) - , (constr 1 - [ ]) ]) ]) ]) - , (\ds ds -> - case - ds - [ (\n d -> - case - ds - [ (\n' - d' -> - case - (lessThanInteger + (constr 1 []) + (constr 0 [])) + , (\x y -> + force ifThenElse + (lessThanInteger + x + y) + (constr 1 []) + (constr 0 [])) + , (\x y -> + force ifThenElse + (lessThanEqualsInteger + x + y) + y + x) + , (\x y -> + force ifThenElse + (lessThanEqualsInteger + x + y) + x + y) ]) + preds + (unIData eta))) + , (\paramValues -> + delay + (validateParamValues + paramValues + (unListData eta))) + , (\preds -> + delay + (validatePreds + (constr 0 + [ (\ds ds -> + case + ds + [ (\n d -> + case + ds + [ (\n' + d' -> + force + (force + ifThenElse + (equalsInteger + n + n') + (delay + (force + ifThenElse + (equalsInteger + d + d') + (constr 0 + [ ]) + (constr 1 + [ ]))) + (delay + (constr 1 + [ ])))) ]) ]) + , (\ds ds -> + case + ds + [ (\n d -> + case + ds + [ (\n' + d' -> + `$fOrdInteger_$ccompare` (multiplyInteger n d') (multiplyInteger n' - d)) - [ (constr 0 - [ ]) - , (constr 1 - [ ]) ]) ]) ]) - , (\x y -> - force - (case - (`$fOrdRational0_$c<=` - x - y) - [ (delay y) - , (delay x) ])) - , (\x y -> - force - (case - (`$fOrdRational0_$c<=` - x - y) - [ (delay x) - , (delay - y) ])) ]) - preds - ((\bl -> - (\bl' -> - case - (force nullList - (force tailList - bl')) - [ (\ds -> error) - , (\ds -> - unsafeRatio - (unIData - (force - headList - bl)) - (unIData - (force - headList - bl'))) ] - (constr 0 [])) - (force tailList bl)) - (unListData eta)))) ])) - (\ds -> - case - ds - [ (\eta -> - case - (force nullList eta) - [(constr 1 []), (constr 0 [])]) - , (\paramValueHd - paramValueTl - actualValueData -> - force - (case - (validateParamValue - paramValueHd - (force headList - actualValueData)) - [ (delay - (validateParamValues - paramValueTl - (force tailList - actualValueData))) - , (delay - (constr 1 [])) ])) ])))))) - ((\s -> s s) - (\s n d -> - force - (case - (equalsInteger 0 d) - [ (delay - (force - (case - (lessThanInteger d 0) - [ (delay - ((\gcd' -> - constr 0 - [ (quotientInteger n gcd') - , (quotientInteger d gcd') ]) - (euclid n d))) - , (delay - ((\x -> s s x) - (subtractInteger 0 n) - (subtractInteger 0 d))) ]))) - , (delay error) ])))) - ((\s -> s s) - (\s x y -> - force - (case - (equalsInteger 0 y) - [(delay (s s y (modInteger x y))), (delay x)])))) - (\`$dOrd` ds ds -> - (\s -> s s) - (\s ds -> - force - (case - ds - [ (delay (constr 0 [])) - , (\x xs -> - delay - (case - x - [ (\predKey expectedPredValues -> - (\meaning -> - (\s -> s s) - (\s ds -> + d)) ]) ]) + , (\ds ds -> + case + ds + [ (\n d -> + case + ds + [ (\n' + d' -> + force + ifThenElse + (lessThanInteger + (multiplyInteger + n + d') + (multiplyInteger + n' + d)) + (constr 0 + [ ]) + (constr 1 + [ ])) ]) ]) + , `$fOrdRational0_$c<=` + , (\ds ds -> + case + ds + [ (\n d -> + case + ds + [ (\n' + d' -> + force + ifThenElse + (lessThanEqualsInteger + (multiplyInteger + n + d') + (multiplyInteger + n' + d)) + (constr 1 + [ ]) + (constr 0 + [ ])) ]) ]) + , (\ds ds -> + case + ds + [ (\n d -> + case + ds + [ (\n' + d' -> + force + ifThenElse + (lessThanInteger + (multiplyInteger + n + d') + (multiplyInteger + n' + d)) + (constr 1 + [ ]) + (constr 0 + [ ])) ]) ]) + , (\x y -> + force + (case + (`$fOrdRational0_$c<=` + x + y) + [ (delay y) + , (delay + x) ])) + , (\x y -> + force + (case + (`$fOrdRational0_$c<=` + x + y) + [ (delay x) + , (delay + y) ])) ]) + preds + ((\bl -> + (\bl' -> + force ifThenElse + (force nullList + (force + tailList + bl')) + (\ds -> + unsafeRatio + (unIData + (force + headList + bl)) + (unIData + (force + headList + bl'))) + (\ds -> error) + (constr 0 [])) + (force tailList + bl)) + (unListData + eta)))) ])) + (\ds -> + case + ds + [ (\eta -> + force ifThenElse + (force nullList eta) + (constr 0 []) + (constr 1 [])) + , (\paramValueHd + paramValueTl + actualValueData -> force (case - ds - [ (delay (s s xs)) - , (\x xs -> - delay - (force - (case - (meaning x ds) - [ (delay - (s s xs)) - , (delay - (constr 1 - [ ])) ]))) ])) - expectedPredValues) - (force - (case - predKey - [ (delay - (case - `$dOrd` - [ (\v v v v v v v v -> - v) ])) - , (delay + (validateParamValue + paramValueHd + (force headList + actualValueData)) + [ (delay + (validateParamValues + paramValueTl + (force tailList + actualValueData))) + , (delay + (constr 1 + [])) ])) ])))))) + ((\s -> s s) + (\s n d -> + force + (force ifThenElse + (equalsInteger 0 d) + (delay error) + (delay + (force + (force ifThenElse + (lessThanInteger d 0) + (delay + ((\x -> s s x) + (subtractInteger 0 n) + (subtractInteger 0 d))) + (delay + ((\gcd' -> + constr 0 + [ (quotientInteger n gcd') + , (quotientInteger d gcd') ]) + (euclid n d)))))))))) + ((\s -> s s) + (\s x y -> + force + (force ifThenElse + (equalsInteger 0 y) + (delay x) + (delay (s s y (modInteger x y))))))) + (\`$dOrd` ds ds -> + (\s -> s s) + (\s ds -> + force + (case + ds + [ (delay (constr 0 [])) + , (\x xs -> + delay + (case + x + [ (\predKey expectedPredValues -> + (\meaning -> + (\s -> s s) + (\s ds -> + force (case - `$dOrd` - [ (\v v v v v v v v -> - v) ])) - , (delay - (\x y -> - force - (case + ds + [ (delay (s s xs)) + , (\x xs -> + delay + (force + (case + (meaning + x + ds) + [ (delay + (s + s + xs)) + , (delay + (constr 1 + [ ])) ]))) ])) + expectedPredValues) + (force + (case + predKey + [ (delay + (case + `$dOrd` + [ (\v v v v v v v v -> + v) ])) + , (delay + (case + `$dOrd` + [ (\v v v v v v v v -> + v) ])) + , (delay + (\x y -> + force (case - `$dOrd` - [ (\v - v - v - v - v - v - v - v -> - v) ] - x - y) - [ (delay - (constr 1 [])) - , (delay - (constr 0 - [ ])) ]))) ]))) ])) ])) - ds)) + (case + `$dOrd` + [ (\v + v + v + v + v + v + v + v -> + v) ] + x + y) + [ (delay + (constr 1 + [])) + , (delay + (constr 0 + [ ])) ]))) ]))) ])) ])) + ds)) + (\x y -> + force ifThenElse (equalsInteger x y) (constr 0 []) (constr 1 []))) (\eta eta -> force - (case + (force ifThenElse (equalsInteger eta eta) - [ (delay - (force - (case - (lessThanEqualsInteger eta eta) - [(delay (constr 1 [])), (delay (constr 2 []))]))) - , (delay (constr 0 [])) ]))) + (delay (constr 0 [])) + (delay + (force ifThenElse + (lessThanEqualsInteger eta eta) + (constr 2 []) + (constr 1 [])))))) (\ds ds -> case ds @@ -1325,8 +1345,9 @@ program case ds [ (\n' d' -> - case + force ifThenElse (lessThanEqualsInteger (multiplyInteger n d') (multiplyInteger n' d)) - [(constr 1 []), (constr 0 [])]) ]) ])) \ No newline at end of file + (constr 0 []) + (constr 1 [])) ]) ])) \ No newline at end of file diff --git a/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/sorted.cbor.size.golden b/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/sorted.cbor.size.golden index 9aba31b86d4..c4846c4faff 100644 --- a/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/sorted.cbor.size.golden +++ b/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/sorted.cbor.size.golden @@ -1 +1 @@ -2090 \ No newline at end of file +2145 \ No newline at end of file diff --git a/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/sorted.large.budget.golden b/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/sorted.large.budget.golden index 50d215b9ae2..ded7156c145 100644 --- a/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/sorted.large.budget.golden +++ b/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/sorted.large.budget.golden @@ -1 +1 @@ -ExBudget {exBudgetCPU = ExCPU 474038709, exBudgetMemory = ExMemory 2383080} \ No newline at end of file +ExBudget {exBudgetCPU = ExCPU 542436171, exBudgetMemory = ExMemory 2602818} \ No newline at end of file diff --git a/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/sorted.pir.golden b/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/sorted.pir.golden index f27ac2bb978..3313b57cbab 100644 --- a/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/sorted.pir.golden +++ b/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/sorted.pir.golden @@ -139,12 +139,12 @@ program !`$fOrdInteger_$ccompare` : integer -> integer -> Ordering = \(eta : integer) (eta : integer) -> Bool_match - (case Bool (equalsInteger eta eta) [False, True]) + (ifThenElse {Bool} (equalsInteger eta eta) True False) {all dead. Ordering} (/\dead -> EQ) (/\dead -> Bool_match - (case Bool (lessThanEqualsInteger eta eta) [False, True]) + (ifThenElse {Bool} (lessThanEqualsInteger eta eta) True False) {all dead. Ordering} (/\dead -> LT) (/\dead -> GT) @@ -162,18 +162,19 @@ program ds {Bool} (\(n' : integer) (d' : integer) -> - case - Bool + ifThenElse + {Bool} (lessThanEqualsInteger (multiplyInteger n d') (multiplyInteger n' d)) - [False, True])) + True + False)) in letrec !euclid : integer -> integer -> integer = \(x : integer) (y : integer) -> Bool_match - (case Bool (equalsInteger 0 y) [False, True]) + (ifThenElse {Bool} (equalsInteger 0 y) True False) {all dead. integer} (/\dead -> x) (/\dead -> euclid y (modInteger x y)) @@ -183,12 +184,12 @@ program !unsafeRatio : integer -> integer -> Rational = \(n : integer) (d : integer) -> Bool_match - (case Bool (equalsInteger 0 d) [False, True]) + (ifThenElse {Bool} (equalsInteger 0 d) True False) {all dead. Rational} (/\dead -> error {Rational}) (/\dead -> Bool_match - (case Bool (lessThanInteger d 0) [False, True]) + (ifThenElse {Bool} (lessThanInteger d 0) True False) {all dead. Rational} (/\dead -> unsafeRatio (subtractInteger 0 n) (subtractInteger 0 d)) @@ -212,8 +213,6 @@ program let data Unit | Unit_match where Unit : Unit - !ifThenElse : all a. bool -> a -> a -> a - = /\a -> \(b : bool) (x : a) (y : a) -> case a b [y, x] in letrec !validateParamValue : ParamValue -> data -> Bool @@ -229,12 +228,16 @@ program (CConsOrd {integer} (\(x : integer) (y : integer) -> - case Bool (equalsInteger x y) [False, True]) + ifThenElse {Bool} (equalsInteger x y) True False) `$fOrdInteger_$ccompare` (\(x : integer) (y : integer) -> - case Bool (lessThanInteger x y) [False, True]) + ifThenElse {Bool} (lessThanInteger x y) True False) (\(x : integer) (y : integer) -> - case Bool (lessThanEqualsInteger x y) [False, True]) + ifThenElse + {Bool} + (lessThanEqualsInteger x y) + True + False) (\(x : integer) (y : integer) -> ifThenElse {Bool} @@ -245,14 +248,22 @@ program ifThenElse {Bool} (lessThanInteger x y) False True) (\(x : integer) (y : integer) -> Bool_match - (case Bool (lessThanEqualsInteger x y) [False, True]) + (ifThenElse + {Bool} + (lessThanEqualsInteger x y) + True + False) {all dead. integer} (/\dead -> y) (/\dead -> x) {all dead. dead}) (\(x : integer) (y : integer) -> Bool_match - (case Bool (lessThanEqualsInteger x y) [False, True]) + (ifThenElse + {Bool} + (lessThanEqualsInteger x y) + True + False) {all dead. integer} (/\dead -> x) (/\dead -> y) @@ -277,16 +288,18 @@ program {Bool} (\(n' : integer) (d' : integer) -> Bool_match - (case - Bool + (ifThenElse + {Bool} (equalsInteger n n') - [False, True]) + True + False) {all dead. Bool} (/\dead -> - case - Bool + ifThenElse + {Bool} (equalsInteger d d') - [False, True]) + True + False) (/\dead -> False) {all dead. dead}))) (\(ds : Rational) (ds : Rational) -> @@ -310,12 +323,13 @@ program ds {Bool} (\(n' : integer) (d' : integer) -> - case - Bool + ifThenElse + {Bool} (lessThanInteger (multiplyInteger n d') (multiplyInteger n' d)) - [False, True]))) + True + False))) `$fOrdRational0_$c<=` (\(ds : Rational) (ds : Rational) -> Rational_match @@ -326,13 +340,11 @@ program ds {Bool} (\(n' : integer) (d' : integer) -> - let - !x : integer = multiplyInteger n d' - !y : integer = multiplyInteger n' d - in ifThenElse {Bool} - (lessThanEqualsInteger x y) + (lessThanEqualsInteger + (multiplyInteger n d') + (multiplyInteger n' d)) False True))) (\(ds : Rational) (ds : Rational) -> @@ -344,13 +356,11 @@ program ds {Bool} (\(n' : integer) (d' : integer) -> - let - !x : integer = multiplyInteger n d' - !y : integer = multiplyInteger n' d - in ifThenElse {Bool} - (lessThanInteger x y) + (lessThanInteger + (multiplyInteger n d') + (multiplyInteger n' d)) False True))) (\(x : Rational) (y : Rational) -> @@ -389,7 +399,7 @@ program ds {list data -> Bool} (\(eta : list data) -> - case Bool (nullList {data} eta) [False, True]) + ifThenElse {Bool} (nullList {data} eta) True False) (\(paramValueHd : ParamValue) (paramValueTl : List ParamValue) (actualValueData : list data) -> @@ -5299,12 +5309,13 @@ program (unConstrData ds))))) in Bool_match - (case - Bool + (ifThenElse + {Bool} (equalsInteger 5 (fstPair {integer} {list data} si)) - [False, True]) + True + False) {all dead. data} (/\dead -> headList @@ -5317,7 +5328,7 @@ program !x : integer = fstPair {integer} {list data} ds in Bool_match - (case Bool (equalsInteger 0 x) [False, True]) + (ifThenElse {Bool} (equalsInteger 0 x) True False) {all dead. Maybe (List (Tuple2 data data))} (/\dead -> Just @@ -5331,7 +5342,7 @@ program caseData_go (unMapData d))) (/\dead -> Bool_match - (case Bool (equalsInteger 2 x) [False, True]) + (ifThenElse {Bool} (equalsInteger 2 x) True False) {all dead. Maybe (List (Tuple2 data data))} (/\dead -> Nothing {List (Tuple2 data data)}) (/\dead -> error {Maybe (List (Tuple2 data data))}) diff --git a/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/sorted.small.budget.golden b/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/sorted.small.budget.golden index 57dab4b5b50..71b7ddd05f9 100644 --- a/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/sorted.small.budget.golden +++ b/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/sorted.small.budget.golden @@ -1 +1 @@ -ExBudget {exBudgetCPU = ExCPU 66972110, exBudgetMemory = ExMemory 309002} \ No newline at end of file +ExBudget {exBudgetCPU = ExCPU 82997157, exBudgetMemory = ExMemory 360305} \ No newline at end of file diff --git a/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/sorted.uplc.golden b/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/sorted.uplc.golden index e9a1f536193..418d25e77f4 100644 --- a/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/sorted.uplc.golden +++ b/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/sorted.uplc.golden @@ -40,696 +40,704 @@ program (\cse -> (\cse -> (\cse -> - (\fun - ds -> - force - (case - ((\ds -> - (\x -> - force - (case - (equalsInteger - 0 - x) - [ (delay - (force - (case - (equalsInteger - 2 - x) - [ (delay - error) - , (delay - (constr 1 - [ ])) ]))) - , (delay - (constr 0 - [ ((\d -> - force - caseData_go - (unMapData - d)) - (force - headList - (force - tailList - (force - (force - sndPair) - ds)))) ])) ])) - (force + (\cse -> + (\fun + ds -> + force + (case + ((\ds -> + (\x -> + force + (force + ifThenElse + (equalsInteger + 0 + x) + (delay + (constr 0 + [ ((\d -> + force + caseData_go + (unMapData + d)) + (force + headList + (force + tailList + (force + (force + sndPair) + ds)))) ])) + (delay + (force + (force + ifThenElse + (equalsInteger + 2 + x) + (delay + (constr 1 + [ ])) + (delay + error)))))) (force - fstPair) - ds)) - (unConstrData - (force - headList + (force + fstPair) + ds)) + (unConstrData (force - tailList + headList (force tailList (force + tailList (force - sndPair) - (unConstrData - ((\si -> - force - (case - (equalsInteger - 5 - (force + (force + sndPair) + (unConstrData + ((\si -> + force + (force + ifThenElse + (equalsInteger + 5 (force - fstPair) - si)) - [ (delay - error) - , (delay - (force - headList - (force - tailList - (force - (force - sndPair) - si)))) ])) - (unConstrData - (force - headList + (force + fstPair) + si)) + (delay + (force + headList + (force + tailList + (force + (force + sndPair) + si)))) + (delay + error))) + (unConstrData (force - tailList + headList (force tailList (force + tailList (force - sndPair) - (unConstrData - ds)))))))))))))) - [ (\cparams -> - delay - (force - (case - (fun - cparams) - [ (delay - ()) - , (delay - error) ]))) - , (delay - ()) ])) - (runRules - (constr 1 - [ (constr 0 - [ 0 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 30 - , cse ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 1000 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 1 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 100000 - , cse ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 10000000 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 2 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 24576 - , (constr 0 - [ ]) ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 122880 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 3 - , (constr 1 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 32768 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 4 - , (constr 1 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 5000 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 5 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 1000000 - , cse ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 5000000 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 6 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 250000000 - , cse ]) ]) - , cse ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 7 - , (constr 1 - [ (constr 1 - [ cse - , (constr 0 - [ ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 8 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 250 - , cse ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 2000 - , (constr 0 - [ ]) ]) ]) - , cse ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 9 - , (constr 3 - [ (constr 1 - [ cse - , cse ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 10 - , (constr 3 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ (cse - 1000) - , cse ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ (cse - 200) - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 11 - , (constr 3 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ (cse - 10) - , cse ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 16 - , (constr 1 - [ (constr 1 - [ cse - , cse ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 17 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 3000 - , cse ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 6500 - , (constr 0 - [ ]) ]) ]) - , cse ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 18 - , (constr 0 - [ ]) ]) - , (constr 1 - [ (constr 0 - [ 19 - , (constr 2 - [ (constr 1 - [ (constr 3 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ (cse - 25) - , (constr 0 - [ ]) ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ (cse - 5) - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) - , (constr 1 - [ (constr 3 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ (cse - 20000) - , (constr 0 - [ ]) ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ (cse - 5000) - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 20 - , (constr 2 - [ (constr 1 - [ (constr 1 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 40000000 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) - , (constr 1 - [ (constr 1 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 15000000000 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 21 - , (constr 2 - [ (constr 1 - [ (constr 1 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 120000000 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) - , (constr 1 - [ (constr 1 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 40000000000 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 22 - , (constr 1 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 12288 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 23 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 100 - , cse ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 200 - , (constr 0 - [ ]) ]) ]) - , cse ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 24 - , (constr 1 - [ (constr 1 - [ cse - , (constr 0 - [ ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 25 - , (constr 2 - [ (constr 1 - [ cse - , (constr 1 - [ cse - , (constr 1 - [ cse - , (constr 1 - [ cse - , cse ]) ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 26 - , (constr 2 - [ (constr 1 - [ cse - , (constr 1 - [ cse - , (constr 1 - [ cse - , (constr 1 - [ (constr 3 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ cse - , (constr 1 - [ (unsafeRatio - 13 - 20) - , (constr 0 - [ ]) ]) ]) ]) - , cse ]) ]) - , (constr 1 - [ cse - , (constr 1 - [ cse - , (constr 1 - [ cse - , (constr 1 - [ cse - , (constr 1 - [ (constr 3 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ cse - , cse ]) ]) - , cse ]) ]) - , cse ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 27 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 0 - , (constr 1 - [ 3 - , (constr 0 - [ ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 10 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 28 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 0 - , (constr 1 - [ 18 - , (constr 0 - [ ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 293 - , (constr 0 - [ ]) ]) ]) - , cse ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 29 - , (constr 1 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 15 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 30 - , (constr 1 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 10000000000000 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 31 - , (constr 1 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 100000000000 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 32 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 13 - , cse ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 37 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 33 - , (constr 3 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , cse ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ (unsafeRatio - 1000 - 1) - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]))) + (force + sndPair) + (unConstrData + ds)))))))))))))) + [ (\cparams -> + delay + (force + (case + (fun + cparams) + [ (delay + ()) + , (delay + error) ]))) + , (delay + ()) ])) + (runRules + (constr 1 + [ (constr 0 + [ 0 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 30 + , cse ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 1000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 1 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 100000 + , cse ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 10000000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 2 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 24576 + , (constr 0 + [ ]) ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 122880 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 3 + , (constr 1 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 32768 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 4 + , (constr 1 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 5000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 5 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 1000000 + , cse ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 5000000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 6 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 250000000 + , cse ]) ]) + , cse ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 7 + , (constr 1 + [ (constr 1 + [ cse + , (constr 0 + [ ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 8 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 250 + , cse ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 2000 + , (constr 0 + [ ]) ]) ]) + , cse ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 9 + , (constr 3 + [ (constr 1 + [ cse + , cse ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 10 + , (constr 3 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ (cse + 1000) + , cse ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ (cse + 200) + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 11 + , (constr 3 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ (cse + 10) + , cse ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 16 + , (constr 1 + [ (constr 1 + [ cse + , cse ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 17 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 3000 + , cse ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 6500 + , (constr 0 + [ ]) ]) ]) + , cse ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 18 + , (constr 0 + [ ]) ]) + , (constr 1 + [ (constr 0 + [ 19 + , (constr 2 + [ (constr 1 + [ (constr 3 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ (cse + 25) + , (constr 0 + [ ]) ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ (cse + 5) + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) + , (constr 1 + [ (constr 3 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ (cse + 20000) + , (constr 0 + [ ]) ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ (cse + 5000) + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 20 + , (constr 2 + [ (constr 1 + [ (constr 1 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 40000000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) + , (constr 1 + [ (constr 1 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 15000000000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 21 + , (constr 2 + [ (constr 1 + [ (constr 1 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 120000000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) + , (constr 1 + [ (constr 1 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 40000000000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 22 + , (constr 1 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 12288 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 23 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 100 + , cse ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 200 + , (constr 0 + [ ]) ]) ]) + , cse ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 24 + , (constr 1 + [ (constr 1 + [ cse + , (constr 0 + [ ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 25 + , (constr 2 + [ (constr 1 + [ cse + , (constr 1 + [ cse + , (constr 1 + [ cse + , (constr 1 + [ cse + , cse ]) ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 26 + , (constr 2 + [ (constr 1 + [ cse + , (constr 1 + [ cse + , (constr 1 + [ cse + , (constr 1 + [ (constr 3 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ cse + , (constr 1 + [ (unsafeRatio + 13 + 20) + , (constr 0 + [ ]) ]) ]) ]) + , cse ]) ]) + , (constr 1 + [ cse + , (constr 1 + [ cse + , (constr 1 + [ cse + , (constr 1 + [ cse + , (constr 1 + [ (constr 3 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ cse + , cse ]) ]) + , cse ]) ]) + , cse ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 27 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 0 + , (constr 1 + [ 3 + , (constr 0 + [ ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 10 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 28 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 0 + , (constr 1 + [ 18 + , (constr 0 + [ ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 293 + , (constr 0 + [ ]) ]) ]) + , cse ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 29 + , (constr 1 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 15 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 30 + , (constr 1 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 10000000000000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 31 + , (constr 1 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 100000000000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 32 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 13 + , cse ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 37 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 33 + , (constr 3 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , cse ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ (unsafeRatio + 1000 + 1) + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]))) + (constr 3 + [ (constr 1 + [ cse + , cse ]) ])) (constr 3 [ (constr 1 [ cse @@ -739,90 +747,89 @@ program [ ]) , (constr 1 [ cse - , cse ]) ]) + , (constr 1 + [ cse + , (constr 0 + [ ]) ]) ]) ]) , (constr 0 [ ]) ]) ]) ])) (constr 3 [ (constr 1 [ cse - , cse ]) ])) - (constr 3 - [ (constr 1 - [ cse - , (constr 1 + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ cse + , cse ]) ]) + , (constr 0 + [ ]) ]) ]) ])) + (constr 1 + [ (constr 3 + [ (constr 1 [ (constr 0 - [ (constr 0 + [ (constr 1 [ ]) , (constr 1 [ cse - , (constr 1 - [ cse - , (constr 0 - [ ]) ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ])) + , (constr 0 + [ ]) ]) ]) + , cse ]) ]) + , (constr 0 + [ ]) ])) (constr 1 - [ (constr 3 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ cse - , (constr 0 - [ ]) ]) ]) - , cse ]) ]) + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ cse + , (constr 1 + [ cse + , (constr 0 + [ ]) ]) ]) ]) , (constr 0 [ ]) ])) - (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) + (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ cse , (constr 1 [ cse - , (constr 1 - [ cse - , (constr 0 - [ ]) ]) ]) ]) - , (constr 0 - [ ]) ])) + , (constr 0 + [ ]) ]) ]) ])) (constr 0 [ (constr 1 [ ]) , (constr 1 [ cse - , (constr 1 - [ cse - , (constr 0 - [ ]) ]) ]) ])) - (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ (cse - 10) - , cse ]) ])) - (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , cse ]) - , (constr 0 - [ ]) ])) - (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 0 - , (constr 1 - [ 1000000 - , (constr 0 - [ ]) ]) ]) ])) + , cse ]) ])) + (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , cse ]) + , (constr 0 + [ ]) ])) + (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 0 + , (constr 1 + [ 1000000 + , (constr 0 + [ ]) ]) ]) ])) + (constr 1 + [ (constr 0 + [ (constr 2 + [ ]) + , cse ]) + , (constr 0 + [ ]) ])) (constr 1 - [ (constr 0 - [ (constr 2 - [ ]) - , cse ]) + [ cse , (constr 0 [ ]) ])) (constr 1 @@ -843,38 +850,35 @@ program [ cse , (constr 0 [ ]) ])) - (constr 1 - [ cse - , (constr 0 - [ ]) ])) + (cse + 1)) (cse - 1)) + 10)) (cse - 10)) - (constr 0 - [ (constr 1 - [ ]) - , cse ])) - (cse - 100)) + 100)) + (cse + 5)) + (constr 0 + [ (constr 1 + [ ]) + , cse ])) (cse 1)) - (constr 0 - [ (constr 1 - []) - , (constr 1 - [ 1 - , (constr 0 - [ ]) ]) ])) - (cse 4)) + (cse 4)) + (constr 0 + [ (constr 1 []) + , (constr 1 + [ 1 + , (constr 0 + [ ]) ]) ])) (cse 2)) - (cse 5)) - (unsafeRatio 3)) - (unsafeRatio 0)) - (unsafeRatio 9)) - (unsafeRatio 51)) - (constr 1 [0, (constr 0 [])])) - (unsafeRatio 1)) - (unsafeRatio 4)) + (cse 10)) + (unsafeRatio 9)) + (unsafeRatio 4)) + (unsafeRatio 3)) + (constr 1 [0, (constr 0 [])])) + (unsafeRatio 51)) + (unsafeRatio 0)) + (unsafeRatio 1)) ((\s -> s s) (\s arg -> delay @@ -990,58 +994,55 @@ program (validatePreds (constr 0 [ (\x y -> - case + force ifThenElse (equalsInteger x y) - [ (constr 1 []) - , (constr 0 []) ]) + (constr 0 []) + (constr 1 [])) , `$fOrdInteger_$ccompare` , (\x y -> - case + force ifThenElse (lessThanInteger x y) - [ (constr 1 []) - , (constr 0 []) ]) + (constr 0 []) + (constr 1 [])) , (\x y -> - case + force ifThenElse (lessThanEqualsInteger x y) - [ (constr 1 []) - , (constr 0 []) ]) + (constr 0 []) + (constr 1 [])) , (\x y -> - case + force ifThenElse (lessThanEqualsInteger x y) - [ (constr 0 []) - , (constr 1 []) ]) + (constr 1 []) + (constr 0 [])) , (\x y -> - case + force ifThenElse (lessThanInteger x y) - [ (constr 0 []) - , (constr 1 []) ]) + (constr 1 []) + (constr 0 [])) , (\x y -> - force - (case - (lessThanEqualsInteger - x - y) - [ (delay x) - , (delay y) ])) + force ifThenElse + (lessThanEqualsInteger + x + y) + y + x) , (\x y -> - force - (case - (lessThanEqualsInteger - x - y) - [ (delay y) - , (delay - x) ])) ]) + force ifThenElse + (lessThanEqualsInteger + x + y) + x + y) ]) preds (unIData eta))) , (\paramValues -> @@ -1062,22 +1063,24 @@ program [ (\n' d' -> force - (case + (force + ifThenElse (equalsInteger n n') - [ (delay - (constr 1 - [ ])) - , (delay - (case - (equalsInteger - d - d') - [ (constr 1 - [ ]) - , (constr 0 - [ ]) ])) ])) ]) ]) + (delay + (force + ifThenElse + (equalsInteger + d + d') + (constr 0 + [ ]) + (constr 1 + [ ]))) + (delay + (constr 1 + [ ])))) ]) ]) , (\ds ds -> case ds @@ -1101,7 +1104,8 @@ program ds [ (\n' d' -> - case + force + ifThenElse (lessThanInteger (multiplyInteger n @@ -1109,10 +1113,10 @@ program (multiplyInteger n' d)) - [ (constr 1 - [ ]) - , (constr 0 - [ ]) ]) ]) ]) + (constr 0 + [ ]) + (constr 1 + [ ])) ]) ]) , `$fOrdRational0_$c<=` , (\ds ds -> case @@ -1122,7 +1126,8 @@ program ds [ (\n' d' -> - case + force + ifThenElse (lessThanEqualsInteger (multiplyInteger n @@ -1130,10 +1135,10 @@ program (multiplyInteger n' d)) - [ (constr 0 - [ ]) - , (constr 1 - [ ]) ]) ]) ]) + (constr 1 + [ ]) + (constr 0 + [ ])) ]) ]) , (\ds ds -> case ds @@ -1142,7 +1147,8 @@ program ds [ (\n' d' -> - case + force + ifThenElse (lessThanInteger (multiplyInteger n @@ -1150,10 +1156,10 @@ program (multiplyInteger n' d)) - [ (constr 0 - [ ]) - , (constr 1 - [ ]) ]) ]) ]) + (constr 1 + [ ]) + (constr 0 + [ ])) ]) ]) , (\x y -> force (case @@ -1174,21 +1180,21 @@ program preds ((\bl -> (\bl' -> - case + force ifThenElse (force nullList (force tailList bl')) - [ (\ds -> error) - , (\ds -> - unsafeRatio - (unIData - (force - headList - bl)) - (unIData - (force - headList - bl'))) ] + (\ds -> + unsafeRatio + (unIData + (force + headList + bl)) + (unIData + (force + headList + bl'))) + (\ds -> error) (constr 0 [])) (force tailList bl)) (unListData eta)))) ])) @@ -1196,9 +1202,10 @@ program case ds [ (\eta -> - case + force ifThenElse (force nullList eta) - [(constr 1 []), (constr 0 [])]) + (constr 0 []) + (constr 1 [])) , (\paramValueHd paramValueTl actualValueData -> @@ -1218,29 +1225,30 @@ program ((\s -> s s) (\s n d -> force - (case + (force ifThenElse (equalsInteger 0 d) - [ (delay - (force - (case - (lessThanInteger d 0) - [ (delay - ((\gcd' -> - constr 0 - [ (quotientInteger n gcd') - , (quotientInteger d gcd') ]) - (euclid n d))) - , (delay - ((\x -> s s x) - (subtractInteger 0 n) - (subtractInteger 0 d))) ]))) - , (delay error) ])))) + (delay error) + (delay + (force + (force ifThenElse + (lessThanInteger d 0) + (delay + ((\x -> s s x) + (subtractInteger 0 n) + (subtractInteger 0 d))) + (delay + ((\gcd' -> + constr 0 + [ (quotientInteger n gcd') + , (quotientInteger d gcd') ]) + (euclid n d)))))))))) ((\s -> s s) (\s x y -> force - (case + (force ifThenElse (equalsInteger 0 y) - [(delay (s s y (modInteger x y))), (delay x)])))) + (delay x) + (delay (s s y (modInteger x y))))))) (\`$dOrd` ds ds -> (\s -> s s) (\s ds -> @@ -1309,14 +1317,14 @@ program ds)) (\eta eta -> force - (case + (force ifThenElse (equalsInteger eta eta) - [ (delay - (force - (case - (lessThanEqualsInteger eta eta) - [(delay (constr 1 [])), (delay (constr 2 []))]))) - , (delay (constr 0 [])) ]))) + (delay (constr 0 [])) + (delay + (force ifThenElse + (lessThanEqualsInteger eta eta) + (constr 2 []) + (constr 1 [])))))) (\ds ds -> case ds @@ -1324,8 +1332,9 @@ program case ds [ (\n' d' -> - case + force ifThenElse (lessThanEqualsInteger (multiplyInteger n d') (multiplyInteger n' d)) - [(constr 1 []), (constr 0 [])]) ]) ])) \ No newline at end of file + (constr 0 []) + (constr 1 [])) ]) ])) \ No newline at end of file diff --git a/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/unsorted.cbor.size.golden b/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/unsorted.cbor.size.golden index 1c412146757..df124cff2e7 100644 --- a/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/unsorted.cbor.size.golden +++ b/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/unsorted.cbor.size.golden @@ -1 +1 @@ -2082 \ No newline at end of file +2137 \ No newline at end of file diff --git a/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/unsorted.large.budget.golden b/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/unsorted.large.budget.golden index 7a4d0e64f15..922461e7d55 100644 --- a/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/unsorted.large.budget.golden +++ b/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/unsorted.large.budget.golden @@ -1 +1 @@ -ExBudget {exBudgetCPU = ExCPU 661811564, exBudgetMemory = ExMemory 3414815} \ No newline at end of file +ExBudget {exBudgetCPU = ExCPU 857610341, exBudgetMemory = ExMemory 4224488} \ No newline at end of file diff --git a/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/unsorted.pir.golden b/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/unsorted.pir.golden index 4c3d0fa342b..c91e54997c3 100644 --- a/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/unsorted.pir.golden +++ b/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/unsorted.pir.golden @@ -136,15 +136,18 @@ program {all dead. dead} in go ds + !equalsInteger : integer -> integer -> Bool + = \(x : integer) (y : integer) -> + ifThenElse {Bool} (equalsInteger x y) True False !`$fOrdInteger_$ccompare` : integer -> integer -> Ordering = \(eta : integer) (eta : integer) -> Bool_match - (case Bool (equalsInteger eta eta) [False, True]) + (ifThenElse {Bool} (equalsInteger eta eta) True False) {all dead. Ordering} (/\dead -> EQ) (/\dead -> Bool_match - (case Bool (lessThanEqualsInteger eta eta) [False, True]) + (ifThenElse {Bool} (lessThanEqualsInteger eta eta) True False) {all dead. Ordering} (/\dead -> LT) (/\dead -> GT) @@ -162,18 +165,19 @@ program ds {Bool} (\(n' : integer) (d' : integer) -> - case - Bool + ifThenElse + {Bool} (lessThanEqualsInteger (multiplyInteger n d') (multiplyInteger n' d)) - [False, True])) + True + False)) in letrec !euclid : integer -> integer -> integer = \(x : integer) (y : integer) -> Bool_match - (case Bool (equalsInteger 0 y) [False, True]) + (ifThenElse {Bool} (equalsInteger 0 y) True False) {all dead. integer} (/\dead -> x) (/\dead -> euclid y (modInteger x y)) @@ -183,12 +187,12 @@ program !unsafeRatio : integer -> integer -> Rational = \(n : integer) (d : integer) -> Bool_match - (case Bool (equalsInteger 0 d) [False, True]) + (ifThenElse {Bool} (equalsInteger 0 d) True False) {all dead. Rational} (/\dead -> error {Rational}) (/\dead -> Bool_match - (case Bool (lessThanInteger d 0) [False, True]) + (ifThenElse {Bool} (lessThanInteger d 0) True False) {all dead. Rational} (/\dead -> unsafeRatio (subtractInteger 0 n) (subtractInteger 0 d)) @@ -212,8 +216,6 @@ program let data Unit | Unit_match where Unit : Unit - !ifThenElse : all a. bool -> a -> a -> a - = /\a -> \(b : bool) (x : a) (y : a) -> case a b [y, x] in letrec !validateParamValue : ParamValue -> data -> Bool @@ -228,13 +230,16 @@ program {integer} (CConsOrd {integer} - (\(x : integer) (y : integer) -> - case Bool (equalsInteger x y) [False, True]) + equalsInteger `$fOrdInteger_$ccompare` (\(x : integer) (y : integer) -> - case Bool (lessThanInteger x y) [False, True]) + ifThenElse {Bool} (lessThanInteger x y) True False) (\(x : integer) (y : integer) -> - case Bool (lessThanEqualsInteger x y) [False, True]) + ifThenElse + {Bool} + (lessThanEqualsInteger x y) + True + False) (\(x : integer) (y : integer) -> ifThenElse {Bool} @@ -245,14 +250,22 @@ program ifThenElse {Bool} (lessThanInteger x y) False True) (\(x : integer) (y : integer) -> Bool_match - (case Bool (lessThanEqualsInteger x y) [False, True]) + (ifThenElse + {Bool} + (lessThanEqualsInteger x y) + True + False) {all dead. integer} (/\dead -> y) (/\dead -> x) {all dead. dead}) (\(x : integer) (y : integer) -> Bool_match - (case Bool (lessThanEqualsInteger x y) [False, True]) + (ifThenElse + {Bool} + (lessThanEqualsInteger x y) + True + False) {all dead. integer} (/\dead -> x) (/\dead -> y) @@ -277,16 +290,18 @@ program {Bool} (\(n' : integer) (d' : integer) -> Bool_match - (case - Bool + (ifThenElse + {Bool} (equalsInteger n n') - [False, True]) + True + False) {all dead. Bool} (/\dead -> - case - Bool + ifThenElse + {Bool} (equalsInteger d d') - [False, True]) + True + False) (/\dead -> False) {all dead. dead}))) (\(ds : Rational) (ds : Rational) -> @@ -310,12 +325,13 @@ program ds {Bool} (\(n' : integer) (d' : integer) -> - case - Bool + ifThenElse + {Bool} (lessThanInteger (multiplyInteger n d') (multiplyInteger n' d)) - [False, True]))) + True + False))) `$fOrdRational0_$c<=` (\(ds : Rational) (ds : Rational) -> Rational_match @@ -326,13 +342,11 @@ program ds {Bool} (\(n' : integer) (d' : integer) -> - let - !x : integer = multiplyInteger n d' - !y : integer = multiplyInteger n' d - in ifThenElse {Bool} - (lessThanEqualsInteger x y) + (lessThanEqualsInteger + (multiplyInteger n d') + (multiplyInteger n' d)) False True))) (\(ds : Rational) (ds : Rational) -> @@ -344,13 +358,11 @@ program ds {Bool} (\(n' : integer) (d' : integer) -> - let - !x : integer = multiplyInteger n d' - !y : integer = multiplyInteger n' d - in ifThenElse {Bool} - (lessThanInteger x y) + (lessThanInteger + (multiplyInteger n d') + (multiplyInteger n' d)) False True))) (\(x : Rational) (y : Rational) -> @@ -389,7 +401,7 @@ program ds {list data -> Bool} (\(eta : list data) -> - case Bool (nullList {data} eta) [False, True]) + ifThenElse {Bool} (nullList {data} eta) True False) (\(paramValueHd : ParamValue) (paramValueTl : List ParamValue) (actualValueData : list data) -> @@ -5189,10 +5201,7 @@ program {ParamValue} (\(k' : integer) (i : ParamValue) -> Bool_match - (case - Bool - (equalsInteger k k') - [False, True]) + (equalsInteger k k') {all dead. ParamValue} (/\dead -> i) (/\dead -> go xs') @@ -5234,12 +5243,13 @@ program (unConstrData ds))))) in Bool_match - (case - Bool + (ifThenElse + {Bool} (equalsInteger 5 (fstPair {integer} {list data} si)) - [False, True]) + True + False) {all dead. data} (/\dead -> headList @@ -5252,7 +5262,7 @@ program !x : integer = fstPair {integer} {list data} ds in Bool_match - (case Bool (equalsInteger 0 x) [False, True]) + (ifThenElse {Bool} (equalsInteger 0 x) True False) {all dead. Maybe (List (Tuple2 data data))} (/\dead -> Just @@ -5266,7 +5276,7 @@ program caseData_go (unMapData d))) (/\dead -> Bool_match - (case Bool (equalsInteger 2 x) [False, True]) + (ifThenElse {Bool} (equalsInteger 2 x) True False) {all dead. Maybe (List (Tuple2 data data))} (/\dead -> Nothing {List (Tuple2 data data)}) (/\dead -> error {Maybe (List (Tuple2 data data))}) diff --git a/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/unsorted.small.budget.golden b/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/unsorted.small.budget.golden index 9202f180128..a538941653b 100644 --- a/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/unsorted.small.budget.golden +++ b/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/unsorted.small.budget.golden @@ -1 +1 @@ -ExBudget {exBudgetCPU = ExCPU 64714367, exBudgetMemory = ExMemory 296003} \ No newline at end of file +ExBudget {exBudgetCPU = ExCPU 80879267, exBudgetMemory = ExMemory 349603} \ No newline at end of file diff --git a/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/unsorted.uplc.golden b/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/unsorted.uplc.golden index 1b7a69dbef8..35b5d34cc5f 100644 --- a/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/unsorted.uplc.golden +++ b/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/unsorted.uplc.golden @@ -2,14 +2,14 @@ program 1.1.0 ((\`$fOrdRational0_$c<=` -> (\`$fOrdInteger_$ccompare` -> - (\validatePreds -> - (\euclid -> - (\unsafeRatio -> - (\cse -> - (\validateParamValue -> - (\validateParamValues -> - (\caseData_go -> - (\cse -> + (\equalsInteger -> + (\validatePreds -> + (\euclid -> + (\unsafeRatio -> + (\cse -> + (\validateParamValue -> + (\validateParamValues -> + (\caseData_go -> (\cse -> (\cse -> (\cse -> @@ -39,817 +39,828 @@ program (\cse -> (\cse -> (\cse -> - (\cfg -> - (\fun - ds -> - force - (case - ((\ds -> - (\x -> - force - (case - (equalsInteger - 0 - x) - [ (delay - (force - (case - (equalsInteger - 2 - x) - [ (delay - error) - , (delay - (constr 1 - [ ])) ]))) - , (delay - (constr 0 - [ ((\d -> - force - caseData_go - (unMapData - d)) - (force - headList - (force - tailList - (force - (force - sndPair) - ds)))) ])) ])) - (force + (\cse -> + (\cfg -> + (\fun + ds -> + force + (case + ((\ds -> + (\x -> + force + (force + ifThenElse + (equalsInteger + 0 + x) + (delay + (constr 0 + [ ((\d -> + force + caseData_go + (unMapData + d)) + (force + headList + (force + tailList + (force + (force + sndPair) + ds)))) ])) + (delay + (force + (force + ifThenElse + (equalsInteger + 2 + x) + (delay + (constr 1 + [ ])) + (delay + error)))))) (force - fstPair) - ds)) - (unConstrData - (force - headList + (force + fstPair) + ds)) + (unConstrData (force - tailList + headList (force tailList (force + tailList (force - sndPair) - (unConstrData - ((\si -> - force - (case - (equalsInteger - 5 - (force + (force + sndPair) + (unConstrData + ((\si -> + force + (force + ifThenElse + (equalsInteger + 5 (force - fstPair) - si)) - [ (delay - error) - , (delay - (force - headList - (force - tailList - (force - (force - sndPair) - si)))) ])) - (unConstrData - (force - headList + (force + fstPair) + si)) + (delay + (force + headList + (force + tailList + (force + (force + sndPair) + si)))) + (delay + error))) + (unConstrData (force - tailList + headList (force tailList (force + tailList (force - sndPair) - (unConstrData - ds)))))))))))))) - [ (\cparams -> - delay - (force - (case - (fun - cparams) - [ (delay - ()) - , (delay - error) ]))) - , (delay - ()) ])) - ((\go - eta -> - go - eta) - ((\s -> - s - s) - (\s - ds -> - force - (case - ds - [ (delay - (constr 0 - [ ])) - , (\x - xs -> - delay - (force - (case + (force + sndPair) + (unConstrData + ds)))))))))))))) + [ (\cparams -> + delay + (force + (case + (fun + cparams) + [ (delay + ()) + , (delay + error) ]))) + , (delay + ()) ])) + ((\go + eta -> + go + eta) + ((\s -> + s + s) + (\s + ds -> + force + (case + ds + [ (delay + (constr 0 + [ ])) + , (\x + xs -> + delay + (force (case - x - [ (\ds - actualValueData -> - validateParamValue - ((\k -> - (\s -> - s - s) - (\s - ds -> - force - (case - ds - [ (delay - error) - , (\ds - xs' -> - delay - (case - ds - [ (\k' - i -> - force - (case - (equalsInteger - k - k') - [ (delay - (s - s - xs')) - , (delay - i) ])) ])) ]))) - (unIData - ds) - cfg) - actualValueData) ]) - [ (delay - (s - s - xs)) - , (delay - (constr 1 - [ ])) ]))) ]))))) - (constr 1 - [ (constr 0 - [ 0 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 30 - , cse ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 1000 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 1 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 100000 - , cse ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 10000000 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) + (case + x + [ (\ds + actualValueData -> + validateParamValue + ((\k -> + (\s -> + s + s) + (\s + ds -> + force + (case + ds + [ (delay + error) + , (\ds + xs' -> + delay + (case + ds + [ (\k' + i -> + force + (case + (equalsInteger + k + k') + [ (delay + i) + , (delay + (s + s + xs')) ])) ])) ]))) + (unIData + ds) + cfg) + actualValueData) ]) + [ (delay + (s + s + xs)) + , (delay + (constr 1 + [ ])) ]))) ]))))) + (constr 1 + [ (constr 0 + [ 0 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 30 + , cse ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 1000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 1 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 100000 + , cse ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 10000000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 2 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 24576 + , (constr 0 + [ ]) ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 122880 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 3 + , (constr 1 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 32768 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 4 + , (constr 1 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 5000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 5 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 1000000 + , cse ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 5000000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 6 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 250000000 + , cse ]) ]) + , cse ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 7 + , (constr 1 + [ (constr 1 + [ cse + , (constr 0 + [ ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 8 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 250 + , cse ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 2000 + , (constr 0 + [ ]) ]) ]) + , cse ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 9 + , (constr 3 + [ (constr 1 + [ cse + , cse ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 10 + , (constr 3 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ (cse + 1000) + , cse ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ (cse + 200) + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 11 + , (constr 3 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ (cse + 10) + , cse ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 16 + , (constr 1 + [ (constr 1 + [ cse + , cse ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 17 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 3000 + , cse ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 6500 + , (constr 0 + [ ]) ]) ]) + , cse ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 18 + , (constr 0 + [ ]) ]) + , (constr 1 + [ (constr 0 + [ 19 + , (constr 2 + [ (constr 1 + [ (constr 3 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ (cse + 25) + , (constr 0 + [ ]) ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ (cse + 5) + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) + , (constr 1 + [ (constr 3 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ (cse + 20000) + , (constr 0 + [ ]) ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ (cse + 5000) + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 20 + , (constr 2 + [ (constr 1 + [ (constr 1 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 40000000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) + , (constr 1 + [ (constr 1 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 15000000000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 21 + , (constr 2 + [ (constr 1 + [ (constr 1 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 120000000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) + , (constr 1 + [ (constr 1 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 40000000000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 22 + , (constr 1 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 12288 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 23 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 100 + , cse ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 200 + , (constr 0 + [ ]) ]) ]) + , cse ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 24 + , (constr 1 + [ (constr 1 + [ cse + , (constr 0 + [ ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 25 + , (constr 2 + [ (constr 1 + [ cse + , (constr 1 + [ cse + , (constr 1 + [ cse + , (constr 1 + [ cse + , cse ]) ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 26 + , (constr 2 + [ (constr 1 + [ cse + , (constr 1 + [ cse + , (constr 1 + [ cse + , (constr 1 + [ (constr 3 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ cse + , (constr 1 + [ (unsafeRatio + 13 + 20) + , (constr 0 + [ ]) ]) ]) ]) + , cse ]) ]) + , (constr 1 + [ cse + , (constr 1 + [ cse + , (constr 1 + [ cse + , (constr 1 + [ cse + , (constr 1 + [ (constr 3 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ cse + , cse ]) ]) + , cse ]) ]) + , cse ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 27 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 0 + , (constr 1 + [ 3 + , (constr 0 + [ ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 10 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 28 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 0 + , (constr 1 + [ 18 + , (constr 0 + [ ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 293 + , (constr 0 + [ ]) ]) ]) + , cse ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 29 + , (constr 1 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 15 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 30 + , (constr 1 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 10000000000000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 31 + , (constr 1 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 100000000000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 32 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 13 + , cse ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 37 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 33 + , (constr 3 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , cse ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ (unsafeRatio + 1000 + 1) + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ])) + (constr 3 + [ (constr 1 + [ cse , (constr 1 [ (constr 0 - [ 2 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 24576 - , (constr 0 - [ ]) ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 122880 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 [ (constr 0 - [ 3 - , (constr 1 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 32768 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) + [ ]) , (constr 1 - [ (constr 0 - [ 4 - , (constr 1 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 5000 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) + [ cse , (constr 1 - [ (constr 0 - [ 5 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 1000000 - , cse ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 5000000 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 6 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 250000000 - , cse ]) ]) - , cse ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 7 - , (constr 1 - [ (constr 1 - [ cse - , (constr 0 - [ ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 8 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 250 - , cse ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 2000 - , (constr 0 - [ ]) ]) ]) - , cse ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 9 - , (constr 3 - [ (constr 1 - [ cse - , cse ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 10 - , (constr 3 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ (cse - 1000) - , cse ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ (cse - 200) - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 11 - , (constr 3 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ (cse - 10) - , cse ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 16 - , (constr 1 - [ (constr 1 - [ cse - , cse ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 17 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 3000 - , cse ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 6500 - , (constr 0 - [ ]) ]) ]) - , cse ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 18 - , (constr 0 - [ ]) ]) - , (constr 1 - [ (constr 0 - [ 19 - , (constr 2 - [ (constr 1 - [ (constr 3 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ (cse - 25) - , (constr 0 - [ ]) ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ (cse - 5) - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) - , (constr 1 - [ (constr 3 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ (cse - 20000) - , (constr 0 - [ ]) ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ (cse - 5000) - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 20 - , (constr 2 - [ (constr 1 - [ (constr 1 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 40000000 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) - , (constr 1 - [ (constr 1 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 15000000000 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 21 - , (constr 2 - [ (constr 1 - [ (constr 1 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 120000000 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) - , (constr 1 - [ (constr 1 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 40000000000 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 22 - , (constr 1 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 12288 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 23 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 100 - , cse ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 200 - , (constr 0 - [ ]) ]) ]) - , cse ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 24 - , (constr 1 - [ (constr 1 - [ cse - , (constr 0 - [ ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 25 - , (constr 2 - [ (constr 1 - [ cse - , (constr 1 - [ cse - , (constr 1 - [ cse - , (constr 1 - [ cse - , cse ]) ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 26 - , (constr 2 - [ (constr 1 - [ cse - , (constr 1 - [ cse - , (constr 1 - [ cse - , (constr 1 - [ (constr 3 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ cse - , (constr 1 - [ (unsafeRatio - 13 - 20) - , (constr 0 - [ ]) ]) ]) ]) - , cse ]) ]) - , (constr 1 - [ cse - , (constr 1 - [ cse - , (constr 1 - [ cse - , (constr 1 - [ cse - , (constr 1 - [ (constr 3 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ cse - , cse ]) ]) - , cse ]) ]) - , cse ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 27 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 0 - , (constr 1 - [ 3 - , (constr 0 - [ ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 10 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 28 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 0 - , (constr 1 - [ 18 - , (constr 0 - [ ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 293 - , (constr 0 - [ ]) ]) ]) - , cse ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 29 - , (constr 1 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 15 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 30 - , (constr 1 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 10000000000000 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 31 - , (constr 1 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 100000000000 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 32 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 13 - , cse ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 37 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 33 - , (constr 3 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , cse ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ (unsafeRatio - 1000 - 1) - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ])) + [ (cse + 5) + , (constr 0 + [ ]) ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ])) (constr 3 [ (constr 1 [ cse - , cse ]) ])) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ cse + , cse ]) ]) + , (constr 0 + [ ]) ]) ]) ])) (constr 3 [ (constr 1 [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ cse - , (constr 1 - [ cse - , (constr 0 - [ ]) ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ])) - (constr 3 - [ (constr 1 - [ cse - , (constr 1 + , cse ]) ])) + (constr 1 + [ (constr 3 + [ (constr 1 [ (constr 0 - [ (constr 0 + [ (constr 1 [ ]) , (constr 1 [ cse - , cse ]) ]) - , (constr 0 - [ ]) ]) ]) ])) + , (constr 0 + [ ]) ]) ]) + , cse ]) ]) + , (constr 0 + [ ]) ])) (constr 1 - [ (constr 3 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ cse - , (constr 0 - [ ]) ]) ]) - , cse ]) ]) + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ cse + , (constr 1 + [ cse + , (constr 0 + [ ]) ]) ]) ]) , (constr 0 [ ]) ])) - (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ cse - , (constr 1 - [ cse - , (constr 0 - [ ]) ]) ]) ]) - , (constr 0 - [ ]) ])) + (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ cse + , cse ]) ])) (constr 0 [ (constr 1 [ ]) @@ -859,44 +870,41 @@ program [ cse , (constr 0 [ ]) ]) ]) ])) - (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ (cse - 10) - , cse ]) ])) - (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , cse ]) - , (constr 0 - [ ]) ])) - (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 0 - , (constr 1 - [ 1000000 - , (constr 0 - [ ]) ]) ]) ])) + (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , cse ]) + , (constr 0 + [ ]) ])) + (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 0 + , (constr 1 + [ 1000000 + , (constr 0 + [ ]) ]) ]) ])) + (constr 1 + [ (constr 0 + [ (constr 2 + [ ]) + , cse ]) + , (constr 0 + [ ]) ])) (constr 1 [ (constr 0 - [ (constr 2 + [ (constr 0 [ ]) - , cse ]) + , (constr 1 + [ 500000000 + , (constr 0 + [ ]) ]) ]) , (constr 0 [ ]) ])) (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 500000000 - , (constr 0 - [ ]) ]) ]) + [ cse , (constr 0 [ ]) ])) (constr 1 @@ -907,414 +915,426 @@ program [ cse , (constr 0 [ ]) ])) - (constr 1 - [ cse - , (constr 0 - [ ]) ])) - (cse - 2)) + (cse + 1)) + (constr 0 + [ (constr 1 + [ ]) + , cse ])) (cse - 1)) - (cse 4)) - (constr 0 - [ (constr 1 - []) - , cse ])) - (cse 100)) - (cse 10)) - (cse 1)) - (constr 0 - [ (constr 1 []) - , (constr 1 - [ 1 - , (constr 0 - []) ]) ])) - (cse 5)) - (unsafeRatio 0)) + 2)) + (cse 10)) + (cse 1)) + (constr 0 + [ (constr 1 + []) + , (constr 1 + [ 1 + , (constr 0 + [ ]) ]) ])) + (cse 100)) + (cse 4)) + (cse 10)) + (unsafeRatio 1)) + (unsafeRatio 9)) (unsafeRatio 4)) - (unsafeRatio 51)) - (constr 1 [0, (constr 0 [])])) - (unsafeRatio 9)) - (unsafeRatio 3)) - (unsafeRatio 1)) - ((\s -> s s) - (\s arg -> - delay - (\xs -> + (unsafeRatio 0)) + (unsafeRatio 3)) + (unsafeRatio 51)) + (constr 1 [0, (constr 0 [])])) + ((\s -> s s) + (\s arg -> + delay + (\xs -> + force + (force (force chooseList) + xs + (delay (constr 0 [])) + (delay + ((\x xs -> + constr 1 + [ (constr 0 + [ (force + (force + fstPair) + x) + , (force + (force + sndPair) + x) ]) + , (force + (s + s + (delay + (\x -> x))) + xs) ]) + (force headList xs) + (force tailList xs)))))) + (delay (\x -> x)))) + (cse (\arg_0 arg_1 -> arg_1))) + (cse (\arg_0 arg_1 -> arg_0))) + (force + ((\s -> s s) + (\s h -> + delay + (\fr -> + (\k -> + fr + (\x -> k (\f_0 f_1 -> f_0 x)) + (\x -> k (\f_0 f_1 -> f_1 x))) + (\fq -> force (s s h) (force h fq)))) + (delay + (\choose + validateParamValue + validateParamValues -> + choose + (\eta eta -> force - (force (force chooseList) - xs - (delay (constr 0 [])) - (delay - ((\x xs -> - constr 1 - [ (constr 0 - [ (force - (force fstPair) - x) - , (force - (force sndPair) - x) ]) - , (force - (s - s - (delay (\x -> x))) - xs) ]) - (force headList xs) - (force tailList xs)))))) - (delay (\x -> x)))) - (cse (\arg_0 arg_1 -> arg_1))) - (cse (\arg_0 arg_1 -> arg_0))) - (force - ((\s -> s s) - (\s h -> - delay - (\fr -> - (\k -> - fr - (\x -> k (\f_0 f_1 -> f_0 x)) - (\x -> k (\f_0 f_1 -> f_1 x))) - (\fq -> force (s s h) (force h fq)))) - (delay - (\choose validateParamValue validateParamValues -> - choose - (\eta eta -> - force - (case - eta - [ (delay (constr 0 [])) - , (\preds -> - delay - (validatePreds - (constr 0 - [ (\x y -> - case - (equalsInteger - x - y) - [ (constr 1 []) - , (constr 0 []) ]) - , `$fOrdInteger_$ccompare` - , (\x y -> - case - (lessThanInteger - x - y) - [ (constr 1 []) - , (constr 0 []) ]) - , (\x y -> - case - (lessThanEqualsInteger - x - y) - [ (constr 1 []) - , (constr 0 []) ]) - , (\x y -> - case - (lessThanEqualsInteger - x - y) - [ (constr 0 []) - , (constr 1 []) ]) - , (\x y -> - case - (lessThanInteger - x - y) - [ (constr 0 []) - , (constr 1 []) ]) - , (\x y -> - force - (case + (case + eta + [ (delay (constr 0 [])) + , (\preds -> + delay + (validatePreds + (constr 0 + [ equalsInteger + , `$fOrdInteger_$ccompare` + , (\x y -> + force ifThenElse + (lessThanInteger + x + y) + (constr 0 []) + (constr 1 [])) + , (\x y -> + force ifThenElse + (lessThanEqualsInteger + x + y) + (constr 0 []) + (constr 1 [])) + , (\x y -> + force ifThenElse (lessThanEqualsInteger x y) - [ (delay x) - , (delay y) ])) - , (\x y -> - force - (case + (constr 1 []) + (constr 0 [])) + , (\x y -> + force ifThenElse + (lessThanInteger + x + y) + (constr 1 []) + (constr 0 [])) + , (\x y -> + force ifThenElse (lessThanEqualsInteger x y) - [ (delay y) - , (delay - x) ])) ]) - preds - (unIData eta))) - , (\paramValues -> - delay - (validateParamValues - paramValues - (unListData eta))) - , (\preds -> - delay - (validatePreds - (constr 0 - [ (\ds ds -> - case - ds - [ (\n d -> - case - ds - [ (\n' - d' -> - force - (case - (equalsInteger - n - n') - [ (delay - (constr 1 - [ ])) - , (delay - (case - (equalsInteger - d - d') - [ (constr 1 - [ ]) - , (constr 0 - [ ]) ])) ])) ]) ]) - , (\ds ds -> - case - ds - [ (\n d -> - case - ds - [ (\n' - d' -> - `$fOrdInteger_$ccompare` - (multiplyInteger - n - d') - (multiplyInteger - n' - d)) ]) ]) - , (\ds ds -> - case - ds - [ (\n d -> - case - ds - [ (\n' - d' -> - case - (lessThanInteger - (multiplyInteger - n - d') - (multiplyInteger - n' - d)) - [ (constr 1 - [ ]) - , (constr 0 - [ ]) ]) ]) ]) - , `$fOrdRational0_$c<=` - , (\ds ds -> - case - ds - [ (\n d -> - case - ds - [ (\n' - d' -> - case - (lessThanEqualsInteger - (multiplyInteger - n - d') - (multiplyInteger - n' - d)) - [ (constr 0 - [ ]) - , (constr 1 - [ ]) ]) ]) ]) - , (\ds ds -> - case - ds - [ (\n d -> - case - ds - [ (\n' - d' -> - case - (lessThanInteger + y + x) + , (\x y -> + force ifThenElse + (lessThanEqualsInteger + x + y) + x + y) ]) + preds + (unIData eta))) + , (\paramValues -> + delay + (validateParamValues + paramValues + (unListData eta))) + , (\preds -> + delay + (validatePreds + (constr 0 + [ (\ds ds -> + case + ds + [ (\n d -> + case + ds + [ (\n' + d' -> + force + (force + ifThenElse + (equalsInteger + n + n') + (delay + (force + ifThenElse + (equalsInteger + d + d') + (constr 0 + [ ]) + (constr 1 + [ ]))) + (delay + (constr 1 + [ ])))) ]) ]) + , (\ds ds -> + case + ds + [ (\n d -> + case + ds + [ (\n' + d' -> + `$fOrdInteger_$ccompare` (multiplyInteger n d') (multiplyInteger n' - d)) - [ (constr 0 - [ ]) - , (constr 1 - [ ]) ]) ]) ]) - , (\x y -> - force - (case - (`$fOrdRational0_$c<=` - x - y) - [ (delay y) - , (delay x) ])) - , (\x y -> - force - (case - (`$fOrdRational0_$c<=` - x - y) - [ (delay x) - , (delay - y) ])) ]) - preds - ((\bl -> - (\bl' -> - case - (force nullList - (force tailList - bl')) - [ (\ds -> error) - , (\ds -> - unsafeRatio - (unIData - (force - headList - bl)) - (unIData - (force - headList - bl'))) ] - (constr 0 [])) - (force tailList bl)) - (unListData eta)))) ])) - (\ds -> - case - ds - [ (\eta -> - case - (force nullList eta) - [(constr 1 []), (constr 0 [])]) - , (\paramValueHd - paramValueTl - actualValueData -> - force - (case - (validateParamValue - paramValueHd - (force headList - actualValueData)) - [ (delay - (validateParamValues - paramValueTl - (force tailList - actualValueData))) - , (delay - (constr 1 [])) ])) ])))))) - ((\s -> s s) - (\s n d -> - force - (case - (equalsInteger 0 d) - [ (delay - (force - (case - (lessThanInteger d 0) - [ (delay - ((\gcd' -> - constr 0 - [ (quotientInteger n gcd') - , (quotientInteger d gcd') ]) - (euclid n d))) - , (delay - ((\x -> s s x) - (subtractInteger 0 n) - (subtractInteger 0 d))) ]))) - , (delay error) ])))) - ((\s -> s s) - (\s x y -> - force - (case - (equalsInteger 0 y) - [(delay (s s y (modInteger x y))), (delay x)])))) - (\`$dOrd` ds ds -> - (\s -> s s) - (\s ds -> - force - (case - ds - [ (delay (constr 0 [])) - , (\x xs -> - delay - (case - x - [ (\predKey expectedPredValues -> - (\meaning -> - (\s -> s s) - (\s ds -> + d)) ]) ]) + , (\ds ds -> + case + ds + [ (\n d -> + case + ds + [ (\n' + d' -> + force + ifThenElse + (lessThanInteger + (multiplyInteger + n + d') + (multiplyInteger + n' + d)) + (constr 0 + [ ]) + (constr 1 + [ ])) ]) ]) + , `$fOrdRational0_$c<=` + , (\ds ds -> + case + ds + [ (\n d -> + case + ds + [ (\n' + d' -> + force + ifThenElse + (lessThanEqualsInteger + (multiplyInteger + n + d') + (multiplyInteger + n' + d)) + (constr 1 + [ ]) + (constr 0 + [ ])) ]) ]) + , (\ds ds -> + case + ds + [ (\n d -> + case + ds + [ (\n' + d' -> + force + ifThenElse + (lessThanInteger + (multiplyInteger + n + d') + (multiplyInteger + n' + d)) + (constr 1 + [ ]) + (constr 0 + [ ])) ]) ]) + , (\x y -> + force + (case + (`$fOrdRational0_$c<=` + x + y) + [ (delay y) + , (delay + x) ])) + , (\x y -> + force + (case + (`$fOrdRational0_$c<=` + x + y) + [ (delay x) + , (delay + y) ])) ]) + preds + ((\bl -> + (\bl' -> + force ifThenElse + (force nullList + (force + tailList + bl')) + (\ds -> + unsafeRatio + (unIData + (force + headList + bl)) + (unIData + (force + headList + bl'))) + (\ds -> error) + (constr 0 [])) + (force tailList + bl)) + (unListData + eta)))) ])) + (\ds -> + case + ds + [ (\eta -> + force ifThenElse + (force nullList eta) + (constr 0 []) + (constr 1 [])) + , (\paramValueHd + paramValueTl + actualValueData -> force (case - ds - [ (delay (s s xs)) - , (\x xs -> - delay - (force - (case - (meaning x ds) - [ (delay - (s s xs)) - , (delay - (constr 1 - [ ])) ]))) ])) - expectedPredValues) - (force - (case - predKey - [ (delay - (case - `$dOrd` - [ (\v v v v v v v v -> - v) ])) - , (delay + (validateParamValue + paramValueHd + (force headList + actualValueData)) + [ (delay + (validateParamValues + paramValueTl + (force tailList + actualValueData))) + , (delay + (constr 1 + [])) ])) ])))))) + ((\s -> s s) + (\s n d -> + force + (force ifThenElse + (equalsInteger 0 d) + (delay error) + (delay + (force + (force ifThenElse + (lessThanInteger d 0) + (delay + ((\x -> s s x) + (subtractInteger 0 n) + (subtractInteger 0 d))) + (delay + ((\gcd' -> + constr 0 + [ (quotientInteger n gcd') + , (quotientInteger d gcd') ]) + (euclid n d)))))))))) + ((\s -> s s) + (\s x y -> + force + (force ifThenElse + (equalsInteger 0 y) + (delay x) + (delay (s s y (modInteger x y))))))) + (\`$dOrd` ds ds -> + (\s -> s s) + (\s ds -> + force + (case + ds + [ (delay (constr 0 [])) + , (\x xs -> + delay + (case + x + [ (\predKey expectedPredValues -> + (\meaning -> + (\s -> s s) + (\s ds -> + force (case - `$dOrd` - [ (\v v v v v v v v -> - v) ])) - , (delay - (\x y -> - force - (case + ds + [ (delay (s s xs)) + , (\x xs -> + delay + (force + (case + (meaning + x + ds) + [ (delay + (s + s + xs)) + , (delay + (constr 1 + [ ])) ]))) ])) + expectedPredValues) + (force + (case + predKey + [ (delay + (case + `$dOrd` + [ (\v v v v v v v v -> + v) ])) + , (delay + (case + `$dOrd` + [ (\v v v v v v v v -> + v) ])) + , (delay + (\x y -> + force (case - `$dOrd` - [ (\v - v - v - v - v - v - v - v -> - v) ] - x - y) - [ (delay - (constr 1 [])) - , (delay - (constr 0 - [ ])) ]))) ]))) ])) ])) - ds)) + (case + `$dOrd` + [ (\v + v + v + v + v + v + v + v -> + v) ] + x + y) + [ (delay + (constr 1 + [])) + , (delay + (constr 0 + [ ])) ]))) ]))) ])) ])) + ds)) + (\x y -> + force ifThenElse (equalsInteger x y) (constr 0 []) (constr 1 []))) (\eta eta -> force - (case + (force ifThenElse (equalsInteger eta eta) - [ (delay - (force - (case - (lessThanEqualsInteger eta eta) - [(delay (constr 1 [])), (delay (constr 2 []))]))) - , (delay (constr 0 [])) ]))) + (delay (constr 0 [])) + (delay + (force ifThenElse + (lessThanEqualsInteger eta eta) + (constr 2 []) + (constr 1 [])))))) (\ds ds -> case ds @@ -1322,8 +1342,9 @@ program case ds [ (\n' d' -> - case + force ifThenElse (lessThanEqualsInteger (multiplyInteger n d') (multiplyInteger n' d)) - [(constr 1 []), (constr 0 [])]) ]) ])) \ No newline at end of file + (constr 0 []) + (constr 1 [])) ]) ])) \ No newline at end of file From d221ef45b7072db2ff080b5276151d3f53751337 Mon Sep 17 00:00:00 2001 From: effectfully Date: Wed, 11 Jun 2025 18:08:41 +0200 Subject: [PATCH 19/25] Fix 'cost-model' --- plutus-core/cost-model/budgeting-bench/Benchmarks/Nops.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/plutus-core/cost-model/budgeting-bench/Benchmarks/Nops.hs b/plutus-core/cost-model/budgeting-bench/Benchmarks/Nops.hs index fd42dc0580b..9aac5e56194 100644 --- a/plutus-core/cost-model/budgeting-bench/Benchmarks/Nops.hs +++ b/plutus-core/cost-model/budgeting-bench/Benchmarks/Nops.hs @@ -122,7 +122,7 @@ nopCostModel = nopCostParameters :: MachineParameters CekMachineCosts NopFun (CekValue DefaultUni NopFun ()) nopCostParameters = - mkMachineParameters def $ + MachineParameters def . mkMachineVariantParameters def $ CostModel defaultCekMachineCostsForTesting nopCostModel -- This is just to avoid some deeply nested case expressions for the NopNc From 9fa4ef3bb7e37a5632ed012120b09979acdac1f9 Mon Sep 17 00:00:00 2001 From: effectfully Date: Wed, 11 Jun 2025 19:10:30 +0200 Subject: [PATCH 20/25] Add a comment to 'CaseOfCase' --- .../src/UntypedPlutusCore/Transform/CaseOfCase.hs | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Transform/CaseOfCase.hs b/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Transform/CaseOfCase.hs index b706de24482..a2261d35a93 100644 --- a/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Transform/CaseOfCase.hs +++ b/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Transform/CaseOfCase.hs @@ -75,6 +75,11 @@ processTerm = \case mkIterApp ite [ cond + -- Here we call a single step of case-reduce in order to immediately clean up the + -- duplication of @alts@. Otherwise optimizing case-of-case-of-case-of... would create + -- exponential blowup of the case branches, which would eventually get deduplicated + -- with case-reduce, but only after that exponential blowup has already slowed the + -- optimizer down unnecessarily. , (trueAnn, Delay trueAnn . CaseReduce.processTerm $ Case ann true alts) , (falseAnn, Delay falseAnn . CaseReduce.processTerm $ Case ann false alts) ] From 29c1442aaeb58cfd8f820ccfd14b2aeb22849f57 Mon Sep 17 00:00:00 2001 From: effectfully Date: Wed, 11 Jun 2025 20:57:47 +0200 Subject: [PATCH 21/25] Fix golden tests --- .../bitwise/test/9.6/8 queens.eval.golden | 6 +- .../bitwise/test/9.6/8 queens.pir.golden | 22 +- .../bitwise/test/9.6/Ed25519.eval.golden | 6 +- .../bitwise/test/9.6/Ed25519.pir.golden | 42 +- .../test/9.6/bls12-381-costs.golden | 18 +- .../test/9.6/ed25519-costs.golden | 32 +- .../9.6/match-builtin-list-10.eval.golden | 6 +- .../9.6/match-builtin-list-100.eval.golden | 6 +- .../9.6/match-builtin-list-5.eval.golden | 6 +- .../9.6/match-builtin-list-50.eval.golden | 6 +- .../9.6/match-scott-list-10.eval.golden | 6 +- .../9.6/match-scott-list-100.eval.golden | 6 +- .../Lookup/9.6/match-scott-list-5.eval.golden | 6 +- .../9.6/match-scott-list-50.eval.golden | 6 +- .../test/Sum/9.6/left-fold-data.eval.golden | 6 +- .../test/Sum/9.6/right-fold-data.eval.golden | 6 +- .../nofib/test/9.6/clausify-F5.eval.golden | 6 +- .../nofib/test/9.6/clausify-F5.pir.golden | 28 +- .../nofib/test/9.6/knights10-4x4.eval.golden | 6 +- .../nofib/test/9.6/knights10-4x4.pir.golden | 98 +- .../nofib/test/9.6/queens4-bt.eval.golden | 6 +- .../nofib/test/9.6/queens4-bt.pir.golden | 44 +- .../nofib/test/9.6/queens5-fc.eval.golden | 6 +- .../nofib/test/9.6/queens5-fc.pir.golden | 44 +- .../V1/9.6/checkScriptContext1-20.eval.golden | 6 +- .../V1/9.6/checkScriptContext1-4.eval.golden | 6 +- .../V1/9.6/checkScriptContext1.pir.golden | 109 +- .../V1/9.6/checkScriptContext1.size.golden | 2 +- .../V1/9.6/checkScriptContext2-20.eval.golden | 6 +- .../V1/9.6/checkScriptContext2-4.eval.golden | 6 +- .../V1/9.6/checkScriptContext2.pir.golden | 107 +- .../V1/9.6/checkScriptContext2.size.golden | 2 +- ...ckScriptContextEqualityData-20.eval.golden | 6 +- .../9.6/checkScriptContext1-20.eval.golden | 6 +- .../9.6/checkScriptContext1-4.eval.golden | 6 +- .../Data/9.6/checkScriptContext1.pir.golden | 13 +- .../Data/9.6/checkScriptContext1.size.golden | 2 +- ...ckScriptContextEqualityData-20.eval.golden | 6 +- .../V2/9.6/checkScriptContext1-20.eval.golden | 6 +- .../V2/9.6/checkScriptContext1-4.eval.golden | 6 +- .../V2/9.6/checkScriptContext1.pir.golden | 112 +- .../V2/9.6/checkScriptContext1.size.golden | 2 +- .../V2/9.6/checkScriptContext2-20.eval.golden | 6 +- .../V2/9.6/checkScriptContext2-4.eval.golden | 6 +- .../V2/9.6/checkScriptContext2.pir.golden | 105 +- .../V2/9.6/checkScriptContext2.size.golden | 2 +- ...ckScriptContextEqualityData-20.eval.golden | 6 +- .../test/V2/9.6/dataFwdStakeTrick.eval.golden | 6 +- .../test/V2/9.6/dataFwdStakeTrick.pir.golden | 11 +- .../test/V2/9.6/dataFwdStakeTrick.uplc.golden | 90 +- .../9.6/dataFwdStakeTrickManual.eval.golden | 6 +- .../V2/9.6/dataFwdStakeTrickManual.pir.golden | 11 +- .../9.6/dataFwdStakeTrickManual.uplc.golden | 28 +- .../test/V2/9.6/sopFwdStakeTrick.eval.golden | 6 +- .../test/V2/9.6/sopFwdStakeTrick.pir.golden | 111 +- .../test/V2/9.6/sopFwdStakeTrick.uplc.golden | 1651 +++++++++-------- .../9.6/checkScriptContext1-20.eval.golden | 6 +- .../9.6/checkScriptContext1-4.eval.golden | 6 +- .../Data/9.6/checkScriptContext1.pir.golden | 13 +- .../Data/9.6/checkScriptContext1.size.golden | 2 +- ...ckScriptContextEqualityData-20.eval.golden | 6 +- .../V3/9.6/checkScriptContext1-20.eval.golden | 6 +- .../V3/9.6/checkScriptContext1-4.eval.golden | 6 +- .../V3/9.6/checkScriptContext1.pir.golden | 309 +-- .../V3/9.6/checkScriptContext1.size.golden | 2 +- .../V3/9.6/checkScriptContext2-20.eval.golden | 6 +- .../V3/9.6/checkScriptContext2-4.eval.golden | 6 +- .../V3/9.6/checkScriptContext2.pir.golden | 308 +-- .../V3/9.6/checkScriptContext2.size.golden | 2 +- ...ckScriptContextEqualityData-20.eval.golden | 6 +- .../9.6/checkScriptContext1-20.eval.golden | 6 +- .../9.6/checkScriptContext1-4.eval.golden | 6 +- .../Data/9.6/checkScriptContext1.pir.golden | 11 +- .../Data/9.6/checkScriptContext1.size.golden | 2 +- ...ckScriptContextEqualityData-20.eval.golden | 6 +- .../9.6/purposeIsWellFormed-4.eval.golden | 6 - .../Data/9.6/purposeIsWellFormed.pir.golden | 648 ++----- .../Data/9.6/purposeIsWellFormed.size.golden | 6 +- 78 files changed, 2129 insertions(+), 2124 deletions(-) diff --git a/plutus-benchmark/bitwise/test/9.6/8 queens.eval.golden b/plutus-benchmark/bitwise/test/9.6/8 queens.eval.golden index e786925684e..8f3a0738dd3 100644 --- a/plutus-benchmark/bitwise/test/9.6/8 queens.eval.golden +++ b/plutus-benchmark/bitwise/test/9.6/8 queens.eval.golden @@ -1,6 +1,6 @@ -CPU: 327_658_552_839 -Memory: 1_230_274_574 -Size: 352 +CPU: 381_725_318_016 +Memory: 1_403_857_547 +Size: 380 (constr 1 diff --git a/plutus-benchmark/bitwise/test/9.6/8 queens.pir.golden b/plutus-benchmark/bitwise/test/9.6/8 queens.pir.golden index 97dfc71de7d..05c8b04779c 100644 --- a/plutus-benchmark/bitwise/test/9.6/8 queens.pir.golden +++ b/plutus-benchmark/bitwise/test/9.6/8 queens.pir.golden @@ -9,7 +9,7 @@ !selectByteString : integer -> bytestring -> integer = \(which : integer) (bs : bytestring) -> Bool_match - (case Bool (lessThanEqualsInteger which 0) [False, True]) + (ifThenElse {Bool} (lessThanEqualsInteger which 0) True False) {all dead. integer} (/\dead -> findFirstSetBit bs) (/\dead -> @@ -17,7 +17,7 @@ !i : integer = selectByteString (subtractInteger which 1) bs in Bool_match - (case Bool (equalsInteger -1 i) [False, True]) + (ifThenElse {Bool} (equalsInteger -1 i) True False) {all dead. integer} (/\dead -> -1) (/\dead -> @@ -80,7 +80,7 @@ (right : bytestring) (control : bytestring) -> Bool_match - (case Bool (equalsInteger selectIx dim) [False, True]) + (ifThenElse {Bool} (equalsInteger selectIx dim) True False) {all dead. List (Tuple2 integer integer)} (/\dead -> Nil {Tuple2 integer integer}) (/\dead -> @@ -88,12 +88,16 @@ !available : integer = selectByteString selectIx control in Bool_match - (case Bool (equalsInteger -1 available) [False, True]) + (ifThenElse {Bool} (equalsInteger -1 available) True False) {all dead. List (Tuple2 integer integer)} (/\dead -> Nil {Tuple2 integer integer}) (/\dead -> Bool_match - (case Bool (equalsInteger row lastRow) [False, True]) + (ifThenElse + {Bool} + (equalsInteger row lastRow) + True + False) {all dead. List (Tuple2 integer integer)} (/\dead -> (let @@ -194,12 +198,16 @@ !bytesNeeded : integer = quotientInteger dim 8 in Bool_match - (case Bool (lessThanInteger dim 8) [False, True]) + (ifThenElse {Bool} (lessThanInteger dim 8) True False) {all dead. List (Tuple2 integer integer)} (/\dead -> Nil {Tuple2 integer integer}) (/\dead -> Bool_match - (case Bool (equalsInteger 0 (remainderInteger dim 8)) [False, True]) + (ifThenElse + {Bool} + (equalsInteger 0 (remainderInteger dim 8)) + True + False) {all dead. List (Tuple2 integer integer)} (/\dead -> let diff --git a/plutus-benchmark/bitwise/test/9.6/Ed25519.eval.golden b/plutus-benchmark/bitwise/test/9.6/Ed25519.eval.golden index ee2bd985286..d2805f2dbe5 100644 --- a/plutus-benchmark/bitwise/test/9.6/Ed25519.eval.golden +++ b/plutus-benchmark/bitwise/test/9.6/Ed25519.eval.golden @@ -1,5 +1,5 @@ -CPU: 1_754_030_727_874 -Memory: 5_520_417_978 -Size: 3_371 +CPU: 2_025_744_495_066 +Memory: 6_392_763_186 +Size: 3_415 (constr 1) \ No newline at end of file diff --git a/plutus-benchmark/bitwise/test/9.6/Ed25519.pir.golden b/plutus-benchmark/bitwise/test/9.6/Ed25519.pir.golden index 0f1aff41379..c0eb6f42614 100644 --- a/plutus-benchmark/bitwise/test/9.6/Ed25519.pir.golden +++ b/plutus-benchmark/bitwise/test/9.6/Ed25519.pir.golden @@ -36,13 +36,13 @@ {all dead. dead}) !even : integer -> Bool = \(n : integer) -> - case Bool (equalsInteger 0 (modInteger n 2)) [False, True] + ifThenElse {Bool} (equalsInteger 0 (modInteger n 2)) True False in letrec !expModManual : integer -> integer -> integer -> integer = \(b' : integer) (e : integer) (m : integer) -> Bool_match - (case Bool (equalsInteger 0 e) [False, True]) + (ifThenElse {Bool} (equalsInteger 0 e) True False) {all dead. integer} (/\dead -> 1) (/\dead -> @@ -178,14 +178,15 @@ {all dead. dead} in Bool_match - (case - Bool + (ifThenElse + {Bool} (equalsInteger 0 (modInteger (subtractInteger (multiplyInteger x x) xx) 57896044618658097711785492504343953926634992332820282019728792003956564819949)) - [False, True]) + True + False) {all dead. integer} (/\dead -> `$j` False) (/\dead -> `$j` True) @@ -207,7 +208,7 @@ (Nil {integer})) False) !x : integer = xRecover yInt - !x_ : Bool = case Bool (readBit bs 7) [False, True] + !x_ : Bool = ifThenElse {Bool} (readBit bs 7) True False in Bool_match (even x) @@ -371,10 +372,11 @@ (next : bytestring -> SHA512State -> Tuple2 SHA512State bytestring) (input : bytestring) -> Bool_match - (case - Bool + (ifThenElse + {Bool} (equalsInteger 0 (lengthOfByteString input)) - [False, True]) + True + False) {all dead. SHA512State} (/\dead -> state) (/\dead -> @@ -457,7 +459,7 @@ !scalarMult : Tuple2 integer integer -> integer -> Tuple2 integer integer = \(p : Tuple2 integer integer) (e : integer) -> Bool_match - (case Bool (equalsInteger 0 e) [False, True]) + (ifThenElse {Bool} (equalsInteger 0 e) True False) {all dead. Tuple2 integer integer} (/\dead -> Tuple2 {integer} {integer} 0 1) (/\dead -> @@ -482,10 +484,11 @@ !added : integer = addInteger (byteStringToInteger True x) yI in Bool_match - (case - Bool + (ifThenElse + {Bool} (lessThanInteger 18446744073709551615 added) - [False, True]) + True + False) {all dead. bytestring} (/\dead -> g @@ -579,10 +582,11 @@ (\(x : integer) (y : integer) -> let !xLSBVal : Bool - = case - Bool + = ifThenElse + {Bool} (readBit (integerToByteString False 32 x) 248) - [False, True] + True + False in writeBits (integerToByteString False 32 y) @@ -2228,7 +2232,7 @@ 1 in Bool_match - (case Bool (lessThanEqualsInteger r -1) [False, True]) + (ifThenElse {Bool} (lessThanEqualsInteger r -1) True False) {all dead. bytestring} (/\dead -> `$j` (addInteger 1024 r)) (/\dead -> `$j` r) @@ -2281,9 +2285,9 @@ {Bool} (\(x : integer) (y : integer) -> Bool_match - (case Bool (equalsInteger x x) [False, True]) + (ifThenElse {Bool} (equalsInteger x x) True False) {all dead. Bool} - (/\dead -> case Bool (equalsInteger y y) [False, True]) + (/\dead -> ifThenElse {Bool} (equalsInteger y y) True False) (/\dead -> False) {all dead. dead}))) (B #c080c2932178c2adc2a7c3917a6009c3b37cc383245824c3a9c2a6c3aac080c286c2986c14c3b334c39915c298c2b47b244dc3a352c396c39a25c3b1c29d050e0509c298c28cc2abc3b0c38866c2b8c285c38bc3a37ac2a3c080c2b9c29b59c28bc2b2c3b902) diff --git a/plutus-benchmark/bls12-381-costs/test/9.6/bls12-381-costs.golden b/plutus-benchmark/bls12-381-costs/test/9.6/bls12-381-costs.golden index 13bf92d7f2f..b7c83c50f33 100644 --- a/plutus-benchmark/bls12-381-costs/test/9.6/bls12-381-costs.golden +++ b/plutus-benchmark/bls12-381-costs/test/9.6/bls12-381-costs.golden @@ -90,56 +90,56 @@ Apply pairing to two pairs of points in G1 x G2 and run finalVerify on the resul n Script size CPU usage Memory usage ---------------------------------------------------------------------- - - 339 (2.1%) 1097763548 (11.0%) 4153 (0.0%) + - 342 (2.1%) 1097919597 (11.0%) 4654 (0.0%) Groth16 verification example n Script size CPU usage Memory usage ---------------------------------------------------------------------- - - 777 (4.7%) 1996724293 (20.0%) 10403 (0.1%) + - 779 (4.8%) 1996880342 (20.0%) 10904 (0.1%) VRF example n Script size CPU usage Memory usage ---------------------------------------------------------------------- - - 668 (4.1%) 1218525138 (12.2%) 34847 (0.2%) + - 673 (4.1%) 1218837236 (12.2%) 35849 (0.3%) G1 Verify n Script size CPU usage Memory usage ---------------------------------------------------------------------- - - 330 (2.0%) 1190176147 (11.9%) 5253 (0.0%) + - 332 (2.0%) 1190332196 (11.9%) 5754 (0.0%) G2 Verify n Script size CPU usage Memory usage ---------------------------------------------------------------------- - - 378 (2.3%) 1097544505 (11.0%) 5253 (0.0%) + - 380 (2.3%) 1097700554 (11.0%) 5754 (0.0%) Aggregate Single Key n Script size CPU usage Memory usage ---------------------------------------------------------------------- - - 811 (4.9%) 2717610310 (27.2%) 50001 (0.4%) + - 813 (5.0%) 2717766359 (27.2%) 50502 (0.4%) Aggregate Multi Key n Script size CPU usage Memory usage ---------------------------------------------------------------------- - - 1815 (11.1%) 3430870991 (34.3%) 327881 (2.3%) + - 1820 (11.1%) 3431651236 (34.3%) 330386 (2.4%) Schnorr Signature G1 n Script size CPU usage Memory usage ---------------------------------------------------------------------- - - 347 (2.1%) 319582466 (3.2%) 10994 (0.1%) + - 352 (2.1%) 319894564 (3.2%) 11996 (0.1%) Schnorr Signature G2 n Script size CPU usage Memory usage ---------------------------------------------------------------------- - - 491 (3.0%) 551793073 (5.5%) 11162 (0.1%) + - 496 (3.0%) 552105171 (5.5%) 12164 (0.1%) Groth16Verify succeeded Simple Verify succeeded diff --git a/plutus-benchmark/ed25519-costs/test/9.6/ed25519-costs.golden b/plutus-benchmark/ed25519-costs/test/9.6/ed25519-costs.golden index c825bcfb724..f266e847c54 100644 --- a/plutus-benchmark/ed25519-costs/test/9.6/ed25519-costs.golden +++ b/plutus-benchmark/ed25519-costs/test/9.6/ed25519-costs.golden @@ -1,20 +1,20 @@ n Script size CPU usage Memory usage ---------------------------------------------------------------------- - 0 428 (2.6%) 4622392 (0.0%) 23021 (0.2%) - 10 2155 (13.2%) 638006222 (6.4%) 475821 (3.4%) - 20 3882 (23.7%) 1271390052 (12.7%) 928621 (6.6%) - 30 5609 (34.2%) 1904773882 (19.0%) 1381421 (9.9%) - 40 7336 (44.8%) 2538157712 (25.4%) 1834221 (13.1%) - 50 9062 (55.3%) 3171541542 (31.7%) 2287021 (16.3%) - 60 10789 (65.9%) 3804925372 (38.0%) 2739821 (19.6%) - 70 12516 (76.4%) 4438309202 (44.4%) 3192621 (22.8%) - 80 14242 (86.9%) 5071693032 (50.7%) 3645421 (26.0%) - 90 15969 (97.5%) 5705076862 (57.1%) 4098221 (29.3%) - 100 17696 (108.0%) 6338460692 (63.4%) 4551021 (32.5%) - 110 19423 (118.5%) 6971844522 (69.7%) 5003821 (35.7%) - 120 21149 (129.1%) 7605228352 (76.1%) 5456621 (39.0%) - 130 22876 (139.6%) 8238612182 (82.4%) 5909421 (42.2%) - 140 24603 (150.2%) 8871996012 (88.7%) 6362221 (45.4%) - 150 26330 (160.7%) 9505379842 (95.1%) 6815021 (48.7%) + 0 437 (2.7%) 4778441 (0.0%) 23522 (0.2%) + 10 2164 (13.2%) 642523741 (6.4%) 489352 (3.5%) + 20 3891 (23.7%) 1280269041 (12.8%) 955182 (6.8%) + 30 5618 (34.3%) 1918014341 (19.2%) 1421012 (10.2%) + 40 7345 (44.8%) 2555759641 (25.6%) 1886842 (13.5%) + 50 9071 (55.4%) 3193504941 (31.9%) 2352672 (16.8%) + 60 10798 (65.9%) 3831250241 (38.3%) 2818502 (20.1%) + 70 12525 (76.4%) 4468995541 (44.7%) 3284332 (23.5%) + 80 14251 (87.0%) 5106740841 (51.1%) 3750162 (26.8%) + 90 15978 (97.5%) 5744486141 (57.4%) 4215992 (30.1%) + 100 17705 (108.1%) 6382231441 (63.8%) 4681822 (33.4%) + 110 19432 (118.6%) 7019976741 (70.2%) 5147652 (36.8%) + 120 21158 (129.1%) 7657722041 (76.6%) 5613482 (40.1%) + 130 22885 (139.7%) 8295467341 (83.0%) 6079312 (43.4%) + 140 24612 (150.2%) 8933212641 (89.3%) 6545142 (46.8%) + 150 26339 (160.8%) 9570957941 (95.7%) 7010972 (50.1%) Off-chain version succeeded on 100 inputs diff --git a/plutus-benchmark/lists/test/Lookup/9.6/match-builtin-list-10.eval.golden b/plutus-benchmark/lists/test/Lookup/9.6/match-builtin-list-10.eval.golden index df87db5e5b4..3727d1390fa 100644 --- a/plutus-benchmark/lists/test/Lookup/9.6/match-builtin-list-10.eval.golden +++ b/plutus-benchmark/lists/test/Lookup/9.6/match-builtin-list-10.eval.golden @@ -1,5 +1,5 @@ -CPU: 165_673_514 -Memory: 700_042 -Size: 147 +CPU: 182_838_904 +Memory: 755_152 +Size: 151 (con integer 155) \ No newline at end of file diff --git a/plutus-benchmark/lists/test/Lookup/9.6/match-builtin-list-100.eval.golden b/plutus-benchmark/lists/test/Lookup/9.6/match-builtin-list-100.eval.golden index 5aac0f6f521..3afafcc7eab 100644 --- a/plutus-benchmark/lists/test/Lookup/9.6/match-builtin-list-100.eval.golden +++ b/plutus-benchmark/lists/test/Lookup/9.6/match-builtin-list-100.eval.golden @@ -1,5 +1,5 @@ -CPU: 13_630_325_294 -Memory: 57_344_332 -Size: 147 +CPU: 15_206_420_194 +Memory: 62_404_432 +Size: 151 (con integer 15050) \ No newline at end of file diff --git a/plutus-benchmark/lists/test/Lookup/9.6/match-builtin-list-5.eval.golden b/plutus-benchmark/lists/test/Lookup/9.6/match-builtin-list-5.eval.golden index 8b31af35d99..225552bf5e9 100644 --- a/plutus-benchmark/lists/test/Lookup/9.6/match-builtin-list-5.eval.golden +++ b/plutus-benchmark/lists/test/Lookup/9.6/match-builtin-list-5.eval.golden @@ -1,5 +1,5 @@ -CPU: 50_027_604 -Memory: 212_662 -Size: 147 +CPU: 54_709_074 +Memory: 227_692 +Size: 151 (con integer 40) \ No newline at end of file diff --git a/plutus-benchmark/lists/test/Lookup/9.6/match-builtin-list-50.eval.golden b/plutus-benchmark/lists/test/Lookup/9.6/match-builtin-list-50.eval.golden index b8ac706248b..504c0c501db 100644 --- a/plutus-benchmark/lists/test/Lookup/9.6/match-builtin-list-50.eval.golden +++ b/plutus-benchmark/lists/test/Lookup/9.6/match-builtin-list-50.eval.golden @@ -1,5 +1,5 @@ -CPU: 3_487_267_194 -Memory: 14_677_282 -Size: 147 +CPU: 3_885_192_144 +Memory: 15_954_832 +Size: 151 (con integer 3775) \ No newline at end of file diff --git a/plutus-benchmark/lists/test/Lookup/9.6/match-scott-list-10.eval.golden b/plutus-benchmark/lists/test/Lookup/9.6/match-scott-list-10.eval.golden index 8d56d5cc311..fd99e12d754 100644 --- a/plutus-benchmark/lists/test/Lookup/9.6/match-scott-list-10.eval.golden +++ b/plutus-benchmark/lists/test/Lookup/9.6/match-scott-list-10.eval.golden @@ -1,5 +1,5 @@ -CPU: 81_203_410 -Memory: 396_750 -Size: 226 +CPU: 101_489_780 +Memory: 461_880 +Size: 234 (con integer 155) \ No newline at end of file diff --git a/plutus-benchmark/lists/test/Lookup/9.6/match-scott-list-100.eval.golden b/plutus-benchmark/lists/test/Lookup/9.6/match-scott-list-100.eval.golden index 2320d7b011c..f023e4c9970 100644 --- a/plutus-benchmark/lists/test/Lookup/9.6/match-scott-list-100.eval.golden +++ b/plutus-benchmark/lists/test/Lookup/9.6/match-scott-list-100.eval.golden @@ -1,5 +1,5 @@ -CPU: 6_509_150_200 -Memory: 30_963_900 -Size: 946 +CPU: 8_116_454_900 +Memory: 36_124_200 +Size: 954 (con integer 15050) \ No newline at end of file diff --git a/plutus-benchmark/lists/test/Lookup/9.6/match-scott-list-5.eval.golden b/plutus-benchmark/lists/test/Lookup/9.6/match-scott-list-5.eval.golden index c4f9ec5c97a..f6fe7fe9279 100644 --- a/plutus-benchmark/lists/test/Lookup/9.6/match-scott-list-5.eval.golden +++ b/plutus-benchmark/lists/test/Lookup/9.6/match-scott-list-5.eval.golden @@ -1,5 +1,5 @@ -CPU: 25_027_230 -Memory: 125_000 -Size: 186 +CPU: 31_269_190 +Memory: 145_040 +Size: 194 (con integer 40) \ No newline at end of file diff --git a/plutus-benchmark/lists/test/Lookup/9.6/match-scott-list-50.eval.golden b/plutus-benchmark/lists/test/Lookup/9.6/match-scott-list-50.eval.golden index 0778baed1b7..bd0b57d1071 100644 --- a/plutus-benchmark/lists/test/Lookup/9.6/match-scott-list-50.eval.golden +++ b/plutus-benchmark/lists/test/Lookup/9.6/match-scott-list-50.eval.golden @@ -1,5 +1,5 @@ -CPU: 1_670_986_650 -Memory: 7_976_150 -Size: 546 +CPU: 2_084_516_500 +Memory: 9_303_800 +Size: 554 (con integer 3775) \ No newline at end of file diff --git a/plutus-benchmark/lists/test/Sum/9.6/left-fold-data.eval.golden b/plutus-benchmark/lists/test/Sum/9.6/left-fold-data.eval.golden index 158b6ea18be..3ca9307edf6 100644 --- a/plutus-benchmark/lists/test/Sum/9.6/left-fold-data.eval.golden +++ b/plutus-benchmark/lists/test/Sum/9.6/left-fold-data.eval.golden @@ -1,5 +1,5 @@ -CPU: 278_601_783 -Memory: 1_136_329 -Size: 165 +CPU: 309_967_632 +Memory: 1_237_030 +Size: 173 (con integer 5050) \ No newline at end of file diff --git a/plutus-benchmark/lists/test/Sum/9.6/right-fold-data.eval.golden b/plutus-benchmark/lists/test/Sum/9.6/right-fold-data.eval.golden index 12d64d5277d..6c424e1ef7d 100644 --- a/plutus-benchmark/lists/test/Sum/9.6/right-fold-data.eval.golden +++ b/plutus-benchmark/lists/test/Sum/9.6/right-fold-data.eval.golden @@ -1,5 +1,5 @@ -CPU: 283_401_783 -Memory: 1_166_329 -Size: 168 +CPU: 314_767_632 +Memory: 1_267_030 +Size: 176 (con integer 5050) \ No newline at end of file diff --git a/plutus-benchmark/nofib/test/9.6/clausify-F5.eval.golden b/plutus-benchmark/nofib/test/9.6/clausify-F5.eval.golden index 0d1ebf161a1..9827abe937f 100644 --- a/plutus-benchmark/nofib/test/9.6/clausify-F5.eval.golden +++ b/plutus-benchmark/nofib/test/9.6/clausify-F5.eval.golden @@ -1,5 +1,5 @@ -CPU: 45_969_754_450 -Memory: 279_787_390 -Size: 1_584 +CPU: 50_150_307_160 +Memory: 293_209_180 +Size: 1_615 (constr 0) \ No newline at end of file diff --git a/plutus-benchmark/nofib/test/9.6/clausify-F5.pir.golden b/plutus-benchmark/nofib/test/9.6/clausify-F5.pir.golden index 647f2314239..799184ba655 100644 --- a/plutus-benchmark/nofib/test/9.6/clausify-F5.pir.golden +++ b/plutus-benchmark/nofib/test/9.6/clausify-F5.pir.golden @@ -42,44 +42,46 @@ Ord a !equalsInteger : integer -> integer -> Bool = \(x : integer) (y : integer) -> - case Bool (equalsInteger x y) [False, True] - !ifThenElse : all a. bool -> a -> a -> a - = /\a -> \(b : bool) (x : a) (y : a) -> case a b [y, x] + ifThenElse {Bool} (equalsInteger x y) True False !`$fOrdInteger` : Ord integer = CConsOrd {integer} equalsInteger (\(eta : integer) (eta : integer) -> Bool_match - (case Bool (equalsInteger eta eta) [False, True]) + (ifThenElse {Bool} (equalsInteger eta eta) True False) {all dead. Ordering} (/\dead -> EQ) (/\dead -> Bool_match - (case Bool (lessThanEqualsInteger eta eta) [False, True]) + (ifThenElse + {Bool} + (lessThanEqualsInteger eta eta) + True + False) {all dead. Ordering} (/\dead -> LT) (/\dead -> GT) {all dead. dead}) {all dead. dead}) (\(x : integer) (y : integer) -> - case Bool (lessThanInteger x y) [False, True]) + ifThenElse {Bool} (lessThanInteger x y) True False) (\(x : integer) (y : integer) -> - case Bool (lessThanEqualsInteger x y) [False, True]) + ifThenElse {Bool} (lessThanEqualsInteger x y) True False) (\(x : integer) (y : integer) -> ifThenElse {Bool} (lessThanEqualsInteger x y) False True) (\(x : integer) (y : integer) -> ifThenElse {Bool} (lessThanInteger x y) False True) (\(x : integer) (y : integer) -> Bool_match - (case Bool (lessThanEqualsInteger x y) [False, True]) + (ifThenElse {Bool} (lessThanEqualsInteger x y) True False) {all dead. integer} (/\dead -> y) (/\dead -> x) {all dead. dead}) (\(x : integer) (y : integer) -> Bool_match - (case Bool (lessThanEqualsInteger x y) [False, True]) + (ifThenElse {Bool} (lessThanEqualsInteger x y) True False) {all dead. integer} (/\dead -> x) (/\dead -> y) @@ -436,13 +438,13 @@ List integer) -> /\dead -> Bool_match - (case - Bool + (ifThenElse + {Bool} (equalsInteger y x) - [ False - , True ]) + True + False) {all dead. Bool} (/\dead -> diff --git a/plutus-benchmark/nofib/test/9.6/knights10-4x4.eval.golden b/plutus-benchmark/nofib/test/9.6/knights10-4x4.eval.golden index 1d3fe9b76e7..2177eba9034 100644 --- a/plutus-benchmark/nofib/test/9.6/knights10-4x4.eval.golden +++ b/plutus-benchmark/nofib/test/9.6/knights10-4x4.eval.golden @@ -1,5 +1,5 @@ -CPU: 1_168_462_754 -Memory: 6_301_258 -Size: 1_934 +CPU: 1_395_086_000 +Memory: 7_028_012 +Size: 2_021 (constr 0) \ No newline at end of file diff --git a/plutus-benchmark/nofib/test/9.6/knights10-4x4.pir.golden b/plutus-benchmark/nofib/test/9.6/knights10-4x4.pir.golden index 3e3385c990d..cc25a8c7b52 100644 --- a/plutus-benchmark/nofib/test/9.6/knights10-4x4.pir.golden +++ b/plutus-benchmark/nofib/test/9.6/knights10-4x4.pir.golden @@ -49,44 +49,48 @@ `$fEqChessSet_$c==` (\(x : ChessSet) (y : ChessSet) -> y) (\(x : ChessSet) (y : ChessSet) -> x) - !ifThenElse : all a. bool -> a -> a -> a - = /\a -> \(b : bool) (x : a) (y : a) -> case a b [y, x] + !equalsInteger : integer -> integer -> Bool + = \(x : integer) (y : integer) -> + ifThenElse {Bool} (equalsInteger x y) True False !v : Ord integer = CConsOrd {integer} - (\(x : integer) (y : integer) -> - case Bool (equalsInteger x y) [False, True]) + equalsInteger (\(eta : integer) (eta : integer) -> Bool_match - (case Bool (equalsInteger eta eta) [False, True]) + (ifThenElse {Bool} (equalsInteger eta eta) True False) {all dead. Ordering} (/\dead -> EQ) (/\dead -> Bool_match - (case Bool (lessThanEqualsInteger eta eta) [False, True]) + (ifThenElse + {Bool} + (lessThanEqualsInteger eta eta) + True + False) {all dead. Ordering} (/\dead -> LT) (/\dead -> GT) {all dead. dead}) {all dead. dead}) (\(x : integer) (y : integer) -> - case Bool (lessThanInteger x y) [False, True]) + ifThenElse {Bool} (lessThanInteger x y) True False) (\(x : integer) (y : integer) -> - case Bool (lessThanEqualsInteger x y) [False, True]) + ifThenElse {Bool} (lessThanEqualsInteger x y) True False) (\(x : integer) (y : integer) -> ifThenElse {Bool} (lessThanEqualsInteger x y) False True) (\(x : integer) (y : integer) -> ifThenElse {Bool} (lessThanInteger x y) False True) (\(x : integer) (y : integer) -> Bool_match - (case Bool (lessThanEqualsInteger x y) [False, True]) + (ifThenElse {Bool} (lessThanEqualsInteger x y) True False) {all dead. integer} (/\dead -> y) (/\dead -> x) {all dead. dead}) (\(x : integer) (y : integer) -> Bool_match - (case Bool (lessThanEqualsInteger x y) [False, True]) + (ifThenElse {Bool} (lessThanEqualsInteger x y) True False) {all dead. integer} (/\dead -> x) (/\dead -> y) @@ -167,7 +171,7 @@ (growFn : a -> List a) (finFn : a -> Bool) -> Bool_match - (case Bool (equalsInteger 0 depth) [False, True]) + (ifThenElse {Bool} (equalsInteger 0 depth) True False) {all dead. List a} (/\dead -> Nil {a}) (/\dead -> @@ -621,10 +625,11 @@ {all dead. Bool} (/\dead -> Bool_match - (case - Bool + (ifThenElse + {Bool} (lessThanEqualsInteger x ipv) - [False, True]) + True + False) {all dead. Bool} (/\dead -> Bool_match @@ -636,10 +641,11 @@ {all dead. Bool} (/\dead -> Bool_match - (case - Bool + (ifThenElse + {Bool} (lessThanEqualsInteger y ipv) - [False, True]) + True + False) {all dead. Bool} (/\dead -> notIn @@ -660,18 +666,20 @@ (\(a' : integer) (b' : integer) -> Bool_match - (case - Bool + (ifThenElse + {Bool} (equalsInteger a a') - [False, True]) + True + False) {all dead. Bool} (/\dead -> - case - Bool + ifThenElse + {Bool} (equalsInteger b b') - [False, True]) + True + False) (/\dead -> False) {all dead. dead}))) t @@ -924,7 +932,7 @@ {Bool} (\(a' : integer) (b' : ChessSet) -> Bool_match - (case Bool (equalsInteger a a') [False, True]) + (equalsInteger a a') {all dead. Bool} (/\dead -> True) (/\dead -> False) @@ -981,14 +989,15 @@ in c (Bool_match - (case - Bool + (ifThenElse + {Bool} (equalsInteger 0 (remainderInteger boardSize 2)) - [False, True]) + True + False) {all dead. ChessSet} (/\dead -> Board @@ -1060,7 +1069,11 @@ !go : integer -> List integer = \(n : integer) -> Bool_match - (case Bool (lessThanEqualsInteger n 0) [False, True]) + (ifThenElse + {Bool} + (lessThanEqualsInteger n 0) + True + False) {all dead. List integer} (/\dead -> Nil {integer}) (/\dead -> Cons {integer} x (go (subtractInteger n 1))) @@ -1138,10 +1151,11 @@ {a} (\(y : integer) (x : ChessSet) -> Bool_match - (case - Bool + (ifThenElse + {Bool} (equalsInteger 1 y) - [False, True]) + True + False) {all dead. a} (/\dead -> c x ds) (/\dead -> ds) @@ -1197,12 +1211,13 @@ ipv)) {all dead. dead} in - case - Bool + ifThenElse + {Bool} (equalsInteger 0 (length {Direction} (possibleMoves board))) - [False, True]) + True + False) (/\dead -> False) {all dead. dead}) {all dead. List ChessSet} @@ -1212,7 +1227,7 @@ !l : integer = length {ChessSet} singles in Bool_match - (case Bool (equalsInteger 0 l) [False, True]) + (ifThenElse {Bool} (equalsInteger 0 l) True False) {all dead. List ChessSet} (/\dead -> go @@ -1532,7 +1547,11 @@ (descAndNo y))) (/\dead -> Bool_match - (case Bool (equalsInteger 1 l) [False, True]) + (ifThenElse + {Bool} + (equalsInteger 1 l) + True + False) {all dead. List ChessSet} (/\dead -> singles) (/\dead -> Nil {ChessSet}) @@ -1554,10 +1573,11 @@ (ipv : Maybe (Tuple2 integer integer)) (ipv : List (Tuple2 integer integer)) -> Bool_match - (case - Bool + (ifThenElse + {Bool} (equalsInteger ipv (multiplyInteger ipv ipv)) - [False, True]) + True + False) {all dead. Bool} (/\dead -> canMoveTo diff --git a/plutus-benchmark/nofib/test/9.6/queens4-bt.eval.golden b/plutus-benchmark/nofib/test/9.6/queens4-bt.eval.golden index 93b0264aa81..2f75a757bf8 100644 --- a/plutus-benchmark/nofib/test/9.6/queens4-bt.eval.golden +++ b/plutus-benchmark/nofib/test/9.6/queens4-bt.eval.golden @@ -1,6 +1,6 @@ -CPU: 3_857_821_578 -Memory: 21_795_869 -Size: 2_036 +CPU: 4_302_046_267 +Memory: 22_978_130 +Size: 2_067 (constr 1 diff --git a/plutus-benchmark/nofib/test/9.6/queens4-bt.pir.golden b/plutus-benchmark/nofib/test/9.6/queens4-bt.pir.golden index 25fbeb37816..6facf188db3 100644 --- a/plutus-benchmark/nofib/test/9.6/queens4-bt.pir.golden +++ b/plutus-benchmark/nofib/test/9.6/queens4-bt.pir.golden @@ -136,7 +136,7 @@ Fc : Algorithm !equalsInteger : integer -> integer -> Bool = \(x : integer) (y : integer) -> - case Bool (equalsInteger x y) [False, True] + ifThenElse {Bool} (equalsInteger x y) True False data Unit | Unit_match where Unit : Unit in @@ -281,10 +281,11 @@ (xs : List integer) -> /\dead -> Bool_match - (case - Bool + (ifThenElse + {Bool} (equalsInteger a x) - [False, True]) + True + False) {all dead. Bool} (/\dead -> False) (/\dead -> go xs) @@ -335,8 +336,8 @@ (ipv : integer) (ipv : Assign -> Assign -> Bool) -> Bool_match - (case - Bool + (ifThenElse + {Bool} (equalsInteger (List_match {Assign} @@ -349,7 +350,8 @@ {integer} (\(var : integer) (val : integer) -> var))) ipv) - [False, True]) + True + False) {all dead. ConflictSet} (/\dead -> Known (Nil {integer})) (/\dead -> Unknown) @@ -554,7 +556,7 @@ !interval : integer -> integer -> List integer = \(a : integer) (b : integer) -> Bool_match - (case Bool (lessThanEqualsInteger a b) [True, False]) + (ifThenElse {Bool} (lessThanEqualsInteger a b) False True) {all dead. List integer} (/\dead -> Nil {integer}) (/\dead -> Cons {integer} a (interval (addInteger 1 a) b)) @@ -998,7 +1000,7 @@ (\(x : ConflictSet) (xs : List ConflictSet) -> /\dead -> Bool_match - (case Bool (equalsInteger 0 ds) [False, True]) + (ifThenElse {Bool} (equalsInteger 0 ds) True False) {all dead. ConflictSet} (/\dead -> x) (/\dead -> go (subtractInteger ds 1) xs) @@ -1070,7 +1072,11 @@ 1 in Bool_match - (case Bool (lessThanInteger n 0) [False, True]) + (ifThenElse + {Bool} + (lessThanInteger n 0) + True + False) {all dead. ConflictSet} (/\dead -> traceError {ConflictSet} "PT6") (/\dead -> go n ds) @@ -1095,7 +1101,7 @@ !abs : integer -> integer = \(n : integer) -> Bool_match - (case Bool (lessThanInteger n 0) [False, True]) + (ifThenElse {Bool} (lessThanInteger n 0) True False) {all dead. integer} (/\dead -> subtractInteger 0 n) (/\dead -> n) @@ -1234,7 +1240,7 @@ (\(j : integer) (n : integer) -> Bool_match (Bool_match - (case Bool (equalsInteger m n) [False, True]) + (ifThenElse {Bool} (equalsInteger m n) True False) {all dead. Bool} (/\dead -> False) (/\dead -> True) @@ -1242,12 +1248,13 @@ {all dead. Bool} (/\dead -> Bool_match - (case - Bool + (ifThenElse + {Bool} (equalsInteger (abs (subtractInteger i j)) (abs (subtractInteger m n))) - [False, True]) + True + False) {all dead. Bool} (/\dead -> False) (/\dead -> True) @@ -1676,8 +1683,8 @@ {all dead. dead} in Bool_match - (case - Bool + (ifThenElse + {Bool} (lessThanInteger (List_match {Assign} @@ -1693,7 +1700,8 @@ (val : integer) -> var))) ds) - [False, True]) + True + False) {all dead. a} (/\dead -> go vallist) (/\dead -> n) diff --git a/plutus-benchmark/nofib/test/9.6/queens5-fc.eval.golden b/plutus-benchmark/nofib/test/9.6/queens5-fc.eval.golden index 6561a3aead1..b29f7c19dc9 100644 --- a/plutus-benchmark/nofib/test/9.6/queens5-fc.eval.golden +++ b/plutus-benchmark/nofib/test/9.6/queens5-fc.eval.golden @@ -1,6 +1,6 @@ -CPU: 137_974_261_782 -Memory: 812_282_055 -Size: 2_036 +CPU: 153_231_070_621 +Memory: 860_817_866 +Size: 2_067 (constr 1 diff --git a/plutus-benchmark/nofib/test/9.6/queens5-fc.pir.golden b/plutus-benchmark/nofib/test/9.6/queens5-fc.pir.golden index 7770ae155eb..31e830ed914 100644 --- a/plutus-benchmark/nofib/test/9.6/queens5-fc.pir.golden +++ b/plutus-benchmark/nofib/test/9.6/queens5-fc.pir.golden @@ -136,7 +136,7 @@ Fc : Algorithm !equalsInteger : integer -> integer -> Bool = \(x : integer) (y : integer) -> - case Bool (equalsInteger x y) [False, True] + ifThenElse {Bool} (equalsInteger x y) True False data Unit | Unit_match where Unit : Unit in @@ -281,10 +281,11 @@ (xs : List integer) -> /\dead -> Bool_match - (case - Bool + (ifThenElse + {Bool} (equalsInteger a x) - [False, True]) + True + False) {all dead. Bool} (/\dead -> False) (/\dead -> go xs) @@ -335,8 +336,8 @@ (ipv : integer) (ipv : Assign -> Assign -> Bool) -> Bool_match - (case - Bool + (ifThenElse + {Bool} (equalsInteger (List_match {Assign} @@ -349,7 +350,8 @@ {integer} (\(var : integer) (val : integer) -> var))) ipv) - [False, True]) + True + False) {all dead. ConflictSet} (/\dead -> Known (Nil {integer})) (/\dead -> Unknown) @@ -554,7 +556,7 @@ !interval : integer -> integer -> List integer = \(a : integer) (b : integer) -> Bool_match - (case Bool (lessThanEqualsInteger a b) [True, False]) + (ifThenElse {Bool} (lessThanEqualsInteger a b) False True) {all dead. List integer} (/\dead -> Nil {integer}) (/\dead -> Cons {integer} a (interval (addInteger 1 a) b)) @@ -998,7 +1000,7 @@ (\(x : ConflictSet) (xs : List ConflictSet) -> /\dead -> Bool_match - (case Bool (equalsInteger 0 ds) [False, True]) + (ifThenElse {Bool} (equalsInteger 0 ds) True False) {all dead. ConflictSet} (/\dead -> x) (/\dead -> go (subtractInteger ds 1) xs) @@ -1070,7 +1072,11 @@ 1 in Bool_match - (case Bool (lessThanInteger n 0) [False, True]) + (ifThenElse + {Bool} + (lessThanInteger n 0) + True + False) {all dead. ConflictSet} (/\dead -> traceError {ConflictSet} "PT6") (/\dead -> go n ds) @@ -1095,7 +1101,7 @@ !abs : integer -> integer = \(n : integer) -> Bool_match - (case Bool (lessThanInteger n 0) [False, True]) + (ifThenElse {Bool} (lessThanInteger n 0) True False) {all dead. integer} (/\dead -> subtractInteger 0 n) (/\dead -> n) @@ -1234,7 +1240,7 @@ (\(j : integer) (n : integer) -> Bool_match (Bool_match - (case Bool (equalsInteger m n) [False, True]) + (ifThenElse {Bool} (equalsInteger m n) True False) {all dead. Bool} (/\dead -> False) (/\dead -> True) @@ -1242,12 +1248,13 @@ {all dead. Bool} (/\dead -> Bool_match - (case - Bool + (ifThenElse + {Bool} (equalsInteger (abs (subtractInteger i j)) (abs (subtractInteger m n))) - [False, True]) + True + False) {all dead. Bool} (/\dead -> False) (/\dead -> True) @@ -1676,8 +1683,8 @@ {all dead. dead} in Bool_match - (case - Bool + (ifThenElse + {Bool} (lessThanInteger (List_match {Assign} @@ -1693,7 +1700,8 @@ (val : integer) -> var))) ds) - [False, True]) + True + False) {all dead. a} (/\dead -> go vallist) (/\dead -> n) diff --git a/plutus-benchmark/script-contexts/test/V1/9.6/checkScriptContext1-20.eval.golden b/plutus-benchmark/script-contexts/test/V1/9.6/checkScriptContext1-20.eval.golden index aed5b0a61da..37d7c52a747 100644 --- a/plutus-benchmark/script-contexts/test/V1/9.6/checkScriptContext1-20.eval.golden +++ b/plutus-benchmark/script-contexts/test/V1/9.6/checkScriptContext1-20.eval.golden @@ -1,5 +1,5 @@ -CPU: 243_352_808 -Memory: 930_200 -Size: 1_490 +CPU: 261_922_639 +Memory: 989_819 +Size: 1_626 (constr 0) \ No newline at end of file diff --git a/plutus-benchmark/script-contexts/test/V1/9.6/checkScriptContext1-4.eval.golden b/plutus-benchmark/script-contexts/test/V1/9.6/checkScriptContext1-4.eval.golden index 38550cb35bb..df6f643cfaf 100644 --- a/plutus-benchmark/script-contexts/test/V1/9.6/checkScriptContext1-4.eval.golden +++ b/plutus-benchmark/script-contexts/test/V1/9.6/checkScriptContext1-4.eval.golden @@ -1,5 +1,5 @@ -CPU: 68_333_032 -Memory: 263_848 -Size: 1_490 +CPU: 74_418_943 +Memory: 283_387 +Size: 1_626 (constr 0) \ No newline at end of file diff --git a/plutus-benchmark/script-contexts/test/V1/9.6/checkScriptContext1.pir.golden b/plutus-benchmark/script-contexts/test/V1/9.6/checkScriptContext1.pir.golden index 7eb166d9bf0..f8d322e253a 100644 --- a/plutus-benchmark/script-contexts/test/V1/9.6/checkScriptContext1.pir.golden +++ b/plutus-benchmark/script-contexts/test/V1/9.6/checkScriptContext1.pir.golden @@ -59,7 +59,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (case Bool (equalsInteger 0 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 0 index) True False) {all dead. Tuple2 a b} (/\dead -> Tuple2 @@ -78,12 +78,12 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (case Bool (equalsInteger 0 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 0 index) True False) {all dead. Credential} (/\dead -> PubKeyCredential (unBData (headList {data} args))) (/\dead -> Bool_match - (case Bool (equalsInteger 1 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 1 index) True False) {all dead. Credential} (/\dead -> ScriptCredential (unBData (headList {data} args))) (/\dead -> traceError {Credential} "PT1") @@ -98,7 +98,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (case Bool (equalsInteger 0 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 0 index) True False) {all dead. StakingCredential} (/\dead -> StakingHash @@ -106,7 +106,7 @@ (headList {data} args))) (/\dead -> Bool_match - (case Bool (equalsInteger 1 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 1 index) True False) {all dead. StakingCredential} (/\dead -> let @@ -136,7 +136,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (case Bool (equalsInteger 0 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 0 index) True False) {all dead. DCert} (/\dead -> DCertDelegRegKey @@ -144,7 +144,7 @@ (headList {data} args))) (/\dead -> Bool_match - (case Bool (equalsInteger 1 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 1 index) True False) {all dead. DCert} (/\dead -> DCertDelegDeRegKey @@ -152,7 +152,7 @@ (headList {data} args))) (/\dead -> Bool_match - (case Bool (equalsInteger 2 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 2 index) True False) {all dead. DCert} (/\dead -> DCertDelegDelegate @@ -161,7 +161,11 @@ (unBData (headList {data} (tailList {data} args)))) (/\dead -> Bool_match - (case Bool (equalsInteger 3 index) [False, True]) + (ifThenElse + {Bool} + (equalsInteger 3 index) + True + False) {all dead. DCert} (/\dead -> DCertPoolRegister @@ -170,10 +174,11 @@ (headList {data} (tailList {data} args)))) (/\dead -> Bool_match - (case - Bool + (ifThenElse + {Bool} (equalsInteger 4 index) - [False, True]) + True + False) {all dead. DCert} (/\dead -> DCertPoolRetire @@ -184,18 +189,20 @@ (tailList {data} args)))) (/\dead -> Bool_match - (case - Bool + (ifThenElse + {Bool} (equalsInteger 5 index) - [False, True]) + True + False) {all dead. DCert} (/\dead -> DCertGenesis) (/\dead -> Bool_match - (case - Bool + (ifThenElse + {Bool} (equalsInteger 6 index) - [False, True]) + True + False) {all dead. DCert} (/\dead -> DCertMir) (/\dead -> traceError {DCert} "PT1") @@ -214,12 +221,12 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (case Bool (equalsInteger 0 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 0 index) True False) {all dead. Bool} (/\dead -> False) (/\dead -> Bool_match - (case Bool (equalsInteger 1 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 1 index) True False) {all dead. Bool} (/\dead -> True) (/\dead -> traceError {Bool} "PT1") @@ -239,18 +246,18 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (case Bool (equalsInteger 0 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 0 index) True False) {all dead. Extended a} (/\dead -> NegInf {a}) (/\dead -> Bool_match - (case Bool (equalsInteger 1 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 1 index) True False) {all dead. Extended a} (/\dead -> Finite {a} (`$dUnsafeFromData` (headList {data} args))) (/\dead -> Bool_match - (case Bool (equalsInteger 2 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 2 index) True False) {all dead. Extended a} (/\dead -> PosInf {a}) (/\dead -> traceError {Extended a} "PT1") @@ -265,7 +272,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (case Bool (equalsInteger 0 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 0 index) True False) {all dead. bytestring} (/\dead -> unBData (headList {data} args)) (/\dead -> traceError {bytestring} "PT1") @@ -280,7 +287,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (case Bool (equalsInteger 0 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 0 index) True False) {all dead. TxOutRef} (/\dead -> TxOutRef @@ -299,12 +306,12 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (case Bool (equalsInteger 1 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 1 index) True False) {all dead. Maybe a} (/\dead -> Nothing {a}) (/\dead -> Bool_match - (case Bool (equalsInteger 0 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 0 index) True False) {all dead. Maybe a} (/\dead -> Just {a} (`$dUnsafeFromData` (headList {data} args))) @@ -364,7 +371,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (case Bool (equalsInteger 0 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 0 index) True False) {all dead. TxOut} (/\dead -> let @@ -378,7 +385,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (case Bool (equalsInteger 0 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 0 index) True False) {all dead. Address} (/\dead -> Address @@ -443,7 +450,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (case Bool (equalsInteger 0 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 0 index) True False) {all dead. ScriptContext} (/\dead -> ScriptContext @@ -454,7 +461,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (case Bool (equalsInteger 0 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 0 index) True False) {all dead. TxInfo} (/\dead -> let @@ -491,10 +498,11 @@ = sndPair {integer} {list data} tup in Bool_match - (case - Bool + (ifThenElse + {Bool} (equalsInteger 0 index) - [False, True]) + True + False) {all dead. TxInInfo} (/\dead -> TxInInfo @@ -589,7 +597,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (case Bool (equalsInteger 0 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 0 index) True False) {all dead. Interval integer} (/\dead -> Interval @@ -603,7 +611,11 @@ = sndPair {integer} {list data} tup in Bool_match - (case Bool (equalsInteger 0 index) [False, True]) + (ifThenElse + {Bool} + (equalsInteger 0 index) + True + False) {all dead. LowerBound integer} (/\dead -> LowerBound @@ -626,7 +638,11 @@ = sndPair {integer} {list data} tup in Bool_match - (case Bool (equalsInteger 0 index) [False, True]) + (ifThenElse + {Bool} + (equalsInteger 0 index) + True + False) {all dead. UpperBound integer} (/\dead -> UpperBound @@ -688,12 +704,12 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (case Bool (equalsInteger 0 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 0 index) True False) {all dead. ScriptPurpose} (/\dead -> Minting (unBData (headList {data} args))) (/\dead -> Bool_match - (case Bool (equalsInteger 1 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 1 index) True False) {all dead. ScriptPurpose} (/\dead -> Spending @@ -701,7 +717,7 @@ (headList {data} args))) (/\dead -> Bool_match - (case Bool (equalsInteger 2 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 2 index) True False) {all dead. ScriptPurpose} (/\dead -> Rewarding @@ -709,7 +725,11 @@ (headList {data} args))) (/\dead -> Bool_match - (case Bool (equalsInteger 3 index) [False, True]) + (ifThenElse + {Bool} + (equalsInteger 3 index) + True + False) {all dead. ScriptPurpose} (/\dead -> Certifying @@ -725,8 +745,8 @@ {Unit} (\(ipv : TxInfo) (ipv : ScriptPurpose) -> Bool_match - (case - Bool + (ifThenElse + {Bool} (equalsInteger 0 (modInteger @@ -759,7 +779,8 @@ in go eta) 2)) - [False, True]) + True + False) {all dead. Unit} (/\dead -> Unit) (/\dead -> diff --git a/plutus-benchmark/script-contexts/test/V1/9.6/checkScriptContext1.size.golden b/plutus-benchmark/script-contexts/test/V1/9.6/checkScriptContext1.size.golden index b5526d659a5..49d66a8bd35 100644 --- a/plutus-benchmark/script-contexts/test/V1/9.6/checkScriptContext1.size.golden +++ b/plutus-benchmark/script-contexts/test/V1/9.6/checkScriptContext1.size.golden @@ -1 +1 @@ -1490 \ No newline at end of file +1626 \ No newline at end of file diff --git a/plutus-benchmark/script-contexts/test/V1/9.6/checkScriptContext2-20.eval.golden b/plutus-benchmark/script-contexts/test/V1/9.6/checkScriptContext2-20.eval.golden index 0d52057a1f1..4812e337f5e 100644 --- a/plutus-benchmark/script-contexts/test/V1/9.6/checkScriptContext2-20.eval.golden +++ b/plutus-benchmark/script-contexts/test/V1/9.6/checkScriptContext2-20.eval.golden @@ -1,5 +1,5 @@ -CPU: 235_128_385 -Memory: 892_558 -Size: 1_430 +CPU: 253_542_167 +Memory: 951_676 +Size: 1_562 (constr 0) \ No newline at end of file diff --git a/plutus-benchmark/script-contexts/test/V1/9.6/checkScriptContext2-4.eval.golden b/plutus-benchmark/script-contexts/test/V1/9.6/checkScriptContext2-4.eval.golden index 7feb9a1620f..ecf47d22d31 100644 --- a/plutus-benchmark/script-contexts/test/V1/9.6/checkScriptContext2-4.eval.golden +++ b/plutus-benchmark/script-contexts/test/V1/9.6/checkScriptContext2-4.eval.golden @@ -1,5 +1,5 @@ -CPU: 66_079_937 -Memory: 253_438 -Size: 1_430 +CPU: 72_009_799 +Memory: 272_476 +Size: 1_562 (constr 0) \ No newline at end of file diff --git a/plutus-benchmark/script-contexts/test/V1/9.6/checkScriptContext2.pir.golden b/plutus-benchmark/script-contexts/test/V1/9.6/checkScriptContext2.pir.golden index e135b6c0f56..8cfdc3fc4de 100644 --- a/plutus-benchmark/script-contexts/test/V1/9.6/checkScriptContext2.pir.golden +++ b/plutus-benchmark/script-contexts/test/V1/9.6/checkScriptContext2.pir.golden @@ -21,7 +21,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (case Bool (equalsInteger 0 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 0 index) True False) {all dead. Tuple2 a b} (/\dead -> Tuple2 @@ -43,12 +43,12 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (case Bool (equalsInteger 0 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 0 index) True False) {all dead. Credential} (/\dead -> PubKeyCredential (unBData (headList {data} args))) (/\dead -> Bool_match - (case Bool (equalsInteger 1 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 1 index) True False) {all dead. Credential} (/\dead -> ScriptCredential (unBData (headList {data} args))) (/\dead -> traceError {Credential} "PT1") @@ -66,7 +66,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (case Bool (equalsInteger 0 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 0 index) True False) {all dead. StakingCredential} (/\dead -> StakingHash @@ -74,7 +74,7 @@ (headList {data} args))) (/\dead -> Bool_match - (case Bool (equalsInteger 1 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 1 index) True False) {all dead. StakingCredential} (/\dead -> let @@ -104,7 +104,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (case Bool (equalsInteger 0 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 0 index) True False) {all dead. DCert} (/\dead -> DCertDelegRegKey @@ -112,7 +112,7 @@ (headList {data} args))) (/\dead -> Bool_match - (case Bool (equalsInteger 1 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 1 index) True False) {all dead. DCert} (/\dead -> DCertDelegDeRegKey @@ -120,7 +120,7 @@ (headList {data} args))) (/\dead -> Bool_match - (case Bool (equalsInteger 2 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 2 index) True False) {all dead. DCert} (/\dead -> DCertDelegDelegate @@ -129,7 +129,11 @@ (unBData (headList {data} (tailList {data} args)))) (/\dead -> Bool_match - (case Bool (equalsInteger 3 index) [False, True]) + (ifThenElse + {Bool} + (equalsInteger 3 index) + True + False) {all dead. DCert} (/\dead -> DCertPoolRegister @@ -138,10 +142,11 @@ (headList {data} (tailList {data} args)))) (/\dead -> Bool_match - (case - Bool + (ifThenElse + {Bool} (equalsInteger 4 index) - [False, True]) + True + False) {all dead. DCert} (/\dead -> DCertPoolRetire @@ -152,18 +157,20 @@ (tailList {data} args)))) (/\dead -> Bool_match - (case - Bool + (ifThenElse + {Bool} (equalsInteger 5 index) - [False, True]) + True + False) {all dead. DCert} (/\dead -> DCertGenesis) (/\dead -> Bool_match - (case - Bool + (ifThenElse + {Bool} (equalsInteger 6 index) - [False, True]) + True + False) {all dead. DCert} (/\dead -> DCertMir) (/\dead -> traceError {DCert} "PT1") @@ -182,12 +189,12 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (case Bool (equalsInteger 0 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 0 index) True False) {all dead. Bool} (/\dead -> False) (/\dead -> Bool_match - (case Bool (equalsInteger 1 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 1 index) True False) {all dead. Bool} (/\dead -> True) (/\dead -> traceError {Bool} "PT1") @@ -207,18 +214,18 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (case Bool (equalsInteger 0 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 0 index) True False) {all dead. Extended a} (/\dead -> NegInf {a}) (/\dead -> Bool_match - (case Bool (equalsInteger 1 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 1 index) True False) {all dead. Extended a} (/\dead -> Finite {a} (`$dUnsafeFromData` (headList {data} args))) (/\dead -> Bool_match - (case Bool (equalsInteger 2 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 2 index) True False) {all dead. Extended a} (/\dead -> PosInf {a}) (/\dead -> traceError {Extended a} "PT1") @@ -233,7 +240,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (case Bool (equalsInteger 0 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 0 index) True False) {all dead. bytestring} (/\dead -> unBData (headList {data} args)) (/\dead -> traceError {bytestring} "PT1") @@ -248,7 +255,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (case Bool (equalsInteger 0 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 0 index) True False) {all dead. TxOutRef} (/\dead -> TxOutRef @@ -270,12 +277,12 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (case Bool (equalsInteger 1 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 1 index) True False) {all dead. Maybe a} (/\dead -> Nothing {a}) (/\dead -> Bool_match - (case Bool (equalsInteger 0 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 0 index) True False) {all dead. Maybe a} (/\dead -> Just {a} (`$dUnsafeFromData` (headList {data} args))) @@ -352,7 +359,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (case Bool (equalsInteger 0 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 0 index) True False) {all dead. TxOut} (/\dead -> let @@ -366,7 +373,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (case Bool (equalsInteger 0 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 0 index) True False) {all dead. Address} (/\dead -> Address @@ -433,7 +440,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (case Bool (equalsInteger 0 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 0 index) True False) {all dead. ScriptContext} (/\dead -> ScriptContext @@ -444,7 +451,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (case Bool (equalsInteger 0 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 0 index) True False) {all dead. TxInfo} (/\dead -> let @@ -481,10 +488,11 @@ = sndPair {integer} {list data} tup in Bool_match - (case - Bool + (ifThenElse + {Bool} (equalsInteger 0 index) - [False, True]) + True + False) {all dead. TxInInfo} (/\dead -> TxInInfo @@ -579,7 +587,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (case Bool (equalsInteger 0 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 0 index) True False) {all dead. Interval integer} (/\dead -> Interval @@ -593,7 +601,11 @@ = sndPair {integer} {list data} tup in Bool_match - (case Bool (equalsInteger 0 index) [False, True]) + (ifThenElse + {Bool} + (equalsInteger 0 index) + True + False) {all dead. LowerBound integer} (/\dead -> LowerBound @@ -618,7 +630,11 @@ = sndPair {integer} {list data} tup in Bool_match - (case Bool (equalsInteger 0 index) [False, True]) + (ifThenElse + {Bool} + (equalsInteger 0 index) + True + False) {all dead. UpperBound integer} (/\dead -> UpperBound @@ -682,12 +698,12 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (case Bool (equalsInteger 0 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 0 index) True False) {all dead. ScriptPurpose} (/\dead -> Minting (unBData (headList {data} args))) (/\dead -> Bool_match - (case Bool (equalsInteger 1 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 1 index) True False) {all dead. ScriptPurpose} (/\dead -> Spending @@ -695,7 +711,11 @@ (headList {data} args))) (/\dead -> Bool_match - (case Bool (equalsInteger 2 index) [False, True]) + (ifThenElse + {Bool} + (equalsInteger 2 index) + True + False) {all dead. ScriptPurpose} (/\dead -> Rewarding @@ -703,10 +723,11 @@ (headList {data} args))) (/\dead -> Bool_match - (case - Bool + (ifThenElse + {Bool} (equalsInteger 3 index) - [False, True]) + True + False) {all dead. ScriptPurpose} (/\dead -> Certifying diff --git a/plutus-benchmark/script-contexts/test/V1/9.6/checkScriptContext2.size.golden b/plutus-benchmark/script-contexts/test/V1/9.6/checkScriptContext2.size.golden index 96047da228c..123408875a3 100644 --- a/plutus-benchmark/script-contexts/test/V1/9.6/checkScriptContext2.size.golden +++ b/plutus-benchmark/script-contexts/test/V1/9.6/checkScriptContext2.size.golden @@ -1 +1 @@ -1430 \ No newline at end of file +1562 \ No newline at end of file diff --git a/plutus-benchmark/script-contexts/test/V1/9.6/checkScriptContextEqualityData-20.eval.golden b/plutus-benchmark/script-contexts/test/V1/9.6/checkScriptContextEqualityData-20.eval.golden index 2e2992db855..49c10a812db 100644 --- a/plutus-benchmark/script-contexts/test/V1/9.6/checkScriptContextEqualityData-20.eval.golden +++ b/plutus-benchmark/script-contexts/test/V1/9.6/checkScriptContextEqualityData-20.eval.golden @@ -1,5 +1,5 @@ -CPU: 34_618_709 -Memory: 30_301 -Size: 312 +CPU: 34_774_758 +Memory: 30_802 +Size: 316 (constr 0) \ No newline at end of file diff --git a/plutus-benchmark/script-contexts/test/V1/Data/9.6/checkScriptContext1-20.eval.golden b/plutus-benchmark/script-contexts/test/V1/Data/9.6/checkScriptContext1-20.eval.golden index 876de0069a2..c5749282844 100644 --- a/plutus-benchmark/script-contexts/test/V1/Data/9.6/checkScriptContext1-20.eval.golden +++ b/plutus-benchmark/script-contexts/test/V1/Data/9.6/checkScriptContext1-20.eval.golden @@ -1,5 +1,5 @@ -CPU: 20_120_713 -Memory: 72_450 -Size: 92 +CPU: 20_276_762 +Memory: 72_951 +Size: 96 (constr 0) \ No newline at end of file diff --git a/plutus-benchmark/script-contexts/test/V1/Data/9.6/checkScriptContext1-4.eval.golden b/plutus-benchmark/script-contexts/test/V1/Data/9.6/checkScriptContext1-4.eval.golden index 860eecec37d..aa930186a93 100644 --- a/plutus-benchmark/script-contexts/test/V1/Data/9.6/checkScriptContext1-4.eval.golden +++ b/plutus-benchmark/script-contexts/test/V1/Data/9.6/checkScriptContext1-4.eval.golden @@ -1,5 +1,5 @@ -CPU: 5_544_473 -Memory: 19_682 -Size: 92 +CPU: 5_700_522 +Memory: 20_183 +Size: 96 (constr 0) \ No newline at end of file diff --git a/plutus-benchmark/script-contexts/test/V1/Data/9.6/checkScriptContext1.pir.golden b/plutus-benchmark/script-contexts/test/V1/Data/9.6/checkScriptContext1.pir.golden index 3c245bbf1b1..d763d363386 100644 --- a/plutus-benchmark/script-contexts/test/V1/Data/9.6/checkScriptContext1.pir.golden +++ b/plutus-benchmark/script-contexts/test/V1/Data/9.6/checkScriptContext1.pir.golden @@ -23,8 +23,8 @@ in \(d : data) -> Bool_match - (case - Bool + (ifThenElse + {Bool} (equalsInteger 0 (modInteger @@ -90,7 +90,11 @@ = sndPair {integer} {list data} tup in Bool_match - (case Bool (equalsInteger 0 index) [False, True]) + (ifThenElse + {Bool} + (equalsInteger 0 index) + True + False) {all dead. bytestring} (/\dead -> unBData (headList {data} args)) (/\dead -> @@ -127,7 +131,8 @@ in go ds) 2)) - [False, True]) + True + False) {all dead. Unit} (/\dead -> Unit) (/\dead -> diff --git a/plutus-benchmark/script-contexts/test/V1/Data/9.6/checkScriptContext1.size.golden b/plutus-benchmark/script-contexts/test/V1/Data/9.6/checkScriptContext1.size.golden index 69226f7293a..56749c830e6 100644 --- a/plutus-benchmark/script-contexts/test/V1/Data/9.6/checkScriptContext1.size.golden +++ b/plutus-benchmark/script-contexts/test/V1/Data/9.6/checkScriptContext1.size.golden @@ -1 +1 @@ -92 \ No newline at end of file +96 \ No newline at end of file diff --git a/plutus-benchmark/script-contexts/test/V1/Data/9.6/checkScriptContextEqualityData-20.eval.golden b/plutus-benchmark/script-contexts/test/V1/Data/9.6/checkScriptContextEqualityData-20.eval.golden index 505751227f6..9a60fd8cbd4 100644 --- a/plutus-benchmark/script-contexts/test/V1/Data/9.6/checkScriptContextEqualityData-20.eval.golden +++ b/plutus-benchmark/script-contexts/test/V1/Data/9.6/checkScriptContextEqualityData-20.eval.golden @@ -1,5 +1,5 @@ -CPU: 30_026_709 -Memory: 1_601 -Size: 25 +CPU: 30_182_758 +Memory: 2_102 +Size: 29 (constr 0) \ No newline at end of file diff --git a/plutus-benchmark/script-contexts/test/V2/9.6/checkScriptContext1-20.eval.golden b/plutus-benchmark/script-contexts/test/V2/9.6/checkScriptContext1-20.eval.golden index 03e2e3187d0..fb50a089932 100644 --- a/plutus-benchmark/script-contexts/test/V2/9.6/checkScriptContext1-20.eval.golden +++ b/plutus-benchmark/script-contexts/test/V2/9.6/checkScriptContext1-20.eval.golden @@ -1,5 +1,5 @@ -CPU: 268_236_778 -Memory: 1_019_476 -Size: 1_539 +CPU: 289_927_589 +Memory: 1_089_115 +Size: 1_683 (constr 0) \ No newline at end of file diff --git a/plutus-benchmark/script-contexts/test/V2/9.6/checkScriptContext1-4.eval.golden b/plutus-benchmark/script-contexts/test/V2/9.6/checkScriptContext1-4.eval.golden index fb91282084b..cfea6f896c7 100644 --- a/plutus-benchmark/script-contexts/test/V2/9.6/checkScriptContext1-4.eval.golden +++ b/plutus-benchmark/script-contexts/test/V2/9.6/checkScriptContext1-4.eval.golden @@ -1,5 +1,5 @@ -CPU: 75_335_066 -Memory: 291_348 -Size: 1_539 +CPU: 82_045_173 +Memory: 312_891 +Size: 1_683 (constr 0) \ No newline at end of file diff --git a/plutus-benchmark/script-contexts/test/V2/9.6/checkScriptContext1.pir.golden b/plutus-benchmark/script-contexts/test/V2/9.6/checkScriptContext1.pir.golden index b5807377331..937039aa728 100644 --- a/plutus-benchmark/script-contexts/test/V2/9.6/checkScriptContext1.pir.golden +++ b/plutus-benchmark/script-contexts/test/V2/9.6/checkScriptContext1.pir.golden @@ -62,12 +62,12 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (case Bool (equalsInteger 0 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 0 index) True False) {all dead. Bool} (/\dead -> False) (/\dead -> Bool_match - (case Bool (equalsInteger 1 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 1 index) True False) {all dead. Bool} (/\dead -> True) (/\dead -> traceError {Bool} "PT1") @@ -87,18 +87,18 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (case Bool (equalsInteger 0 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 0 index) True False) {all dead. Extended a} (/\dead -> NegInf {a}) (/\dead -> Bool_match - (case Bool (equalsInteger 1 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 1 index) True False) {all dead. Extended a} (/\dead -> Finite {a} (`$dUnsafeFromData` (headList {data} args))) (/\dead -> Bool_match - (case Bool (equalsInteger 2 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 2 index) True False) {all dead. Extended a} (/\dead -> PosInf {a}) (/\dead -> traceError {Extended a} "PT1") @@ -113,12 +113,12 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (case Bool (equalsInteger 0 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 0 index) True False) {all dead. Credential} (/\dead -> PubKeyCredential (unBData (headList {data} args))) (/\dead -> Bool_match - (case Bool (equalsInteger 1 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 1 index) True False) {all dead. Credential} (/\dead -> ScriptCredential (unBData (headList {data} args))) (/\dead -> traceError {Credential} "PT1") @@ -133,7 +133,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (case Bool (equalsInteger 0 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 0 index) True False) {all dead. StakingCredential} (/\dead -> StakingHash @@ -141,7 +141,7 @@ (headList {data} args))) (/\dead -> Bool_match - (case Bool (equalsInteger 1 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 1 index) True False) {all dead. StakingCredential} (/\dead -> let @@ -171,7 +171,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (case Bool (equalsInteger 0 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 0 index) True False) {all dead. DCert} (/\dead -> DCertDelegRegKey @@ -179,7 +179,7 @@ (headList {data} args))) (/\dead -> Bool_match - (case Bool (equalsInteger 1 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 1 index) True False) {all dead. DCert} (/\dead -> DCertDelegDeRegKey @@ -187,7 +187,7 @@ (headList {data} args))) (/\dead -> Bool_match - (case Bool (equalsInteger 2 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 2 index) True False) {all dead. DCert} (/\dead -> DCertDelegDelegate @@ -196,7 +196,11 @@ (unBData (headList {data} (tailList {data} args)))) (/\dead -> Bool_match - (case Bool (equalsInteger 3 index) [False, True]) + (ifThenElse + {Bool} + (equalsInteger 3 index) + True + False) {all dead. DCert} (/\dead -> DCertPoolRegister @@ -205,10 +209,11 @@ (headList {data} (tailList {data} args)))) (/\dead -> Bool_match - (case - Bool + (ifThenElse + {Bool} (equalsInteger 4 index) - [False, True]) + True + False) {all dead. DCert} (/\dead -> DCertPoolRetire @@ -219,18 +224,20 @@ (tailList {data} args)))) (/\dead -> Bool_match - (case - Bool + (ifThenElse + {Bool} (equalsInteger 5 index) - [False, True]) + True + False) {all dead. DCert} (/\dead -> DCertGenesis) (/\dead -> Bool_match - (case - Bool + (ifThenElse + {Bool} (equalsInteger 6 index) - [False, True]) + True + False) {all dead. DCert} (/\dead -> DCertMir) (/\dead -> traceError {DCert} "PT1") @@ -249,7 +256,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (case Bool (equalsInteger 0 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 0 index) True False) {all dead. bytestring} (/\dead -> unBData (headList {data} args)) (/\dead -> traceError {bytestring} "PT1") @@ -264,7 +271,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (case Bool (equalsInteger 0 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 0 index) True False) {all dead. TxOutRef} (/\dead -> TxOutRef @@ -287,12 +294,12 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (case Bool (equalsInteger 0 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 0 index) True False) {all dead. ScriptPurpose} (/\dead -> Minting (unBData (headList {data} args))) (/\dead -> Bool_match - (case Bool (equalsInteger 1 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 1 index) True False) {all dead. ScriptPurpose} (/\dead -> Spending @@ -300,7 +307,7 @@ (headList {data} args))) (/\dead -> Bool_match - (case Bool (equalsInteger 2 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 2 index) True False) {all dead. ScriptPurpose} (/\dead -> Rewarding @@ -308,7 +315,11 @@ (headList {data} args))) (/\dead -> Bool_match - (case Bool (equalsInteger 3 index) [False, True]) + (ifThenElse + {Bool} + (equalsInteger 3 index) + True + False) {all dead. ScriptPurpose} (/\dead -> Certifying @@ -329,12 +340,12 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (case Bool (equalsInteger 1 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 1 index) True False) {all dead. Maybe a} (/\dead -> Nothing {a}) (/\dead -> Bool_match - (case Bool (equalsInteger 0 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 0 index) True False) {all dead. Maybe a} (/\dead -> Just {a} (`$dUnsafeFromData` (headList {data} args))) @@ -394,7 +405,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (case Bool (equalsInteger 0 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 0 index) True False) {all dead. TxOut} (/\dead -> let @@ -409,7 +420,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (case Bool (equalsInteger 0 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 0 index) True False) {all dead. Address} (/\dead -> Address @@ -434,18 +445,22 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (case Bool (equalsInteger 0 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 0 index) True False) {all dead. OutputDatum} (/\dead -> NoOutputDatum) (/\dead -> Bool_match - (case Bool (equalsInteger 1 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 1 index) True False) {all dead. OutputDatum} (/\dead -> OutputDatumHash (unBData (headList {data} args))) (/\dead -> Bool_match - (case Bool (equalsInteger 2 index) [False, True]) + (ifThenElse + {Bool} + (equalsInteger 2 index) + True + False) {all dead. OutputDatum} (/\dead -> OutputDatum (headList {data} args)) (/\dead -> traceError {OutputDatum} "PT1") @@ -468,7 +483,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (case Bool (equalsInteger 0 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 0 index) True False) {all dead. TxInInfo} (/\dead -> TxInInfo @@ -514,7 +529,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (case Bool (equalsInteger 0 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 0 index) True False) {all dead. ScriptContext} (/\dead -> ScriptContext @@ -525,7 +540,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (case Bool (equalsInteger 0 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 0 index) True False) {all dead. TxInfo} (/\dead -> let @@ -642,7 +657,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (case Bool (equalsInteger 0 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 0 index) True False) {all dead. Interval integer} (/\dead -> Interval @@ -656,7 +671,11 @@ = sndPair {integer} {list data} tup in Bool_match - (case Bool (equalsInteger 0 index) [False, True]) + (ifThenElse + {Bool} + (equalsInteger 0 index) + True + False) {all dead. LowerBound integer} (/\dead -> LowerBound @@ -679,7 +698,11 @@ = sndPair {integer} {list data} tup in Bool_match - (case Bool (equalsInteger 0 index) [False, True]) + (ifThenElse + {Bool} + (equalsInteger 0 index) + True + False) {all dead. UpperBound integer} (/\dead -> UpperBound @@ -730,8 +753,8 @@ {Unit} (\(ipv : TxInfo) (ipv : ScriptPurpose) -> Bool_match - (case - Bool + (ifThenElse + {Bool} (equalsInteger 0 (modInteger @@ -770,7 +793,8 @@ in go eta) 2)) - [False, True]) + True + False) {all dead. Unit} (/\dead -> Unit) (/\dead -> diff --git a/plutus-benchmark/script-contexts/test/V2/9.6/checkScriptContext1.size.golden b/plutus-benchmark/script-contexts/test/V2/9.6/checkScriptContext1.size.golden index e4a36c3722d..62cab397cc0 100644 --- a/plutus-benchmark/script-contexts/test/V2/9.6/checkScriptContext1.size.golden +++ b/plutus-benchmark/script-contexts/test/V2/9.6/checkScriptContext1.size.golden @@ -1 +1 @@ -1539 \ No newline at end of file +1683 \ No newline at end of file diff --git a/plutus-benchmark/script-contexts/test/V2/9.6/checkScriptContext2-20.eval.golden b/plutus-benchmark/script-contexts/test/V2/9.6/checkScriptContext2-20.eval.golden index 7bcd640fef3..aea59aba152 100644 --- a/plutus-benchmark/script-contexts/test/V2/9.6/checkScriptContext2-20.eval.golden +++ b/plutus-benchmark/script-contexts/test/V2/9.6/checkScriptContext2-20.eval.golden @@ -1,5 +1,5 @@ -CPU: 259_980_355 -Memory: 981_634 -Size: 1_477 +CPU: 281_515_117 +Memory: 1_050_772 +Size: 1_617 (constr 0) \ No newline at end of file diff --git a/plutus-benchmark/script-contexts/test/V2/9.6/checkScriptContext2-4.eval.golden b/plutus-benchmark/script-contexts/test/V2/9.6/checkScriptContext2-4.eval.golden index f22a0cf6f98..d57fcacab65 100644 --- a/plutus-benchmark/script-contexts/test/V2/9.6/checkScriptContext2-4.eval.golden +++ b/plutus-benchmark/script-contexts/test/V2/9.6/checkScriptContext2-4.eval.golden @@ -1,5 +1,5 @@ -CPU: 73_049_971 -Memory: 280_738 -Size: 1_477 +CPU: 79_604_029 +Memory: 301_780 +Size: 1_617 (constr 0) \ No newline at end of file diff --git a/plutus-benchmark/script-contexts/test/V2/9.6/checkScriptContext2.pir.golden b/plutus-benchmark/script-contexts/test/V2/9.6/checkScriptContext2.pir.golden index e42cd7f5b64..ac8e034fbff 100644 --- a/plutus-benchmark/script-contexts/test/V2/9.6/checkScriptContext2.pir.golden +++ b/plutus-benchmark/script-contexts/test/V2/9.6/checkScriptContext2.pir.golden @@ -17,12 +17,12 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (case Bool (equalsInteger 0 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 0 index) True False) {all dead. Bool} (/\dead -> False) (/\dead -> Bool_match - (case Bool (equalsInteger 1 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 1 index) True False) {all dead. Bool} (/\dead -> True) (/\dead -> traceError {Bool} "PT1") @@ -42,18 +42,18 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (case Bool (equalsInteger 0 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 0 index) True False) {all dead. Extended a} (/\dead -> NegInf {a}) (/\dead -> Bool_match - (case Bool (equalsInteger 1 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 1 index) True False) {all dead. Extended a} (/\dead -> Finite {a} (`$dUnsafeFromData` (headList {data} args))) (/\dead -> Bool_match - (case Bool (equalsInteger 2 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 2 index) True False) {all dead. Extended a} (/\dead -> PosInf {a}) (/\dead -> traceError {Extended a} "PT1") @@ -71,12 +71,12 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (case Bool (equalsInteger 0 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 0 index) True False) {all dead. Credential} (/\dead -> PubKeyCredential (unBData (headList {data} args))) (/\dead -> Bool_match - (case Bool (equalsInteger 1 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 1 index) True False) {all dead. Credential} (/\dead -> ScriptCredential (unBData (headList {data} args))) (/\dead -> traceError {Credential} "PT1") @@ -94,7 +94,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (case Bool (equalsInteger 0 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 0 index) True False) {all dead. StakingCredential} (/\dead -> StakingHash @@ -102,7 +102,7 @@ (headList {data} args))) (/\dead -> Bool_match - (case Bool (equalsInteger 1 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 1 index) True False) {all dead. StakingCredential} (/\dead -> let @@ -132,7 +132,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (case Bool (equalsInteger 0 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 0 index) True False) {all dead. DCert} (/\dead -> DCertDelegRegKey @@ -140,7 +140,7 @@ (headList {data} args))) (/\dead -> Bool_match - (case Bool (equalsInteger 1 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 1 index) True False) {all dead. DCert} (/\dead -> DCertDelegDeRegKey @@ -148,7 +148,7 @@ (headList {data} args))) (/\dead -> Bool_match - (case Bool (equalsInteger 2 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 2 index) True False) {all dead. DCert} (/\dead -> DCertDelegDelegate @@ -157,7 +157,11 @@ (unBData (headList {data} (tailList {data} args)))) (/\dead -> Bool_match - (case Bool (equalsInteger 3 index) [False, True]) + (ifThenElse + {Bool} + (equalsInteger 3 index) + True + False) {all dead. DCert} (/\dead -> DCertPoolRegister @@ -166,10 +170,11 @@ (headList {data} (tailList {data} args)))) (/\dead -> Bool_match - (case - Bool + (ifThenElse + {Bool} (equalsInteger 4 index) - [False, True]) + True + False) {all dead. DCert} (/\dead -> DCertPoolRetire @@ -180,18 +185,20 @@ (tailList {data} args)))) (/\dead -> Bool_match - (case - Bool + (ifThenElse + {Bool} (equalsInteger 5 index) - [False, True]) + True + False) {all dead. DCert} (/\dead -> DCertGenesis) (/\dead -> Bool_match - (case - Bool + (ifThenElse + {Bool} (equalsInteger 6 index) - [False, True]) + True + False) {all dead. DCert} (/\dead -> DCertMir) (/\dead -> traceError {DCert} "PT1") @@ -210,7 +217,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (case Bool (equalsInteger 0 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 0 index) True False) {all dead. bytestring} (/\dead -> unBData (headList {data} args)) (/\dead -> traceError {bytestring} "PT1") @@ -225,7 +232,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (case Bool (equalsInteger 0 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 0 index) True False) {all dead. TxOutRef} (/\dead -> TxOutRef @@ -248,12 +255,12 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (case Bool (equalsInteger 0 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 0 index) True False) {all dead. ScriptPurpose} (/\dead -> Minting (unBData (headList {data} args))) (/\dead -> Bool_match - (case Bool (equalsInteger 1 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 1 index) True False) {all dead. ScriptPurpose} (/\dead -> Spending @@ -261,7 +268,7 @@ (headList {data} args))) (/\dead -> Bool_match - (case Bool (equalsInteger 2 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 2 index) True False) {all dead. ScriptPurpose} (/\dead -> Rewarding @@ -269,7 +276,11 @@ (headList {data} args))) (/\dead -> Bool_match - (case Bool (equalsInteger 3 index) [False, True]) + (ifThenElse + {Bool} + (equalsInteger 3 index) + True + False) {all dead. ScriptPurpose} (/\dead -> Certifying @@ -293,12 +304,12 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (case Bool (equalsInteger 1 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 1 index) True False) {all dead. Maybe a} (/\dead -> Nothing {a}) (/\dead -> Bool_match - (case Bool (equalsInteger 0 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 0 index) True False) {all dead. Maybe a} (/\dead -> Just {a} (`$dUnsafeFromData` (headList {data} args))) @@ -382,7 +393,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (case Bool (equalsInteger 0 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 0 index) True False) {all dead. TxOut} (/\dead -> let @@ -397,7 +408,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (case Bool (equalsInteger 0 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 0 index) True False) {all dead. Address} (/\dead -> Address @@ -422,18 +433,22 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (case Bool (equalsInteger 0 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 0 index) True False) {all dead. OutputDatum} (/\dead -> NoOutputDatum) (/\dead -> Bool_match - (case Bool (equalsInteger 1 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 1 index) True False) {all dead. OutputDatum} (/\dead -> OutputDatumHash (unBData (headList {data} args))) (/\dead -> Bool_match - (case Bool (equalsInteger 2 index) [False, True]) + (ifThenElse + {Bool} + (equalsInteger 2 index) + True + False) {all dead. OutputDatum} (/\dead -> OutputDatum (headList {data} args)) (/\dead -> traceError {OutputDatum} "PT1") @@ -456,7 +471,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (case Bool (equalsInteger 0 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 0 index) True False) {all dead. TxInInfo} (/\dead -> TxInInfo @@ -504,7 +519,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (case Bool (equalsInteger 0 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 0 index) True False) {all dead. ScriptContext} (/\dead -> ScriptContext @@ -515,7 +530,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (case Bool (equalsInteger 0 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 0 index) True False) {all dead. TxInfo} (/\dead -> let @@ -632,7 +647,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (case Bool (equalsInteger 0 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 0 index) True False) {all dead. Interval integer} (/\dead -> Interval @@ -646,7 +661,11 @@ = sndPair {integer} {list data} tup in Bool_match - (case Bool (equalsInteger 0 index) [False, True]) + (ifThenElse + {Bool} + (equalsInteger 0 index) + True + False) {all dead. LowerBound integer} (/\dead -> LowerBound @@ -671,7 +690,11 @@ = sndPair {integer} {list data} tup in Bool_match - (case Bool (equalsInteger 0 index) [False, True]) + (ifThenElse + {Bool} + (equalsInteger 0 index) + True + False) {all dead. UpperBound integer} (/\dead -> UpperBound diff --git a/plutus-benchmark/script-contexts/test/V2/9.6/checkScriptContext2.size.golden b/plutus-benchmark/script-contexts/test/V2/9.6/checkScriptContext2.size.golden index 3559f242bc4..f84ccb28c6b 100644 --- a/plutus-benchmark/script-contexts/test/V2/9.6/checkScriptContext2.size.golden +++ b/plutus-benchmark/script-contexts/test/V2/9.6/checkScriptContext2.size.golden @@ -1 +1 @@ -1477 \ No newline at end of file +1617 \ No newline at end of file diff --git a/plutus-benchmark/script-contexts/test/V2/9.6/checkScriptContextEqualityData-20.eval.golden b/plutus-benchmark/script-contexts/test/V2/9.6/checkScriptContextEqualityData-20.eval.golden index 991ec211150..99475b040ae 100644 --- a/plutus-benchmark/script-contexts/test/V2/9.6/checkScriptContextEqualityData-20.eval.golden +++ b/plutus-benchmark/script-contexts/test/V2/9.6/checkScriptContextEqualityData-20.eval.golden @@ -1,5 +1,5 @@ -CPU: 37_371_261 -Memory: 32_501 -Size: 334 +CPU: 37_527_310 +Memory: 33_002 +Size: 338 (constr 0) \ No newline at end of file diff --git a/plutus-benchmark/script-contexts/test/V2/9.6/dataFwdStakeTrick.eval.golden b/plutus-benchmark/script-contexts/test/V2/9.6/dataFwdStakeTrick.eval.golden index abe210745d5..80e6461cf0e 100644 --- a/plutus-benchmark/script-contexts/test/V2/9.6/dataFwdStakeTrick.eval.golden +++ b/plutus-benchmark/script-contexts/test/V2/9.6/dataFwdStakeTrick.eval.golden @@ -1,5 +1,5 @@ -CPU: 5_578_022 -Memory: 9_878 -Size: 158 +CPU: 5_890_120 +Memory: 10_880 +Size: 170 (constr 0) \ No newline at end of file diff --git a/plutus-benchmark/script-contexts/test/V2/9.6/dataFwdStakeTrick.pir.golden b/plutus-benchmark/script-contexts/test/V2/9.6/dataFwdStakeTrick.pir.golden index cf67ce98a2f..a88a404d5e2 100644 --- a/plutus-benchmark/script-contexts/test/V2/9.6/dataFwdStakeTrick.pir.golden +++ b/plutus-benchmark/script-contexts/test/V2/9.6/dataFwdStakeTrick.pir.golden @@ -38,12 +38,12 @@ in !wdrlAtOne : data = fstPair {data} {data} (headList {pair data data} rest) in Bool_match - (case Bool (equalsData obsScriptCred wdrlAtZero) [False, True]) + (ifThenElse {Bool} (equalsData obsScriptCred wdrlAtZero) True False) {all dead. Unit} (/\dead -> Unit) (/\dead -> Bool_match - (case Bool (equalsData obsScriptCred wdrlAtOne) [False, True]) + (ifThenElse {Bool} (equalsData obsScriptCred wdrlAtOne) True False) {all dead. Unit} (/\dead -> Unit) (/\dead -> @@ -71,10 +71,11 @@ in in go) (\(x : pair data data) -> - case - Bool + ifThenElse + {Bool} (equalsData obsScriptCred (fstPair {data} {data} x)) - [False, True]) + True + False) rest) {all dead. Unit} (/\dead -> Unit) diff --git a/plutus-benchmark/script-contexts/test/V2/9.6/dataFwdStakeTrick.uplc.golden b/plutus-benchmark/script-contexts/test/V2/9.6/dataFwdStakeTrick.uplc.golden index 340884f9e60..4d859a4c39c 100644 --- a/plutus-benchmark/script-contexts/test/V2/9.6/dataFwdStakeTrick.uplc.golden +++ b/plutus-benchmark/script-contexts/test/V2/9.6/dataFwdStakeTrick.uplc.golden @@ -1,59 +1,53 @@ (program 1.1.0 - (\obsScriptCred - ctx -> + (\obsScriptCred ctx -> (\ds -> (\wdrlAtZero -> (\rest -> (\wdrlAtOne -> force - (case + (force ifThenElse (equalsData obsScriptCred wdrlAtZero) - [ (delay - (force - (case - (equalsData obsScriptCred wdrlAtOne) - [ (delay - (force - (case - ((\s -> - s s) - (\s - xs -> - force - (force - (force chooseList) - xs - (delay (constr 1 [])) - (delay - (force - (case - (equalsData - obsScriptCred - (force - (force - fstPair) - (force - headList - xs))) - [ (delay - ((\x -> - s s x) - (force - tailList - xs))) - , (delay - (constr 0 - [ ])) ]))))) - rest) - [ (delay (constr 0 [])) - , (delay - ((\x -> error) - (force trace - "not found" - (constr 0 [])))) ]))) - , (delay (constr 0 [])) ]))) - , (delay (constr 0 [])) ])) + (delay (constr 0 [])) + (delay + (force + (force ifThenElse + (equalsData obsScriptCred wdrlAtOne) + (delay (constr 0 [])) + (delay + (force + (case + ((\s -> s s) + (\s xs -> + force + (force (force chooseList) + xs + (delay (constr 1 [])) + (delay + (force + (force ifThenElse + (equalsData + obsScriptCred + (force + (force + fstPair) + (force + headList + xs))) + (delay + (constr 0 [])) + (delay + ((\x -> s s x) + (force + tailList + xs)))))))) + rest) + [ (delay (constr 0 [])) + , (delay + ((\x -> error) + (force trace + "not found" + (constr 0 [])))) ])))))))) (force (force fstPair) (force headList rest))) (force tailList ds)) (force (force fstPair) (force headList ds))) diff --git a/plutus-benchmark/script-contexts/test/V2/9.6/dataFwdStakeTrickManual.eval.golden b/plutus-benchmark/script-contexts/test/V2/9.6/dataFwdStakeTrickManual.eval.golden index e7ec88a5471..82644c559cf 100644 --- a/plutus-benchmark/script-contexts/test/V2/9.6/dataFwdStakeTrickManual.eval.golden +++ b/plutus-benchmark/script-contexts/test/V2/9.6/dataFwdStakeTrickManual.eval.golden @@ -1,5 +1,5 @@ -CPU: 5_770_022 -Memory: 11_078 -Size: 174 +CPU: 6_082_120 +Memory: 12_080 +Size: 186 (constr 0) \ No newline at end of file diff --git a/plutus-benchmark/script-contexts/test/V2/9.6/dataFwdStakeTrickManual.pir.golden b/plutus-benchmark/script-contexts/test/V2/9.6/dataFwdStakeTrickManual.pir.golden index dda85fd0708..0c0bb1acee3 100644 --- a/plutus-benchmark/script-contexts/test/V2/9.6/dataFwdStakeTrickManual.pir.golden +++ b/plutus-benchmark/script-contexts/test/V2/9.6/dataFwdStakeTrickManual.pir.golden @@ -10,10 +10,11 @@ in !lookForCred : pair data data -> list (pair data data) -> Unit = \(p : pair data data) (tl : list (pair data data)) -> Bool_match - (case - Bool + (ifThenElse + {Bool} (equalsData r_stake_cred (fstPair {data} {data} p)) - [False, True]) + True + False) {all dead. Unit} (/\dead -> Unit) (/\dead -> lookForCred tl) @@ -81,12 +82,12 @@ in !wdrlAtOne : data = fstPair {data} {data} (headList {pair data data} rest) in Bool_match - (case Bool (equalsData r_stake_cred wdrlAtZero) [False, True]) + (ifThenElse {Bool} (equalsData r_stake_cred wdrlAtZero) True False) {all dead. Unit} (/\dead -> Unit) (/\dead -> Bool_match - (case Bool (equalsData r_stake_cred wdrlAtOne) [False, True]) + (ifThenElse {Bool} (equalsData r_stake_cred wdrlAtOne) True False) {all dead. Unit} (/\dead -> Unit) (/\dead -> lookForCred rest) diff --git a/plutus-benchmark/script-contexts/test/V2/9.6/dataFwdStakeTrickManual.uplc.golden b/plutus-benchmark/script-contexts/test/V2/9.6/dataFwdStakeTrickManual.uplc.golden index 0e6d6c28ad4..ab723fb2178 100644 --- a/plutus-benchmark/script-contexts/test/V2/9.6/dataFwdStakeTrickManual.uplc.golden +++ b/plutus-benchmark/script-contexts/test/V2/9.6/dataFwdStakeTrickManual.uplc.golden @@ -10,17 +10,16 @@ (\rest -> (\wdrlAtOne -> force - (case + (force ifThenElse (equalsData r_stake_cred wdrlAtZero) - [ (delay - (force - (case - (equalsData - r_stake_cred - wdrlAtOne) - [ (delay (force lookForCred rest)) - , (delay (constr 0 [])) ]))) - , (delay (constr 0 [])) ])) + (delay (constr 0 [])) + (delay + (force + (force ifThenElse + (equalsData r_stake_cred wdrlAtOne) + (delay (constr 0 [])) + (delay + (force lookForCred rest))))))) (force (force fstPair) (force headList rest))) (force tailList wdrl)) (force (force fstPair) (force headList wdrl))) @@ -73,10 +72,11 @@ (constr 0 []))) (\p tl -> force - (case + (force ifThenElse (equalsData r_stake_cred (force (force fstPair) p)) - [ (delay - (force (lookForCred (delay (\x -> x))) tl)) - , (delay (constr 0 [])) ])))))))) \ No newline at end of file + (delay (constr 0 [])) + (delay + (force (lookForCred (delay (\x -> x))) + tl)))))))))) \ No newline at end of file diff --git a/plutus-benchmark/script-contexts/test/V2/9.6/sopFwdStakeTrick.eval.golden b/plutus-benchmark/script-contexts/test/V2/9.6/sopFwdStakeTrick.eval.golden index 17ad564e739..12547e58d09 100644 --- a/plutus-benchmark/script-contexts/test/V2/9.6/sopFwdStakeTrick.eval.golden +++ b/plutus-benchmark/script-contexts/test/V2/9.6/sopFwdStakeTrick.eval.golden @@ -1,5 +1,5 @@ -CPU: 335_371_977 -Memory: 1_258_948 -Size: 1_699 +CPU: 364_372_993 +Memory: 1_352_932 +Size: 1_861 (constr 0) \ No newline at end of file diff --git a/plutus-benchmark/script-contexts/test/V2/9.6/sopFwdStakeTrick.pir.golden b/plutus-benchmark/script-contexts/test/V2/9.6/sopFwdStakeTrick.pir.golden index b60f09d175c..df9b41312e9 100644 --- a/plutus-benchmark/script-contexts/test/V2/9.6/sopFwdStakeTrick.pir.golden +++ b/plutus-benchmark/script-contexts/test/V2/9.6/sopFwdStakeTrick.pir.golden @@ -2,6 +2,9 @@ let data Bool | Bool_match where True : Bool False : Bool + !equalsByteString : bytestring -> bytestring -> Bool + = \(x : bytestring) (y : bytestring) -> + ifThenElse {Bool} (equalsByteString x y) True False data Credential | Credential_match where PubKeyCredential : bytestring -> Credential ScriptCredential : bytestring -> Credential @@ -25,16 +28,14 @@ let Credential_match r {Bool} - (\(r : bytestring) -> - case Bool (equalsByteString l r) [False, True]) + (\(r : bytestring) -> equalsByteString l r) (\(ipv : bytestring) -> False)) (\(a : bytestring) -> Credential_match r {Bool} (\(ipv : bytestring) -> False) - (\(a' : bytestring) -> - case Bool (equalsByteString a a') [False, True]))) + (\(a' : bytestring) -> equalsByteString a a'))) (\(ipv : integer) (ipv : integer) (ipv : integer) -> False)) (\(a : integer) (b : integer) (c : integer) -> StakingCredential_match @@ -43,14 +44,14 @@ let (\(ipv : Credential) -> False) (\(a' : integer) (b' : integer) (c' : integer) -> Bool_match - (case Bool (equalsInteger a a') [False, True]) + (ifThenElse {Bool} (equalsInteger a a') True False) {all dead. Bool} (/\dead -> Bool_match - (case Bool (equalsInteger b b') [False, True]) + (ifThenElse {Bool} (equalsInteger b b') True False) {all dead. Bool} (/\dead -> - case Bool (equalsInteger c c') [False, True]) + ifThenElse {Bool} (equalsInteger c c') True False) (/\dead -> False) {all dead. dead}) (/\dead -> False) @@ -70,12 +71,12 @@ let !args : list data = sndPair {integer} {list data} tup in Bool_match - (case Bool (equalsInteger 0 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 0 index) True False) {all dead. Bool} (/\dead -> False) (/\dead -> Bool_match - (case Bool (equalsInteger 1 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 1 index) True False) {all dead. Bool} (/\dead -> True) (/\dead -> traceError {Bool} "PT1") @@ -95,18 +96,18 @@ let !args : list data = sndPair {integer} {list data} tup in Bool_match - (case Bool (equalsInteger 0 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 0 index) True False) {all dead. Extended a} (/\dead -> NegInf {a}) (/\dead -> Bool_match - (case Bool (equalsInteger 1 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 1 index) True False) {all dead. Extended a} (/\dead -> Finite {a} (`$dUnsafeFromData` (headList {data} args))) (/\dead -> Bool_match - (case Bool (equalsInteger 2 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 2 index) True False) {all dead. Extended a} (/\dead -> PosInf {a}) (/\dead -> traceError {Extended a} "PT1") @@ -121,12 +122,12 @@ let !args : list data = sndPair {integer} {list data} tup in Bool_match - (case Bool (equalsInteger 0 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 0 index) True False) {all dead. Credential} (/\dead -> PubKeyCredential (unBData (headList {data} args))) (/\dead -> Bool_match - (case Bool (equalsInteger 1 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 1 index) True False) {all dead. Credential} (/\dead -> ScriptCredential (unBData (headList {data} args))) (/\dead -> traceError {Credential} "PT1") @@ -141,7 +142,7 @@ let !args : list data = sndPair {integer} {list data} tup in Bool_match - (case Bool (equalsInteger 0 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 0 index) True False) {all dead. StakingCredential} (/\dead -> StakingHash @@ -149,7 +150,7 @@ let (headList {data} args))) (/\dead -> Bool_match - (case Bool (equalsInteger 1 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 1 index) True False) {all dead. StakingCredential} (/\dead -> let @@ -179,7 +180,7 @@ let !args : list data = sndPair {integer} {list data} tup in Bool_match - (case Bool (equalsInteger 0 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 0 index) True False) {all dead. DCert} (/\dead -> DCertDelegRegKey @@ -187,7 +188,7 @@ let (headList {data} args))) (/\dead -> Bool_match - (case Bool (equalsInteger 1 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 1 index) True False) {all dead. DCert} (/\dead -> DCertDelegDeRegKey @@ -195,7 +196,7 @@ let (headList {data} args))) (/\dead -> Bool_match - (case Bool (equalsInteger 2 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 2 index) True False) {all dead. DCert} (/\dead -> DCertDelegDelegate @@ -204,7 +205,7 @@ let (unBData (headList {data} (tailList {data} args)))) (/\dead -> Bool_match - (case Bool (equalsInteger 3 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 3 index) True False) {all dead. DCert} (/\dead -> DCertPoolRegister @@ -213,7 +214,11 @@ let (headList {data} (tailList {data} args)))) (/\dead -> Bool_match - (case Bool (equalsInteger 4 index) [False, True]) + (ifThenElse + {Bool} + (equalsInteger 4 index) + True + False) {all dead. DCert} (/\dead -> DCertPoolRetire @@ -222,18 +227,20 @@ let (headList {data} (tailList {data} args)))) (/\dead -> Bool_match - (case - Bool + (ifThenElse + {Bool} (equalsInteger 5 index) - [False, True]) + True + False) {all dead. DCert} (/\dead -> DCertGenesis) (/\dead -> Bool_match - (case - Bool + (ifThenElse + {Bool} (equalsInteger 6 index) - [False, True]) + True + False) {all dead. DCert} (/\dead -> DCertMir) (/\dead -> traceError {DCert} "PT1") @@ -252,7 +259,7 @@ let !args : list data = sndPair {integer} {list data} tup in Bool_match - (case Bool (equalsInteger 0 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 0 index) True False) {all dead. bytestring} (/\dead -> unBData (headList {data} args)) (/\dead -> traceError {bytestring} "PT1") @@ -267,7 +274,7 @@ let !args : list data = sndPair {integer} {list data} tup in Bool_match - (case Bool (equalsInteger 0 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 0 index) True False) {all dead. TxOutRef} (/\dead -> TxOutRef @@ -290,12 +297,12 @@ let !args : list data = sndPair {integer} {list data} tup in Bool_match - (case Bool (equalsInteger 0 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 0 index) True False) {all dead. ScriptPurpose} (/\dead -> Minting (unBData (headList {data} args))) (/\dead -> Bool_match - (case Bool (equalsInteger 1 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 1 index) True False) {all dead. ScriptPurpose} (/\dead -> Spending @@ -303,7 +310,7 @@ let (headList {data} args))) (/\dead -> Bool_match - (case Bool (equalsInteger 2 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 2 index) True False) {all dead. ScriptPurpose} (/\dead -> Rewarding @@ -311,7 +318,7 @@ let (headList {data} args))) (/\dead -> Bool_match - (case Bool (equalsInteger 3 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 3 index) True False) {all dead. ScriptPurpose} (/\dead -> Certifying @@ -335,12 +342,12 @@ let !args : list data = sndPair {integer} {list data} tup in Bool_match - (case Bool (equalsInteger 1 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 1 index) True False) {all dead. Maybe a} (/\dead -> Nothing {a}) (/\dead -> Bool_match - (case Bool (equalsInteger 0 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 0 index) True False) {all dead. Maybe a} (/\dead -> Just {a} (`$dUnsafeFromData` (headList {data} args))) @@ -424,7 +431,7 @@ let !args : list data = sndPair {integer} {list data} tup in Bool_match - (case Bool (equalsInteger 0 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 0 index) True False) {all dead. TxOut} (/\dead -> let @@ -439,7 +446,7 @@ let !args : list data = sndPair {integer} {list data} tup in Bool_match - (case Bool (equalsInteger 0 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 0 index) True False) {all dead. Address} (/\dead -> Address @@ -464,18 +471,22 @@ let !args : list data = sndPair {integer} {list data} tup in Bool_match - (case Bool (equalsInteger 0 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 0 index) True False) {all dead. OutputDatum} (/\dead -> NoOutputDatum) (/\dead -> Bool_match - (case Bool (equalsInteger 1 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 1 index) True False) {all dead. OutputDatum} (/\dead -> OutputDatumHash (unBData (headList {data} args))) (/\dead -> Bool_match - (case Bool (equalsInteger 2 index) [False, True]) + (ifThenElse + {Bool} + (equalsInteger 2 index) + True + False) {all dead. OutputDatum} (/\dead -> OutputDatum (headList {data} args)) (/\dead -> traceError {OutputDatum} "PT1") @@ -498,7 +509,7 @@ let !args : list data = sndPair {integer} {list data} tup in Bool_match - (case Bool (equalsInteger 0 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 0 index) True False) {all dead. TxInInfo} (/\dead -> TxInInfo @@ -545,7 +556,7 @@ in !args : list data = sndPair {integer} {list data} tup in Bool_match - (case Bool (equalsInteger 0 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 0 index) True False) {all dead. ScriptContext} (/\dead -> ScriptContext @@ -556,7 +567,7 @@ in !args : list data = sndPair {integer} {list data} tup in Bool_match - (case Bool (equalsInteger 0 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 0 index) True False) {all dead. TxInfo} (/\dead -> let @@ -669,7 +680,7 @@ in !args : list data = sndPair {integer} {list data} tup in Bool_match - (case Bool (equalsInteger 0 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 0 index) True False) {all dead. Interval integer} (/\dead -> Interval @@ -681,7 +692,11 @@ in !args : list data = sndPair {integer} {list data} tup in Bool_match - (case Bool (equalsInteger 0 index) [False, True]) + (ifThenElse + {Bool} + (equalsInteger 0 index) + True + False) {all dead. LowerBound integer} (/\dead -> LowerBound @@ -702,7 +717,11 @@ in !args : list data = sndPair {integer} {list data} tup in Bool_match - (case Bool (equalsInteger 0 index) [False, True]) + (ifThenElse + {Bool} + (equalsInteger 0 index) + True + False) {all dead. UpperBound integer} (/\dead -> UpperBound diff --git a/plutus-benchmark/script-contexts/test/V2/9.6/sopFwdStakeTrick.uplc.golden b/plutus-benchmark/script-contexts/test/V2/9.6/sopFwdStakeTrick.uplc.golden index 785f1b1ae4f..f963b2db107 100644 --- a/plutus-benchmark/script-contexts/test/V2/9.6/sopFwdStakeTrick.uplc.golden +++ b/plutus-benchmark/script-contexts/test/V2/9.6/sopFwdStakeTrick.uplc.golden @@ -20,546 +20,557 @@ (\index -> (\args -> force - (case + (force + ifThenElse (equalsInteger 0 index) - [ (delay - (traceError - "PT1")) - , (delay - (constr 0 - [ ((\tup -> - (\index -> - (\args -> - force - (case - (equalsInteger - 0 - index) - [ (delay - (traceError - "PT1")) - , (delay - ((\l -> - (\l -> - (\l -> - (\l -> - (\l -> - (\l -> - (\l -> - (\l -> - (\l -> - (\l -> - (\`$fUnsafeFromDataMap_$cunsafeFromBuiltinData` -> - (\cse -> - (\cse -> - (\`$fUnsafeFromDataTxOut_$cunsafeFromBuiltinData` -> - (\`$fUnsafeFromDataScriptContext_$cunsafeFromBuiltinData` -> - (\arg_0 - arg_1 - arg_2 - arg_3 - arg_4 - arg_5 - arg_6 - arg_7 - arg_8 - arg_9 - arg_10 - arg_11 -> - constr 0 - [ arg_0 - , arg_1 - , arg_2 - , arg_3 - , arg_4 - , arg_5 - , arg_6 - , arg_7 - , arg_8 - , arg_9 - , arg_10 - , arg_11 ]) - ((\d -> - (\s -> - s - s) - (\s -> - caseList' - (constr 0 - [ ]) - (\x - xs -> - constr 1 - [ (`$fUnsafeFromDataScriptContext_$cunsafeFromBuiltinData` - x) - , (s - s - xs) ])) - (unListData - d)) - (force - headList - args)) - ((\d -> - (\s -> - s - s) - (\s -> - caseList' - (constr 0 - [ ]) - (\x - xs -> - constr 1 - [ (`$fUnsafeFromDataScriptContext_$cunsafeFromBuiltinData` - x) - , (s - s - xs) ])) - (unListData - d)) - (force - headList - l))) - (\d -> - (\tup -> - (\index -> - (\args -> - force - (case - (equalsInteger - 0 - index) - [ (delay - (traceError - "PT1")) - , (delay - (constr 0 - [ (`$fUnsafeFromDataTxOutRef_$cunsafeFromBuiltinData` - (force - headList - args)) - , (`$fUnsafeFromDataTxOut_$cunsafeFromBuiltinData` - (force - headList - (force - tailList - args))) ])) ])) - (force - (force - sndPair) - tup)) - (force - (force - fstPair) - tup)) - (unConstrData + (delay + (constr 0 + [ ((\tup -> + (\index -> + (\args -> + force + (force + ifThenElse + (equalsInteger + 0 + index) + (delay + ((\l -> + (\l -> + (\l -> + (\l -> + (\l -> + (\l -> + (\l -> + (\l -> + (\l -> + (\l -> + (\`$fUnsafeFromDataMap_$cunsafeFromBuiltinData` -> + (\cse -> + (\cse -> + (\`$fUnsafeFromDataTxOut_$cunsafeFromBuiltinData` -> + (\`$fUnsafeFromDataScriptContext_$cunsafeFromBuiltinData` -> + (\arg_0 + arg_1 + arg_2 + arg_3 + arg_4 + arg_5 + arg_6 + arg_7 + arg_8 + arg_9 + arg_10 + arg_11 -> + constr 0 + [ arg_0 + , arg_1 + , arg_2 + , arg_3 + , arg_4 + , arg_5 + , arg_6 + , arg_7 + , arg_8 + , arg_9 + , arg_10 + , arg_11 ]) + ((\d -> + (\s -> + s + s) + (\s -> + caseList' + (constr 0 + [ ]) + (\x + xs -> + constr 1 + [ (`$fUnsafeFromDataScriptContext_$cunsafeFromBuiltinData` + x) + , (s + s + xs) ])) + (unListData d)) - ((\d -> - (\s -> - s - s) - (\s -> - caseList' - (constr 0 - [ ]) - (\x - xs -> - constr 1 - [ (`$fUnsafeFromDataTxOut_$cunsafeFromBuiltinData` - x) - , (s - s - xs) ])) - (unListData - d)) - (force - headList - l))) - (\eta -> - (\tup -> - (\index -> - (\args -> - force - (case - (equalsInteger - 0 - index) - [ (delay - (traceError - "PT1")) - , (delay - ((\l -> - (\l -> - constr 0 - [ ((\tup -> - (\index -> - (\args -> - force - (case - (equalsInteger - 0 - index) - [ (delay - (traceError - "PT1")) - , (delay - (constr 0 - [ (`$fUnsafeFromDataCredential_$cunsafeFromBuiltinData` - (force - headList - args)) - , (`$fUnsafeFromDataMaybe_$cunsafeFromBuiltinData` - `$fUnsafeFromDataStakingCredential_$cunsafeFromBuiltinData` - (force - headList - (force - tailList - args))) ])) ])) - (force - (force - sndPair) - tup)) - (force - (force - fstPair) - tup)) - (unConstrData - (force - headList - args))) - , (cse - (force - headList - l)) - , ((\tup -> - (\index -> - (\args -> - force - (case - (equalsInteger - 0 - index) - [ (delay - (force - (case - (equalsInteger - 1 - index) - [ (delay - (force - (case - (equalsInteger - 2 - index) - [ (delay - (traceError - "PT1")) - , (delay - (constr 1 - [ (force - headList - args) ])) ]))) - , (delay - (constr 2 - [ (unBData - (force - headList - args)) ])) ]))) - , (delay - (constr 0 - [ ])) ])) - (force - (force - sndPair) - tup)) - (force - (force - fstPair) - tup)) - (unConstrData - (force - headList - l))) - , (`$fUnsafeFromDataMaybe_$cunsafeFromBuiltinData` - unBData - (force - headList - (force - tailList - l))) ]) - (force - tailList - l)) - (force - tailList - args))) ])) - (force - (force - sndPair) - tup)) - (force - (force - fstPair) - tup)) - (unConstrData - eta)) - (cse - (force - headList - l)) - (cse - (force - headList - l)) - ((\d -> - (\s -> - s - s) + (force + headList + args)) + ((\d -> (\s -> - caseList' - (constr 0 - [ ]) - (\x - xs -> - constr 1 - [ (`$fUnsafeFromDataDCert_$cunsafeFromBuiltinData` - x) - , (s - s - xs) ])) - (unListData - d)) - (force - headList - l)) - (`$fUnsafeFromDataMap_$cunsafeFromBuiltinData` - `$fUnsafeFromDataStakingCredential_$cunsafeFromBuiltinData` - unIData - (force - headList - l)) - ((\tup -> - (\index -> - (\args -> - force - (case - (equalsInteger - 0 - index) - [ (delay - (traceError - "PT1")) - , (delay - (constr 0 - [ ((\tup -> - (\index -> - (\args -> - force - (case - (equalsInteger - 0 - index) - [ (delay - (traceError - "PT1")) - , (delay + s + s) + (\s -> + caseList' + (constr 0 + [ ]) + (\x + xs -> + constr 1 + [ (`$fUnsafeFromDataScriptContext_$cunsafeFromBuiltinData` + x) + , (s + s + xs) ])) + (unListData + d)) + (force + headList + l))) + (\d -> + (\tup -> + (\index -> + (\args -> + force + (force + ifThenElse + (equalsInteger + 0 + index) + (delay + (constr 0 + [ (`$fUnsafeFromDataTxOutRef_$cunsafeFromBuiltinData` + (force + headList + args)) + , (`$fUnsafeFromDataTxOut_$cunsafeFromBuiltinData` + (force + headList + (force + tailList + args))) ])) + (delay + (traceError + "PT1")))) + (force + (force + sndPair) + tup)) + (force + (force + fstPair) + tup)) + (unConstrData + d)) + ((\d -> + (\s -> + s + s) + (\s -> + caseList' + (constr 0 + [ ]) + (\x + xs -> + constr 1 + [ (`$fUnsafeFromDataTxOut_$cunsafeFromBuiltinData` + x) + , (s + s + xs) ])) + (unListData + d)) + (force + headList + l))) + (\eta -> + (\tup -> + (\index -> + (\args -> + force + (force + ifThenElse + (equalsInteger + 0 + index) + (delay + ((\l -> + (\l -> + constr 0 + [ ((\tup -> + (\index -> + (\args -> + force + (force + ifThenElse + (equalsInteger + 0 + index) + (delay (constr 0 - [ (`$fUnsafeFromDataExtended_$cunsafeFromBuiltinData` - unIData + [ (`$fUnsafeFromDataCredential_$cunsafeFromBuiltinData` (force headList args)) - , (`$fUnsafeFromDataBool_$cunsafeFromBuiltinData` + , (`$fUnsafeFromDataMaybe_$cunsafeFromBuiltinData` + `$fUnsafeFromDataStakingCredential_$cunsafeFromBuiltinData` (force headList (force tailList - args))) ])) ])) - (force - (force - sndPair) - tup)) - (force - (force - fstPair) - tup)) - (unConstrData - (force - headList - args))) - , ((\tup -> - (\index -> - (\args -> - force - (case - (equalsInteger - 0 - index) - [ (delay + args))) ])) + (delay (traceError - "PT1")) - , (delay + "PT1")))) + (force + (force + sndPair) + tup)) + (force + (force + fstPair) + tup)) + (unConstrData + (force + headList + args))) + , (cse + (force + headList + l)) + , ((\tup -> + (\index -> + (\args -> + force + (force + ifThenElse + (equalsInteger + 0 + index) + (delay (constr 0 - [ (`$fUnsafeFromDataExtended_$cunsafeFromBuiltinData` - unIData - (force - headList - args)) - , (`$fUnsafeFromDataBool_$cunsafeFromBuiltinData` - (force - headList - (force - tailList - args))) ])) ])) - (force - (force - sndPair) - tup)) + [ ])) + (delay + (force + (force + ifThenElse + (equalsInteger + 1 + index) + (delay + (constr 2 + [ (unBData + (force + headList + args)) ])) + (delay + (force + (force + ifThenElse + (equalsInteger + 2 + index) + (delay + (constr 1 + [ (force + headList + args) ])) + (delay + (traceError + "PT1")))))))))) + (force + (force + sndPair) + tup)) + (force + (force + fstPair) + tup)) + (unConstrData + (force + headList + l))) + , (`$fUnsafeFromDataMaybe_$cunsafeFromBuiltinData` + unBData + (force + headList + (force + tailList + l))) ]) + (force + tailList + l)) + (force + tailList + args))) + (delay + (traceError + "PT1")))) + (force + (force + sndPair) + tup)) + (force + (force + fstPair) + tup)) + (unConstrData + eta)) + (cse + (force + headList + l)) + (cse + (force + headList + l)) + ((\d -> + (\s -> + s + s) + (\s -> + caseList' + (constr 0 + [ ]) + (\x + xs -> + constr 1 + [ (`$fUnsafeFromDataDCert_$cunsafeFromBuiltinData` + x) + , (s + s + xs) ])) + (unListData + d)) + (force + headList + l)) + (`$fUnsafeFromDataMap_$cunsafeFromBuiltinData` + `$fUnsafeFromDataStakingCredential_$cunsafeFromBuiltinData` + unIData + (force + headList + l)) + ((\tup -> + (\index -> + (\args -> + force + (force + ifThenElse + (equalsInteger + 0 + index) + (delay + (constr 0 + [ ((\tup -> + (\index -> + (\args -> + force (force - (force - fstPair) - tup)) - (unConstrData + ifThenElse + (equalsInteger + 0 + index) + (delay + (constr 0 + [ (`$fUnsafeFromDataExtended_$cunsafeFromBuiltinData` + unIData + (force + headList + args)) + , (`$fUnsafeFromDataBool_$cunsafeFromBuiltinData` + (force + headList + (force + tailList + args))) ])) + (delay + (traceError + "PT1")))) + (force + (force + sndPair) + tup)) + (force + (force + fstPair) + tup)) + (unConstrData + (force + headList + args))) + , ((\tup -> + (\index -> + (\args -> + force (force - headList - (force - tailList - args)))) ])) ])) - (force + ifThenElse + (equalsInteger + 0 + index) + (delay + (constr 0 + [ (`$fUnsafeFromDataExtended_$cunsafeFromBuiltinData` + unIData + (force + headList + args)) + , (`$fUnsafeFromDataBool_$cunsafeFromBuiltinData` + (force + headList + (force + tailList + args))) ])) + (delay + (traceError + "PT1")))) + (force + (force + sndPair) + tup)) + (force + (force + fstPair) + tup)) + (unConstrData + (force + headList + (force + tailList + args)))) ])) + (delay + (traceError + "PT1")))) + (force + (force + sndPair) + tup)) + (force + (force + fstPair) + tup)) + (unConstrData + (force + headList + l))) + ((\d -> + (\s -> + s + s) + (\s -> + caseList' + (constr 0 + [ ]) + (\x + xs -> + constr 1 + [ (unBData + x) + , (s + s + xs) ])) + (unListData + d)) + (force + headList + l)) + (`$fUnsafeFromDataMap_$cunsafeFromBuiltinData` + `$fUnsafeFromDataScriptContext_$cunsafeFromBuiltinData` + `$fUnsafeFromDataBuiltinData_$cunsafeFromBuiltinData` + (force + headList + l)) + (cse + `$fUnsafeFromDataBuiltinData_$cunsafeFromBuiltinData` + (force + headList + l))) + (cse + (cse + unIData))) + (`$fUnsafeFromDataMap_$cunsafeFromBuiltinData` + unBData)) + (\`$dUnsafeFromData` + `$dUnsafeFromData` + d -> + (\s -> + s + s) + (\s -> + caseList' + (constr 0 + [ ]) + (\tup + tups -> + constr 1 + [ (constr 0 + [ (`$dUnsafeFromData` (force - sndPair) - tup)) - (force - (force - fstPair) - tup)) - (unConstrData - (force - headList - l))) - ((\d -> - (\s -> + (force + fstPair) + tup)) + , (`$dUnsafeFromData` + (force + (force + sndPair) + tup)) ]) + , (s s - s) - (\s -> - caseList' - (constr 0 - [ ]) - (\x - xs -> - constr 1 - [ (unBData - x) - , (s - s - xs) ])) - (unListData - d)) - (force - headList - l)) - (`$fUnsafeFromDataMap_$cunsafeFromBuiltinData` - `$fUnsafeFromDataScriptContext_$cunsafeFromBuiltinData` - `$fUnsafeFromDataBuiltinData_$cunsafeFromBuiltinData` - (force - headList - l)) - (cse - `$fUnsafeFromDataBuiltinData_$cunsafeFromBuiltinData` - (force - headList - l))) - (cse - (cse - unIData))) - (`$fUnsafeFromDataMap_$cunsafeFromBuiltinData` - unBData)) - (\`$dUnsafeFromData` - `$dUnsafeFromData` - d -> - (\s -> - s - s) - (\s -> - caseList' - (constr 0 - [ ]) - (\tup - tups -> - constr 1 - [ (constr 0 - [ (`$dUnsafeFromData` - (force - (force - fstPair) - tup)) - , (`$dUnsafeFromData` - (force - (force - sndPair) - tup)) ]) - , (s - s - tups) ])) - (unMapData - d)) - (`$fUnsafeFromDataTxId_$cunsafeFromBuiltinData` - (force - headList - (force - tailList - l)))) - (force - tailList - l)) - (force - tailList - l)) - (force - tailList - l)) - (force - tailList - l)) - (force - tailList - l)) - (force - tailList - l)) - (force - tailList - l)) - (force - tailList - l)) - (force - tailList - l)) - (force - tailList - args))) ])) - (force - (force - sndPair) - tup)) - (force - (force - fstPair) - tup)) - (unConstrData - (force - headList - args))) - , (`$fUnsafeFromDataScriptContext_$cunsafeFromBuiltinData` - (force - headList - (force - tailList - args))) ])) ])) + tups) ])) + (unMapData + d)) + (`$fUnsafeFromDataTxId_$cunsafeFromBuiltinData` + (force + headList + (force + tailList + l)))) + (force + tailList + l)) + (force + tailList + l)) + (force + tailList + l)) + (force + tailList + l)) + (force + tailList + l)) + (force + tailList + l)) + (force + tailList + l)) + (force + tailList + l)) + (force + tailList + l)) + (force + tailList + args))) + (delay + (traceError + "PT1")))) + (force + (force + sndPair) + tup)) + (force + (force + fstPair) + tup)) + (unConstrData + (force + headList + args))) + , (`$fUnsafeFromDataScriptContext_$cunsafeFromBuiltinData` + (force + headList + (force + tailList + args))) ])) + (delay + (traceError + "PT1")))) (force (force sndPair) tup)) (force (force fstPair) tup)) @@ -722,38 +733,39 @@ case ds [ (\r -> - case - l - [ (\l -> - case - r - [ (\r -> - case - (equalsByteString + (\equalsByteString -> + case + l + [ (\l -> + case + r + [ (\r -> + equalsByteString l r) - [ (constr 1 - [ ]) - , (constr 0 - [ ]) ]) - , (\ipv -> - constr 1 - [ ]) ]) - , (\a -> - case - r - [ (\ipv -> - constr 1 - []) - , (\a' -> - case - (equalsByteString + , (\ipv -> + constr 1 + [ ]) ]) + , (\a -> + case + r + [ (\ipv -> + constr 1 + [ ]) + , (\a' -> + equalsByteString a - a') - [ (constr 1 - [ ]) - , (constr 0 - [ ]) ]) ]) ]) + a') ]) ]) + (\x + y -> + force + ifThenElse + (equalsByteString + x + y) + (constr 0 []) + (constr 1 + []))) , (\ipv ipv ipv -> constr 1 []) ]) , (\a @@ -766,52 +778,54 @@ b' c' -> force - (case + (force + ifThenElse (equalsInteger a a') - [ (delay - (constr 1 - [])) - , (delay - (force - (case - (equalsInteger - b - b') - [ (delay - (constr 1 - [ ])) - , (delay - (case - (equalsInteger - c - c') - [ (constr 1 - [ ]) - , (constr 0 - [ ]) ])) ]))) ])) ]) ])) + (delay + (force + (force + ifThenElse + (equalsInteger + b + b') + (delay + (force + ifThenElse + (equalsInteger + c + c') + (constr 0 + [ ]) + (constr 1 + [ ]))) + (delay + (constr 1 + [ ]))))) + (delay + (constr 1 + [ ])))) ]) ])) (\d -> d)) (\d -> (\tup -> (\index -> (\args -> force - (case + (force ifThenElse (equalsInteger 0 index) - [ (delay - (force - (case - (equalsInteger - 1 - index) - [ (delay - (traceError - "PT1")) - , (delay - (constr 0 - [ ])) ]))) - , (delay (constr 1 [])) ])) + (delay (constr 1 [])) + (delay + (force + (force ifThenElse + (equalsInteger + 1 + index) + (delay + (constr 0 [])) + (delay + (traceError + "PT1"))))))) (force (force sndPair) tup)) (force (force fstPair) tup)) (unConstrData d))) @@ -821,33 +835,36 @@ (\index -> (\args -> force - (case + (force + ifThenElse (equalsInteger 0 index) - [ (delay - (force - (case - (equalsInteger - 1 - index) - [ (delay - (force - (case - (equalsInteger - 2 - index) - [ (delay - (traceError - "PT1")) - , (delay - (constr 2 - [ ])) ]))) - , (delay - (constr 0 - [ (`$dUnsafeFromData` - (force - headList - args)) ])) ]))) - , (delay (constr 1 [])) ])) + (delay (constr 1 [])) + (delay + (force + (force + ifThenElse + (equalsInteger + 1 + index) + (delay + (constr 0 + [ (`$dUnsafeFromData` + (force + headList + args)) ])) + (delay + (force + (force + ifThenElse + (equalsInteger + 2 + index) + (delay + (constr 2 + [])) + (delay + (traceError + "PT1")))))))))) (force (force sndPair) tup)) (force (force fstPair) tup)) (unConstrData d))) @@ -856,52 +873,54 @@ (\index -> (\args -> force - (case + (force + ifThenElse (equalsInteger 0 index) - [ (delay - (force - (case - (equalsInteger - 1 - index) - [ (delay - (force - (case - (equalsInteger - 2 - index) - [ (delay - (force - (case - (equalsInteger - 3 - index) - [ (delay - (traceError - "PT1")) - , (delay - (constr 0 - [ (`$fUnsafeFromDataDCert_$cunsafeFromBuiltinData` - (force - headList - args)) ])) ]))) - , (delay - (constr 2 - [ (`$fUnsafeFromDataStakingCredential_$cunsafeFromBuiltinData` - (force - headList - args)) ])) ]))) - , (delay - (constr 3 - [ (`$fUnsafeFromDataTxOutRef_$cunsafeFromBuiltinData` + (delay + (constr 1 + [ (unBData + (force headList + args)) ])) + (delay + (force + (force + ifThenElse + (equalsInteger 1 index) + (delay + (constr 3 + [ (`$fUnsafeFromDataTxOutRef_$cunsafeFromBuiltinData` + (force + headList + args)) ])) + (delay + (force + (force + ifThenElse + (equalsInteger + 2 + index) + (delay + (constr 2 + [ (`$fUnsafeFromDataStakingCredential_$cunsafeFromBuiltinData` + (force + headList + args)) ])) + (delay + (force (force - headList - args)) ])) ]))) - , (delay - (constr 1 - [ (unBData - (force headList - args)) ])) ])) + ifThenElse + (equalsInteger + 3 + index) + (delay + (constr 0 + [ (`$fUnsafeFromDataDCert_$cunsafeFromBuiltinData` + (force + headList + args)) ])) + (delay + (traceError + "PT1"))))))))))))) (force (force sndPair) tup)) (force (force fstPair) tup)) (unConstrData d))) @@ -910,98 +929,104 @@ (\index -> (\args -> force - (case + (force + ifThenElse (equalsInteger 0 index) - [ (delay - (force - (case - (equalsInteger 1 index) - [ (delay - (force - (case - (equalsInteger - 2 - index) - [ (delay - (force - (case - (equalsInteger - 3 - index) - [ (delay + (delay + (constr 2 + [ (`$fUnsafeFromDataStakingCredential_$cunsafeFromBuiltinData` + (force headList + args)) ])) + (delay + (force + (force + ifThenElse + (equalsInteger 1 index) + (delay + (constr 0 + [ (`$fUnsafeFromDataStakingCredential_$cunsafeFromBuiltinData` + (force headList + args)) ])) + (delay + (force + (force + ifThenElse + (equalsInteger + 2 + index) + (delay + (constr 1 + [ (`$fUnsafeFromDataStakingCredential_$cunsafeFromBuiltinData` + (force + headList + args)) + , (unBData + (force + headList + (force + tailList + args))) ])) + (delay + (force + (force + ifThenElse + (equalsInteger + 3 + index) + (delay + (constr 5 + [ (unBData (force - (case - (equalsInteger - 4 - index) - [ (delay - (force - (case - (equalsInteger - 5 - index) - [ (delay - (force - (case - (equalsInteger - 6 - index) - [ (delay - (traceError - "PT1")) - , (delay - (constr 4 - [ ])) ]))) - , (delay - (constr 3 - [ ])) ]))) - , (delay - (constr 6 - [ (unBData - (force - headList - args)) - , (unIData - (force - headList - (force - tailList - args))) ])) ]))) - , (delay - (constr 5 - [ (unBData - (force - headList - args)) - , (unBData - (force - headList - (force - tailList - args))) ])) ]))) - , (delay - (constr 1 - [ (`$fUnsafeFromDataStakingCredential_$cunsafeFromBuiltinData` - (force - headList - args)) - , (unBData - (force - headList + headList + args)) + , (unBData (force - tailList - args))) ])) ]))) - , (delay - (constr 0 - [ (`$fUnsafeFromDataStakingCredential_$cunsafeFromBuiltinData` - (force - headList - args)) ])) ]))) - , (delay - (constr 2 - [ (`$fUnsafeFromDataStakingCredential_$cunsafeFromBuiltinData` - (force headList - args)) ])) ])) + headList + (force + tailList + args))) ])) + (delay + (force + (force + ifThenElse + (equalsInteger + 4 + index) + (delay + (constr 6 + [ (unBData + (force + headList + args)) + , (unIData + (force + headList + (force + tailList + args))) ])) + (delay + (force + (force + ifThenElse + (equalsInteger + 5 + index) + (delay + (constr 3 + [ ])) + (delay + (force + (force + ifThenElse + (equalsInteger + 6 + index) + (delay + (constr 4 + [ ])) + (delay + (traceError + "PT1")))))))))))))))))))))) (force (force sndPair) tup)) (force (force fstPair) tup)) (unConstrData d))) @@ -1010,37 +1035,34 @@ (\index -> (\args -> force - (case + (force + ifThenElse (equalsInteger 0 index) - [ (delay - (force - (case - (equalsInteger 1 index) - [ (delay (traceError "PT1")) - , (delay - ((\l -> - constr 1 - [ (unIData - (force - headList - args)) - , (unIData - (force - headList - l)) - , (unIData - (force - headList - (force - tailList - l))) ]) - (force tailList - args))) ]))) - , (delay - (constr 0 - [ (`$fUnsafeFromDataCredential_$cunsafeFromBuiltinData` - (force headList - args)) ])) ])) + (delay + (constr 0 + [ (`$fUnsafeFromDataCredential_$cunsafeFromBuiltinData` + (force headList args)) ])) + (delay + (force + (force ifThenElse + (equalsInteger 1 index) + (delay + ((\l -> + constr 1 + [ (unIData + (force headList + args)) + , (unIData + (force headList + l)) + , (unIData + (force headList + (force + tailList + l))) ]) + (force tailList args))) + (delay + (traceError "PT1"))))))) (force (force sndPair) tup)) (force (force fstPair) tup)) (unConstrData d))) @@ -1049,23 +1071,21 @@ (\index -> (\args -> force - (case + (force ifThenElse (equalsInteger 0 index) - [ (delay - (force - (case - (equalsInteger 1 index) - [ (delay (traceError "PT1")) - , (delay - (constr 1 - [ (unBData - (force headList - args)) ])) ]))) - , (delay - (constr 0 - [ (unBData - (force headList - args)) ])) ])) + (delay + (constr 0 + [(unBData (force headList args))])) + (delay + (force + (force ifThenElse + (equalsInteger 1 index) + (delay + (constr 1 + [ (unBData + (force headList + args)) ])) + (delay (traceError "PT1"))))))) (force (force sndPair) tup)) (force (force fstPair) tup)) (unConstrData d))) @@ -1074,17 +1094,17 @@ (\index -> (\args -> force - (case + (force + ifThenElse (equalsInteger 0 index) - [ (delay (traceError "PT1")) - , (delay - (constr 0 - [ (`$fUnsafeFromDataTxId_$cunsafeFromBuiltinData` - (force headList args)) - , (unIData - (force headList - (force tailList - args))) ])) ])) + (delay + (constr 0 + [ (`$fUnsafeFromDataTxId_$cunsafeFromBuiltinData` + (force headList args)) + , (unIData + (force headList + (force tailList args))) ])) + (delay (traceError "PT1")))) (force (force sndPair) tup)) (force (force fstPair) tup)) (unConstrData d))) @@ -1093,10 +1113,10 @@ (\index -> (\args -> force - (case + (force ifThenElse (equalsInteger 0 index) - [ (delay (traceError "PT1")) - , (delay (unBData (force headList args))) ])) + (delay (unBData (force headList args))) + (delay (traceError "PT1")))) (force (force sndPair) tup)) (force (force fstPair) tup)) (unConstrData d))) @@ -1105,19 +1125,18 @@ (\index -> (\args -> force - (case + (force ifThenElse (equalsInteger 1 index) - [ (delay - (force - (case - (equalsInteger 0 index) - [ (delay (traceError "PT1")) - , (delay - (constr 0 - [ (`$dUnsafeFromData` - (force headList - args)) ])) ]))) - , (delay (constr 1 [])) ])) + (delay (constr 1 [])) + (delay + (force + (force ifThenElse + (equalsInteger 0 index) + (delay + (constr 0 + [ (`$dUnsafeFromData` + (force headList args)) ])) + (delay (traceError "PT1"))))))) (force (force sndPair) tup)) (force (force fstPair) tup)) (unConstrData d))) diff --git a/plutus-benchmark/script-contexts/test/V2/Data/9.6/checkScriptContext1-20.eval.golden b/plutus-benchmark/script-contexts/test/V2/Data/9.6/checkScriptContext1-20.eval.golden index 7dc6d854033..3ae5cb3089e 100644 --- a/plutus-benchmark/script-contexts/test/V2/Data/9.6/checkScriptContext1-20.eval.golden +++ b/plutus-benchmark/script-contexts/test/V2/Data/9.6/checkScriptContext1-20.eval.golden @@ -1,5 +1,5 @@ -CPU: 20_250_376 -Memory: 72_782 -Size: 95 +CPU: 20_406_425 +Memory: 73_283 +Size: 99 (constr 0) \ No newline at end of file diff --git a/plutus-benchmark/script-contexts/test/V2/Data/9.6/checkScriptContext1-4.eval.golden b/plutus-benchmark/script-contexts/test/V2/Data/9.6/checkScriptContext1-4.eval.golden index d519bd7b44e..02b633f2c12 100644 --- a/plutus-benchmark/script-contexts/test/V2/Data/9.6/checkScriptContext1-4.eval.golden +++ b/plutus-benchmark/script-contexts/test/V2/Data/9.6/checkScriptContext1-4.eval.golden @@ -1,5 +1,5 @@ -CPU: 5_674_136 -Memory: 20_014 -Size: 95 +CPU: 5_830_185 +Memory: 20_515 +Size: 99 (constr 0) \ No newline at end of file diff --git a/plutus-benchmark/script-contexts/test/V2/Data/9.6/checkScriptContext1.pir.golden b/plutus-benchmark/script-contexts/test/V2/Data/9.6/checkScriptContext1.pir.golden index e712dccca43..d4afbd20d72 100644 --- a/plutus-benchmark/script-contexts/test/V2/Data/9.6/checkScriptContext1.pir.golden +++ b/plutus-benchmark/script-contexts/test/V2/Data/9.6/checkScriptContext1.pir.golden @@ -22,8 +22,8 @@ in \(d : data) -> Bool_match - (case - Bool + (ifThenElse + {Bool} (equalsInteger 0 (modInteger @@ -95,7 +95,11 @@ = sndPair {integer} {list data} tup in Bool_match - (case Bool (equalsInteger 0 index) [False, True]) + (ifThenElse + {Bool} + (equalsInteger 0 index) + True + False) {all dead. bytestring} (/\dead -> unBData (headList {data} args)) (/\dead -> @@ -134,7 +138,8 @@ in go ds) 2)) - [False, True]) + True + False) {all dead. Unit} (/\dead -> Unit) (/\dead -> diff --git a/plutus-benchmark/script-contexts/test/V2/Data/9.6/checkScriptContext1.size.golden b/plutus-benchmark/script-contexts/test/V2/Data/9.6/checkScriptContext1.size.golden index 90be1cdd8ee..d97edbb29fa 100644 --- a/plutus-benchmark/script-contexts/test/V2/Data/9.6/checkScriptContext1.size.golden +++ b/plutus-benchmark/script-contexts/test/V2/Data/9.6/checkScriptContext1.size.golden @@ -1 +1 @@ -95 \ No newline at end of file +99 \ No newline at end of file diff --git a/plutus-benchmark/script-contexts/test/V2/Data/9.6/checkScriptContextEqualityData-20.eval.golden b/plutus-benchmark/script-contexts/test/V2/Data/9.6/checkScriptContextEqualityData-20.eval.golden index 8b66dabe303..7043bca7bed 100644 --- a/plutus-benchmark/script-contexts/test/V2/Data/9.6/checkScriptContextEqualityData-20.eval.golden +++ b/plutus-benchmark/script-contexts/test/V2/Data/9.6/checkScriptContextEqualityData-20.eval.golden @@ -1,5 +1,5 @@ -CPU: 32_427_261 -Memory: 1_601 -Size: 25 +CPU: 32_583_310 +Memory: 2_102 +Size: 29 (constr 0) \ No newline at end of file diff --git a/plutus-benchmark/script-contexts/test/V3/9.6/checkScriptContext1-20.eval.golden b/plutus-benchmark/script-contexts/test/V3/9.6/checkScriptContext1-20.eval.golden index 47843d84835..de126d9e9ce 100644 --- a/plutus-benchmark/script-contexts/test/V3/9.6/checkScriptContext1-20.eval.golden +++ b/plutus-benchmark/script-contexts/test/V3/9.6/checkScriptContext1-20.eval.golden @@ -1,5 +1,5 @@ -CPU: 271_439_835 -Memory: 1_031_489 -Size: 2_790 +CPU: 293_286_695 +Memory: 1_101_629 +Size: 3_086 (constr 0) \ No newline at end of file diff --git a/plutus-benchmark/script-contexts/test/V3/9.6/checkScriptContext1-4.eval.golden b/plutus-benchmark/script-contexts/test/V3/9.6/checkScriptContext1-4.eval.golden index 504706cdd32..1c700e66f99 100644 --- a/plutus-benchmark/script-contexts/test/V3/9.6/checkScriptContext1-4.eval.golden +++ b/plutus-benchmark/script-contexts/test/V3/9.6/checkScriptContext1-4.eval.golden @@ -1,5 +1,5 @@ -CPU: 79_306_123 -Memory: 308_161 -Size: 2_790 +CPU: 86_172_279 +Memory: 330_205 +Size: 3_086 (constr 0) \ No newline at end of file diff --git a/plutus-benchmark/script-contexts/test/V3/9.6/checkScriptContext1.pir.golden b/plutus-benchmark/script-contexts/test/V3/9.6/checkScriptContext1.pir.golden index 7d0ac0355dd..24194021d0d 100644 --- a/plutus-benchmark/script-contexts/test/V3/9.6/checkScriptContext1.pir.golden +++ b/plutus-benchmark/script-contexts/test/V3/9.6/checkScriptContext1.pir.golden @@ -62,12 +62,12 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (case Bool (equalsInteger 0 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 0 index) True False) {all dead. Bool} (/\dead -> False) (/\dead -> Bool_match - (case Bool (equalsInteger 1 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 1 index) True False) {all dead. Bool} (/\dead -> True) (/\dead -> traceError {Bool} "PT1") @@ -87,18 +87,18 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (case Bool (equalsInteger 0 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 0 index) True False) {all dead. Extended a} (/\dead -> NegInf {a}) (/\dead -> Bool_match - (case Bool (equalsInteger 1 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 1 index) True False) {all dead. Extended a} (/\dead -> Finite {a} (`$dUnsafeFromData` (headList {data} args))) (/\dead -> Bool_match - (case Bool (equalsInteger 2 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 2 index) True False) {all dead. Extended a} (/\dead -> PosInf {a}) (/\dead -> traceError {Extended a} "PT1") @@ -116,7 +116,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (case Bool (equalsInteger 0 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 0 index) True False) {all dead. GovernanceActionId} (/\dead -> GovernanceActionId @@ -156,12 +156,12 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (case Bool (equalsInteger 0 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 0 index) True False) {all dead. Credential} (/\dead -> PubKeyCredential (unBData (headList {data} args))) (/\dead -> Bool_match - (case Bool (equalsInteger 1 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 1 index) True False) {all dead. Credential} (/\dead -> ScriptCredential (unBData (headList {data} args))) (/\dead -> traceError {Credential} "PT1") @@ -177,12 +177,12 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (case Bool (equalsInteger 1 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 1 index) True False) {all dead. Maybe a} (/\dead -> Nothing {a}) (/\dead -> Bool_match - (case Bool (equalsInteger 0 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 0 index) True False) {all dead. Maybe a} (/\dead -> Just {a} (`$dUnsafeFromData` (headList {data} args))) @@ -247,7 +247,7 @@ !euclid : integer -> integer -> integer = \(x : integer) (y : integer) -> Bool_match - (case Bool (equalsInteger 0 y) [False, True]) + (ifThenElse {Bool} (equalsInteger 0 y) True False) {all dead. integer} (/\dead -> x) (/\dead -> euclid y (modInteger x y)) @@ -257,12 +257,12 @@ !unsafeRatio : integer -> integer -> Rational = \(n : integer) (d : integer) -> Bool_match - (case Bool (equalsInteger 0 d) [False, True]) + (ifThenElse {Bool} (equalsInteger 0 d) True False) {all dead. Rational} (/\dead -> traceError {Rational} "PT3") (/\dead -> Bool_match - (case Bool (lessThanInteger d 0) [False, True]) + (ifThenElse {Bool} (lessThanInteger d 0) True False) {all dead. Rational} (/\dead -> unsafeRatio (subtractInteger 0 n) (subtractInteger 0 d)) @@ -284,7 +284,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (case Bool (equalsInteger 0 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 0 index) True False) {all dead. ProposalProcedure} (/\dead -> let @@ -301,7 +301,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (case Bool (equalsInteger 0 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 0 index) True False) {all dead. GovernanceAction} (/\dead -> let @@ -319,7 +319,7 @@ (headList {data} (tailList {data} l)))) (/\dead -> Bool_match - (case Bool (equalsInteger 1 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 1 index) True False) {all dead. GovernanceAction} (/\dead -> HardForkInitiation @@ -337,7 +337,11 @@ = sndPair {integer} {list data} tup in Bool_match - (case Bool (equalsInteger 0 index) [False, True]) + (ifThenElse + {Bool} + (equalsInteger 0 index) + True + False) {all dead. ProtocolVersion} (/\dead -> ProtocolVersion @@ -350,7 +354,11 @@ {all dead. dead})) (/\dead -> Bool_match - (case Bool (equalsInteger 2 index) [False, True]) + (ifThenElse + {Bool} + (equalsInteger 2 index) + True + False) {all dead. GovernanceAction} (/\dead -> TreasuryWithdrawals @@ -366,10 +374,11 @@ (headList {data} (tailList {data} args)))) (/\dead -> Bool_match - (case - Bool + (ifThenElse + {Bool} (equalsInteger 3 index) - [False, True]) + True + False) {all dead. GovernanceAction} (/\dead -> NoConfidence @@ -379,10 +388,11 @@ (headList {data} args))) (/\dead -> Bool_match - (case - Bool + (ifThenElse + {Bool} (equalsInteger 4 index) - [False, True]) + True + False) {all dead. GovernanceAction} (/\dead -> let @@ -429,10 +439,11 @@ tup in Bool_match - (case - Bool + (ifThenElse + {Bool} (equalsInteger 0 index) - [False, True]) + True + False) {all dead. Tuple2 integer integer} (/\dead -> @@ -457,10 +468,11 @@ unsafeRatio a b))) (/\dead -> Bool_match - (case - Bool + (ifThenElse + {Bool} (equalsInteger 5 index) - [False, True]) + True + False) {all dead. GovernanceAction} (/\dead -> NewConstitution @@ -489,10 +501,11 @@ tup in Bool_match - (case - Bool + (ifThenElse + {Bool} (equalsInteger 0 index) - [False, True]) + True + False) {all dead. Maybe bytestring} (/\dead -> `$fUnsafeFromDataMaybe_$cunsafeFromBuiltinData` @@ -506,10 +519,11 @@ {all dead. dead})) (/\dead -> Bool_match - (case - Bool + (ifThenElse + {Bool} (equalsInteger 6 index) - [False, True]) + True + False) {all dead. GovernanceAction} (/\dead -> InfoAction) (/\dead -> @@ -537,7 +551,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (case Bool (equalsInteger 0 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 0 index) True False) {all dead. DRep} (/\dead -> DRep @@ -545,12 +559,12 @@ (headList {data} args))) (/\dead -> Bool_match - (case Bool (equalsInteger 1 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 1 index) True False) {all dead. DRep} (/\dead -> DRepAlwaysAbstain) (/\dead -> Bool_match - (case Bool (equalsInteger 2 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 2 index) True False) {all dead. DRep} (/\dead -> DRepAlwaysNoConfidence) (/\dead -> traceError {DRep} "PT1") @@ -569,12 +583,12 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (case Bool (equalsInteger 0 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 0 index) True False) {all dead. Delegatee} (/\dead -> DelegStake (unBData (headList {data} args))) (/\dead -> Bool_match - (case Bool (equalsInteger 1 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 1 index) True False) {all dead. Delegatee} (/\dead -> DelegVote @@ -582,7 +596,7 @@ (headList {data} args))) (/\dead -> Bool_match - (case Bool (equalsInteger 2 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 2 index) True False) {all dead. Delegatee} (/\dead -> DelegStakeVote @@ -614,7 +628,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (case Bool (equalsInteger 0 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 0 index) True False) {all dead. TxCert} (/\dead -> TxCertRegStaking @@ -626,7 +640,7 @@ (headList {data} (tailList {data} args)))) (/\dead -> Bool_match - (case Bool (equalsInteger 1 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 1 index) True False) {all dead. TxCert} (/\dead -> TxCertUnRegStaking @@ -638,7 +652,7 @@ (headList {data} (tailList {data} args)))) (/\dead -> Bool_match - (case Bool (equalsInteger 2 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 2 index) True False) {all dead. TxCert} (/\dead -> TxCertDelegStaking @@ -648,7 +662,11 @@ (headList {data} (tailList {data} args)))) (/\dead -> Bool_match - (case Bool (equalsInteger 3 index) [False, True]) + (ifThenElse + {Bool} + (equalsInteger 3 index) + True + False) {all dead. TxCert} (/\dead -> let @@ -662,10 +680,11 @@ (unIData (headList {data} (tailList {data} l)))) (/\dead -> Bool_match - (case - Bool + (ifThenElse + {Bool} (equalsInteger 4 index) - [False, True]) + True + False) {all dead. TxCert} (/\dead -> TxCertRegDRep @@ -677,10 +696,11 @@ (tailList {data} args)))) (/\dead -> Bool_match - (case - Bool + (ifThenElse + {Bool} (equalsInteger 5 index) - [False, True]) + True + False) {all dead. TxCert} (/\dead -> TxCertUpdateDRep @@ -688,10 +708,11 @@ (headList {data} args))) (/\dead -> Bool_match - (case - Bool + (ifThenElse + {Bool} (equalsInteger 6 index) - [False, True]) + True + False) {all dead. TxCert} (/\dead -> TxCertUnRegDRep @@ -703,10 +724,11 @@ (tailList {data} args)))) (/\dead -> Bool_match - (case - Bool + (ifThenElse + {Bool} (equalsInteger 7 index) - [False, True]) + True + False) {all dead. TxCert} (/\dead -> TxCertPoolRegister @@ -720,10 +742,11 @@ args)))) (/\dead -> Bool_match - (case - Bool + (ifThenElse + {Bool} (equalsInteger 8 index) - [False, True]) + True + False) {all dead. TxCert} (/\dead -> TxCertPoolRetire @@ -739,12 +762,13 @@ args)))) (/\dead -> Bool_match - (case - Bool + (ifThenElse + {Bool} (equalsInteger 9 index) - [False, True]) + True + False) {all dead. TxCert} (/\dead -> TxCertAuthHotCommittee @@ -760,12 +784,13 @@ args)))) (/\dead -> Bool_match - (case - Bool + (ifThenElse + {Bool} (equalsInteger 10 index) - [False, True]) + True + False) {all dead. TxCert} (/\dead -> TxCertResignColdCommittee @@ -800,7 +825,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (case Bool (equalsInteger 0 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 0 index) True False) {all dead. Voter} (/\dead -> CommitteeVoter @@ -808,7 +833,7 @@ (headList {data} args))) (/\dead -> Bool_match - (case Bool (equalsInteger 1 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 1 index) True False) {all dead. Voter} (/\dead -> DRepVoter @@ -816,7 +841,7 @@ (headList {data} args))) (/\dead -> Bool_match - (case Bool (equalsInteger 2 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 2 index) True False) {all dead. Voter} (/\dead -> StakePoolVoter (unBData (headList {data} args))) @@ -834,7 +859,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (case Bool (equalsInteger 0 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 0 index) True False) {all dead. TxOutRef} (/\dead -> TxOutRef @@ -851,7 +876,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (case Bool (equalsInteger 0 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 0 index) True False) {all dead. TxOut} (/\dead -> let @@ -866,7 +891,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (case Bool (equalsInteger 0 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 0 index) True False) {all dead. Address} (/\dead -> Address @@ -883,10 +908,11 @@ = sndPair {integer} {list data} tup in Bool_match - (case - Bool + (ifThenElse + {Bool} (equalsInteger 0 index) - [False, True]) + True + False) {all dead. StakingCredential} (/\dead -> StakingHash @@ -894,10 +920,11 @@ (headList {data} args))) (/\dead -> Bool_match - (case - Bool + (ifThenElse + {Bool} (equalsInteger 1 index) - [False, True]) + True + False) {all dead. StakingCredential} (/\dead -> let @@ -934,18 +961,22 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (case Bool (equalsInteger 0 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 0 index) True False) {all dead. OutputDatum} (/\dead -> NoOutputDatum) (/\dead -> Bool_match - (case Bool (equalsInteger 1 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 1 index) True False) {all dead. OutputDatum} (/\dead -> OutputDatumHash (unBData (headList {data} args))) (/\dead -> Bool_match - (case Bool (equalsInteger 2 index) [False, True]) + (ifThenElse + {Bool} + (equalsInteger 2 index) + True + False) {all dead. OutputDatum} (/\dead -> OutputDatum (headList {data} args)) (/\dead -> traceError {OutputDatum} "PT1") @@ -968,7 +999,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (case Bool (equalsInteger 0 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 0 index) True False) {all dead. TxInInfo} (/\dead -> TxInInfo @@ -1036,7 +1067,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (case Bool (equalsInteger 0 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 0 index) True False) {all dead. ScriptContext} (/\dead -> let @@ -1050,7 +1081,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (case Bool (equalsInteger 0 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 0 index) True False) {all dead. TxInfo} (/\dead -> let @@ -1170,7 +1201,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (case Bool (equalsInteger 0 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 0 index) True False) {all dead. Interval integer} (/\dead -> Interval @@ -1184,7 +1215,11 @@ = sndPair {integer} {list data} tup in Bool_match - (case Bool (equalsInteger 0 index) [False, True]) + (ifThenElse + {Bool} + (equalsInteger 0 index) + True + False) {all dead. LowerBound integer} (/\dead -> LowerBound @@ -1207,7 +1242,11 @@ = sndPair {integer} {list data} tup in Bool_match - (case Bool (equalsInteger 0 index) [False, True]) + (ifThenElse + {Bool} + (equalsInteger 0 index) + True + False) {all dead. UpperBound integer} (/\dead -> UpperBound @@ -1237,15 +1276,20 @@ = sndPair {integer} {list data} tup in Bool_match - (case Bool (equalsInteger 0 index) [False, True]) + (ifThenElse + {Bool} + (equalsInteger 0 index) + True + False) {all dead. ScriptPurpose} (/\dead -> Minting (unBData (headList {data} args))) (/\dead -> Bool_match - (case - Bool + (ifThenElse + {Bool} (equalsInteger 1 index) - [False, True]) + True + False) {all dead. ScriptPurpose} (/\dead -> Spending @@ -1253,10 +1297,11 @@ (headList {data} args))) (/\dead -> Bool_match - (case - Bool + (ifThenElse + {Bool} (equalsInteger 2 index) - [False, True]) + True + False) {all dead. ScriptPurpose} (/\dead -> Rewarding @@ -1264,10 +1309,11 @@ (headList {data} args))) (/\dead -> Bool_match - (case - Bool + (ifThenElse + {Bool} (equalsInteger 3 index) - [False, True]) + True + False) {all dead. ScriptPurpose} (/\dead -> Certifying @@ -1278,10 +1324,11 @@ (tailList {data} args)))) (/\dead -> Bool_match - (case - Bool + (ifThenElse + {Bool} (equalsInteger 4 index) - [False, True]) + True + False) {all dead. ScriptPurpose} (/\dead -> Voting @@ -1289,10 +1336,11 @@ (headList {data} args))) (/\dead -> Bool_match - (case - Bool + (ifThenElse + {Bool} (equalsInteger 5 index) - [False, True]) + True + False) {all dead. ScriptPurpose} (/\dead -> Proposing @@ -1342,23 +1390,29 @@ = sndPair {integer} {list data} tup in Bool_match - (case Bool (equalsInteger 0 index) [False, True]) + (ifThenElse + {Bool} + (equalsInteger 0 index) + True + False) {all dead. Vote} (/\dead -> VoteNo) (/\dead -> Bool_match - (case - Bool + (ifThenElse + {Bool} (equalsInteger 1 index) - [False, True]) + True + False) {all dead. Vote} (/\dead -> VoteYes) (/\dead -> Bool_match - (case - Bool + (ifThenElse + {Bool} (equalsInteger 2 index) - [False, True]) + True + False) {all dead. Vote} (/\dead -> Abstain) (/\dead -> traceError {Vote} "PT1") @@ -1403,12 +1457,12 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (case Bool (equalsInteger 0 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 0 index) True False) {all dead. ScriptInfo} (/\dead -> MintingScript (unBData (headList {data} args))) (/\dead -> Bool_match - (case Bool (equalsInteger 1 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 1 index) True False) {all dead. ScriptInfo} (/\dead -> SpendingScript @@ -1420,7 +1474,7 @@ (headList {data} (tailList {data} args)))) (/\dead -> Bool_match - (case Bool (equalsInteger 2 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 2 index) True False) {all dead. ScriptInfo} (/\dead -> RewardingScript @@ -1428,7 +1482,11 @@ (headList {data} args))) (/\dead -> Bool_match - (case Bool (equalsInteger 3 index) [False, True]) + (ifThenElse + {Bool} + (equalsInteger 3 index) + True + False) {all dead. ScriptInfo} (/\dead -> CertifyingScript @@ -1437,10 +1495,11 @@ (headList {data} (tailList {data} args)))) (/\dead -> Bool_match - (case - Bool + (ifThenElse + {Bool} (equalsInteger 4 index) - [False, True]) + True + False) {all dead. ScriptInfo} (/\dead -> VotingScript @@ -1448,10 +1507,11 @@ (headList {data} args))) (/\dead -> Bool_match - (case - Bool + (ifThenElse + {Bool} (equalsInteger 5 index) - [False, True]) + True + False) {all dead. ScriptInfo} (/\dead -> ProposingScript @@ -1473,8 +1533,8 @@ {Unit} (\(ipv : TxInfo) (ipv : data) (ipv : ScriptInfo) -> Bool_match - (case - Bool + (ifThenElse + {Bool} (equalsInteger 0 (modInteger @@ -1515,7 +1575,8 @@ in go eta) 2)) - [False, True]) + True + False) {all dead. Unit} (/\dead -> Unit) (/\dead -> diff --git a/plutus-benchmark/script-contexts/test/V3/9.6/checkScriptContext1.size.golden b/plutus-benchmark/script-contexts/test/V3/9.6/checkScriptContext1.size.golden index 78c295b5b83..83fb37b52fa 100644 --- a/plutus-benchmark/script-contexts/test/V3/9.6/checkScriptContext1.size.golden +++ b/plutus-benchmark/script-contexts/test/V3/9.6/checkScriptContext1.size.golden @@ -1 +1 @@ -2790 \ No newline at end of file +3086 \ No newline at end of file diff --git a/plutus-benchmark/script-contexts/test/V3/9.6/checkScriptContext2-20.eval.golden b/plutus-benchmark/script-contexts/test/V3/9.6/checkScriptContext2-20.eval.golden index e0a3aa65905..c35e43f1524 100644 --- a/plutus-benchmark/script-contexts/test/V3/9.6/checkScriptContext2-20.eval.golden +++ b/plutus-benchmark/script-contexts/test/V3/9.6/checkScriptContext2-20.eval.golden @@ -1,5 +1,5 @@ -CPU: 264_015_412 -Memory: 998_847 -Size: 2_723 +CPU: 285_706_223 +Memory: 1_068_486 +Size: 3_015 (constr 0) \ No newline at end of file diff --git a/plutus-benchmark/script-contexts/test/V3/9.6/checkScriptContext2-4.eval.golden b/plutus-benchmark/script-contexts/test/V3/9.6/checkScriptContext2-4.eval.golden index 14824786289..e8bd14fd354 100644 --- a/plutus-benchmark/script-contexts/test/V3/9.6/checkScriptContext2-4.eval.golden +++ b/plutus-benchmark/script-contexts/test/V3/9.6/checkScriptContext2-4.eval.golden @@ -1,5 +1,5 @@ -CPU: 77_085_028 -Memory: 297_951 -Size: 2_723 +CPU: 83_795_135 +Memory: 319_494 +Size: 3_015 (constr 0) \ No newline at end of file diff --git a/plutus-benchmark/script-contexts/test/V3/9.6/checkScriptContext2.pir.golden b/plutus-benchmark/script-contexts/test/V3/9.6/checkScriptContext2.pir.golden index 332fc18c5d3..5c170c5a611 100644 --- a/plutus-benchmark/script-contexts/test/V3/9.6/checkScriptContext2.pir.golden +++ b/plutus-benchmark/script-contexts/test/V3/9.6/checkScriptContext2.pir.golden @@ -17,12 +17,12 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (case Bool (equalsInteger 0 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 0 index) True False) {all dead. Bool} (/\dead -> False) (/\dead -> Bool_match - (case Bool (equalsInteger 1 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 1 index) True False) {all dead. Bool} (/\dead -> True) (/\dead -> traceError {Bool} "PT1") @@ -42,18 +42,18 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (case Bool (equalsInteger 0 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 0 index) True False) {all dead. Extended a} (/\dead -> NegInf {a}) (/\dead -> Bool_match - (case Bool (equalsInteger 1 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 1 index) True False) {all dead. Extended a} (/\dead -> Finite {a} (`$dUnsafeFromData` (headList {data} args))) (/\dead -> Bool_match - (case Bool (equalsInteger 2 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 2 index) True False) {all dead. Extended a} (/\dead -> PosInf {a}) (/\dead -> traceError {Extended a} "PT1") @@ -71,7 +71,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (case Bool (equalsInteger 0 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 0 index) True False) {all dead. GovernanceActionId} (/\dead -> GovernanceActionId @@ -121,12 +121,12 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (case Bool (equalsInteger 0 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 0 index) True False) {all dead. Credential} (/\dead -> PubKeyCredential (unBData (headList {data} args))) (/\dead -> Bool_match - (case Bool (equalsInteger 1 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 1 index) True False) {all dead. Credential} (/\dead -> ScriptCredential (unBData (headList {data} args))) (/\dead -> traceError {Credential} "PT1") @@ -145,12 +145,12 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (case Bool (equalsInteger 1 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 1 index) True False) {all dead. Maybe a} (/\dead -> Nothing {a}) (/\dead -> Bool_match - (case Bool (equalsInteger 0 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 0 index) True False) {all dead. Maybe a} (/\dead -> Just {a} (`$dUnsafeFromData` (headList {data} args))) @@ -217,7 +217,7 @@ !euclid : integer -> integer -> integer = \(x : integer) (y : integer) -> Bool_match - (case Bool (equalsInteger 0 y) [False, True]) + (ifThenElse {Bool} (equalsInteger 0 y) True False) {all dead. integer} (/\dead -> x) (/\dead -> euclid y (modInteger x y)) @@ -227,12 +227,12 @@ !unsafeRatio : integer -> integer -> Rational = \(n : integer) (d : integer) -> Bool_match - (case Bool (equalsInteger 0 d) [False, True]) + (ifThenElse {Bool} (equalsInteger 0 d) True False) {all dead. Rational} (/\dead -> traceError {Rational} "PT3") (/\dead -> Bool_match - (case Bool (lessThanInteger d 0) [False, True]) + (ifThenElse {Bool} (lessThanInteger d 0) True False) {all dead. Rational} (/\dead -> unsafeRatio (subtractInteger 0 n) (subtractInteger 0 d)) @@ -254,7 +254,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (case Bool (equalsInteger 0 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 0 index) True False) {all dead. ProposalProcedure} (/\dead -> let @@ -271,7 +271,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (case Bool (equalsInteger 0 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 0 index) True False) {all dead. GovernanceAction} (/\dead -> let @@ -289,7 +289,7 @@ (headList {data} (tailList {data} l)))) (/\dead -> Bool_match - (case Bool (equalsInteger 1 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 1 index) True False) {all dead. GovernanceAction} (/\dead -> HardForkInitiation @@ -307,7 +307,11 @@ = sndPair {integer} {list data} tup in Bool_match - (case Bool (equalsInteger 0 index) [False, True]) + (ifThenElse + {Bool} + (equalsInteger 0 index) + True + False) {all dead. ProtocolVersion} (/\dead -> ProtocolVersion @@ -320,7 +324,11 @@ {all dead. dead})) (/\dead -> Bool_match - (case Bool (equalsInteger 2 index) [False, True]) + (ifThenElse + {Bool} + (equalsInteger 2 index) + True + False) {all dead. GovernanceAction} (/\dead -> TreasuryWithdrawals @@ -336,10 +344,11 @@ (headList {data} (tailList {data} args)))) (/\dead -> Bool_match - (case - Bool + (ifThenElse + {Bool} (equalsInteger 3 index) - [False, True]) + True + False) {all dead. GovernanceAction} (/\dead -> NoConfidence @@ -349,10 +358,11 @@ (headList {data} args))) (/\dead -> Bool_match - (case - Bool + (ifThenElse + {Bool} (equalsInteger 4 index) - [False, True]) + True + False) {all dead. GovernanceAction} (/\dead -> let @@ -399,10 +409,11 @@ tup in Bool_match - (case - Bool + (ifThenElse + {Bool} (equalsInteger 0 index) - [False, True]) + True + False) {all dead. Tuple2 integer integer} (/\dead -> @@ -427,10 +438,11 @@ unsafeRatio a b))) (/\dead -> Bool_match - (case - Bool + (ifThenElse + {Bool} (equalsInteger 5 index) - [False, True]) + True + False) {all dead. GovernanceAction} (/\dead -> NewConstitution @@ -459,10 +471,11 @@ tup in Bool_match - (case - Bool + (ifThenElse + {Bool} (equalsInteger 0 index) - [False, True]) + True + False) {all dead. Maybe bytestring} (/\dead -> `$fUnsafeFromDataMaybe_$cunsafeFromBuiltinData` @@ -476,10 +489,11 @@ {all dead. dead})) (/\dead -> Bool_match - (case - Bool + (ifThenElse + {Bool} (equalsInteger 6 index) - [False, True]) + True + False) {all dead. GovernanceAction} (/\dead -> InfoAction) (/\dead -> @@ -507,7 +521,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (case Bool (equalsInteger 0 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 0 index) True False) {all dead. DRep} (/\dead -> DRep @@ -515,12 +529,12 @@ (headList {data} args))) (/\dead -> Bool_match - (case Bool (equalsInteger 1 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 1 index) True False) {all dead. DRep} (/\dead -> DRepAlwaysAbstain) (/\dead -> Bool_match - (case Bool (equalsInteger 2 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 2 index) True False) {all dead. DRep} (/\dead -> DRepAlwaysNoConfidence) (/\dead -> traceError {DRep} "PT1") @@ -539,12 +553,12 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (case Bool (equalsInteger 0 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 0 index) True False) {all dead. Delegatee} (/\dead -> DelegStake (unBData (headList {data} args))) (/\dead -> Bool_match - (case Bool (equalsInteger 1 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 1 index) True False) {all dead. Delegatee} (/\dead -> DelegVote @@ -552,7 +566,7 @@ (headList {data} args))) (/\dead -> Bool_match - (case Bool (equalsInteger 2 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 2 index) True False) {all dead. Delegatee} (/\dead -> DelegStakeVote @@ -584,7 +598,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (case Bool (equalsInteger 0 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 0 index) True False) {all dead. TxCert} (/\dead -> TxCertRegStaking @@ -596,7 +610,7 @@ (headList {data} (tailList {data} args)))) (/\dead -> Bool_match - (case Bool (equalsInteger 1 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 1 index) True False) {all dead. TxCert} (/\dead -> TxCertUnRegStaking @@ -608,7 +622,7 @@ (headList {data} (tailList {data} args)))) (/\dead -> Bool_match - (case Bool (equalsInteger 2 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 2 index) True False) {all dead. TxCert} (/\dead -> TxCertDelegStaking @@ -618,7 +632,11 @@ (headList {data} (tailList {data} args)))) (/\dead -> Bool_match - (case Bool (equalsInteger 3 index) [False, True]) + (ifThenElse + {Bool} + (equalsInteger 3 index) + True + False) {all dead. TxCert} (/\dead -> let @@ -632,10 +650,11 @@ (unIData (headList {data} (tailList {data} l)))) (/\dead -> Bool_match - (case - Bool + (ifThenElse + {Bool} (equalsInteger 4 index) - [False, True]) + True + False) {all dead. TxCert} (/\dead -> TxCertRegDRep @@ -647,10 +666,11 @@ (tailList {data} args)))) (/\dead -> Bool_match - (case - Bool + (ifThenElse + {Bool} (equalsInteger 5 index) - [False, True]) + True + False) {all dead. TxCert} (/\dead -> TxCertUpdateDRep @@ -658,10 +678,11 @@ (headList {data} args))) (/\dead -> Bool_match - (case - Bool + (ifThenElse + {Bool} (equalsInteger 6 index) - [False, True]) + True + False) {all dead. TxCert} (/\dead -> TxCertUnRegDRep @@ -673,10 +694,11 @@ (tailList {data} args)))) (/\dead -> Bool_match - (case - Bool + (ifThenElse + {Bool} (equalsInteger 7 index) - [False, True]) + True + False) {all dead. TxCert} (/\dead -> TxCertPoolRegister @@ -690,10 +712,11 @@ args)))) (/\dead -> Bool_match - (case - Bool + (ifThenElse + {Bool} (equalsInteger 8 index) - [False, True]) + True + False) {all dead. TxCert} (/\dead -> TxCertPoolRetire @@ -709,12 +732,13 @@ args)))) (/\dead -> Bool_match - (case - Bool + (ifThenElse + {Bool} (equalsInteger 9 index) - [False, True]) + True + False) {all dead. TxCert} (/\dead -> TxCertAuthHotCommittee @@ -730,12 +754,13 @@ args)))) (/\dead -> Bool_match - (case - Bool + (ifThenElse + {Bool} (equalsInteger 10 index) - [False, True]) + True + False) {all dead. TxCert} (/\dead -> TxCertResignColdCommittee @@ -770,7 +795,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (case Bool (equalsInteger 0 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 0 index) True False) {all dead. Voter} (/\dead -> CommitteeVoter @@ -778,7 +803,7 @@ (headList {data} args))) (/\dead -> Bool_match - (case Bool (equalsInteger 1 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 1 index) True False) {all dead. Voter} (/\dead -> DRepVoter @@ -786,7 +811,7 @@ (headList {data} args))) (/\dead -> Bool_match - (case Bool (equalsInteger 2 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 2 index) True False) {all dead. Voter} (/\dead -> StakePoolVoter (unBData (headList {data} args))) @@ -804,7 +829,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (case Bool (equalsInteger 0 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 0 index) True False) {all dead. TxOutRef} (/\dead -> TxOutRef @@ -839,7 +864,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (case Bool (equalsInteger 0 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 0 index) True False) {all dead. TxOut} (/\dead -> let @@ -854,7 +879,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (case Bool (equalsInteger 0 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 0 index) True False) {all dead. Address} (/\dead -> Address @@ -871,10 +896,11 @@ = sndPair {integer} {list data} tup in Bool_match - (case - Bool + (ifThenElse + {Bool} (equalsInteger 0 index) - [False, True]) + True + False) {all dead. StakingCredential} (/\dead -> StakingHash @@ -882,10 +908,11 @@ (headList {data} args))) (/\dead -> Bool_match - (case - Bool + (ifThenElse + {Bool} (equalsInteger 1 index) - [False, True]) + True + False) {all dead. StakingCredential} (/\dead -> let @@ -922,18 +949,22 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (case Bool (equalsInteger 0 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 0 index) True False) {all dead. OutputDatum} (/\dead -> NoOutputDatum) (/\dead -> Bool_match - (case Bool (equalsInteger 1 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 1 index) True False) {all dead. OutputDatum} (/\dead -> OutputDatumHash (unBData (headList {data} args))) (/\dead -> Bool_match - (case Bool (equalsInteger 2 index) [False, True]) + (ifThenElse + {Bool} + (equalsInteger 2 index) + True + False) {all dead. OutputDatum} (/\dead -> OutputDatum (headList {data} args)) (/\dead -> traceError {OutputDatum} "PT1") @@ -956,7 +987,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (case Bool (equalsInteger 0 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 0 index) True False) {all dead. TxInInfo} (/\dead -> TxInInfo @@ -1026,7 +1057,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (case Bool (equalsInteger 0 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 0 index) True False) {all dead. ScriptContext} (/\dead -> let @@ -1040,7 +1071,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (case Bool (equalsInteger 0 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 0 index) True False) {all dead. TxInfo} (/\dead -> let @@ -1160,7 +1191,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (case Bool (equalsInteger 0 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 0 index) True False) {all dead. Interval integer} (/\dead -> Interval @@ -1174,7 +1205,11 @@ = sndPair {integer} {list data} tup in Bool_match - (case Bool (equalsInteger 0 index) [False, True]) + (ifThenElse + {Bool} + (equalsInteger 0 index) + True + False) {all dead. LowerBound integer} (/\dead -> LowerBound @@ -1199,7 +1234,11 @@ = sndPair {integer} {list data} tup in Bool_match - (case Bool (equalsInteger 0 index) [False, True]) + (ifThenElse + {Bool} + (equalsInteger 0 index) + True + False) {all dead. UpperBound integer} (/\dead -> UpperBound @@ -1232,16 +1271,21 @@ = sndPair {integer} {list data} tup in Bool_match - (case Bool (equalsInteger 0 index) [False, True]) + (ifThenElse + {Bool} + (equalsInteger 0 index) + True + False) {all dead. ScriptPurpose} (/\dead -> Minting (unBData (headList {data} args))) (/\dead -> Bool_match - (case - Bool + (ifThenElse + {Bool} (equalsInteger 1 index) - [False, True]) + True + False) {all dead. ScriptPurpose} (/\dead -> Spending @@ -1249,10 +1293,11 @@ (headList {data} args))) (/\dead -> Bool_match - (case - Bool + (ifThenElse + {Bool} (equalsInteger 2 index) - [False, True]) + True + False) {all dead. ScriptPurpose} (/\dead -> Rewarding @@ -1260,10 +1305,11 @@ (headList {data} args))) (/\dead -> Bool_match - (case - Bool + (ifThenElse + {Bool} (equalsInteger 3 index) - [False, True]) + True + False) {all dead. ScriptPurpose} (/\dead -> Certifying @@ -1277,10 +1323,11 @@ args)))) (/\dead -> Bool_match - (case - Bool + (ifThenElse + {Bool} (equalsInteger 4 index) - [False, True]) + True + False) {all dead. ScriptPurpose} (/\dead -> Voting @@ -1290,12 +1337,13 @@ args))) (/\dead -> Bool_match - (case - Bool + (ifThenElse + {Bool} (equalsInteger 5 index) - [False, True]) + True + False) {all dead. ScriptPurpose} (/\dead -> Proposing @@ -1346,26 +1394,29 @@ = sndPair {integer} {list data} tup in Bool_match - (case - Bool + (ifThenElse + {Bool} (equalsInteger 0 index) - [False, True]) + True + False) {all dead. Vote} (/\dead -> VoteNo) (/\dead -> Bool_match - (case - Bool + (ifThenElse + {Bool} (equalsInteger 1 index) - [False, True]) + True + False) {all dead. Vote} (/\dead -> VoteYes) (/\dead -> Bool_match - (case - Bool + (ifThenElse + {Bool} (equalsInteger 2 index) - [False, True]) + True + False) {all dead. Vote} (/\dead -> Abstain) (/\dead -> traceError {Vote} "PT1") @@ -1410,12 +1461,12 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (case Bool (equalsInteger 0 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 0 index) True False) {all dead. ScriptInfo} (/\dead -> MintingScript (unBData (headList {data} args))) (/\dead -> Bool_match - (case Bool (equalsInteger 1 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 1 index) True False) {all dead. ScriptInfo} (/\dead -> SpendingScript @@ -1427,7 +1478,11 @@ (headList {data} (tailList {data} args)))) (/\dead -> Bool_match - (case Bool (equalsInteger 2 index) [False, True]) + (ifThenElse + {Bool} + (equalsInteger 2 index) + True + False) {all dead. ScriptInfo} (/\dead -> RewardingScript @@ -1435,10 +1490,11 @@ (headList {data} args))) (/\dead -> Bool_match - (case - Bool + (ifThenElse + {Bool} (equalsInteger 3 index) - [False, True]) + True + False) {all dead. ScriptInfo} (/\dead -> CertifyingScript @@ -1449,10 +1505,11 @@ (tailList {data} args)))) (/\dead -> Bool_match - (case - Bool + (ifThenElse + {Bool} (equalsInteger 4 index) - [False, True]) + True + False) {all dead. ScriptInfo} (/\dead -> VotingScript @@ -1460,10 +1517,11 @@ (headList {data} args))) (/\dead -> Bool_match - (case - Bool + (ifThenElse + {Bool} (equalsInteger 5 index) - [False, True]) + True + False) {all dead. ScriptInfo} (/\dead -> ProposingScript diff --git a/plutus-benchmark/script-contexts/test/V3/9.6/checkScriptContext2.size.golden b/plutus-benchmark/script-contexts/test/V3/9.6/checkScriptContext2.size.golden index 70372d03eb0..966f606261a 100644 --- a/plutus-benchmark/script-contexts/test/V3/9.6/checkScriptContext2.size.golden +++ b/plutus-benchmark/script-contexts/test/V3/9.6/checkScriptContext2.size.golden @@ -1 +1 @@ -2723 \ No newline at end of file +3015 \ No newline at end of file diff --git a/plutus-benchmark/script-contexts/test/V3/9.6/checkScriptContextEqualityData-20.eval.golden b/plutus-benchmark/script-contexts/test/V3/9.6/checkScriptContextEqualityData-20.eval.golden index 89b0bc7cfc7..0704e87df44 100644 --- a/plutus-benchmark/script-contexts/test/V3/9.6/checkScriptContextEqualityData-20.eval.golden +++ b/plutus-benchmark/script-contexts/test/V3/9.6/checkScriptContextEqualityData-20.eval.golden @@ -1,5 +1,5 @@ -CPU: 37_958_283 -Memory: 33_101 -Size: 340 +CPU: 38_114_332 +Memory: 33_602 +Size: 344 (constr 0) \ No newline at end of file diff --git a/plutus-benchmark/script-contexts/test/V3/Data/9.6/checkScriptContext1-20.eval.golden b/plutus-benchmark/script-contexts/test/V3/Data/9.6/checkScriptContext1-20.eval.golden index 7dc6d854033..3ae5cb3089e 100644 --- a/plutus-benchmark/script-contexts/test/V3/Data/9.6/checkScriptContext1-20.eval.golden +++ b/plutus-benchmark/script-contexts/test/V3/Data/9.6/checkScriptContext1-20.eval.golden @@ -1,5 +1,5 @@ -CPU: 20_250_376 -Memory: 72_782 -Size: 95 +CPU: 20_406_425 +Memory: 73_283 +Size: 99 (constr 0) \ No newline at end of file diff --git a/plutus-benchmark/script-contexts/test/V3/Data/9.6/checkScriptContext1-4.eval.golden b/plutus-benchmark/script-contexts/test/V3/Data/9.6/checkScriptContext1-4.eval.golden index d519bd7b44e..02b633f2c12 100644 --- a/plutus-benchmark/script-contexts/test/V3/Data/9.6/checkScriptContext1-4.eval.golden +++ b/plutus-benchmark/script-contexts/test/V3/Data/9.6/checkScriptContext1-4.eval.golden @@ -1,5 +1,5 @@ -CPU: 5_674_136 -Memory: 20_014 -Size: 95 +CPU: 5_830_185 +Memory: 20_515 +Size: 99 (constr 0) \ No newline at end of file diff --git a/plutus-benchmark/script-contexts/test/V3/Data/9.6/checkScriptContext1.pir.golden b/plutus-benchmark/script-contexts/test/V3/Data/9.6/checkScriptContext1.pir.golden index ed79ee0d629..8c08dfde09a 100644 --- a/plutus-benchmark/script-contexts/test/V3/Data/9.6/checkScriptContext1.pir.golden +++ b/plutus-benchmark/script-contexts/test/V3/Data/9.6/checkScriptContext1.pir.golden @@ -32,12 +32,12 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (case Bool (equalsInteger 1 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 1 index) True False) {all dead. Maybe a} (/\dead -> Nothing {a}) (/\dead -> Bool_match - (case Bool (equalsInteger 0 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 0 index) True False) {all dead. Maybe a} (/\dead -> Just {a} (`$dUnsafeFromData` (headList {data} args))) @@ -78,8 +78,8 @@ {Unit} (\(ipv : data) -> Bool_match - (case - Bool + (ifThenElse + {Bool} (equalsInteger 0 (modInteger @@ -194,7 +194,8 @@ in go ds) 2)) - [False, True]) + True + False) {all dead. Unit} (/\dead -> Unit) (/\dead -> diff --git a/plutus-benchmark/script-contexts/test/V3/Data/9.6/checkScriptContext1.size.golden b/plutus-benchmark/script-contexts/test/V3/Data/9.6/checkScriptContext1.size.golden index 90be1cdd8ee..d97edbb29fa 100644 --- a/plutus-benchmark/script-contexts/test/V3/Data/9.6/checkScriptContext1.size.golden +++ b/plutus-benchmark/script-contexts/test/V3/Data/9.6/checkScriptContext1.size.golden @@ -1 +1 @@ -95 \ No newline at end of file +99 \ No newline at end of file diff --git a/plutus-benchmark/script-contexts/test/V3/Data/9.6/checkScriptContextEqualityData-20.eval.golden b/plutus-benchmark/script-contexts/test/V3/Data/9.6/checkScriptContextEqualityData-20.eval.golden index fa7df59243b..b8cda418940 100644 --- a/plutus-benchmark/script-contexts/test/V3/Data/9.6/checkScriptContextEqualityData-20.eval.golden +++ b/plutus-benchmark/script-contexts/test/V3/Data/9.6/checkScriptContextEqualityData-20.eval.golden @@ -1,5 +1,5 @@ -CPU: 32_918_283 -Memory: 1_601 -Size: 25 +CPU: 33_074_332 +Memory: 2_102 +Size: 29 (constr 0) \ No newline at end of file diff --git a/plutus-benchmark/script-contexts/test/V3/Data/9.6/purposeIsWellFormed-4.eval.golden b/plutus-benchmark/script-contexts/test/V3/Data/9.6/purposeIsWellFormed-4.eval.golden index dd92e160af0..b8f3523b13f 100644 --- a/plutus-benchmark/script-contexts/test/V3/Data/9.6/purposeIsWellFormed-4.eval.golden +++ b/plutus-benchmark/script-contexts/test/V3/Data/9.6/purposeIsWellFormed-4.eval.golden @@ -1,11 +1,5 @@ -<<<<<<< HEAD -CPU: 60_455_049 -Memory: 281_482 -Size: 2_317 -======= CPU: 38_049_927 Memory: 136_213 Size: 2_273 ->>>>>>> 7e21569f69b83520d5dfa47ad3a5908224009f45 (con unit ()) \ No newline at end of file diff --git a/plutus-benchmark/script-contexts/test/V3/Data/9.6/purposeIsWellFormed.pir.golden b/plutus-benchmark/script-contexts/test/V3/Data/9.6/purposeIsWellFormed.pir.golden index 251134e19c2..70078312786 100644 --- a/plutus-benchmark/script-contexts/test/V3/Data/9.6/purposeIsWellFormed.pir.golden +++ b/plutus-benchmark/script-contexts/test/V3/Data/9.6/purposeIsWellFormed.pir.golden @@ -2,340 +2,6 @@ let data Bool | Bool_match where True : Bool False : Bool -<<<<<<< HEAD -in -letrec - data (List :: * -> *) a | List_match where - Nil : List a - Cons : a -> List a -> List a -in -let - !mapQuantity : integer -> List integer - = \(x : integer) -> - (let - a = List integer - in - \(c : integer -> a -> a) (n : a) -> - Bool_match - (case Bool (lessThanEqualsInteger x 0) [True, False]) - {all dead. a} - (/\dead -> c x n) - (/\dead -> n) - {all dead. dead}) - (\(ds : integer) (ds : List integer) -> Cons {integer} ds ds) - (Nil {integer}) - !concatMap : all a b. (a -> List b) -> List a -> List b - = /\a b -> - \(f : a -> List b) -> - letrec - !go : List a -> List b - = \(ds : List a) -> - List_match - {a} - ds - {all dead. List b} - (/\dead -> Nil {b}) - (\(x : a) (xs : List a) -> - /\dead -> - let - !ys : List b = go xs - in - letrec - !go : List b -> List b - = \(ds : List b) -> - List_match - {b} - ds - {all dead. List b} - (/\dead -> ys) - (\(x : b) (xs : List b) -> - /\dead -> Cons {b} x (go xs)) - {all dead. dead} - in - let - !l : List b = f x - in - go l) - {all dead. dead} - in - \(eta : List a) -> go eta - !caseList' : all a r. r -> (a -> list a -> r) -> list a -> r - = /\a r -> - \(z : r) (f : a -> list a -> r) (xs : list a) -> - chooseList - {a} - {all dead. r} - xs - (/\dead -> z) - (/\dead -> f (headList {a} xs) (tailList {a} xs)) - {r} - data (Tuple2 :: * -> * -> *) a b | Tuple2_match where - Tuple2 : a -> b -> Tuple2 a b - !toSOPList : - all k a. - (\a -> data -> a) k -> - (\a -> data -> a) a -> - (\k a -> list (pair data data)) k a -> - List (Tuple2 k a) - = /\k a -> - \(`$dUnsafeFromData` : (\a -> data -> a) k) - (`$dUnsafeFromData` : (\a -> data -> a) a) - (d : (\k a -> list (pair data data)) k a) -> - letrec - !go : list (pair data data) -> List (Tuple2 k a) - = caseList' - {pair data data} - {List (Tuple2 k a)} - (Nil {Tuple2 k a}) - (\(hd : pair data data) (tl : list (pair data data)) -> - Cons - {Tuple2 k a} - (Tuple2 - {k} - {a} - (`$dUnsafeFromData` (fstPair {data} {data} hd)) - (`$dUnsafeFromData` (sndPair {data} {data} hd))) - (go tl)) - in - go d -in -letrec - !goList : List (Tuple2 data data) -> list (pair data data) - = \(ds : List (Tuple2 data data)) -> - List_match - {Tuple2 data data} - ds - {list (pair data data)} - [] - (\(d : Tuple2 data data) (ds : List (Tuple2 data data)) -> - mkCons - {pair data data} - (Tuple2_match - {data} - {data} - d - {pair data data} - (\(d : data) (d : data) -> mkPairData d d)) - (goList ds)) -in -let - !unsafeFromSOPList : - all k a. - (\a -> a -> data) k -> - (\a -> a -> data) a -> - List (Tuple2 k a) -> - (\k a -> list (pair data data)) k a - = /\k a -> - \(`$dToData` : (\a -> a -> data) k) - (`$dToData` : (\a -> a -> data) a) -> - letrec - !go : List (Tuple2 k a) -> List (Tuple2 data data) - = \(ds : List (Tuple2 k a)) -> - List_match - {Tuple2 k a} - ds - {all dead. List (Tuple2 data data)} - (/\dead -> Nil {Tuple2 data data}) - (\(x : Tuple2 k a) (xs : List (Tuple2 k a)) -> - /\dead -> - Cons - {Tuple2 data data} - (Tuple2_match - {k} - {a} - x - {Tuple2 data data} - (\(k : k) (a : a) -> - Tuple2 - {data} - {data} - (`$dToData` k) - (`$dToData` a))) - (go xs)) - {all dead. dead} - in - \(eta : List (Tuple2 k a)) -> goList (go eta) -in -letrec - !go : - List - (Tuple2 - bytestring - ((\k a -> list (pair data data)) bytestring integer)) -> - List - (Tuple2 bytestring ((\k a -> list (pair data data)) bytestring integer)) - = \(ds : - List - (Tuple2 - bytestring - ((\k a -> list (pair data data)) bytestring integer))) -> - List_match - {Tuple2 - bytestring - ((\k a -> list (pair data data)) bytestring integer)} - ds - {all dead. - List - (Tuple2 - bytestring - ((\k a -> list (pair data data)) bytestring integer))} - (/\dead -> - Nil - {Tuple2 - bytestring - ((\k a -> list (pair data data)) bytestring integer)}) - (\(x : - Tuple2 - bytestring - ((\k a -> list (pair data data)) bytestring integer)) - (xs : - List - (Tuple2 - bytestring - ((\k a -> list (pair data data)) bytestring integer))) -> - /\dead -> - Tuple2_match - {bytestring} - {(\k a -> list (pair data data)) bytestring integer} - x - {List - (Tuple2 - bytestring - ((\k a -> list (pair data data)) bytestring integer))} - (\(currency : bytestring) - (tokenQuantities : - (\k a -> list (pair data data)) bytestring integer) -> - List_match - {Tuple2 bytestring integer} - (concatMap - {Tuple2 bytestring integer} - {Tuple2 bytestring integer} - (\(eta : Tuple2 bytestring integer) -> - Tuple2_match - {bytestring} - {integer} - eta - {List (Tuple2 bytestring integer)} - (\(c : bytestring) -> - letrec - !go : - List integer -> - List (Tuple2 bytestring integer) - = \(ds : List integer) -> - List_match - {integer} - ds - {all dead. - List (Tuple2 bytestring integer)} - (/\dead -> - Nil {Tuple2 bytestring integer}) - (\(x : integer) - (xs : List integer) -> - /\dead -> - Cons - {Tuple2 bytestring integer} - (Tuple2 - {bytestring} - {integer} - c - x) - (go xs)) - {all dead. dead} - in - \(a : integer) -> go (mapQuantity a))) - (toSOPList - {bytestring} - {integer} - unBData - unIData - tokenQuantities)) - {all dead. - List - (Tuple2 - bytestring - ((\k a -> list (pair data data)) - bytestring - integer))} - (/\dead -> go xs) - (\(ipv : Tuple2 bytestring integer) - (ipv : List (Tuple2 bytestring integer)) -> - /\dead -> - Cons - {Tuple2 - bytestring - ((\k a -> list (pair data data)) - bytestring - integer)} - (Tuple2 - {bytestring} - {(\k a -> list (pair data data)) - bytestring - integer} - currency - (unsafeFromSOPList - {bytestring} - {integer} - bData - (\(i : integer) -> iData i) - (concatMap - {Tuple2 bytestring integer} - {Tuple2 bytestring integer} - (\(eta : Tuple2 bytestring integer) -> - Tuple2_match - {bytestring} - {integer} - eta - {List (Tuple2 bytestring integer)} - (\(c : bytestring) -> - letrec - !go : - List integer -> - List - (Tuple2 bytestring integer) - = \(ds : List integer) -> - List_match - {integer} - ds - {all dead. - List - (Tuple2 - bytestring - integer)} - (/\dead -> - Nil - {Tuple2 - bytestring - integer}) - (\(x : integer) - (xs : List integer) -> - /\dead -> - Cons - {Tuple2 - bytestring - integer} - (Tuple2 - {bytestring} - {integer} - c - x) - (go xs)) - {all dead. dead} - in - \(a : integer) -> - go (mapQuantity a))) - (toSOPList - {bytestring} - {integer} - unBData - unIData - tokenQuantities)))) - (go xs)) - {all dead. dead})) - {all dead. dead} -in -let -======= ->>>>>>> 7e21569f69b83520d5dfa47ad3a5908224009f45 !`$fEqCredential_$c==` : data -> data -> Bool = \(ds : data) (ds : data) -> let @@ -345,24 +11,26 @@ let !tup : pair integer (list data) = unConstrData ds in Bool_match - (case - Bool + (ifThenElse + {Bool} (equalsInteger 1 (fstPair {integer} {list data} tup)) - [False, True]) + True + False) {all dead. Bool} (/\dead -> let !tup : pair integer (list data) = unConstrData ds in Bool_match - (case - Bool + (ifThenElse + {Bool} (equalsInteger 1 (fstPair {integer} {list data} tup)) - [False, True]) + True + False) {all dead. Bool} (/\dead -> - case - Bool + ifThenElse + {Bool} (equalsByteString (unBData (headList @@ -372,7 +40,8 @@ let (headList {data} (sndPair {integer} {list data} tup)))) - [False, True]) + True + False) (/\dead -> False) {all dead. dead}) (/\dead -> False) @@ -380,24 +49,26 @@ let !tup : pair integer (list data) = unConstrData ds in Bool_match - (case - Bool + (ifThenElse + {Bool} (equalsInteger 0 (fstPair {integer} {list data} tup)) - [False, True]) + True + False) {all dead. Bool} (/\dead -> let !tup : pair integer (list data) = unConstrData ds in Bool_match - (case - Bool + (ifThenElse + {Bool} (equalsInteger 0 (fstPair {integer} {list data} tup)) - [False, True]) + True + False) {all dead. Bool} (/\dead -> - case - Bool + ifThenElse + {Bool} (equalsByteString (unBData (headList {data} (sndPair {integer} {list data} tup))) @@ -405,7 +76,8 @@ let (headList {data} (sndPair {integer} {list data} tup)))) - [False, True]) + True + False) (/\dead -> fail ()) {all dead. dead}) (/\dead -> fail ()) @@ -416,40 +88,44 @@ let !fail : unit -> Bool = \(ds : unit) -> Bool_match - (case - Bool + (ifThenElse + {Bool} (equalsInteger 2 (fstPair {integer} {list data} (unConstrData ds))) - [False, True]) + True + False) {all dead. Bool} (/\dead -> - case - Bool + ifThenElse + {Bool} (equalsInteger 2 (fstPair {integer} {list data} (unConstrData ds))) - [False, True]) + True + False) (/\dead -> False) {all dead. dead} !fail : unit -> Bool = \(ds : unit) -> Bool_match - (case - Bool + (ifThenElse + {Bool} (equalsInteger 1 (fstPair {integer} {list data} (unConstrData ds))) - [False, True]) + True + False) {all dead. Bool} (/\dead -> Bool_match - (case - Bool + (ifThenElse + {Bool} (equalsInteger 1 (fstPair {integer} {list data} (unConstrData ds))) - [False, True]) + True + False) {all dead. Bool} (/\dead -> True) (/\dead -> fail ()) @@ -459,20 +135,22 @@ let !tup : pair integer (list data) = unConstrData ds in Bool_match - (case - Bool + (ifThenElse + {Bool} (equalsInteger 0 (fstPair {integer} {list data} tup)) - [False, True]) + True + False) {all dead. Bool} (/\dead -> let !tup : pair integer (list data) = unConstrData ds in Bool_match - (case - Bool + (ifThenElse + {Bool} (equalsInteger 0 (fstPair {integer} {list data} tup)) - [False, True]) + True + False) {all dead. Bool} (/\dead -> `$fEqCredential_$c==` @@ -490,10 +168,11 @@ let !tup : pair integer (list data) = unConstrData scrut in Bool_match - (case - Bool + (ifThenElse + {Bool} (equalsInteger 2 (fstPair {integer} {list data} tup)) - [False, True]) + True + False) {all dead. r} (/\dead -> let @@ -518,7 +197,11 @@ let ds (\(a' : bytestring) (b' : data) -> Bool_match - (case Bool (equalsByteString a a') [False, True]) + (ifThenElse + {Bool} + (equalsByteString a a') + True + False) {all dead. Bool} (/\dead -> `$fEqDRep0_$c==` b b') (/\dead -> False) @@ -531,20 +214,22 @@ let !tup : pair integer (list data) = unConstrData ds in Bool_match - (case - Bool + (ifThenElse + {Bool} (equalsInteger 1 (fstPair {integer} {list data} tup)) - [False, True]) + True + False) {all dead. Bool} (/\dead -> let !tup : pair integer (list data) = unConstrData ds in Bool_match - (case - Bool + (ifThenElse + {Bool} (equalsInteger 1 (fstPair {integer} {list data} tup)) - [False, True]) + True + False) {all dead. Bool} (/\dead -> `$fEqDRep0_$c==` @@ -561,24 +246,26 @@ let !tup : pair integer (list data) = unConstrData ds in Bool_match - (case - Bool + (ifThenElse + {Bool} (equalsInteger 0 (fstPair {integer} {list data} tup)) - [False, True]) + True + False) {all dead. Bool} (/\dead -> let !tup : pair integer (list data) = unConstrData ds in Bool_match - (case - Bool + (ifThenElse + {Bool} (equalsInteger 0 (fstPair {integer} {list data} tup)) - [False, True]) + True + False) {all dead. Bool} (/\dead -> - case - Bool + ifThenElse + {Bool} (equalsByteString (unBData (headList {data} (sndPair {integer} {list data} tup))) @@ -586,7 +273,8 @@ let (headList {data} (sndPair {integer} {list data} tup)))) - [False, True]) + True + False) (/\dead -> fail ()) {all dead. dead}) (/\dead -> fail ()) @@ -599,10 +287,11 @@ let !tup : pair integer (list data) = unConstrData scrut in Bool_match - (case - Bool + (ifThenElse + {Bool} (equalsInteger 9 (fstPair {integer} {list data} tup)) - [False, True]) + True + False) {all dead. r} (/\dead -> let @@ -619,10 +308,11 @@ let !tup : pair integer (list data) = unConstrData scrut in Bool_match - (case - Bool + (ifThenElse + {Bool} (equalsInteger 2 (fstPair {integer} {list data} tup)) - [False, True]) + True + False) {all dead. r} (/\dead -> let @@ -638,10 +328,11 @@ let !tup : pair integer (list data) = unConstrData scrut in Bool_match - (case - Bool + (ifThenElse + {Bool} (equalsInteger 4 (fstPair {integer} {list data} tup)) - [False, True]) + True + False) {all dead. r} (/\dead -> let @@ -662,10 +353,11 @@ let !tup : pair integer (list data) = unConstrData scrut in Bool_match - (case - Bool + (ifThenElse + {Bool} (equalsInteger 3 (fstPair {integer} {list data} tup)) - [False, True]) + True + False) {all dead. r} (/\dead -> let @@ -696,12 +388,12 @@ let !args : list data = sndPair {integer} {list data} tup in Bool_match - (case Bool (equalsInteger 1 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 1 index) True False) {all dead. Maybe a} (/\dead -> Nothing {a}) (/\dead -> Bool_match - (case Bool (equalsInteger 0 index) [False, True]) + (ifThenElse {Bool} (equalsInteger 0 index) True False) {all dead. Maybe a} (/\dead -> Just {a} (`$dUnsafeFromData` (headList {data} args))) @@ -718,10 +410,11 @@ let !tup : pair integer (list data) = unConstrData scrut in Bool_match - (case - Bool + (ifThenElse + {Bool} (equalsInteger 0 (fstPair {integer} {list data} tup)) - [False, True]) + True + False) {all dead. r} (/\dead -> let @@ -743,10 +436,11 @@ let !tup : pair integer (list data) = unConstrData scrut in Bool_match - (case - Bool + (ifThenElse + {Bool} (equalsInteger 6 (fstPair {integer} {list data} tup)) - [False, True]) + True + False) {all dead. r} (/\dead -> let @@ -767,10 +461,11 @@ let !tup : pair integer (list data) = unConstrData scrut in Bool_match - (case - Bool + (ifThenElse + {Bool} (equalsInteger 1 (fstPair {integer} {list data} tup)) - [False, True]) + True + False) {all dead. r} (/\dead -> let @@ -846,12 +541,13 @@ let False (\(hd : pair data data) -> Bool_match - (case - Bool + (ifThenElse + {Bool} (equalsData (`$dToData` ds) (fstPair {data} {data} hd)) - [False, True]) + True + False) {all dead. list (pair data data) -> Bool} (/\dead -> \(ds : list (pair data data)) -> True) (/\dead -> go) @@ -897,7 +593,7 @@ let !null : all a. (\a -> list data) a -> Bool = /\a -> \(eta : (\a -> list data) a) -> - case Bool (nullList {data} eta) [False, True] + ifThenElse {Bool} (nullList {data} eta) True False !txOutRefId : data -> bytestring = \(ds : data) -> unBData @@ -927,10 +623,11 @@ in !tup : pair integer (list data) = unConstrData scriptInfo in Bool_match - (case - Bool + (ifThenElse + {Bool} (equalsInteger 0 (fstPair {integer} {list data} tup)) - [False, True]) + True + False) {all dead. Bool} (/\dead -> (let @@ -1011,10 +708,11 @@ in !tup : pair integer (list data) = unConstrData scriptInfo in Bool_match - (case - Bool + (ifThenElse + {Bool} (equalsInteger 1 (fstPair {integer} {list data} tup)) - [False, True]) + True + False) {all dead. Bool} (/\dead -> let @@ -1051,18 +749,20 @@ in !l : data = headList {data} l in Bool_match - (case - Bool + (ifThenElse + {Bool} (equalsByteString (txOutRefId l) (txOutRefId v)) - [False, True]) + True + False) {all dead. Bool} (/\dead -> - case - Bool + ifThenElse + {Bool} (equalsInteger (txOutRefIdx l) (txOutRefIdx v)) - [False, True]) + True + False) (/\dead -> False) {all dead. dead}) (unListData (headList {data} l)))) @@ -1072,10 +772,11 @@ in !tup : pair integer (list data) = unConstrData scriptInfo in Bool_match - (case - Bool + (ifThenElse + {Bool} (equalsInteger 2 (fstPair {integer} {list data} tup)) - [False, True]) + True + False) {all dead. Bool} (/\dead -> member @@ -1089,10 +790,11 @@ in !tup : pair integer (list data) = unConstrData scriptInfo in Bool_match - (case - Bool + (ifThenElse + {Bool} (equalsInteger 3 (fstPair {integer} {list data} tup)) - [False, True]) + True + False) {all dead. Bool} (/\dead -> let @@ -1119,15 +821,16 @@ in = unConstrData eta in Bool_match - (case - Bool + (ifThenElse + {Bool} (equalsInteger 10 (fstPair {integer} {list data} tup)) - [False, True]) + True + False) {all dead. Bool} (/\dead -> let @@ -1135,15 +838,16 @@ in = unConstrData v in Bool_match - (case - Bool + (ifThenElse + {Bool} (equalsInteger 10 (fstPair {integer} {list data} tup)) - [False, True]) + True + False) {all dead. Bool} (/\dead -> `$fEqCredential_$c==` @@ -1198,10 +902,11 @@ in (`$fEqCredential_$c==` a a') {all dead. Bool} (/\dead -> - case - Bool + ifThenElse + {Bool} (equalsInteger b b') - [False, True]) + True + False) (/\dead -> False) {all dead. dead}) (\(void : unit) -> fail ())) @@ -1213,15 +918,16 @@ in = unConstrData eta in Bool_match - (case - Bool + (ifThenElse + {Bool} (equalsInteger 5 (fstPair {integer} {list data} tup)) - [False, True]) + True + False) {all dead. Bool} (/\dead -> let @@ -1229,15 +935,16 @@ in = unConstrData v in Bool_match - (case - Bool + (ifThenElse + {Bool} (equalsInteger 5 (fstPair {integer} {list data} tup)) - [False, True]) + True + False) {all dead. Bool} (/\dead -> `$fEqCredential_$c==` @@ -1271,10 +978,11 @@ in (`$fEqCredential_$c==` a a') {all dead. Bool} (/\dead -> - case - Bool + ifThenElse + {Bool} (equalsInteger b b') - [False, True]) + True + False) (/\dead -> False) {all dead. dead}) (\(void : unit) -> fail ())) @@ -1303,12 +1011,13 @@ in b') {all dead. Bool} (/\dead -> - case - Bool + ifThenElse + {Bool} (equalsInteger c c') - [False, True]) + True + False) (/\dead -> False) {all dead. dead}) (/\dead -> False) @@ -1366,13 +1075,13 @@ in (\(a : integer) -> /\dead -> - case - Bool + ifThenElse + {Bool} (equalsInteger a a) - [ False - , True ]) + True + False) (/\dead -> False) {all dead. @@ -1418,12 +1127,13 @@ in {all dead. Bool} (\(a : integer) -> /\dead -> - case - Bool + ifThenElse + {Bool} (equalsInteger a a) - [False, True]) + True + False) (/\dead -> False) {all dead. dead}) (/\dead -> @@ -1447,12 +1157,13 @@ in = unConstrData scriptInfo in Bool_match - (case - Bool + (ifThenElse + {Bool} (equalsInteger 4 (fstPair {integer} {list data} tup)) - [False, True]) + True + False) {all dead. Bool} (/\dead -> member @@ -1482,12 +1193,13 @@ in = unConstrData scriptInfo in Bool_match - (case - Bool + (ifThenElse + {Bool} (equalsInteger 5 (fstPair {integer} {list data} tup)) - [False, True]) + True + False) {all dead. Bool} (/\dead -> let diff --git a/plutus-benchmark/script-contexts/test/V3/Data/9.6/purposeIsWellFormed.size.golden b/plutus-benchmark/script-contexts/test/V3/Data/9.6/purposeIsWellFormed.size.golden index b92d6b72999..673819deb0e 100644 --- a/plutus-benchmark/script-contexts/test/V3/Data/9.6/purposeIsWellFormed.size.golden +++ b/plutus-benchmark/script-contexts/test/V3/Data/9.6/purposeIsWellFormed.size.golden @@ -1,5 +1 @@ -<<<<<<< HEAD -2315 -======= -2271 ->>>>>>> 7e21569f69b83520d5dfa47ad3a5908224009f45 +2271 \ No newline at end of file From 51dfc51c23b77d45a738ffc35e94e109e452779e Mon Sep 17 00:00:00 2001 From: effectfully Date: Fri, 20 Jun 2025 01:57:55 +0100 Subject: [PATCH 22/25] Polishing --- .../src/PlutusCore/Builtin/Case.hs | 4 +++ .../src/PlutusCore/Builtin/Runtime.hs | 32 +++++++++++++++---- .../Evaluation/Machine/Exception.hs | 2 +- .../Evaluation/Machine/MachineParameters.hs | 10 +++--- .../Machine/MachineParameters/Default.hs | 8 +++-- .../Transform/StrictLetRec/Tests/Lib.hs | 1 - .../Evaluation/Golden/caseNonTag.plc.golden | 4 +-- .../Evaluation/Golden/caseNonTag.type.golden | 8 ++++- .../Evaluation/Golden/caseNonTag.uplc.golden | 5 ++- .../testlib/Evaluation/Golden.hs | 6 +++- .../PlutusLedgerApi/V1/EvaluationContext.hs | 13 ++++---- .../PlutusLedgerApi/V2/EvaluationContext.hs | 14 ++++---- .../PlutusLedgerApi/V3/EvaluationContext.hs | 15 +++++---- plutus-tx/src/PlutusTx/Builtins/Internal.hs | 3 +- 14 files changed, 80 insertions(+), 45 deletions(-) diff --git a/plutus-core/plutus-core/src/PlutusCore/Builtin/Case.hs b/plutus-core/plutus-core/src/PlutusCore/Builtin/Case.hs index c9049722a6a..938b02f0625 100644 --- a/plutus-core/plutus-core/src/PlutusCore/Builtin/Case.hs +++ b/plutus-core/plutus-core/src/PlutusCore/Builtin/Case.hs @@ -31,6 +31,10 @@ class CaseBuiltin uni where -- this type isn't supported at all). caseBuiltin :: UniOf term ~ uni => Some (ValueOf uni) -> Vector term -> Either Text term +-- See Note [DO NOT newtype-wrap functions]. +-- | A @data@ version of 'CaseBuiltin'. we parameterize the evaluator by a 'CaserBuiltin' so that +-- the caller can choose whether to use the 'caseBuiltin' method or the always failing caser (the +-- latter is required for earlier protocol versions when we didn't support casing on builtins). data CaserBuiltin uni = CaserBuiltin { unCaserBuiltin :: !(forall term. UniOf term ~ uni => Some (ValueOf uni) -> Vector term -> Either Text term) diff --git a/plutus-core/plutus-core/src/PlutusCore/Builtin/Runtime.hs b/plutus-core/plutus-core/src/PlutusCore/Builtin/Runtime.hs index 2dbeb498fd3..38848e48d53 100644 --- a/plutus-core/plutus-core/src/PlutusCore/Builtin/Runtime.hs +++ b/plutus-core/plutus-core/src/PlutusCore/Builtin/Runtime.hs @@ -61,14 +61,32 @@ instance NFData (BuiltinRuntime val) where -- this to WHNF to get it forced to NF. rnf = rwhnf +{- Note [DO NOT newtype-wrap functions] +If you put a functional type into a @newtype@ rather than strict @data@, the GHC optimizer will be +able to see through it and will feel compelled to rearrange lambdas and case-expressions as it sees +fit, which it often does incorrectly due to @-fpedantic-bottoms@ not being enabled by default. + +We've had a very confusing case of GHC turning + + case y of + y' -> \x -> z + +into + + \x -> case y of + y' -> z + +and ruining carefully set up optimizations +(see https://github.com/IntersectMBO/plutus/pull/4914#issuecomment-1396306606). + +Even strict @data@ is slower than @newtype@, but in practice GHC is going to +worker-wrapper-transform such code making it as efficient as the @newtype@ version. + +So you should never newtype-wrap functions, use strict @data@ instead. +-} + +-- See Note [DO NOT newtype-wrap functions]. -- | A @data@ wrapper around a function returning the 'BuiltinRuntime' of a built-in function. --- We use @data@ rather than @newtype@, because GHC is able to see through @newtype@s and may break --- carefully set up optimizations, see --- https://github.com/IntersectMBO/plutus/pull/4914#issuecomment-1396306606 --- --- Using @data@ may make things more expensive, however it was verified at the time of writing that --- the wrapper is removed before the CEK machine starts, leaving the stored function to be used --- directly. -- -- In order for lookups to be efficient the 'BuiltinRuntime's need to be cached, i.e. pulled out -- of the function statically. See 'makeBuiltinMeaning' for how we achieve that. diff --git a/plutus-core/plutus-core/src/PlutusCore/Evaluation/Machine/Exception.hs b/plutus-core/plutus-core/src/PlutusCore/Evaluation/Machine/Exception.hs index 923caa87e14..8ad6133d71b 100644 --- a/plutus-core/plutus-core/src/PlutusCore/Evaluation/Machine/Exception.hs +++ b/plutus-core/plutus-core/src/PlutusCore/Evaluation/Machine/Exception.hs @@ -119,7 +119,7 @@ instance (HasPrettyDefaults config ~ 'True, Pretty fun) => prettyBy _ (UnliftingMachineError unliftingError) = pretty unliftingError prettyBy _ NonConstrScrutinizedMachineError = - "A non-constructor value was scrutinized in a case expression" + "A non-constructor/non-builtin value was scrutinized in a case expression" prettyBy _ (MissingCaseBranchMachineError i) = "Case expression missing the branch required by the scrutinee tag:" <+> pretty i prettyBy _ (PanicMachineError err) = vcat diff --git a/plutus-core/plutus-core/src/PlutusCore/Evaluation/Machine/MachineParameters.hs b/plutus-core/plutus-core/src/PlutusCore/Evaluation/Machine/MachineParameters.hs index 1b2fefcc2d1..7de415e258b 100644 --- a/plutus-core/plutus-core/src/PlutusCore/Evaluation/Machine/MachineParameters.hs +++ b/plutus-core/plutus-core/src/PlutusCore/Evaluation/Machine/MachineParameters.hs @@ -33,10 +33,7 @@ data CostModel machinecosts builtincosts = } deriving stock (Eq, Show) makeLenses ''CostModel -{-| At execution time we need a 'BuiltinsRuntime' object which includes both the - cost model for builtins and their denotations. This bundles one of those - together with the cost model for evaluator steps. The 'term' type will be - CekValue when we're using this with the CEK machine. -} +-- | The part of 'MachineParameters' that is individual for each semantics variant of 'DefaultFun'. data MachineVariantParameters machineCosts fun val = MachineVariantParameters { machineCosts :: machineCosts @@ -45,6 +42,11 @@ data MachineVariantParameters machineCosts fun val = deriving stock Generic deriving anyclass (NFData) +{-| At execution time we need a 'BuiltinsRuntime' object which includes both the cost model for +builtins and their denotations. This bundles one of those together with the cost model for evaluator +steps and a 'CaserBuiltin' specifying how casing on values of built-in types works. +The @val@ type will be 'CekValue' when we're using this with the CEK machine. +-} data MachineParameters machineCosts fun val = MachineParameters { machineCaserBuiltin :: CaserBuiltin (UniOf val) diff --git a/plutus-core/plutus-core/src/PlutusCore/Evaluation/Machine/MachineParameters/Default.hs b/plutus-core/plutus-core/src/PlutusCore/Evaluation/Machine/MachineParameters/Default.hs index f806ee13b35..0b2073f7c49 100644 --- a/plutus-core/plutus-core/src/PlutusCore/Evaluation/Machine/MachineParameters/Default.hs +++ b/plutus-core/plutus-core/src/PlutusCore/Evaluation/Machine/MachineParameters/Default.hs @@ -1,3 +1,4 @@ +{-# OPTIONS_GHC -ddump-prep -ddump-to-file -dsuppress-all -dno-suppress-type-signatures -dppr-case-as-let -fforce-recomp -dumpdir /home/effectfully/code/iohk/plutus/junk/GHC-Core-dumps #-} -- | Defines the type of default machine parameters and a function for creating a value of the type. -- We keep them separate, because the function unfolds into multiple thousands of lines of Core that -- we need to be able to visually inspect, hence we dedicate a separate file to it. @@ -16,12 +17,13 @@ import Control.DeepSeq (force) import Control.Monad.Except import GHC.Exts (inline) --- | 'MachineParameters' instantiated at CEK-machine-specific types and default builtins. --- Encompasses everything we need for evaluating a UPLC program with default builtins using the CEK --- machine. +-- | The semantics-variant-dependent part of 'MachineParameters'. type DefaultMachineVariantParameters = MachineVariantParameters CekMachineCosts DefaultFun (CekValue DefaultUni DefaultFun ()) +-- | 'MachineParameters' instantiated at CEK-machine-specific types and default builtins. +-- Encompasses everything we need for evaluating a UPLC program with default builtins using the CEK +-- machine. type DefaultMachineParameters = MachineParameters CekMachineCosts DefaultFun (CekValue DefaultUni DefaultFun ()) diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/StrictLetRec/Tests/Lib.hs b/plutus-core/plutus-ir/test/PlutusIR/Transform/StrictLetRec/Tests/Lib.hs index b786a8498b7..66d94927990 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/StrictLetRec/Tests/Lib.hs +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/StrictLetRec/Tests/Lib.hs @@ -94,7 +94,6 @@ evaluateUplcProgramWithTraces uplcProg = machineParameters :: DefaultMachineParameters machineParameters = - -- TODO: proper semantic variant. What should def be? MachineParameters def $ mkMachineVariantParameters def costModel defaultCompilationCtx diff --git a/plutus-core/untyped-plutus-core/test/Evaluation/Golden/caseNonTag.plc.golden b/plutus-core/untyped-plutus-core/test/Evaluation/Golden/caseNonTag.plc.golden index 1bd7d1fbdda..25f60e83446 100644 --- a/plutus-core/untyped-plutus-core/test/Evaluation/Golden/caseNonTag.plc.golden +++ b/plutus-core/untyped-plutus-core/test/Evaluation/Golden/caseNonTag.plc.golden @@ -1,3 +1,3 @@ (Left An error has occurred: -A non-constructor value was scrutinized in a case expression -Caused by: (con integer 1)) \ No newline at end of file +A non-constructor/non-builtin value was scrutinized in a case expression +Caused by: (builtin addInteger)) \ No newline at end of file diff --git a/plutus-core/untyped-plutus-core/test/Evaluation/Golden/caseNonTag.type.golden b/plutus-core/untyped-plutus-core/test/Evaluation/Golden/caseNonTag.type.golden index 557f8ffd629..ae4f9e4987e 100644 --- a/plutus-core/untyped-plutus-core/test/Evaluation/Golden/caseNonTag.type.golden +++ b/plutus-core/untyped-plutus-core/test/Evaluation/Golden/caseNonTag.type.golden @@ -1 +1,7 @@ -(Right (con integer)) \ No newline at end of file +(Left Type mismatch at () +Expected a term of type + '(sop)' +But found one of type + '(fun (con integer) (fun (con integer) (con integer)))' +Namely, + '(builtin addInteger)') \ No newline at end of file diff --git a/plutus-core/untyped-plutus-core/test/Evaluation/Golden/caseNonTag.uplc.golden b/plutus-core/untyped-plutus-core/test/Evaluation/Golden/caseNonTag.uplc.golden index 315273b1b83..25f60e83446 100644 --- a/plutus-core/untyped-plutus-core/test/Evaluation/Golden/caseNonTag.uplc.golden +++ b/plutus-core/untyped-plutus-core/test/Evaluation/Golden/caseNonTag.uplc.golden @@ -1,4 +1,3 @@ (Left An error has occurred: -'case' over a value of a built-in type failed with -'case 1' is out of bounds for the given number of branches: 0 -Caused by: (con integer 1)) \ No newline at end of file +A non-constructor/non-builtin value was scrutinized in a case expression +Caused by: (builtin addInteger)) \ No newline at end of file diff --git a/plutus-core/untyped-plutus-core/testlib/Evaluation/Golden.hs b/plutus-core/untyped-plutus-core/testlib/Evaluation/Golden.hs index 44fcb30e09d..b25631d36df 100644 --- a/plutus-core/untyped-plutus-core/testlib/Evaluation/Golden.hs +++ b/plutus-core/untyped-plutus-core/testlib/Evaluation/Golden.hs @@ -388,8 +388,11 @@ caseProd1 = runQuote $ do caseNoBranch :: Term TyName Name DefaultUni DefaultFun () caseNoBranch = Case () integer tag1 [] +caseInteger :: Term TyName Name DefaultUni DefaultFun () +caseInteger = Case () integer (mkConstant @Integer () 1) [] + caseNonTag :: Term TyName Name DefaultUni DefaultFun () -caseNonTag = Case () integer (mkConstant @Integer () 1) [] +caseNonTag = Case () integer (builtin () AddInteger) [] -- | For testing that an accidental exception will get caught. headSingletonException :: Term TyName Name DefaultUni DefaultFun () @@ -481,6 +484,7 @@ namesAndTests = , ("case4", case4) , ("caseProd1", caseProd1) , ("caseNoBranch", caseNoBranch) + , ("caseInteger", caseInteger) , ("caseNonTag", caseNonTag) ] diff --git a/plutus-ledger-api/src/PlutusLedgerApi/V1/EvaluationContext.hs b/plutus-ledger-api/src/PlutusLedgerApi/V1/EvaluationContext.hs index cf0e2582afd..66faf322296 100644 --- a/plutus-ledger-api/src/PlutusLedgerApi/V1/EvaluationContext.hs +++ b/plutus-ledger-api/src/PlutusLedgerApi/V1/EvaluationContext.hs @@ -35,21 +35,20 @@ a protocol update with the updated cost model parameters. -} mkEvaluationContext :: (MonadError CostModelApplyError m, MonadWriter [CostModelApplyWarn] m) - => [Int64] - -- ^ the (updated) cost model parameters of the protocol + => [Int64] -- ^ the (updated) cost model parameters of the protocol -> m EvaluationContext mkEvaluationContext = tagWithParamNames @V1.ParamName >=> pure . toCostModelParams >=> mkDynEvaluationContext - PlutusV1 - (\pv -> + PlutusV1 + (\pv -> if pv < futurePV then unavailableCaserBuiltin $ getMajorProtocolVersion pv else CaserBuiltin caseBuiltin) - [DefaultFunSemanticsVariantA, DefaultFunSemanticsVariantB] - -- See Note [Mapping of protocol versions and ledger languages to semantics variants]. - (\pv -> + [DefaultFunSemanticsVariantA, DefaultFunSemanticsVariantB] + -- See Note [Mapping of protocol versions and ledger languages to semantics variants]. + (\pv -> if pv < changPV then DefaultFunSemanticsVariantA else DefaultFunSemanticsVariantB) diff --git a/plutus-ledger-api/src/PlutusLedgerApi/V2/EvaluationContext.hs b/plutus-ledger-api/src/PlutusLedgerApi/V2/EvaluationContext.hs index 097a8840b37..8f6703e2546 100644 --- a/plutus-ledger-api/src/PlutusLedgerApi/V2/EvaluationContext.hs +++ b/plutus-ledger-api/src/PlutusLedgerApi/V2/EvaluationContext.hs @@ -32,11 +32,12 @@ supplied in the wrong order then script cost calculations will be incorrect. IMPORTANT: The evaluation context of every Plutus version must be recreated upon a protocol update with the updated cost model parameters. -} -mkEvaluationContext :: (MonadError CostModelApplyError m, MonadWriter [CostModelApplyWarn] m) - => [Int64] -- ^ the (updated) cost model parameters of the protocol - -> m EvaluationContext +mkEvaluationContext + :: (MonadError CostModelApplyError m, MonadWriter [CostModelApplyWarn] m) + => [Int64] -- ^ the (updated) cost model parameters of the protocol + -> m EvaluationContext mkEvaluationContext = - tagWithParamNames @V2.ParamName + tagWithParamNames @V2.ParamName >=> pure . toCostModelParams >=> mkDynEvaluationContext PlutusV2 @@ -44,8 +45,9 @@ mkEvaluationContext = if pv < futurePV then unavailableCaserBuiltin $ getMajorProtocolVersion pv else CaserBuiltin caseBuiltin) - [DefaultFunSemanticsVariantA, DefaultFunSemanticsVariantB] + [DefaultFunSemanticsVariantA, DefaultFunSemanticsVariantB] -- See Note [Mapping of protocol versions and ledger languages to semantics variants]. - (\pv -> if pv < changPV + (\pv -> + if pv < changPV then DefaultFunSemanticsVariantA else DefaultFunSemanticsVariantB) diff --git a/plutus-ledger-api/src/PlutusLedgerApi/V3/EvaluationContext.hs b/plutus-ledger-api/src/PlutusLedgerApi/V3/EvaluationContext.hs index 6f0992088d7..a1cb8b107d3 100644 --- a/plutus-ledger-api/src/PlutusLedgerApi/V3/EvaluationContext.hs +++ b/plutus-ledger-api/src/PlutusLedgerApi/V3/EvaluationContext.hs @@ -31,18 +31,19 @@ supplied in the wrong order then script cost calculations will be incorrect. IMPORTANT: The evaluation context of every Plutus version must be recreated upon a protocol update with the updated cost model parameters. -} -mkEvaluationContext :: (MonadError CostModelApplyError m, MonadWriter [CostModelApplyWarn] m) - => [Int64] -- ^ the (updated) cost model parameters of the protocol - -> m EvaluationContext +mkEvaluationContext + :: (MonadError CostModelApplyError m, MonadWriter [CostModelApplyWarn] m) + => [Int64] -- ^ the (updated) cost model parameters of the protocol + -> m EvaluationContext mkEvaluationContext = - tagWithParamNames @V3.ParamName + tagWithParamNames @V3.ParamName >=> pure . toCostModelParams >=> mkDynEvaluationContext PlutusV3 (\pv -> - if pv < futurePV - then unavailableCaserBuiltin $ getMajorProtocolVersion pv - else CaserBuiltin caseBuiltin) + if pv < futurePV + then unavailableCaserBuiltin $ getMajorProtocolVersion pv + else CaserBuiltin caseBuiltin) [DefaultFunSemanticsVariantC] -- See Note [Mapping of protocol versions and ledger languages to semantics variants]. (const DefaultFunSemanticsVariantC) diff --git a/plutus-tx/src/PlutusTx/Builtins/Internal.hs b/plutus-tx/src/PlutusTx/Builtins/Internal.hs index 7e5580af66f..5bfec985488 100644 --- a/plutus-tx/src/PlutusTx/Builtins/Internal.hs +++ b/plutus-tx/src/PlutusTx/Builtins/Internal.hs @@ -10,8 +10,7 @@ {-# OPTIONS_GHC -O0 #-} {-# OPTIONS_GHC -Wno-unrecognised-pragmas #-} -{-# HLINT ignore "Use newtype instead of data" #-} --- See Note [Opaque builtin types] +{-# HLINT ignore "Use newtype instead of data" #-} -- See Note [Opaque builtin types] {-| This module contains the special Haskell names that are used to map to builtin types or functions in Plutus Core. From 02a071c58332684747e6797691984d029d0d4fae Mon Sep 17 00:00:00 2001 From: effectfully Date: Sat, 21 Jun 2025 02:35:20 +0100 Subject: [PATCH 23/25] Fix the remaining issues --- .../Data/GoldenTests/sorted.cbor.size.golden | 2 +- .../GoldenTests/sorted.large.budget.golden | 2 +- .../Data/GoldenTests/sorted.pir.golden | 105 +- .../GoldenTests/sorted.small.budget.golden | 2 +- .../Data/GoldenTests/sorted.uplc.golden | 1759 ++++++------ .../GoldenTests/unsorted.cbor.size.golden | 2 +- .../GoldenTests/unsorted.large.budget.golden | 2 +- .../Data/GoldenTests/unsorted.pir.golden | 114 +- .../GoldenTests/unsorted.small.budget.golden | 2 +- .../Data/GoldenTests/unsorted.uplc.golden | 2439 ++++++++--------- .../GoldenTests/sorted.cbor.size.golden | 2 +- .../GoldenTests/sorted.large.budget.golden | 2 +- .../Validator/GoldenTests/sorted.pir.golden | 91 +- .../GoldenTests/sorted.small.budget.golden | 2 +- .../Validator/GoldenTests/sorted.uplc.golden | 1747 ++++++------ .../GoldenTests/unsorted.cbor.size.golden | 2 +- .../GoldenTests/unsorted.large.budget.golden | 2 +- .../Validator/GoldenTests/unsorted.pir.golden | 100 +- .../GoldenTests/unsorted.small.budget.golden | 2 +- .../GoldenTests/unsorted.uplc.golden | 2439 ++++++++--------- .../bitwise/test/9.6/8 queens.eval.golden | 6 +- .../bitwise/test/9.6/8 queens.pir.golden | 22 +- .../bitwise/test/9.6/Ed25519.eval.golden | 6 +- .../bitwise/test/9.6/Ed25519.pir.golden | 42 +- .../test/9.6/bls12-381-costs.golden | 18 +- .../test/9.6/ed25519-costs.golden | 32 +- .../9.6/match-builtin-list-10.eval.golden | 6 +- .../9.6/match-builtin-list-100.eval.golden | 6 +- .../9.6/match-builtin-list-5.eval.golden | 6 +- .../9.6/match-builtin-list-50.eval.golden | 6 +- .../9.6/match-scott-list-10.eval.golden | 6 +- .../9.6/match-scott-list-100.eval.golden | 6 +- .../Lookup/9.6/match-scott-list-5.eval.golden | 6 +- .../9.6/match-scott-list-50.eval.golden | 6 +- .../test/Sum/9.6/left-fold-data.eval.golden | 6 +- .../test/Sum/9.6/right-fold-data.eval.golden | 6 +- .../nofib/test/9.6/clausify-F5.eval.golden | 6 +- .../nofib/test/9.6/clausify-F5.pir.golden | 28 +- .../nofib/test/9.6/knights10-4x4.eval.golden | 6 +- .../nofib/test/9.6/knights10-4x4.pir.golden | 98 +- .../nofib/test/9.6/queens4-bt.eval.golden | 6 +- .../nofib/test/9.6/queens4-bt.pir.golden | 44 +- .../nofib/test/9.6/queens5-fc.eval.golden | 6 +- .../nofib/test/9.6/queens5-fc.pir.golden | 44 +- .../V1/9.6/checkScriptContext1-20.eval.golden | 6 +- .../V1/9.6/checkScriptContext1-4.eval.golden | 6 +- .../V1/9.6/checkScriptContext1.pir.golden | 109 +- .../V1/9.6/checkScriptContext1.size.golden | 2 +- .../V1/9.6/checkScriptContext2-20.eval.golden | 6 +- .../V1/9.6/checkScriptContext2-4.eval.golden | 6 +- .../V1/9.6/checkScriptContext2.pir.golden | 107 +- .../V1/9.6/checkScriptContext2.size.golden | 2 +- ...ckScriptContextEqualityData-20.eval.golden | 6 +- .../9.6/checkScriptContext1-20.eval.golden | 6 +- .../9.6/checkScriptContext1-4.eval.golden | 6 +- .../Data/9.6/checkScriptContext1.pir.golden | 13 +- .../Data/9.6/checkScriptContext1.size.golden | 2 +- ...ckScriptContextEqualityData-20.eval.golden | 6 +- .../V2/9.6/checkScriptContext1-20.eval.golden | 6 +- .../V2/9.6/checkScriptContext1-4.eval.golden | 6 +- .../V2/9.6/checkScriptContext1.pir.golden | 112 +- .../V2/9.6/checkScriptContext1.size.golden | 2 +- .../V2/9.6/checkScriptContext2-20.eval.golden | 6 +- .../V2/9.6/checkScriptContext2-4.eval.golden | 6 +- .../V2/9.6/checkScriptContext2.pir.golden | 105 +- .../V2/9.6/checkScriptContext2.size.golden | 2 +- ...ckScriptContextEqualityData-20.eval.golden | 6 +- .../test/V2/9.6/dataFwdStakeTrick.eval.golden | 6 +- .../test/V2/9.6/dataFwdStakeTrick.pir.golden | 11 +- .../test/V2/9.6/dataFwdStakeTrick.uplc.golden | 90 +- .../9.6/dataFwdStakeTrickManual.eval.golden | 6 +- .../V2/9.6/dataFwdStakeTrickManual.pir.golden | 11 +- .../9.6/dataFwdStakeTrickManual.uplc.golden | 28 +- .../test/V2/9.6/sopFwdStakeTrick.eval.golden | 6 +- .../test/V2/9.6/sopFwdStakeTrick.pir.golden | 111 +- .../test/V2/9.6/sopFwdStakeTrick.uplc.golden | 1651 ++++++----- .../9.6/checkScriptContext1-20.eval.golden | 6 +- .../9.6/checkScriptContext1-4.eval.golden | 6 +- .../Data/9.6/checkScriptContext1.pir.golden | 13 +- .../Data/9.6/checkScriptContext1.size.golden | 2 +- ...ckScriptContextEqualityData-20.eval.golden | 6 +- .../V3/9.6/checkScriptContext1-20.eval.golden | 6 +- .../V3/9.6/checkScriptContext1-4.eval.golden | 6 +- .../V3/9.6/checkScriptContext1.pir.golden | 309 +-- .../V3/9.6/checkScriptContext1.size.golden | 2 +- .../V3/9.6/checkScriptContext2-20.eval.golden | 6 +- .../V3/9.6/checkScriptContext2-4.eval.golden | 6 +- .../V3/9.6/checkScriptContext2.pir.golden | 308 +-- .../V3/9.6/checkScriptContext2.size.golden | 2 +- ...ckScriptContextEqualityData-20.eval.golden | 6 +- .../9.6/checkScriptContext1-20.eval.golden | 6 +- .../9.6/checkScriptContext1-4.eval.golden | 6 +- .../Data/9.6/checkScriptContext1.pir.golden | 11 +- .../Data/9.6/checkScriptContext1.size.golden | 2 +- ...ckScriptContextEqualityData-20.eval.golden | 6 +- .../9.6/purposeIsWellFormed-4.eval.golden | 6 +- .../Data/9.6/purposeIsWellFormed.pir.golden | 323 +-- .../Data/9.6/purposeIsWellFormed.size.golden | 2 +- .../Evaluation/Machine/MachineParameters.hs | 5 + .../Machine/MachineParameters/Default.hs | 1 - .../Evaluation/Golden/caseInteger.plc.golden | 3 + .../Evaluation/Golden/caseInteger.type.golden | 1 + .../Evaluation/Golden/caseInteger.uplc.golden | 4 + .../9.6/currencySymbolValueOf.eval.golden | 6 +- .../9.6/currencySymbolValueOf.pir.golden | 2 +- .../Spec/Budget/9.6/geq1.eval.golden | 6 +- .../Spec/Budget/9.6/geq2.eval.golden | 6 +- .../Spec/Budget/9.6/geq3.eval.golden | 6 +- .../Spec/Budget/9.6/geq4.eval.golden | 6 +- .../Spec/Budget/9.6/geq5.eval.golden | 6 +- .../test-plugin/Spec/Budget/9.6/gt.pir.golden | 11 +- .../Spec/Budget/9.6/gt1.eval.golden | 6 +- .../Spec/Budget/9.6/gt2.eval.golden | 6 +- .../Spec/Budget/9.6/gt3.eval.golden | 6 +- .../Spec/Budget/9.6/gt4.eval.golden | 6 +- .../Spec/Budget/9.6/gt5.eval.golden | 6 +- .../9.6/currencySymbolValueOf.eval.golden | 6 +- .../9.6/currencySymbolValueOf.pir.golden | 7 +- .../Spec/Data/Budget/9.6/geq1.eval.golden | 6 +- .../Spec/Data/Budget/9.6/geq2.eval.golden | 6 +- .../Spec/Data/Budget/9.6/geq3.eval.golden | 6 +- .../Spec/Data/Budget/9.6/geq4.eval.golden | 6 +- .../Spec/Data/Budget/9.6/geq5.eval.golden | 6 +- .../Spec/Data/Budget/9.6/gt.pir.golden | 52 +- .../Spec/Data/Budget/9.6/gt1.eval.golden | 6 +- .../Spec/Data/Budget/9.6/gt2.eval.golden | 6 +- .../Spec/Data/Budget/9.6/gt3.eval.golden | 6 +- .../Spec/Data/Budget/9.6/gt4.eval.golden | 6 +- .../Spec/Data/Budget/9.6/gt5.eval.golden | 6 +- .../Budget/9.6/mintValueBurned.eval.golden | 6 +- .../Budget/9.6/mintValueMinted.eval.golden | 6 +- .../9.6/succeedsIfHasDatum.pir.golden | 11 +- .../9.6/succeedsIfHasDatum.uplc.golden | 65 +- .../Spec/Data/Value/9.6/Long.stat.golden | 30 +- .../Spec/Data/Value/9.6/Short.stat.golden | 38 +- .../Spec/Value/9.6/Long.stat.golden | 30 +- .../Spec/Value/9.6/Short.stat.golden | 42 +- plutus-tx-plugin/src/PlutusTx/Options.hs | 10 +- plutus-tx-plugin/src/PlutusTx/Plugin.hs | 2 +- .../Budget/9.6/destructSum-manual.eval.golden | 6 +- .../Budget/9.6/destructSum-manual.pir.golden | 21 +- .../Budget/9.6/destructSum-manual.uplc.golden | 183 +- .../AsData/Budget/9.6/destructSum.eval.golden | 6 +- .../AsData/Budget/9.6/destructSum.pir.golden | 21 +- .../AsData/Budget/9.6/destructSum.uplc.golden | 160 +- .../Budget/9.6/patternMatching.eval.golden | 6 +- .../Budget/9.6/patternMatching.pir.golden | 2 +- .../Budget/9.6/patternMatching.uplc.golden | 36 +- .../Budget/9.6/recordFields.eval.golden | 6 +- .../AsData/Budget/9.6/recordFields.pir.golden | 2 +- .../Budget/9.6/recordFields.uplc.golden | 28 +- .../AsData/Budget/9.6/recursive.pir.golden | 2 +- .../AsData/Budget/9.6/recursive.uplc.golden | 10 +- .../test/Budget/9.6/allCheap.eval.golden | 6 +- .../test/Budget/9.6/allCheap.pir.golden | 2 +- .../test/Budget/9.6/allCheap.uplc.golden | 5 +- .../test/Budget/9.6/allEmptyList.eval.golden | 2 +- .../test/Budget/9.6/allEmptyList.pir.golden | 2 +- .../test/Budget/9.6/allEmptyList.uplc.golden | 5 +- .../test/Budget/9.6/allExpensive.eval.golden | 6 +- .../test/Budget/9.6/allExpensive.pir.golden | 2 +- .../test/Budget/9.6/allExpensive.uplc.golden | 5 +- .../Budget/9.6/andWithGHCOpts.eval.golden | 6 +- .../test/Budget/9.6/andWithGHCOpts.pir.golden | 4 +- .../Budget/9.6/andWithGHCOpts.uplc.golden | 13 +- .../test/Budget/9.6/andWithLocal.eval.golden | 6 +- .../test/Budget/9.6/andWithLocal.pir.golden | 7 +- .../test/Budget/9.6/andWithLocal.uplc.golden | 16 +- .../Budget/9.6/andWithoutGHCOpts.eval.golden | 6 +- .../Budget/9.6/andWithoutGHCOpts.pir.golden | 20 +- .../Budget/9.6/andWithoutGHCOpts.uplc.golden | 7 +- .../test/Budget/9.6/anyCheap.eval.golden | 6 +- .../test/Budget/9.6/anyCheap.pir.golden | 2 +- .../test/Budget/9.6/anyCheap.uplc.golden | 5 +- .../test/Budget/9.6/anyEmptyList.eval.golden | 2 +- .../test/Budget/9.6/anyEmptyList.pir.golden | 2 +- .../test/Budget/9.6/anyEmptyList.uplc.golden | 5 +- .../test/Budget/9.6/anyExpensive.eval.golden | 6 +- .../test/Budget/9.6/anyExpensive.pir.golden | 2 +- .../test/Budget/9.6/anyExpensive.uplc.golden | 5 +- .../test/Budget/9.6/constAccL.eval.golden | 6 +- .../test/Budget/9.6/constAccL.pir.golden | 2 +- .../test/Budget/9.6/constAccL.uplc.golden | 8 +- .../test/Budget/9.6/constAccR.eval.golden | 6 +- .../test/Budget/9.6/constAccR.pir.golden | 2 +- .../test/Budget/9.6/constAccR.uplc.golden | 6 +- .../test/Budget/9.6/constElL.eval.golden | 6 +- .../test/Budget/9.6/constElL.pir.golden | 2 +- .../test/Budget/9.6/constElL.uplc.golden | 8 +- .../test/Budget/9.6/constElR.eval.golden | 6 +- .../test/Budget/9.6/constElR.pir.golden | 2 +- .../test/Budget/9.6/constElR.uplc.golden | 6 +- .../test/Budget/9.6/elemCheap.eval.golden | 6 +- .../test/Budget/9.6/elemCheap.pir.golden | 2 +- .../test/Budget/9.6/elemCheap.uplc.golden | 5 +- .../test/Budget/9.6/elemExpensive.eval.golden | 6 +- .../test/Budget/9.6/elemExpensive.pir.golden | 2 +- .../test/Budget/9.6/elemExpensive.uplc.golden | 5 +- .../test/Budget/9.6/filter.eval.golden | 6 +- .../test/Budget/9.6/filter.pir.golden | 6 +- .../test/Budget/9.6/filter.uplc.golden | 5 +- .../test/Budget/9.6/findCheap.eval.golden | 6 +- .../test/Budget/9.6/findCheap.pir.golden | 2 +- .../test/Budget/9.6/findCheap.uplc.golden | 5 +- .../test/Budget/9.6/findEmptyList.eval.golden | 2 +- .../test/Budget/9.6/findEmptyList.pir.golden | 2 +- .../test/Budget/9.6/findEmptyList.uplc.golden | 5 +- .../test/Budget/9.6/findExpensive.eval.golden | 6 +- .../test/Budget/9.6/findExpensive.pir.golden | 2 +- .../test/Budget/9.6/findExpensive.uplc.golden | 5 +- .../Budget/9.6/findIndexCheap.eval.golden | 6 +- .../test/Budget/9.6/findIndexCheap.pir.golden | 2 +- .../Budget/9.6/findIndexCheap.uplc.golden | 7 +- .../Budget/9.6/findIndexEmptyList.eval.golden | 2 +- .../Budget/9.6/findIndexEmptyList.pir.golden | 2 +- .../Budget/9.6/findIndexEmptyList.uplc.golden | 7 +- .../Budget/9.6/findIndexExpensive.eval.golden | 6 +- .../Budget/9.6/findIndexExpensive.pir.golden | 2 +- .../Budget/9.6/findIndexExpensive.uplc.golden | 7 +- .../test/Budget/9.6/gte0.eval.golden | 6 +- .../test/Budget/9.6/gte0.pir.golden | 4 +- .../test/Budget/9.6/gte0.uplc.golden | 11 +- .../test/Budget/9.6/listIndexing.eval.golden | 6 +- .../test/Budget/9.6/listIndexing.pir.golden | 2 +- .../test/Budget/9.6/listIndexing.uplc.golden | 10 +- .../test/Budget/9.6/lte0.eval.golden | 6 +- .../test/Budget/9.6/lte0.pir.golden | 4 +- .../test/Budget/9.6/lte0.uplc.golden | 11 +- .../test/Budget/9.6/map1.eval.golden | 6 +- .../test/Budget/9.6/map1.pir.golden | 23 +- .../test/Budget/9.6/map1.uplc.golden | 65 +- .../test/Budget/9.6/map2.eval.golden | 6 +- .../test/Budget/9.6/map2.pir.golden | 14 +- .../test/Budget/9.6/map2.uplc.golden | 63 +- .../test/Budget/9.6/map3.eval.golden | 6 +- .../test/Budget/9.6/map3.pir.golden | 20 +- .../test/Budget/9.6/map3.uplc.golden | 121 +- .../test/Budget/9.6/matchAsDataE.eval.golden | 6 +- .../test/Budget/9.6/matchAsDataE.pir.golden | 4 +- .../test/Budget/9.6/matchAsDataE.uplc.golden | 32 +- .../test/Budget/9.6/not-not.eval.golden | 6 +- .../test/Budget/9.6/not-not.pir.golden | 2 +- .../test/Budget/9.6/not-not.uplc.golden | 9 +- .../test/Budget/9.6/notElemCheap.eval.golden | 6 +- .../test/Budget/9.6/notElemCheap.pir.golden | 2 +- .../test/Budget/9.6/notElemCheap.uplc.golden | 5 +- .../Budget/9.6/notElemExpensive.eval.golden | 6 +- .../Budget/9.6/notElemExpensive.pir.golden | 2 +- .../Budget/9.6/notElemExpensive.uplc.golden | 5 +- .../test/Budget/9.6/recursiveGte0.eval.golden | 6 +- .../test/Budget/9.6/recursiveGte0.pir.golden | 4 +- .../test/Budget/9.6/recursiveGte0.uplc.golden | 13 +- .../test/Budget/9.6/recursiveLte0.eval.golden | 6 +- .../test/Budget/9.6/recursiveLte0.pir.golden | 4 +- .../test/Budget/9.6/recursiveLte0.uplc.golden | 12 +- .../test/Budget/9.6/show.eval.golden | 6 +- .../test/Budget/9.6/show.pir.golden | 104 +- .../test/Budget/9.6/show.uplc.golden | 371 ++- .../test/Budget/9.6/sumL.eval.golden | 6 +- .../test/Budget/9.6/sumL.pir.golden | 2 +- .../test/Budget/9.6/sumL.uplc.golden | 8 +- .../test/Budget/9.6/sumR.eval.golden | 6 +- .../test/Budget/9.6/sumR.pir.golden | 2 +- .../test/Budget/9.6/sumR.uplc.golden | 7 +- .../test/Budget/9.6/toFromData.eval.golden | 6 +- .../test/Budget/9.6/toFromData.pir.golden | 18 +- .../test/Budget/9.6/toFromData.uplc.golden | 282 +- .../BuiltinList/Budget/9.6/all.eval.golden | 6 +- .../BuiltinList/Budget/9.6/all.pir.golden | 3 +- .../BuiltinList/Budget/9.6/all.uplc.golden | 62 +- .../BuiltinList/Budget/9.6/and.eval.golden | 6 +- .../BuiltinList/Budget/9.6/and.pir.golden | 3 +- .../BuiltinList/Budget/9.6/and.uplc.golden | 12 +- .../BuiltinList/Budget/9.6/any.eval.golden | 6 +- .../BuiltinList/Budget/9.6/any.pir.golden | 3 +- .../BuiltinList/Budget/9.6/any.uplc.golden | 63 +- .../Budget/9.6/concatMap.eval.golden | 6 +- .../Budget/9.6/concatMap.pir.golden | 3 +- .../Budget/9.6/concatMap.uplc.golden | 22 +- .../BuiltinList/Budget/9.6/drop.eval.golden | 6 +- .../BuiltinList/Budget/9.6/drop.pir.golden | 3 +- .../BuiltinList/Budget/9.6/drop.uplc.golden | 31 +- .../Budget/9.6/dropWhile.eval.golden | 6 +- .../Budget/9.6/dropWhile.pir.golden | 3 +- .../Budget/9.6/dropWhile.uplc.golden | 13 +- .../BuiltinList/Budget/9.6/elem.eval.golden | 6 +- .../BuiltinList/Budget/9.6/elem.pir.golden | 3 +- .../BuiltinList/Budget/9.6/elem.uplc.golden | 15 +- .../BuiltinList/Budget/9.6/elemBy.eval.golden | 6 +- .../BuiltinList/Budget/9.6/elemBy.pir.golden | 3 +- .../BuiltinList/Budget/9.6/elemBy.uplc.golden | 16 +- .../BuiltinList/Budget/9.6/filter.eval.golden | 6 +- .../BuiltinList/Budget/9.6/filter.pir.golden | 3 +- .../BuiltinList/Budget/9.6/filter.uplc.golden | 9 +- .../BuiltinList/Budget/9.6/find.eval.golden | 6 +- .../BuiltinList/Budget/9.6/find.pir.golden | 3 +- .../BuiltinList/Budget/9.6/find.uplc.golden | 65 +- .../Budget/9.6/findIndexJust.eval.golden | 6 +- .../Budget/9.6/findIndexJust.pir.golden | 3 +- .../Budget/9.6/findIndexJust.uplc.golden | 16 +- .../Budget/9.6/findIndexNothing.eval.golden | 6 +- .../Budget/9.6/findIndexNothing.pir.golden | 3 +- .../Budget/9.6/findIndexNothing.uplc.golden | 16 +- .../Budget/9.6/findIndices.eval.golden | 6 +- .../Budget/9.6/findIndices.pir.golden | 3 +- .../Budget/9.6/findIndices.uplc.golden | 15 +- .../BuiltinList/Budget/9.6/index.eval.golden | 6 +- .../BuiltinList/Budget/9.6/index.pir.golden | 3 +- .../BuiltinList/Budget/9.6/index.uplc.golden | 30 +- .../Budget/9.6/indexNegative.pir.golden | 3 +- .../Budget/9.6/indexNegative.uplc.golden | 30 +- .../Budget/9.6/indexTooLarge.pir.golden | 3 +- .../Budget/9.6/indexTooLarge.uplc.golden | 30 +- .../Budget/9.6/mapMaybe.eval.golden | 6 +- .../Budget/9.6/mapMaybe.pir.golden | 3 +- .../Budget/9.6/mapMaybe.uplc.golden | 18 +- .../Budget/9.6/notElem.eval.golden | 6 +- .../BuiltinList/Budget/9.6/notElem.pir.golden | 3 +- .../Budget/9.6/notElem.uplc.golden | 16 +- .../BuiltinList/Budget/9.6/nub.eval.golden | 6 +- .../BuiltinList/Budget/9.6/nub.pir.golden | 3 +- .../BuiltinList/Budget/9.6/nub.uplc.golden | 43 +- .../BuiltinList/Budget/9.6/nubBy.eval.golden | 6 +- .../BuiltinList/Budget/9.6/nubBy.pir.golden | 3 +- .../BuiltinList/Budget/9.6/nubBy.uplc.golden | 28 +- .../BuiltinList/Budget/9.6/null.eval.golden | 6 +- .../BuiltinList/Budget/9.6/null.pir.golden | 3 +- .../BuiltinList/Budget/9.6/null.uplc.golden | 4 +- .../BuiltinList/Budget/9.6/or.eval.golden | 6 +- .../test/BuiltinList/Budget/9.6/or.pir.golden | 3 +- .../BuiltinList/Budget/9.6/or.uplc.golden | 12 +- .../Budget/9.6/replicate.eval.golden | 6 +- .../Budget/9.6/replicate.pir.golden | 3 +- .../Budget/9.6/replicate.uplc.golden | 14 +- .../BuiltinList/Budget/9.6/take.eval.golden | 6 +- .../BuiltinList/Budget/9.6/take.pir.golden | 3 +- .../BuiltinList/Budget/9.6/take.uplc.golden | 34 +- .../Budget/9.6/uniqueElementJust.eval.golden | 6 +- .../Budget/9.6/uniqueElementJust.pir.golden | 3 +- .../Budget/9.6/uniqueElementJust.uplc.golden | 26 +- .../test/DataList/Budget/9.6/any.eval.golden | 6 +- .../test/DataList/Budget/9.6/any.pir.golden | 2 +- .../test/DataList/Budget/9.6/any.uplc.golden | 5 +- .../test/DataList/Budget/9.6/elem.eval.golden | 6 +- .../test/DataList/Budget/9.6/elem.pir.golden | 2 +- .../test/DataList/Budget/9.6/elem.uplc.golden | 5 +- .../DataList/Budget/9.6/filter.eval.golden | 6 +- .../DataList/Budget/9.6/filter.pir.golden | 2 +- .../DataList/Budget/9.6/filter.uplc.golden | 10 +- .../DataList/Budget/9.6/partition.eval.golden | 6 +- .../DataList/Budget/9.6/partition.pir.golden | 6 +- .../DataList/Budget/9.6/partition.uplc.golden | 12 +- .../test/IsData/9.6/dataToData.pir.golden | 3 +- .../IsData/9.6/deconstructData.pir.golden | 3 +- .../test/IsData/9.6/equalityAsData.pir.golden | 3 +- .../test/IsData/9.6/matchAsData.pir.golden | 3 +- .../9.6/unsafeDeconstructData.pir.golden | 3 +- .../Optimization/9.6/matchAsData.pir.golden | 4 +- .../9.6/unsafeDeconstructData.pir.golden | 6 +- .../test/Plugin/Basic/9.6/ifOpt.pir.golden | 3 +- .../Plugin/Basic/9.6/integerCase.pir.golden | 3 +- .../Basic/9.6/integerPatternMatch.pir.golden | 3 +- .../test/Plugin/Basic/9.6/letFun.pir.golden | 3 +- .../Coverage/9.6/coverageCode.pir.golden | 3 +- .../test/Plugin/Debug/9.6/fib.pir.golden | 28 +- .../test/Plugin/Debug/9.6/letFun.pir.golden | 28 +- .../Functions/9.6/recursive/even.pir.golden | 3 +- .../Functions/9.6/recursive/fib.pir.golden | 3 +- .../9.6/unfoldings/allDirect.pir.golden | 3 +- .../mutualRecursionUnfoldings.pir.golden | 3 +- .../Primitives/9.6/ifThenElse.pir.golden | 3 +- .../Primitives/9.6/intCompare.pir.golden | 3 +- .../Plugin/Primitives/9.6/intEq.pir.golden | 3 +- .../Plugin/Primitives/9.6/verify.pir.golden | 3 +- .../Plugin/Primitives/9.6/void.pir.golden | 3 +- .../test/Plugin/Profiling/9.6/fib.pir.golden | 3 +- .../Plugin/Strict/9.6/issue4645.pir.golden | 2 +- .../Plugin/Strict/9.6/strictITE.pir.golden | 2 +- .../Typeclasses/9.6/compareTest.pir.golden | 3 +- .../Typeclasses/9.6/multiFunction.pir.golden | 3 +- .../9.6/partialApplication.pir.golden | 3 +- .../Strictness/9.6/let-default.eval.golden | 6 +- .../Strictness/9.6/let-default.pir.golden | 2 +- .../Strictness/9.6/let-default.uplc.golden | 5 +- .../Strictness/9.6/let-nonstrict.eval.golden | 6 +- .../Strictness/9.6/let-nonstrict.pir.golden | 2 +- .../Strictness/9.6/let-nonstrict.uplc.golden | 5 +- .../Strictness/9.6/let-strict.eval.golden | 6 +- .../test/Strictness/9.6/let-strict.pir.golden | 2 +- .../Strictness/9.6/let-strict.uplc.golden | 5 +- .../Rational/Additive/minus.size.golden | 2 +- .../Golden/Rational/Additive/plus.size.golden | 2 +- .../Rational/Construction/ratio.size.golden | 2 +- .../Construction/unsafeRatio.size.golden | 2 +- .../size/Golden/Rational/Eq/equal.size.golden | 2 +- .../Golden/Rational/Eq/not-equal.size.golden | 2 +- .../Rational/Multiplicative/scale.size.golden | 2 +- .../Rational/Multiplicative/times.size.golden | 2 +- .../Golden/Rational/Ord/compare.size.golden | 2 +- .../Ord/greater-than-equal.size.golden | 2 +- .../Rational/Ord/greater-than.size.golden | 2 +- .../Rational/Ord/less-than-equal.size.golden | 2 +- .../Golden/Rational/Ord/less-than.size.golden | 2 +- .../size/Golden/Rational/Ord/max.size.golden | 2 +- .../size/Golden/Rational/Ord/min.size.golden | 2 +- .../Other/abs-specialized.size.golden | 2 +- .../Golden/Rational/Other/recip.size.golden | 2 +- .../Golden/Rational/Other/round.size.golden | 2 +- .../Serialization/fromBuiltinData.size.golden | 2 +- .../unsafeFromBuiltinData.size.golden | 2 +- 410 files changed, 8037 insertions(+), 8457 deletions(-) create mode 100644 plutus-core/untyped-plutus-core/test/Evaluation/Golden/caseInteger.plc.golden create mode 100644 plutus-core/untyped-plutus-core/test/Evaluation/Golden/caseInteger.type.golden create mode 100644 plutus-core/untyped-plutus-core/test/Evaluation/Golden/caseInteger.uplc.golden diff --git a/cardano-constitution/test/Cardano/Constitution/Validator/Data/GoldenTests/sorted.cbor.size.golden b/cardano-constitution/test/Cardano/Constitution/Validator/Data/GoldenTests/sorted.cbor.size.golden index 1bf1dcc81bd..9aba31b86d4 100644 --- a/cardano-constitution/test/Cardano/Constitution/Validator/Data/GoldenTests/sorted.cbor.size.golden +++ b/cardano-constitution/test/Cardano/Constitution/Validator/Data/GoldenTests/sorted.cbor.size.golden @@ -1 +1 @@ -2140 \ No newline at end of file +2090 \ No newline at end of file diff --git a/cardano-constitution/test/Cardano/Constitution/Validator/Data/GoldenTests/sorted.large.budget.golden b/cardano-constitution/test/Cardano/Constitution/Validator/Data/GoldenTests/sorted.large.budget.golden index 70b0c33905b..66007bb088e 100644 --- a/cardano-constitution/test/Cardano/Constitution/Validator/Data/GoldenTests/sorted.large.budget.golden +++ b/cardano-constitution/test/Cardano/Constitution/Validator/Data/GoldenTests/sorted.large.budget.golden @@ -1 +1 @@ -ExBudget {exBudgetCPU = ExCPU 540852171, exBudgetMemory = ExMemory 2592918} \ No newline at end of file +ExBudget {exBudgetCPU = ExCPU 472550709, exBudgetMemory = ExMemory 2373780} \ No newline at end of file diff --git a/cardano-constitution/test/Cardano/Constitution/Validator/Data/GoldenTests/sorted.pir.golden b/cardano-constitution/test/Cardano/Constitution/Validator/Data/GoldenTests/sorted.pir.golden index b6339aab48a..c2dcaf79fdb 100644 --- a/cardano-constitution/test/Cardano/Constitution/Validator/Data/GoldenTests/sorted.pir.golden +++ b/cardano-constitution/test/Cardano/Constitution/Validator/Data/GoldenTests/sorted.pir.golden @@ -139,12 +139,12 @@ program !`$fOrdInteger_$ccompare` : integer -> integer -> Ordering = \(eta : integer) (eta : integer) -> Bool_match - (ifThenElse {Bool} (equalsInteger eta eta) True False) + (case Bool (equalsInteger eta eta) [False, True]) {all dead. Ordering} (/\dead -> EQ) (/\dead -> Bool_match - (ifThenElse {Bool} (lessThanEqualsInteger eta eta) True False) + (case Bool (lessThanEqualsInteger eta eta) [False, True]) {all dead. Ordering} (/\dead -> LT) (/\dead -> GT) @@ -162,19 +162,18 @@ program ds {Bool} (\(n' : integer) (d' : integer) -> - ifThenElse - {Bool} + case + Bool (lessThanEqualsInteger (multiplyInteger n d') (multiplyInteger n' d)) - True - False)) + [False, True])) in letrec !euclid : integer -> integer -> integer = \(x : integer) (y : integer) -> Bool_match - (ifThenElse {Bool} (equalsInteger 0 y) True False) + (case Bool (equalsInteger 0 y) [False, True]) {all dead. integer} (/\dead -> x) (/\dead -> euclid y (modInteger x y)) @@ -184,12 +183,12 @@ program !unsafeRatio : integer -> integer -> Rational = \(n : integer) (d : integer) -> Bool_match - (ifThenElse {Bool} (equalsInteger 0 d) True False) + (case Bool (equalsInteger 0 d) [False, True]) {all dead. Rational} (/\dead -> error {Rational}) (/\dead -> Bool_match - (ifThenElse {Bool} (lessThanInteger d 0) True False) + (case Bool (lessThanInteger d 0) [False, True]) {all dead. Rational} (/\dead -> unsafeRatio (subtractInteger 0 n) (subtractInteger 0 d)) @@ -211,6 +210,8 @@ program (\v -> List (Tuple2 PredKey (List v))) Rational -> ParamValue in let + !ifThenElse : all a. bool -> a -> a -> a + = /\a -> \(b : bool) (x : a) (y : a) -> case a b [y, x] data Unit | Unit_match where Unit : Unit in @@ -228,16 +229,12 @@ program (CConsOrd {integer} (\(x : integer) (y : integer) -> - ifThenElse {Bool} (equalsInteger x y) True False) + case Bool (equalsInteger x y) [False, True]) `$fOrdInteger_$ccompare` (\(x : integer) (y : integer) -> - ifThenElse {Bool} (lessThanInteger x y) True False) + case Bool (lessThanInteger x y) [False, True]) (\(x : integer) (y : integer) -> - ifThenElse - {Bool} - (lessThanEqualsInteger x y) - True - False) + case Bool (lessThanEqualsInteger x y) [False, True]) (\(x : integer) (y : integer) -> ifThenElse {Bool} @@ -248,22 +245,14 @@ program ifThenElse {Bool} (lessThanInteger x y) False True) (\(x : integer) (y : integer) -> Bool_match - (ifThenElse - {Bool} - (lessThanEqualsInteger x y) - True - False) + (case Bool (lessThanEqualsInteger x y) [False, True]) {all dead. integer} (/\dead -> y) (/\dead -> x) {all dead. dead}) (\(x : integer) (y : integer) -> Bool_match - (ifThenElse - {Bool} - (lessThanEqualsInteger x y) - True - False) + (case Bool (lessThanEqualsInteger x y) [False, True]) {all dead. integer} (/\dead -> x) (/\dead -> y) @@ -288,18 +277,16 @@ program {Bool} (\(n' : integer) (d' : integer) -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger n n') - True - False) + [False, True]) {all dead. Bool} (/\dead -> - ifThenElse - {Bool} + case + Bool (equalsInteger d d') - True - False) + [False, True]) (/\dead -> False) {all dead. dead}))) (\(ds : Rational) (ds : Rational) -> @@ -323,13 +310,12 @@ program ds {Bool} (\(n' : integer) (d' : integer) -> - ifThenElse - {Bool} + case + Bool (lessThanInteger (multiplyInteger n d') (multiplyInteger n' d)) - True - False))) + [False, True]))) `$fOrdRational0_$c<=` (\(ds : Rational) (ds : Rational) -> Rational_match @@ -340,11 +326,13 @@ program ds {Bool} (\(n' : integer) (d' : integer) -> + let + !x : integer = multiplyInteger n d' + !y : integer = multiplyInteger n' d + in ifThenElse {Bool} - (lessThanEqualsInteger - (multiplyInteger n d') - (multiplyInteger n' d)) + (lessThanEqualsInteger x y) False True))) (\(ds : Rational) (ds : Rational) -> @@ -356,11 +344,13 @@ program ds {Bool} (\(n' : integer) (d' : integer) -> + let + !x : integer = multiplyInteger n d' + !y : integer = multiplyInteger n' d + in ifThenElse {Bool} - (lessThanInteger - (multiplyInteger n d') - (multiplyInteger n' d)) + (lessThanInteger x y) False True))) (\(x : Rational) (y : Rational) -> @@ -399,7 +389,7 @@ program ds {list data -> Bool} (\(eta : list data) -> - ifThenElse {Bool} (nullList {data} eta) True False) + case Bool (nullList {data} eta) [False, True]) (\(paramValueHd : ParamValue) (paramValueTl : List ParamValue) (actualValueData : list data) -> @@ -499,12 +489,12 @@ program !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 1 index) True False) + (case Bool (equalsInteger 1 index) [False, True]) {all dead. Maybe a} (/\dead -> Nothing {a}) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. Maybe a} (/\dead -> Just {a} (`$dUnsafeFromData` (headList {data} args))) @@ -5330,13 +5320,12 @@ program (unConstrData ds))))) in Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 5 (fstPair {integer} {list data} tup)) - True - False) + [False, True]) {all dead. data} (/\dead -> headList @@ -5357,11 +5346,10 @@ program !tup : pair integer (list data) = unConstrData scrut in Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 0 (fstPair {integer} {list data} tup)) - True - False) + [False, True]) {all dead. r} (/\dead -> let @@ -5397,11 +5385,10 @@ program !tup : pair integer (list data) = unConstrData scrut in Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 2 (fstPair {integer} {list data} tup)) - True - False) + [False, True]) {all dead. r} (/\dead -> let diff --git a/cardano-constitution/test/Cardano/Constitution/Validator/Data/GoldenTests/sorted.small.budget.golden b/cardano-constitution/test/Cardano/Constitution/Validator/Data/GoldenTests/sorted.small.budget.golden index cb93543f47a..76e2f4791d6 100644 --- a/cardano-constitution/test/Cardano/Constitution/Validator/Data/GoldenTests/sorted.small.budget.golden +++ b/cardano-constitution/test/Cardano/Constitution/Validator/Data/GoldenTests/sorted.small.budget.golden @@ -1 +1 @@ -ExBudget {exBudgetCPU = ExCPU 82805157, exBudgetMemory = ExMemory 359105} \ No newline at end of file +ExBudget {exBudgetCPU = ExCPU 66876110, exBudgetMemory = ExMemory 308402} \ No newline at end of file diff --git a/cardano-constitution/test/Cardano/Constitution/Validator/Data/GoldenTests/sorted.uplc.golden b/cardano-constitution/test/Cardano/Constitution/Validator/Data/GoldenTests/sorted.uplc.golden index 57877825cd6..e15c9f28d7b 100644 --- a/cardano-constitution/test/Cardano/Constitution/Validator/Data/GoldenTests/sorted.uplc.golden +++ b/cardano-constitution/test/Cardano/Constitution/Validator/Data/GoldenTests/sorted.uplc.golden @@ -39,706 +39,719 @@ program (\cse -> (\cse -> (\cse -> - (\fun - ds -> - force - (case - ((\cse -> - (\cse -> - force + (\cse -> + (\fun + ds -> + force + (case + ((\cse -> + (\cse -> + force + (case + (equalsInteger + 0 + cse) + [ (delay + (force + (case + (equalsInteger + 2 + cse) + [ (delay + error) + , (delay + ((\l -> + constr 1 + [ ]) + (force + (force + sndPair) + cse))) ]))) + , (delay + (constr 0 + [ (force + caseData_go + (unMapData + (force + headList + (force + tailList + (force + (force + sndPair) + cse))))) ])) ])) (force - ifThenElse - (equalsInteger - 0 - cse) - (delay - (constr 0 - [ (force - caseData_go - (unMapData - (force - headList - (force - tailList - (force - (force - sndPair) - cse))))) ])) - (delay - (force - (force - ifThenElse - (equalsInteger - 2 - cse) - (delay - ((\l -> - constr 1 - [ ]) - (force - (force - sndPair) - cse))) - (delay - error)))))) - (force - (force - fstPair) - cse)) - (unConstrData - (force - headList + (force + fstPair) + cse)) + (unConstrData (force - tailList + headList (force tailList (force + tailList (force - sndPair) - (unConstrData - ((\tup -> - force - (force - ifThenElse - (equalsInteger - 5 - (force + (force + sndPair) + (unConstrData + ((\tup -> + force + (case + (equalsInteger + 5 (force - fstPair) - tup)) - (delay - (force - headList - (force - tailList (force - (force - sndPair) - tup)))) - (delay - error))) - (unConstrData - (force - headList + fstPair) + tup)) + [ (delay + error) + , (delay + (force + headList + (force + tailList + (force + (force + sndPair) + tup)))) ])) + (unConstrData (force - tailList + headList (force tailList (force + tailList (force - sndPair) - (unConstrData - ds)))))))))))))) - [ (\cparams -> - delay - (force - (case - (fun - cparams) - [ (delay - ()) - , (delay - error) ]))) - , (delay - ()) ])) - (runRules - (constr 1 - [ (constr 0 - [ 0 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 30 - , cse ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 1000 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 1 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 100000 - , cse ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 10000000 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 2 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 24576 - , (constr 0 - [ ]) ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 122880 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 3 - , (constr 1 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 32768 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 4 - , (constr 1 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 5000 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 5 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 1000000 - , cse ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 5000000 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 6 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 250000000 - , cse ]) ]) - , cse ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 7 - , (constr 1 - [ (constr 1 - [ cse - , (constr 0 - [ ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 8 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 250 - , cse ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 2000 - , (constr 0 - [ ]) ]) ]) - , cse ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 9 - , (constr 3 - [ (constr 1 - [ cse - , cse ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 10 - , (constr 3 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ (cse - 1000) - , cse ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ (cse - 200) - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 11 - , (constr 3 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ (cse - 10) - , cse ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 16 - , (constr 1 - [ (constr 1 - [ cse - , cse ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 17 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 3000 - , cse ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 6500 - , (constr 0 - [ ]) ]) ]) - , cse ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 18 - , (constr 0 - [ ]) ]) - , (constr 1 - [ (constr 0 - [ 19 - , (constr 2 - [ (constr 1 - [ (constr 3 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ (cse - 25) - , (constr 0 - [ ]) ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ (cse - 5) - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) - , (constr 1 - [ (constr 3 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ (cse - 20000) - , (constr 0 - [ ]) ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ (cse - 5000) - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 20 - , (constr 2 - [ (constr 1 - [ (constr 1 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 40000000 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) - , (constr 1 - [ (constr 1 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 15000000000 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 21 - , (constr 2 - [ (constr 1 - [ (constr 1 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 120000000 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) - , (constr 1 - [ (constr 1 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 40000000000 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 22 - , (constr 1 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 12288 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 23 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 100 - , cse ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 200 - , (constr 0 - [ ]) ]) ]) - , cse ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 24 - , (constr 1 - [ (constr 1 - [ cse - , (constr 0 - [ ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 25 - , (constr 2 - [ (constr 1 - [ cse - , (constr 1 - [ cse - , (constr 1 - [ cse - , (constr 1 - [ cse - , cse ]) ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 26 - , (constr 2 - [ (constr 1 - [ cse - , (constr 1 - [ cse - , (constr 1 - [ cse - , (constr 1 - [ (constr 3 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ cse - , (constr 1 - [ (unsafeRatio - 13 - 20) - , (constr 0 - [ ]) ]) ]) ]) - , cse ]) ]) - , (constr 1 - [ cse - , (constr 1 - [ cse - , (constr 1 - [ cse - , (constr 1 - [ cse - , (constr 1 - [ (constr 3 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ cse - , cse ]) ]) - , cse ]) ]) - , cse ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 27 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 0 - , (constr 1 - [ 3 - , (constr 0 - [ ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 10 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 28 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 0 - , (constr 1 - [ 18 - , (constr 0 - [ ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 293 - , (constr 0 - [ ]) ]) ]) - , cse ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 29 - , (constr 1 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 15 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 30 - , (constr 1 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 10000000000000 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 31 - , (constr 1 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 100000000000 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 32 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 13 - , cse ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 37 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 33 - , (constr 3 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , cse ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ (unsafeRatio - 1000 - 1) - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]))) + (force + sndPair) + (unConstrData + ds)))))))))))))) + [ (\cparams -> + delay + (force + (case + (fun + cparams) + [ (delay + ()) + , (delay + error) ]))) + , (delay + ()) ])) + (runRules + (constr 1 + [ (constr 0 + [ 0 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 30 + , cse ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 1000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 1 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 100000 + , cse ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 10000000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 2 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 24576 + , (constr 0 + [ ]) ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 122880 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 3 + , (constr 1 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 32768 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 4 + , (constr 1 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 5000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 5 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 1000000 + , cse ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 5000000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 6 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 250000000 + , cse ]) ]) + , cse ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 7 + , (constr 1 + [ (constr 1 + [ cse + , (constr 0 + [ ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 8 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 250 + , cse ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 2000 + , (constr 0 + [ ]) ]) ]) + , cse ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 9 + , (constr 3 + [ (constr 1 + [ cse + , cse ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 10 + , (constr 3 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ (cse + 1000) + , cse ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ (cse + 200) + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 11 + , (constr 3 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ (cse + 10) + , cse ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 16 + , (constr 1 + [ (constr 1 + [ cse + , cse ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 17 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 3000 + , cse ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 6500 + , (constr 0 + [ ]) ]) ]) + , cse ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 18 + , (constr 0 + [ ]) ]) + , (constr 1 + [ (constr 0 + [ 19 + , (constr 2 + [ (constr 1 + [ (constr 3 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ (cse + 25) + , (constr 0 + [ ]) ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ (cse + 5) + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) + , (constr 1 + [ (constr 3 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ (cse + 20000) + , (constr 0 + [ ]) ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ (cse + 5000) + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 20 + , (constr 2 + [ (constr 1 + [ (constr 1 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 40000000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) + , (constr 1 + [ (constr 1 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 15000000000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 21 + , (constr 2 + [ (constr 1 + [ (constr 1 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 120000000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) + , (constr 1 + [ (constr 1 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 40000000000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 22 + , (constr 1 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 12288 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 23 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 100 + , cse ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 200 + , (constr 0 + [ ]) ]) ]) + , cse ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 24 + , (constr 1 + [ (constr 1 + [ cse + , (constr 0 + [ ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 25 + , (constr 2 + [ (constr 1 + [ cse + , (constr 1 + [ cse + , (constr 1 + [ cse + , (constr 1 + [ cse + , cse ]) ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 26 + , (constr 2 + [ (constr 1 + [ cse + , (constr 1 + [ cse + , (constr 1 + [ cse + , (constr 1 + [ (constr 3 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ cse + , (constr 1 + [ (unsafeRatio + 13 + 20) + , (constr 0 + [ ]) ]) ]) ]) + , cse ]) ]) + , (constr 1 + [ cse + , (constr 1 + [ cse + , (constr 1 + [ cse + , (constr 1 + [ cse + , (constr 1 + [ (constr 3 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ cse + , cse ]) ]) + , cse ]) ]) + , cse ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 27 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 0 + , (constr 1 + [ 3 + , (constr 0 + [ ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 10 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 28 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 0 + , (constr 1 + [ 18 + , (constr 0 + [ ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 293 + , (constr 0 + [ ]) ]) ]) + , cse ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 29 + , (constr 1 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 15 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 30 + , (constr 1 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 10000000000000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 31 + , (constr 1 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 100000000000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 32 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 13 + , cse ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 37 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 33 + , (constr 3 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , cse ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ (unsafeRatio + 1000 + 1) + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]))) + (constr 3 + [ (constr 1 + [ cse + , cse ]) ])) (constr 3 [ (constr 1 [ cse - , cse ]) ])) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ cse + , (constr 1 + [ cse + , (constr 0 + [ ]) ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ])) (constr 3 [ (constr 1 [ cse @@ -751,46 +764,38 @@ program , cse ]) ]) , (constr 0 [ ]) ]) ]) ])) - (constr 3 - [ (constr 1 - [ cse - , (constr 1 + (constr 1 + [ (constr 3 + [ (constr 1 [ (constr 0 - [ (constr 0 + [ (constr 1 [ ]) , (constr 1 [ cse - , (constr 1 - [ cse - , (constr 0 - [ ]) ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ])) + , (constr 0 + [ ]) ]) ]) + , cse ]) ]) + , (constr 0 + [ ]) ])) (constr 1 - [ (constr 3 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ cse - , (constr 0 - [ ]) ]) ]) - , cse ]) ]) + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ cse + , (constr 1 + [ (cse + 10) + , (constr 0 + [ ]) ]) ]) ]) , (constr 0 [ ]) ])) - (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ cse - , (constr 1 - [ cse - , (constr 0 - [ ]) ]) ]) ]) - , (constr 0 - [ ]) ])) + (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ cse + , cse ]) ])) (constr 0 [ (constr 1 [ ]) @@ -800,39 +805,41 @@ program [ cse , (constr 0 [ ]) ]) ]) ])) - (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ (cse - 10) - , cse ]) ])) - (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , cse ]) - , (constr 0 - [ ]) ])) - (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 0 - , (constr 1 - [ 1000000 - , (constr 0 - [ ]) ]) ]) ])) + (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , cse ]) + , (constr 0 + [ ]) ])) + (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 0 + , (constr 1 + [ 1000000 + , (constr 0 + [ ]) ]) ]) ])) + (constr 1 + [ (constr 0 + [ (constr 2 + [ ]) + , cse ]) + , (constr 0 + [ ]) ])) (constr 1 [ (constr 0 - [ (constr 2 + [ (constr 0 [ ]) - , cse ]) + , (constr 1 + [ 500000000 + , (constr 0 + [ ]) ]) ]) , (constr 0 [ ]) ])) (constr 1 - [ (cse - 4) + [ cse , (constr 0 [ ]) ])) (constr 1 @@ -840,45 +847,36 @@ program , (constr 0 [ ]) ])) (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 500000000 - , (constr 0 - [ ]) ]) ]) + [ cse , (constr 0 [ ]) ])) - (constr 1 - [ cse - , (constr 0 - [ ]) ])) + (cse + 2)) (cse - 1)) - (cse - 10)) - (constr 0 - [ (constr 1 - [ ]) - , cse ])) - (constr 0 - [ (constr 1 - []) - , (constr 1 - [ 1 - , (constr 0 - [ ]) ]) ])) - (cse 2)) - (cse 1)) - (cse 5)) - (cse 100)) - (unsafeRatio 3)) + 4)) + (constr 0 + [ (constr 1 + [ ]) + , cse ])) + (cse + 100)) + (cse 1)) + (cse 1)) + (constr 0 + [ (constr 1 []) + , (constr 1 + [ 1 + , (constr 0 + [ ]) ]) ])) + (cse 10)) + (cse 5)) + (unsafeRatio 51)) (unsafeRatio 4)) - (unsafeRatio 9)) - (unsafeRatio 51)) - (constr 1 [0, (constr 0 [])])) - (unsafeRatio 1)) - (unsafeRatio 0)) + (constr 1 [0, (constr 0 [])])) + (unsafeRatio 3)) + (unsafeRatio 0)) + (unsafeRatio 9)) + (unsafeRatio 1)) ((\s -> s s) (\s arg -> delay @@ -994,55 +992,58 @@ program (validatePreds (constr 0 [ (\x y -> - force ifThenElse + case (equalsInteger x y) - (constr 0 []) - (constr 1 [])) + [ (constr 1 []) + , (constr 0 []) ]) , `$fOrdInteger_$ccompare` , (\x y -> - force ifThenElse + case (lessThanInteger x y) - (constr 0 []) - (constr 1 [])) + [ (constr 1 []) + , (constr 0 []) ]) , (\x y -> - force ifThenElse + case (lessThanEqualsInteger x y) - (constr 0 []) - (constr 1 [])) + [ (constr 1 []) + , (constr 0 []) ]) , (\x y -> - force ifThenElse + case (lessThanEqualsInteger x y) - (constr 1 []) - (constr 0 [])) + [ (constr 0 []) + , (constr 1 []) ]) , (\x y -> - force ifThenElse + case (lessThanInteger x y) - (constr 1 []) - (constr 0 [])) + [ (constr 0 []) + , (constr 1 []) ]) , (\x y -> - force ifThenElse - (lessThanEqualsInteger - x - y) - y - x) + force + (case + (lessThanEqualsInteger + x + y) + [ (delay x) + , (delay y) ])) , (\x y -> - force ifThenElse - (lessThanEqualsInteger - x - y) - x - y) ]) + force + (case + (lessThanEqualsInteger + x + y) + [ (delay y) + , (delay + x) ])) ]) preds (unIData eta))) , (\paramValues -> @@ -1063,24 +1064,22 @@ program [ (\n' d' -> force - (force - ifThenElse + (case (equalsInteger n n') - (delay - (force - ifThenElse - (equalsInteger - d - d') - (constr 0 - [ ]) - (constr 1 - [ ]))) - (delay - (constr 1 - [ ])))) ]) ]) + [ (delay + (constr 1 + [ ])) + , (delay + (case + (equalsInteger + d + d') + [ (constr 1 + [ ]) + , (constr 0 + [ ]) ])) ])) ]) ]) , (\ds ds -> case ds @@ -1104,8 +1103,7 @@ program ds [ (\n' d' -> - force - ifThenElse + case (lessThanInteger (multiplyInteger n @@ -1113,10 +1111,10 @@ program (multiplyInteger n' d)) - (constr 0 - [ ]) - (constr 1 - [ ])) ]) ]) + [ (constr 1 + [ ]) + , (constr 0 + [ ]) ]) ]) ]) , `$fOrdRational0_$c<=` , (\ds ds -> case @@ -1126,8 +1124,7 @@ program ds [ (\n' d' -> - force - ifThenElse + case (lessThanEqualsInteger (multiplyInteger n @@ -1135,10 +1132,10 @@ program (multiplyInteger n' d)) - (constr 1 - [ ]) - (constr 0 - [ ])) ]) ]) + [ (constr 0 + [ ]) + , (constr 1 + [ ]) ]) ]) ]) , (\ds ds -> case ds @@ -1147,8 +1144,7 @@ program ds [ (\n' d' -> - force - ifThenElse + case (lessThanInteger (multiplyInteger n @@ -1156,10 +1152,10 @@ program (multiplyInteger n' d)) - (constr 1 - [ ]) - (constr 0 - [ ])) ]) ]) + [ (constr 0 + [ ]) + , (constr 1 + [ ]) ]) ]) ]) , (\x y -> force (case @@ -1180,21 +1176,21 @@ program preds ((\bl -> (\bl' -> - force ifThenElse + case (force nullList (force tailList bl')) - (\ds -> - unsafeRatio - (unIData - (force - headList - bl)) - (unIData - (force - headList - bl'))) - (\ds -> error) + [ (\ds -> error) + , (\ds -> + unsafeRatio + (unIData + (force + headList + bl)) + (unIData + (force + headList + bl'))) ] (constr 0 [])) (force tailList bl)) (unListData eta)))) ])) @@ -1202,10 +1198,9 @@ program case ds [ (\eta -> - force ifThenElse + case (force nullList eta) - (constr 0 []) - (constr 1 [])) + [(constr 1 []), (constr 0 [])]) , (\paramValueHd paramValueTl actualValueData -> @@ -1225,30 +1220,29 @@ program ((\s -> s s) (\s n d -> force - (force ifThenElse + (case (equalsInteger 0 d) - (delay error) - (delay - (force - (force ifThenElse - (lessThanInteger d 0) - (delay - ((\x -> s s x) - (subtractInteger 0 n) - (subtractInteger 0 d))) - (delay - ((\gcd' -> - constr 0 - [ (quotientInteger n gcd') - , (quotientInteger d gcd') ]) - (euclid n d)))))))))) + [ (delay + (force + (case + (lessThanInteger d 0) + [ (delay + ((\gcd' -> + constr 0 + [ (quotientInteger n gcd') + , (quotientInteger d gcd') ]) + (euclid n d))) + , (delay + ((\x -> s s x) + (subtractInteger 0 n) + (subtractInteger 0 d))) ]))) + , (delay error) ])))) ((\s -> s s) (\s x y -> force - (force ifThenElse + (case (equalsInteger 0 y) - (delay x) - (delay (s s y (modInteger x y))))))) + [(delay (s s y (modInteger x y))), (delay x)])))) (\`$dOrd` ds ds -> (\s -> s s) (\s ds -> @@ -1317,14 +1311,14 @@ program ds)) (\eta eta -> force - (force ifThenElse + (case (equalsInteger eta eta) - (delay (constr 0 [])) - (delay - (force ifThenElse - (lessThanEqualsInteger eta eta) - (constr 2 []) - (constr 1 [])))))) + [ (delay + (force + (case + (lessThanEqualsInteger eta eta) + [(delay (constr 1 [])), (delay (constr 2 []))]))) + , (delay (constr 0 [])) ]))) (\ds ds -> case ds @@ -1332,9 +1326,8 @@ program case ds [ (\n' d' -> - force ifThenElse + case (lessThanEqualsInteger (multiplyInteger n d') (multiplyInteger n' d)) - (constr 0 []) - (constr 1 [])) ]) ])) \ No newline at end of file + [(constr 1 []), (constr 0 [])]) ]) ])) \ No newline at end of file diff --git a/cardano-constitution/test/Cardano/Constitution/Validator/Data/GoldenTests/unsorted.cbor.size.golden b/cardano-constitution/test/Cardano/Constitution/Validator/Data/GoldenTests/unsorted.cbor.size.golden index 7dd861da92d..1c412146757 100644 --- a/cardano-constitution/test/Cardano/Constitution/Validator/Data/GoldenTests/unsorted.cbor.size.golden +++ b/cardano-constitution/test/Cardano/Constitution/Validator/Data/GoldenTests/unsorted.cbor.size.golden @@ -1 +1 @@ -2138 \ No newline at end of file +2082 \ No newline at end of file diff --git a/cardano-constitution/test/Cardano/Constitution/Validator/Data/GoldenTests/unsorted.large.budget.golden b/cardano-constitution/test/Cardano/Constitution/Validator/Data/GoldenTests/unsorted.large.budget.golden index 0043e5123e4..e9b04a5dfe4 100644 --- a/cardano-constitution/test/Cardano/Constitution/Validator/Data/GoldenTests/unsorted.large.budget.golden +++ b/cardano-constitution/test/Cardano/Constitution/Validator/Data/GoldenTests/unsorted.large.budget.golden @@ -1 +1 @@ -ExBudget {exBudgetCPU = ExCPU 856122341, exBudgetMemory = ExMemory 4215188} \ No newline at end of file +ExBudget {exBudgetCPU = ExCPU 660323564, exBudgetMemory = ExMemory 3405515} \ No newline at end of file diff --git a/cardano-constitution/test/Cardano/Constitution/Validator/Data/GoldenTests/unsorted.pir.golden b/cardano-constitution/test/Cardano/Constitution/Validator/Data/GoldenTests/unsorted.pir.golden index 6423e8518a8..6a6e6307dc0 100644 --- a/cardano-constitution/test/Cardano/Constitution/Validator/Data/GoldenTests/unsorted.pir.golden +++ b/cardano-constitution/test/Cardano/Constitution/Validator/Data/GoldenTests/unsorted.pir.golden @@ -136,18 +136,15 @@ program {all dead. dead} in go ds - !equalsInteger : integer -> integer -> Bool - = \(x : integer) (y : integer) -> - ifThenElse {Bool} (equalsInteger x y) True False !`$fOrdInteger_$ccompare` : integer -> integer -> Ordering = \(eta : integer) (eta : integer) -> Bool_match - (ifThenElse {Bool} (equalsInteger eta eta) True False) + (case Bool (equalsInteger eta eta) [False, True]) {all dead. Ordering} (/\dead -> EQ) (/\dead -> Bool_match - (ifThenElse {Bool} (lessThanEqualsInteger eta eta) True False) + (case Bool (lessThanEqualsInteger eta eta) [False, True]) {all dead. Ordering} (/\dead -> LT) (/\dead -> GT) @@ -165,19 +162,18 @@ program ds {Bool} (\(n' : integer) (d' : integer) -> - ifThenElse - {Bool} + case + Bool (lessThanEqualsInteger (multiplyInteger n d') (multiplyInteger n' d)) - True - False)) + [False, True])) in letrec !euclid : integer -> integer -> integer = \(x : integer) (y : integer) -> Bool_match - (ifThenElse {Bool} (equalsInteger 0 y) True False) + (case Bool (equalsInteger 0 y) [False, True]) {all dead. integer} (/\dead -> x) (/\dead -> euclid y (modInteger x y)) @@ -187,12 +183,12 @@ program !unsafeRatio : integer -> integer -> Rational = \(n : integer) (d : integer) -> Bool_match - (ifThenElse {Bool} (equalsInteger 0 d) True False) + (case Bool (equalsInteger 0 d) [False, True]) {all dead. Rational} (/\dead -> error {Rational}) (/\dead -> Bool_match - (ifThenElse {Bool} (lessThanInteger d 0) True False) + (case Bool (lessThanInteger d 0) [False, True]) {all dead. Rational} (/\dead -> unsafeRatio (subtractInteger 0 n) (subtractInteger 0 d)) @@ -214,6 +210,8 @@ program (\v -> List (Tuple2 PredKey (List v))) Rational -> ParamValue in let + !ifThenElse : all a. bool -> a -> a -> a + = /\a -> \(b : bool) (x : a) (y : a) -> case a b [y, x] data Unit | Unit_match where Unit : Unit in @@ -230,16 +228,13 @@ program {integer} (CConsOrd {integer} - equalsInteger + (\(x : integer) (y : integer) -> + case Bool (equalsInteger x y) [False, True]) `$fOrdInteger_$ccompare` (\(x : integer) (y : integer) -> - ifThenElse {Bool} (lessThanInteger x y) True False) + case Bool (lessThanInteger x y) [False, True]) (\(x : integer) (y : integer) -> - ifThenElse - {Bool} - (lessThanEqualsInteger x y) - True - False) + case Bool (lessThanEqualsInteger x y) [False, True]) (\(x : integer) (y : integer) -> ifThenElse {Bool} @@ -250,22 +245,14 @@ program ifThenElse {Bool} (lessThanInteger x y) False True) (\(x : integer) (y : integer) -> Bool_match - (ifThenElse - {Bool} - (lessThanEqualsInteger x y) - True - False) + (case Bool (lessThanEqualsInteger x y) [False, True]) {all dead. integer} (/\dead -> y) (/\dead -> x) {all dead. dead}) (\(x : integer) (y : integer) -> Bool_match - (ifThenElse - {Bool} - (lessThanEqualsInteger x y) - True - False) + (case Bool (lessThanEqualsInteger x y) [False, True]) {all dead. integer} (/\dead -> x) (/\dead -> y) @@ -290,18 +277,16 @@ program {Bool} (\(n' : integer) (d' : integer) -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger n n') - True - False) + [False, True]) {all dead. Bool} (/\dead -> - ifThenElse - {Bool} + case + Bool (equalsInteger d d') - True - False) + [False, True]) (/\dead -> False) {all dead. dead}))) (\(ds : Rational) (ds : Rational) -> @@ -325,13 +310,12 @@ program ds {Bool} (\(n' : integer) (d' : integer) -> - ifThenElse - {Bool} + case + Bool (lessThanInteger (multiplyInteger n d') (multiplyInteger n' d)) - True - False))) + [False, True]))) `$fOrdRational0_$c<=` (\(ds : Rational) (ds : Rational) -> Rational_match @@ -342,11 +326,13 @@ program ds {Bool} (\(n' : integer) (d' : integer) -> + let + !x : integer = multiplyInteger n d' + !y : integer = multiplyInteger n' d + in ifThenElse {Bool} - (lessThanEqualsInteger - (multiplyInteger n d') - (multiplyInteger n' d)) + (lessThanEqualsInteger x y) False True))) (\(ds : Rational) (ds : Rational) -> @@ -358,11 +344,13 @@ program ds {Bool} (\(n' : integer) (d' : integer) -> + let + !x : integer = multiplyInteger n d' + !y : integer = multiplyInteger n' d + in ifThenElse {Bool} - (lessThanInteger - (multiplyInteger n d') - (multiplyInteger n' d)) + (lessThanInteger x y) False True))) (\(x : Rational) (y : Rational) -> @@ -401,7 +389,7 @@ program ds {list data -> Bool} (\(eta : list data) -> - ifThenElse {Bool} (nullList {data} eta) True False) + case Bool (nullList {data} eta) [False, True]) (\(paramValueHd : ParamValue) (paramValueTl : List ParamValue) (actualValueData : list data) -> @@ -431,12 +419,12 @@ program !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 1 index) True False) + (case Bool (equalsInteger 1 index) [False, True]) {all dead. Maybe a} (/\dead -> Nothing {a}) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. Maybe a} (/\dead -> Just {a} (`$dUnsafeFromData` (headList {data} args))) @@ -5223,7 +5211,10 @@ program {ParamValue} (\(k' : integer) (i : ParamValue) -> Bool_match - (equalsInteger k k') + (case + Bool + (equalsInteger k k') + [False, True]) {all dead. ParamValue} (/\dead -> i) (/\dead -> go xs') @@ -5264,13 +5255,12 @@ program (unConstrData ds))))) in Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 5 (fstPair {integer} {list data} tup)) - True - False) + [False, True]) {all dead. data} (/\dead -> headList @@ -5291,11 +5281,10 @@ program !tup : pair integer (list data) = unConstrData scrut in Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 0 (fstPair {integer} {list data} tup)) - True - False) + [False, True]) {all dead. r} (/\dead -> let @@ -5331,11 +5320,10 @@ program !tup : pair integer (list data) = unConstrData scrut in Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 2 (fstPair {integer} {list data} tup)) - True - False) + [False, True]) {all dead. r} (/\dead -> let diff --git a/cardano-constitution/test/Cardano/Constitution/Validator/Data/GoldenTests/unsorted.small.budget.golden b/cardano-constitution/test/Cardano/Constitution/Validator/Data/GoldenTests/unsorted.small.budget.golden index 3910e76ff57..cc35217a63c 100644 --- a/cardano-constitution/test/Cardano/Constitution/Validator/Data/GoldenTests/unsorted.small.budget.golden +++ b/cardano-constitution/test/Cardano/Constitution/Validator/Data/GoldenTests/unsorted.small.budget.golden @@ -1 +1 @@ -ExBudget {exBudgetCPU = ExCPU 80783267, exBudgetMemory = ExMemory 349003} \ No newline at end of file +ExBudget {exBudgetCPU = ExCPU 64618367, exBudgetMemory = ExMemory 295403} \ No newline at end of file diff --git a/cardano-constitution/test/Cardano/Constitution/Validator/Data/GoldenTests/unsorted.uplc.golden b/cardano-constitution/test/Cardano/Constitution/Validator/Data/GoldenTests/unsorted.uplc.golden index b9142a5739c..52f57192ece 100644 --- a/cardano-constitution/test/Cardano/Constitution/Validator/Data/GoldenTests/unsorted.uplc.golden +++ b/cardano-constitution/test/Cardano/Constitution/Validator/Data/GoldenTests/unsorted.uplc.golden @@ -2,14 +2,14 @@ program 1.1.0 ((\`$fOrdRational0_$c<=` -> (\`$fOrdInteger_$ccompare` -> - (\equalsInteger -> - (\validatePreds -> - (\euclid -> - (\unsafeRatio -> - (\cse -> - (\validateParamValue -> - (\validateParamValues -> - (\caseData_go -> + (\validatePreds -> + (\euclid -> + (\unsafeRatio -> + (\cse -> + (\validateParamValue -> + (\validateParamValues -> + (\caseData_go -> + (\cse -> (\cse -> (\cse -> (\cse -> @@ -39,784 +39,779 @@ program (\cse -> (\cse -> (\cse -> - (\cse -> - (\cfg -> - (\fun - ds -> - force - (case - ((\cse -> - (\cse -> - force - (force - ifThenElse - (equalsInteger - 0 - cse) - (delay - (constr 0 - [ (force - caseData_go - (unMapData - (force - headList - (force - tailList - (force - (force - sndPair) - cse))))) ])) - (delay - (force - (force - ifThenElse - (equalsInteger - 2 - cse) - (delay - ((\l -> - constr 1 - [ ]) - (force - (force - sndPair) - cse))) - (delay - error)))))) + (\cfg -> + (\fun + ds -> + force + (case + ((\cse -> + (\cse -> + force + (case + (equalsInteger + 0 + cse) + [ (delay + (force + (case + (equalsInteger + 2 + cse) + [ (delay + error) + , (delay + ((\l -> + constr 1 + [ ]) + (force + (force + sndPair) + cse))) ]))) + , (delay + (constr 0 + [ (force + caseData_go + (unMapData + (force + headList + (force + tailList + (force + (force + sndPair) + cse))))) ])) ])) + (force (force - (force - fstPair) - cse)) - (unConstrData + fstPair) + cse)) + (unConstrData + (force + headList (force - headList + tailList (force tailList (force - tailList (force - (force - sndPair) - (unConstrData - ((\tup -> - force - (force - ifThenElse - (equalsInteger - 5 - (force - (force - fstPair) - tup)) - (delay + sndPair) + (unConstrData + ((\tup -> + force + (case + (equalsInteger + 5 + (force (force - headList - (force - tailList - (force - (force - sndPair) - tup)))) - (delay - error))) - (unConstrData + fstPair) + tup)) + [ (delay + error) + , (delay + (force + headList + (force + tailList + (force + (force + sndPair) + tup)))) ])) + (unConstrData + (force + headList (force - headList + tailList (force tailList (force - tailList (force - (force - sndPair) - (unConstrData - ds)))))))))))))) - [ (\cparams -> - delay - (force - (case - (fun - cparams) - [ (delay - ()) - , (delay - error) ]))) - , (delay - ()) ])) - ((\go - eta -> - go - eta) - ((\s -> - s - s) - (\s - ds -> - force - (case - ds - [ (delay - (constr 0 - [ ])) - , (\x - xs -> - delay - (force + sndPair) + (unConstrData + ds)))))))))))))) + [ (\cparams -> + delay + (force + (case + (fun + cparams) + [ (delay + ()) + , (delay + error) ]))) + , (delay + ()) ])) + ((\go + eta -> + go + eta) + ((\s -> + s + s) + (\s + ds -> + force + (case + ds + [ (delay + (constr 0 + [ ])) + , (\x + xs -> + delay + (force + (case (case - (case - x - [ (\ds - actualValueData -> - validateParamValue - ((\k -> - (\s -> - s - s) - (\s - ds -> - force - (case - ds - [ (delay - error) - , (\ds - xs' -> - delay - (case - ds - [ (\k' - i -> - force - (case - (equalsInteger - k - k') - [ (delay - i) - , (delay - (s - s - xs')) ])) ])) ]))) - (unIData - ds) - cfg) - actualValueData) ]) - [ (delay - (s - s - xs)) - , (delay - (constr 1 - [ ])) ]))) ]))))) - (constr 1 - [ (constr 0 - [ 0 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 30 - , cse ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 1000 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 1 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 100000 - , cse ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 10000000 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 2 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 24576 - , (constr 0 - [ ]) ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 122880 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 3 - , (constr 1 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 32768 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 4 - , (constr 1 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 5000 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 5 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 1000000 - , cse ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 5000000 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 6 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 250000000 - , cse ]) ]) - , cse ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 7 - , (constr 1 - [ (constr 1 - [ cse - , (constr 0 - [ ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 8 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 250 - , cse ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 2000 - , (constr 0 - [ ]) ]) ]) - , cse ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 9 - , (constr 3 - [ (constr 1 - [ cse - , cse ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 10 - , (constr 3 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ (cse - 1000) - , cse ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ (cse - 200) - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 11 - , (constr 3 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ (cse - 10) - , cse ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 16 - , (constr 1 - [ (constr 1 - [ cse - , cse ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 17 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 3000 - , cse ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 6500 - , (constr 0 - [ ]) ]) ]) - , cse ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 18 - , (constr 0 - [ ]) ]) - , (constr 1 - [ (constr 0 - [ 19 - , (constr 2 - [ (constr 1 - [ (constr 3 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ (cse - 25) - , (constr 0 - [ ]) ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ (cse - 5) - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) - , (constr 1 - [ (constr 3 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ (cse - 20000) - , (constr 0 - [ ]) ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ (cse - 5000) - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 20 - , (constr 2 - [ (constr 1 - [ (constr 1 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 40000000 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) - , (constr 1 - [ (constr 1 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 15000000000 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 21 - , (constr 2 - [ (constr 1 - [ (constr 1 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 120000000 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) - , (constr 1 - [ (constr 1 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 40000000000 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 22 - , (constr 1 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 12288 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 23 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 100 - , cse ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 200 - , (constr 0 - [ ]) ]) ]) - , cse ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 24 - , (constr 1 - [ (constr 1 - [ cse - , (constr 0 - [ ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 25 - , (constr 2 - [ (constr 1 - [ cse - , (constr 1 - [ cse - , (constr 1 - [ cse - , (constr 1 - [ cse - , cse ]) ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 26 - , (constr 2 - [ (constr 1 - [ cse - , (constr 1 - [ cse - , (constr 1 - [ cse - , (constr 1 - [ (constr 3 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ cse - , (constr 1 - [ (unsafeRatio - 13 - 20) - , (constr 0 - [ ]) ]) ]) ]) - , cse ]) ]) - , (constr 1 - [ cse - , (constr 1 - [ cse - , (constr 1 - [ cse - , (constr 1 - [ cse - , (constr 1 - [ (constr 3 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ cse - , cse ]) ]) - , cse ]) ]) - , cse ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 27 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 0 - , (constr 1 - [ 3 - , (constr 0 - [ ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 10 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 28 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 0 - , (constr 1 - [ 18 - , (constr 0 - [ ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 293 - , (constr 0 - [ ]) ]) ]) - , cse ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 29 - , (constr 1 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 15 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 30 - , (constr 1 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 10000000000000 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 31 - , (constr 1 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 100000000000 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 32 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 13 - , cse ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 37 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 33 - , (constr 3 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , cse ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ (unsafeRatio - 1000 - 1) - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ])) - (constr 3 - [ (constr 1 - [ cse + x + [ (\ds + actualValueData -> + validateParamValue + ((\k -> + (\s -> + s + s) + (\s + ds -> + force + (case + ds + [ (delay + error) + , (\ds + xs' -> + delay + (case + ds + [ (\k' + i -> + force + (case + (equalsInteger + k + k') + [ (delay + (s + s + xs')) + , (delay + i) ])) ])) ]))) + (unIData + ds) + cfg) + actualValueData) ]) + [ (delay + (s + s + xs)) + , (delay + (constr 1 + [ ])) ]))) ]))))) + (constr 1 + [ (constr 0 + [ 0 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 30 + , cse ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 1000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 1 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 100000 + , cse ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 10000000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) , (constr 1 [ (constr 0 + [ 2 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 24576 + , (constr 0 + [ ]) ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 122880 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 [ (constr 0 - [ ]) + [ 3 + , (constr 1 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 32768 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) , (constr 1 - [ cse - , cse ]) ]) - , (constr 0 - [ ]) ]) ]) ])) + [ (constr 0 + [ 4 + , (constr 1 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 5000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 5 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 1000000 + , cse ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 5000000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 6 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 250000000 + , cse ]) ]) + , cse ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 7 + , (constr 1 + [ (constr 1 + [ cse + , (constr 0 + [ ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 8 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 250 + , cse ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 2000 + , (constr 0 + [ ]) ]) ]) + , cse ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 9 + , (constr 3 + [ (constr 1 + [ cse + , cse ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 10 + , (constr 3 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ (cse + 1000) + , cse ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ (cse + 200) + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 11 + , (constr 3 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ (cse + 10) + , cse ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 16 + , (constr 1 + [ (constr 1 + [ cse + , cse ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 17 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 3000 + , cse ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 6500 + , (constr 0 + [ ]) ]) ]) + , cse ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 18 + , (constr 0 + [ ]) ]) + , (constr 1 + [ (constr 0 + [ 19 + , (constr 2 + [ (constr 1 + [ (constr 3 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ (cse + 25) + , (constr 0 + [ ]) ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ (cse + 5) + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) + , (constr 1 + [ (constr 3 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ (cse + 20000) + , (constr 0 + [ ]) ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ (cse + 5000) + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 20 + , (constr 2 + [ (constr 1 + [ (constr 1 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 40000000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) + , (constr 1 + [ (constr 1 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 15000000000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 21 + , (constr 2 + [ (constr 1 + [ (constr 1 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 120000000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) + , (constr 1 + [ (constr 1 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 40000000000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 22 + , (constr 1 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 12288 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 23 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 100 + , cse ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 200 + , (constr 0 + [ ]) ]) ]) + , cse ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 24 + , (constr 1 + [ (constr 1 + [ cse + , (constr 0 + [ ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 25 + , (constr 2 + [ (constr 1 + [ cse + , (constr 1 + [ cse + , (constr 1 + [ cse + , (constr 1 + [ cse + , cse ]) ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 26 + , (constr 2 + [ (constr 1 + [ cse + , (constr 1 + [ cse + , (constr 1 + [ cse + , (constr 1 + [ (constr 3 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ cse + , (constr 1 + [ (unsafeRatio + 13 + 20) + , (constr 0 + [ ]) ]) ]) ]) + , cse ]) ]) + , (constr 1 + [ cse + , (constr 1 + [ cse + , (constr 1 + [ cse + , (constr 1 + [ cse + , (constr 1 + [ (constr 3 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ cse + , cse ]) ]) + , cse ]) ]) + , cse ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 27 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 0 + , (constr 1 + [ 3 + , (constr 0 + [ ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 10 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 28 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 0 + , (constr 1 + [ 18 + , (constr 0 + [ ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 293 + , (constr 0 + [ ]) ]) ]) + , cse ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 29 + , (constr 1 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 15 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 30 + , (constr 1 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 10000000000000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 31 + , (constr 1 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 100000000000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 32 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 13 + , cse ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 37 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 33 + , (constr 3 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , cse ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ (unsafeRatio + 1000 + 1) + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ])) (constr 3 [ (constr 1 [ cse - , cse ]) ])) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ cse + , (constr 1 + [ cse + , (constr 0 + [ ]) ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ])) (constr 3 [ (constr 1 [ cse @@ -826,43 +821,38 @@ program [ ]) , (constr 1 [ cse - , (constr 1 - [ cse - , (constr 0 - [ ]) ]) ]) ]) + , cse ]) ]) , (constr 0 [ ]) ]) ]) ])) - (constr 1 - [ (constr 3 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ cse - , (constr 0 - [ ]) ]) ]) - , cse ]) ]) - , (constr 0 - [ ]) ])) + (constr 3 + [ (constr 1 + [ cse + , cse ]) ])) (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ cse - , (constr 1 - [ cse - , (constr 0 - [ ]) ]) ]) ]) + [ (constr 3 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ cse + , (constr 0 + [ ]) ]) ]) + , cse ]) ]) , (constr 0 [ ]) ])) - (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ cse - , cse ]) ])) + (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ cse + , (constr 1 + [ cse + , (constr 0 + [ ]) ]) ]) ]) + , (constr 0 + [ ]) ])) (constr 0 [ (constr 1 [ ]) @@ -872,472 +862,462 @@ program [ cse , (constr 0 [ ]) ]) ]) ])) - (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , cse ]) - , (constr 0 - [ ]) ])) - (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 0 - , (constr 1 - [ 1000000 - , (constr 0 - [ ]) ]) ]) ])) - (constr 1 - [ (constr 0 - [ (constr 2 - [ ]) - , cse ]) - , (constr 0 - [ ]) ])) + (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ (cse + 10) + , cse ]) ])) + (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , cse ]) + , (constr 0 + [ ]) ])) + (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 0 + , (constr 1 + [ 1000000 + , (constr 0 + [ ]) ]) ]) ])) (constr 1 [ (constr 0 - [ (constr 0 + [ (constr 2 [ ]) - , (constr 1 - [ 500000000 - , (constr 0 - [ ]) ]) ]) + , cse ]) , (constr 0 [ ]) ])) (constr 1 - [ cse + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 500000000 + , (constr 0 + [ ]) ]) ]) , (constr 0 [ ]) ])) (constr 1 - [ (cse - 4) + [ cse , (constr 0 [ ]) ])) (constr 1 [ cse , (constr 0 [ ]) ])) - (cse - 1)) - (constr 0 - [ (constr 1 - [ ]) - , cse ])) + (constr 1 + [ cse + , (constr 0 + [ ]) ])) + (cse + 100)) (cse 1)) - (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 1 - , (constr 0 - [ ]) ]) ])) - (cse 2)) - (cse 10)) - (cse 5)) - (cse 100)) - (cse 10)) - (unsafeRatio 3)) - (unsafeRatio 1)) - (unsafeRatio 0)) - (unsafeRatio 9)) + (cse 10)) + (constr 0 + [ (constr 1 + []) + , cse ])) + (cse 1)) + (cse 2)) + (constr 0 + [ (constr 1 []) + , (constr 1 + [ 1 + , (constr 0 + [ ]) ]) ])) + (cse 4)) + (cse 5)) + (unsafeRatio 9)) + (unsafeRatio 1)) + (unsafeRatio 0)) (constr 1 [0, (constr 0 [])])) - (unsafeRatio 51)) - (unsafeRatio 4)) - ((\s -> s s) - (\s arg -> - delay - (\xs -> - force - (force (force chooseList) - xs - (delay (constr 0 [])) - (delay - ((\x -> - constr 1 - [ (constr 0 - [ (force - (force - fstPair) - x) - , (force - (force - sndPair) - x) ]) - , (force - (s - s - (delay - (\x -> x))) - (force tailList - xs)) ]) - (force headList xs)))))) - (delay (\x -> x)))) - (cse (\arg_0 arg_1 -> arg_1))) - (cse (\arg_0 arg_1 -> arg_0))) - (force - ((\s -> s s) - (\s h -> - delay - (\fr -> - (\k -> - fr - (\x -> k (\f_0 f_1 -> f_0 x)) - (\x -> k (\f_0 f_1 -> f_1 x))) - (\fq -> force (s s h) (force h fq)))) - (delay - (\choose - validateParamValue - validateParamValues -> - choose - (\eta eta -> + (unsafeRatio 4)) + (unsafeRatio 3)) + (unsafeRatio 51)) + ((\s -> s s) + (\s arg -> + delay + (\xs -> force - (case - eta - [ (delay (constr 0 [])) - , (\preds -> - delay - (validatePreds - (constr 0 - [ equalsInteger - , `$fOrdInteger_$ccompare` - , (\x y -> - force ifThenElse - (lessThanInteger - x - y) - (constr 0 []) - (constr 1 [])) - , (\x y -> - force ifThenElse - (lessThanEqualsInteger - x - y) - (constr 0 []) - (constr 1 [])) - , (\x y -> - force ifThenElse - (lessThanEqualsInteger - x - y) - (constr 1 []) - (constr 0 [])) - , (\x y -> - force ifThenElse - (lessThanInteger - x - y) - (constr 1 []) - (constr 0 [])) - , (\x y -> - force ifThenElse + (force (force chooseList) + xs + (delay (constr 0 [])) + (delay + ((\x -> + constr 1 + [ (constr 0 + [ (force + (force fstPair) + x) + , (force + (force sndPair) + x) ]) + , (force + (s + s + (delay (\x -> x))) + (force tailList + xs)) ]) + (force headList xs)))))) + (delay (\x -> x)))) + (cse (\arg_0 arg_1 -> arg_1))) + (cse (\arg_0 arg_1 -> arg_0))) + (force + ((\s -> s s) + (\s h -> + delay + (\fr -> + (\k -> + fr + (\x -> k (\f_0 f_1 -> f_0 x)) + (\x -> k (\f_0 f_1 -> f_1 x))) + (\fq -> force (s s h) (force h fq)))) + (delay + (\choose validateParamValue validateParamValues -> + choose + (\eta eta -> + force + (case + eta + [ (delay (constr 0 [])) + , (\preds -> + delay + (validatePreds + (constr 0 + [ (\x y -> + case + (equalsInteger + x + y) + [ (constr 1 []) + , (constr 0 []) ]) + , `$fOrdInteger_$ccompare` + , (\x y -> + case + (lessThanInteger + x + y) + [ (constr 1 []) + , (constr 0 []) ]) + , (\x y -> + case + (lessThanEqualsInteger + x + y) + [ (constr 1 []) + , (constr 0 []) ]) + , (\x y -> + case + (lessThanEqualsInteger + x + y) + [ (constr 0 []) + , (constr 1 []) ]) + , (\x y -> + case + (lessThanInteger + x + y) + [ (constr 0 []) + , (constr 1 []) ]) + , (\x y -> + force + (case (lessThanEqualsInteger x y) - y - x) - , (\x y -> - force ifThenElse + [ (delay x) + , (delay y) ])) + , (\x y -> + force + (case (lessThanEqualsInteger x y) - x - y) ]) - preds - (unIData eta))) - , (\paramValues -> - delay - (validateParamValues - paramValues - (unListData eta))) - , (\preds -> - delay - (validatePreds - (constr 0 - [ (\ds ds -> - case - ds - [ (\n d -> - case - ds - [ (\n' - d' -> - force - (force - ifThenElse - (equalsInteger - n - n') - (delay - (force - ifThenElse - (equalsInteger - d - d') - (constr 0 - [ ]) - (constr 1 - [ ]))) - (delay - (constr 1 - [ ])))) ]) ]) - , (\ds ds -> - case - ds - [ (\n d -> - case - ds - [ (\n' - d' -> - `$fOrdInteger_$ccompare` + [ (delay y) + , (delay + x) ])) ]) + preds + (unIData eta))) + , (\paramValues -> + delay + (validateParamValues + paramValues + (unListData eta))) + , (\preds -> + delay + (validatePreds + (constr 0 + [ (\ds ds -> + case + ds + [ (\n d -> + case + ds + [ (\n' + d' -> + force + (case + (equalsInteger + n + n') + [ (delay + (constr 1 + [ ])) + , (delay + (case + (equalsInteger + d + d') + [ (constr 1 + [ ]) + , (constr 0 + [ ]) ])) ])) ]) ]) + , (\ds ds -> + case + ds + [ (\n d -> + case + ds + [ (\n' + d' -> + `$fOrdInteger_$ccompare` + (multiplyInteger + n + d') + (multiplyInteger + n' + d)) ]) ]) + , (\ds ds -> + case + ds + [ (\n d -> + case + ds + [ (\n' + d' -> + case + (lessThanInteger (multiplyInteger n d') (multiplyInteger n' - d)) ]) ]) - , (\ds ds -> - case - ds - [ (\n d -> - case - ds - [ (\n' - d' -> - force - ifThenElse - (lessThanInteger - (multiplyInteger - n - d') - (multiplyInteger - n' - d)) - (constr 0 - [ ]) - (constr 1 - [ ])) ]) ]) - , `$fOrdRational0_$c<=` - , (\ds ds -> - case - ds - [ (\n d -> - case - ds - [ (\n' - d' -> - force - ifThenElse - (lessThanEqualsInteger - (multiplyInteger - n - d') - (multiplyInteger - n' - d)) - (constr 1 - [ ]) - (constr 0 - [ ])) ]) ]) - , (\ds ds -> - case - ds - [ (\n d -> - case - ds - [ (\n' - d' -> - force - ifThenElse - (lessThanInteger - (multiplyInteger - n - d') - (multiplyInteger - n' - d)) - (constr 1 - [ ]) - (constr 0 - [ ])) ]) ]) - , (\x y -> - force - (case - (`$fOrdRational0_$c<=` - x - y) - [ (delay y) - , (delay - x) ])) - , (\x y -> - force - (case - (`$fOrdRational0_$c<=` - x - y) - [ (delay x) - , (delay - y) ])) ]) - preds - ((\bl -> - (\bl' -> - force ifThenElse - (force nullList - (force - tailList - bl')) - (\ds -> - unsafeRatio - (unIData - (force - headList - bl)) - (unIData - (force - headList - bl'))) - (\ds -> error) - (constr 0 [])) - (force tailList - bl)) - (unListData - eta)))) ])) - (\ds -> - case - ds - [ (\eta -> - force ifThenElse - (force nullList eta) - (constr 0 []) - (constr 1 [])) - , (\paramValueHd - paramValueTl - actualValueData -> - force - (case - (validateParamValue - paramValueHd - (force headList - actualValueData)) - [ (delay - (validateParamValues - paramValueTl - (force tailList - actualValueData))) - , (delay - (constr 1 - [])) ])) ])))))) - ((\s -> s s) - (\s n d -> - force - (force ifThenElse - (equalsInteger 0 d) - (delay error) - (delay - (force - (force ifThenElse - (lessThanInteger d 0) - (delay - ((\x -> s s x) - (subtractInteger 0 n) - (subtractInteger 0 d))) - (delay - ((\gcd' -> - constr 0 - [ (quotientInteger n gcd') - , (quotientInteger d gcd') ]) - (euclid n d)))))))))) + d)) + [ (constr 1 + [ ]) + , (constr 0 + [ ]) ]) ]) ]) + , `$fOrdRational0_$c<=` + , (\ds ds -> + case + ds + [ (\n d -> + case + ds + [ (\n' + d' -> + case + (lessThanEqualsInteger + (multiplyInteger + n + d') + (multiplyInteger + n' + d)) + [ (constr 0 + [ ]) + , (constr 1 + [ ]) ]) ]) ]) + , (\ds ds -> + case + ds + [ (\n d -> + case + ds + [ (\n' + d' -> + case + (lessThanInteger + (multiplyInteger + n + d') + (multiplyInteger + n' + d)) + [ (constr 0 + [ ]) + , (constr 1 + [ ]) ]) ]) ]) + , (\x y -> + force + (case + (`$fOrdRational0_$c<=` + x + y) + [ (delay y) + , (delay x) ])) + , (\x y -> + force + (case + (`$fOrdRational0_$c<=` + x + y) + [ (delay x) + , (delay + y) ])) ]) + preds + ((\bl -> + (\bl' -> + case + (force nullList + (force tailList + bl')) + [ (\ds -> error) + , (\ds -> + unsafeRatio + (unIData + (force + headList + bl)) + (unIData + (force + headList + bl'))) ] + (constr 0 [])) + (force tailList bl)) + (unListData eta)))) ])) + (\ds -> + case + ds + [ (\eta -> + case + (force nullList eta) + [(constr 1 []), (constr 0 [])]) + , (\paramValueHd + paramValueTl + actualValueData -> + force + (case + (validateParamValue + paramValueHd + (force headList + actualValueData)) + [ (delay + (validateParamValues + paramValueTl + (force tailList + actualValueData))) + , (delay + (constr 1 [])) ])) ])))))) ((\s -> s s) - (\s x y -> + (\s n d -> force - (force ifThenElse - (equalsInteger 0 y) - (delay x) - (delay (s s y (modInteger x y))))))) - (\`$dOrd` ds ds -> - (\s -> s s) - (\s ds -> - force - (case - ds - [ (delay (constr 0 [])) - , (\x xs -> - delay - (case - x - [ (\predKey expectedPredValues -> - (\meaning -> - (\s -> s s) - (\s ds -> - force + (case + (equalsInteger 0 d) + [ (delay + (force + (case + (lessThanInteger d 0) + [ (delay + ((\gcd' -> + constr 0 + [ (quotientInteger n gcd') + , (quotientInteger d gcd') ]) + (euclid n d))) + , (delay + ((\x -> s s x) + (subtractInteger 0 n) + (subtractInteger 0 d))) ]))) + , (delay error) ])))) + ((\s -> s s) + (\s x y -> + force + (case + (equalsInteger 0 y) + [(delay (s s y (modInteger x y))), (delay x)])))) + (\`$dOrd` ds ds -> + (\s -> s s) + (\s ds -> + force + (case + ds + [ (delay (constr 0 [])) + , (\x xs -> + delay + (case + x + [ (\predKey expectedPredValues -> + (\meaning -> + (\s -> s s) + (\s ds -> + force + (case + ds + [ (delay (s s xs)) + , (\x xs -> + delay + (force + (case + (meaning x ds) + [ (delay + (s s xs)) + , (delay + (constr 1 + [ ])) ]))) ])) + expectedPredValues) + (force + (case + predKey + [ (delay (case - ds - [ (delay (s s xs)) - , (\x xs -> - delay - (force - (case - (meaning - x - ds) - [ (delay - (s - s - xs)) - , (delay - (constr 1 - [ ])) ]))) ])) - expectedPredValues) - (force - (case - predKey - [ (delay - (case - `$dOrd` - [ (\v v v v v v v v -> - v) ])) - , (delay - (case - `$dOrd` - [ (\v v v v v v v v -> - v) ])) - , (delay - (\x y -> - force + `$dOrd` + [ (\v v v v v v v v -> + v) ])) + , (delay + (case + `$dOrd` + [ (\v v v v v v v v -> + v) ])) + , (delay + (\x y -> + force + (case (case - (case - `$dOrd` - [ (\v - v - v - v - v - v - v - v -> - v) ] - x - y) - [ (delay - (constr 1 - [])) - , (delay - (constr 0 - [ ])) ]))) ]))) ])) ])) - ds)) - (\x y -> - force ifThenElse (equalsInteger x y) (constr 0 []) (constr 1 []))) + `$dOrd` + [ (\v + v + v + v + v + v + v + v -> + v) ] + x + y) + [ (delay + (constr 1 [])) + , (delay + (constr 0 + [ ])) ]))) ]))) ])) ])) + ds)) (\eta eta -> force - (force ifThenElse + (case (equalsInteger eta eta) - (delay (constr 0 [])) - (delay - (force ifThenElse - (lessThanEqualsInteger eta eta) - (constr 2 []) - (constr 1 [])))))) + [ (delay + (force + (case + (lessThanEqualsInteger eta eta) + [(delay (constr 1 [])), (delay (constr 2 []))]))) + , (delay (constr 0 [])) ]))) (\ds ds -> case ds @@ -1345,9 +1325,8 @@ program case ds [ (\n' d' -> - force ifThenElse + case (lessThanEqualsInteger (multiplyInteger n d') (multiplyInteger n' d)) - (constr 0 []) - (constr 1 [])) ]) ])) \ No newline at end of file + [(constr 1 []), (constr 0 [])]) ]) ])) \ No newline at end of file diff --git a/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/sorted.cbor.size.golden b/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/sorted.cbor.size.golden index c4846c4faff..9aba31b86d4 100644 --- a/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/sorted.cbor.size.golden +++ b/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/sorted.cbor.size.golden @@ -1 +1 @@ -2145 \ No newline at end of file +2090 \ No newline at end of file diff --git a/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/sorted.large.budget.golden b/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/sorted.large.budget.golden index ded7156c145..50d215b9ae2 100644 --- a/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/sorted.large.budget.golden +++ b/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/sorted.large.budget.golden @@ -1 +1 @@ -ExBudget {exBudgetCPU = ExCPU 542436171, exBudgetMemory = ExMemory 2602818} \ No newline at end of file +ExBudget {exBudgetCPU = ExCPU 474038709, exBudgetMemory = ExMemory 2383080} \ No newline at end of file diff --git a/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/sorted.pir.golden b/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/sorted.pir.golden index 3313b57cbab..f27ac2bb978 100644 --- a/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/sorted.pir.golden +++ b/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/sorted.pir.golden @@ -139,12 +139,12 @@ program !`$fOrdInteger_$ccompare` : integer -> integer -> Ordering = \(eta : integer) (eta : integer) -> Bool_match - (ifThenElse {Bool} (equalsInteger eta eta) True False) + (case Bool (equalsInteger eta eta) [False, True]) {all dead. Ordering} (/\dead -> EQ) (/\dead -> Bool_match - (ifThenElse {Bool} (lessThanEqualsInteger eta eta) True False) + (case Bool (lessThanEqualsInteger eta eta) [False, True]) {all dead. Ordering} (/\dead -> LT) (/\dead -> GT) @@ -162,19 +162,18 @@ program ds {Bool} (\(n' : integer) (d' : integer) -> - ifThenElse - {Bool} + case + Bool (lessThanEqualsInteger (multiplyInteger n d') (multiplyInteger n' d)) - True - False)) + [False, True])) in letrec !euclid : integer -> integer -> integer = \(x : integer) (y : integer) -> Bool_match - (ifThenElse {Bool} (equalsInteger 0 y) True False) + (case Bool (equalsInteger 0 y) [False, True]) {all dead. integer} (/\dead -> x) (/\dead -> euclid y (modInteger x y)) @@ -184,12 +183,12 @@ program !unsafeRatio : integer -> integer -> Rational = \(n : integer) (d : integer) -> Bool_match - (ifThenElse {Bool} (equalsInteger 0 d) True False) + (case Bool (equalsInteger 0 d) [False, True]) {all dead. Rational} (/\dead -> error {Rational}) (/\dead -> Bool_match - (ifThenElse {Bool} (lessThanInteger d 0) True False) + (case Bool (lessThanInteger d 0) [False, True]) {all dead. Rational} (/\dead -> unsafeRatio (subtractInteger 0 n) (subtractInteger 0 d)) @@ -213,6 +212,8 @@ program let data Unit | Unit_match where Unit : Unit + !ifThenElse : all a. bool -> a -> a -> a + = /\a -> \(b : bool) (x : a) (y : a) -> case a b [y, x] in letrec !validateParamValue : ParamValue -> data -> Bool @@ -228,16 +229,12 @@ program (CConsOrd {integer} (\(x : integer) (y : integer) -> - ifThenElse {Bool} (equalsInteger x y) True False) + case Bool (equalsInteger x y) [False, True]) `$fOrdInteger_$ccompare` (\(x : integer) (y : integer) -> - ifThenElse {Bool} (lessThanInteger x y) True False) + case Bool (lessThanInteger x y) [False, True]) (\(x : integer) (y : integer) -> - ifThenElse - {Bool} - (lessThanEqualsInteger x y) - True - False) + case Bool (lessThanEqualsInteger x y) [False, True]) (\(x : integer) (y : integer) -> ifThenElse {Bool} @@ -248,22 +245,14 @@ program ifThenElse {Bool} (lessThanInteger x y) False True) (\(x : integer) (y : integer) -> Bool_match - (ifThenElse - {Bool} - (lessThanEqualsInteger x y) - True - False) + (case Bool (lessThanEqualsInteger x y) [False, True]) {all dead. integer} (/\dead -> y) (/\dead -> x) {all dead. dead}) (\(x : integer) (y : integer) -> Bool_match - (ifThenElse - {Bool} - (lessThanEqualsInteger x y) - True - False) + (case Bool (lessThanEqualsInteger x y) [False, True]) {all dead. integer} (/\dead -> x) (/\dead -> y) @@ -288,18 +277,16 @@ program {Bool} (\(n' : integer) (d' : integer) -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger n n') - True - False) + [False, True]) {all dead. Bool} (/\dead -> - ifThenElse - {Bool} + case + Bool (equalsInteger d d') - True - False) + [False, True]) (/\dead -> False) {all dead. dead}))) (\(ds : Rational) (ds : Rational) -> @@ -323,13 +310,12 @@ program ds {Bool} (\(n' : integer) (d' : integer) -> - ifThenElse - {Bool} + case + Bool (lessThanInteger (multiplyInteger n d') (multiplyInteger n' d)) - True - False))) + [False, True]))) `$fOrdRational0_$c<=` (\(ds : Rational) (ds : Rational) -> Rational_match @@ -340,11 +326,13 @@ program ds {Bool} (\(n' : integer) (d' : integer) -> + let + !x : integer = multiplyInteger n d' + !y : integer = multiplyInteger n' d + in ifThenElse {Bool} - (lessThanEqualsInteger - (multiplyInteger n d') - (multiplyInteger n' d)) + (lessThanEqualsInteger x y) False True))) (\(ds : Rational) (ds : Rational) -> @@ -356,11 +344,13 @@ program ds {Bool} (\(n' : integer) (d' : integer) -> + let + !x : integer = multiplyInteger n d' + !y : integer = multiplyInteger n' d + in ifThenElse {Bool} - (lessThanInteger - (multiplyInteger n d') - (multiplyInteger n' d)) + (lessThanInteger x y) False True))) (\(x : Rational) (y : Rational) -> @@ -399,7 +389,7 @@ program ds {list data -> Bool} (\(eta : list data) -> - ifThenElse {Bool} (nullList {data} eta) True False) + case Bool (nullList {data} eta) [False, True]) (\(paramValueHd : ParamValue) (paramValueTl : List ParamValue) (actualValueData : list data) -> @@ -5309,13 +5299,12 @@ program (unConstrData ds))))) in Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 5 (fstPair {integer} {list data} si)) - True - False) + [False, True]) {all dead. data} (/\dead -> headList @@ -5328,7 +5317,7 @@ program !x : integer = fstPair {integer} {list data} ds in Bool_match - (ifThenElse {Bool} (equalsInteger 0 x) True False) + (case Bool (equalsInteger 0 x) [False, True]) {all dead. Maybe (List (Tuple2 data data))} (/\dead -> Just @@ -5342,7 +5331,7 @@ program caseData_go (unMapData d))) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 2 x) True False) + (case Bool (equalsInteger 2 x) [False, True]) {all dead. Maybe (List (Tuple2 data data))} (/\dead -> Nothing {List (Tuple2 data data)}) (/\dead -> error {Maybe (List (Tuple2 data data))}) diff --git a/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/sorted.small.budget.golden b/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/sorted.small.budget.golden index 71b7ddd05f9..57dab4b5b50 100644 --- a/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/sorted.small.budget.golden +++ b/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/sorted.small.budget.golden @@ -1 +1 @@ -ExBudget {exBudgetCPU = ExCPU 82997157, exBudgetMemory = ExMemory 360305} \ No newline at end of file +ExBudget {exBudgetCPU = ExCPU 66972110, exBudgetMemory = ExMemory 309002} \ No newline at end of file diff --git a/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/sorted.uplc.golden b/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/sorted.uplc.golden index 418d25e77f4..e9a1f536193 100644 --- a/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/sorted.uplc.golden +++ b/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/sorted.uplc.golden @@ -40,704 +40,696 @@ program (\cse -> (\cse -> (\cse -> - (\cse -> - (\fun - ds -> - force - (case - ((\ds -> - (\x -> - force - (force - ifThenElse - (equalsInteger - 0 - x) - (delay - (constr 0 - [ ((\d -> - force - caseData_go - (unMapData - d)) - (force - headList - (force - tailList - (force - (force - sndPair) - ds)))) ])) - (delay - (force - (force - ifThenElse - (equalsInteger - 2 - x) - (delay - (constr 1 - [ ])) - (delay - error)))))) + (\fun + ds -> + force + (case + ((\ds -> + (\x -> + force + (case + (equalsInteger + 0 + x) + [ (delay + (force + (case + (equalsInteger + 2 + x) + [ (delay + error) + , (delay + (constr 1 + [ ])) ]))) + , (delay + (constr 0 + [ ((\d -> + force + caseData_go + (unMapData + d)) + (force + headList + (force + tailList + (force + (force + sndPair) + ds)))) ])) ])) + (force (force - (force - fstPair) - ds)) - (unConstrData + fstPair) + ds)) + (unConstrData + (force + headList (force - headList + tailList (force tailList (force - tailList (force - (force - sndPair) - (unConstrData - ((\si -> - force - (force - ifThenElse - (equalsInteger - 5 - (force - (force - fstPair) - si)) - (delay + sndPair) + (unConstrData + ((\si -> + force + (case + (equalsInteger + 5 + (force (force - headList - (force - tailList - (force - (force - sndPair) - si)))) - (delay - error))) - (unConstrData + fstPair) + si)) + [ (delay + error) + , (delay + (force + headList + (force + tailList + (force + (force + sndPair) + si)))) ])) + (unConstrData + (force + headList (force - headList + tailList (force tailList (force - tailList (force - (force - sndPair) - (unConstrData - ds)))))))))))))) - [ (\cparams -> - delay - (force - (case - (fun - cparams) - [ (delay - ()) - , (delay - error) ]))) - , (delay - ()) ])) - (runRules - (constr 1 - [ (constr 0 - [ 0 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 30 - , cse ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 1000 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 1 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 100000 - , cse ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 10000000 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 2 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 24576 - , (constr 0 - [ ]) ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 122880 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 3 - , (constr 1 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 32768 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 4 - , (constr 1 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 5000 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 5 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 1000000 - , cse ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 5000000 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 6 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 250000000 - , cse ]) ]) - , cse ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 7 - , (constr 1 - [ (constr 1 - [ cse - , (constr 0 - [ ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 8 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 250 - , cse ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 2000 - , (constr 0 - [ ]) ]) ]) - , cse ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 9 - , (constr 3 - [ (constr 1 - [ cse - , cse ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 10 - , (constr 3 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ (cse - 1000) - , cse ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ (cse - 200) - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 11 - , (constr 3 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ (cse - 10) - , cse ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 16 - , (constr 1 - [ (constr 1 - [ cse - , cse ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 17 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 3000 - , cse ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 6500 - , (constr 0 - [ ]) ]) ]) - , cse ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 18 - , (constr 0 - [ ]) ]) - , (constr 1 - [ (constr 0 - [ 19 - , (constr 2 - [ (constr 1 - [ (constr 3 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ (cse - 25) - , (constr 0 - [ ]) ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ (cse - 5) - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) - , (constr 1 - [ (constr 3 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ (cse - 20000) - , (constr 0 - [ ]) ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ (cse - 5000) - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 20 - , (constr 2 - [ (constr 1 - [ (constr 1 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 40000000 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) - , (constr 1 - [ (constr 1 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 15000000000 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 21 - , (constr 2 - [ (constr 1 - [ (constr 1 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 120000000 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) - , (constr 1 - [ (constr 1 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 40000000000 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 22 - , (constr 1 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 12288 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 23 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 100 - , cse ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 200 - , (constr 0 - [ ]) ]) ]) - , cse ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 24 - , (constr 1 - [ (constr 1 - [ cse - , (constr 0 - [ ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 25 - , (constr 2 - [ (constr 1 - [ cse - , (constr 1 - [ cse - , (constr 1 - [ cse - , (constr 1 - [ cse - , cse ]) ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 26 - , (constr 2 - [ (constr 1 - [ cse - , (constr 1 - [ cse - , (constr 1 - [ cse - , (constr 1 - [ (constr 3 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ cse - , (constr 1 - [ (unsafeRatio - 13 - 20) - , (constr 0 - [ ]) ]) ]) ]) - , cse ]) ]) - , (constr 1 - [ cse - , (constr 1 - [ cse - , (constr 1 - [ cse - , (constr 1 - [ cse - , (constr 1 - [ (constr 3 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ cse - , cse ]) ]) - , cse ]) ]) - , cse ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 27 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 0 - , (constr 1 - [ 3 - , (constr 0 - [ ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 10 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 28 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 0 - , (constr 1 - [ 18 - , (constr 0 - [ ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 293 - , (constr 0 - [ ]) ]) ]) - , cse ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 29 - , (constr 1 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 15 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 30 - , (constr 1 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 10000000000000 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 31 - , (constr 1 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 100000000000 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 32 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 13 - , cse ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 37 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 33 - , (constr 3 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , cse ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ (unsafeRatio - 1000 - 1) - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]))) - (constr 3 - [ (constr 1 - [ cse - , cse ]) ])) + sndPair) + (unConstrData + ds)))))))))))))) + [ (\cparams -> + delay + (force + (case + (fun + cparams) + [ (delay + ()) + , (delay + error) ]))) + , (delay + ()) ])) + (runRules + (constr 1 + [ (constr 0 + [ 0 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 30 + , cse ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 1000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 1 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 100000 + , cse ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 10000000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 2 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 24576 + , (constr 0 + [ ]) ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 122880 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 3 + , (constr 1 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 32768 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 4 + , (constr 1 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 5000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 5 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 1000000 + , cse ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 5000000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 6 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 250000000 + , cse ]) ]) + , cse ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 7 + , (constr 1 + [ (constr 1 + [ cse + , (constr 0 + [ ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 8 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 250 + , cse ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 2000 + , (constr 0 + [ ]) ]) ]) + , cse ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 9 + , (constr 3 + [ (constr 1 + [ cse + , cse ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 10 + , (constr 3 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ (cse + 1000) + , cse ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ (cse + 200) + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 11 + , (constr 3 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ (cse + 10) + , cse ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 16 + , (constr 1 + [ (constr 1 + [ cse + , cse ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 17 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 3000 + , cse ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 6500 + , (constr 0 + [ ]) ]) ]) + , cse ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 18 + , (constr 0 + [ ]) ]) + , (constr 1 + [ (constr 0 + [ 19 + , (constr 2 + [ (constr 1 + [ (constr 3 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ (cse + 25) + , (constr 0 + [ ]) ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ (cse + 5) + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) + , (constr 1 + [ (constr 3 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ (cse + 20000) + , (constr 0 + [ ]) ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ (cse + 5000) + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 20 + , (constr 2 + [ (constr 1 + [ (constr 1 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 40000000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) + , (constr 1 + [ (constr 1 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 15000000000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 21 + , (constr 2 + [ (constr 1 + [ (constr 1 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 120000000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) + , (constr 1 + [ (constr 1 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 40000000000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 22 + , (constr 1 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 12288 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 23 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 100 + , cse ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 200 + , (constr 0 + [ ]) ]) ]) + , cse ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 24 + , (constr 1 + [ (constr 1 + [ cse + , (constr 0 + [ ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 25 + , (constr 2 + [ (constr 1 + [ cse + , (constr 1 + [ cse + , (constr 1 + [ cse + , (constr 1 + [ cse + , cse ]) ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 26 + , (constr 2 + [ (constr 1 + [ cse + , (constr 1 + [ cse + , (constr 1 + [ cse + , (constr 1 + [ (constr 3 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ cse + , (constr 1 + [ (unsafeRatio + 13 + 20) + , (constr 0 + [ ]) ]) ]) ]) + , cse ]) ]) + , (constr 1 + [ cse + , (constr 1 + [ cse + , (constr 1 + [ cse + , (constr 1 + [ cse + , (constr 1 + [ (constr 3 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ cse + , cse ]) ]) + , cse ]) ]) + , cse ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 27 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 0 + , (constr 1 + [ 3 + , (constr 0 + [ ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 10 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 28 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 0 + , (constr 1 + [ 18 + , (constr 0 + [ ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 293 + , (constr 0 + [ ]) ]) ]) + , cse ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 29 + , (constr 1 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 15 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 30 + , (constr 1 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 10000000000000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 31 + , (constr 1 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 100000000000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 32 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 13 + , cse ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 37 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 33 + , (constr 3 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , cse ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ (unsafeRatio + 1000 + 1) + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]))) (constr 3 [ (constr 1 [ cse @@ -747,89 +739,90 @@ program [ ]) , (constr 1 [ cse - , (constr 1 - [ cse - , (constr 0 - [ ]) ]) ]) ]) + , cse ]) ]) , (constr 0 [ ]) ]) ]) ])) (constr 3 [ (constr 1 [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ cse - , cse ]) ]) - , (constr 0 - [ ]) ]) ]) ])) - (constr 1 - [ (constr 3 - [ (constr 1 + , cse ]) ])) + (constr 3 + [ (constr 1 + [ cse + , (constr 1 [ (constr 0 - [ (constr 1 + [ (constr 0 [ ]) , (constr 1 [ cse - , (constr 0 - [ ]) ]) ]) - , cse ]) ]) - , (constr 0 - [ ]) ])) + , (constr 1 + [ cse + , (constr 0 + [ ]) ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ])) (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ cse - , (constr 1 - [ cse - , (constr 0 - [ ]) ]) ]) ]) + [ (constr 3 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ cse + , (constr 0 + [ ]) ]) ]) + , cse ]) ]) , (constr 0 [ ]) ])) - (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ cse + (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) , (constr 1 [ cse - , (constr 0 - [ ]) ]) ]) ])) + , (constr 1 + [ cse + , (constr 0 + [ ]) ]) ]) ]) + , (constr 0 + [ ]) ])) (constr 0 [ (constr 1 [ ]) , (constr 1 [ cse - , cse ]) ])) - (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , cse ]) - , (constr 0 - [ ]) ])) - (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 0 - , (constr 1 - [ 1000000 - , (constr 0 - [ ]) ]) ]) ])) - (constr 1 - [ (constr 0 - [ (constr 2 - [ ]) - , cse ]) - , (constr 0 - [ ]) ])) + , (constr 1 + [ cse + , (constr 0 + [ ]) ]) ]) ])) + (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ (cse + 10) + , cse ]) ])) + (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , cse ]) + , (constr 0 + [ ]) ])) + (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 0 + , (constr 1 + [ 1000000 + , (constr 0 + [ ]) ]) ]) ])) (constr 1 - [ cse + [ (constr 0 + [ (constr 2 + [ ]) + , cse ]) , (constr 0 [ ]) ])) (constr 1 @@ -850,35 +843,38 @@ program [ cse , (constr 0 [ ]) ])) - (cse - 1)) + (constr 1 + [ cse + , (constr 0 + [ ]) ])) (cse - 10)) + 1)) (cse - 100)) - (cse - 5)) - (constr 0 - [ (constr 1 - [ ]) - , cse ])) + 10)) + (constr 0 + [ (constr 1 + [ ]) + , cse ])) + (cse + 100)) (cse 1)) - (cse 4)) - (constr 0 - [ (constr 1 []) - , (constr 1 - [ 1 - , (constr 0 - [ ]) ]) ])) + (constr 0 + [ (constr 1 + []) + , (constr 1 + [ 1 + , (constr 0 + [ ]) ]) ])) + (cse 4)) (cse 2)) - (cse 10)) - (unsafeRatio 9)) - (unsafeRatio 4)) - (unsafeRatio 3)) - (constr 1 [0, (constr 0 [])])) - (unsafeRatio 51)) - (unsafeRatio 0)) - (unsafeRatio 1)) + (cse 5)) + (unsafeRatio 3)) + (unsafeRatio 0)) + (unsafeRatio 9)) + (unsafeRatio 51)) + (constr 1 [0, (constr 0 [])])) + (unsafeRatio 1)) + (unsafeRatio 4)) ((\s -> s s) (\s arg -> delay @@ -994,55 +990,58 @@ program (validatePreds (constr 0 [ (\x y -> - force ifThenElse + case (equalsInteger x y) - (constr 0 []) - (constr 1 [])) + [ (constr 1 []) + , (constr 0 []) ]) , `$fOrdInteger_$ccompare` , (\x y -> - force ifThenElse + case (lessThanInteger x y) - (constr 0 []) - (constr 1 [])) + [ (constr 1 []) + , (constr 0 []) ]) , (\x y -> - force ifThenElse + case (lessThanEqualsInteger x y) - (constr 0 []) - (constr 1 [])) + [ (constr 1 []) + , (constr 0 []) ]) , (\x y -> - force ifThenElse + case (lessThanEqualsInteger x y) - (constr 1 []) - (constr 0 [])) + [ (constr 0 []) + , (constr 1 []) ]) , (\x y -> - force ifThenElse + case (lessThanInteger x y) - (constr 1 []) - (constr 0 [])) + [ (constr 0 []) + , (constr 1 []) ]) , (\x y -> - force ifThenElse - (lessThanEqualsInteger - x - y) - y - x) + force + (case + (lessThanEqualsInteger + x + y) + [ (delay x) + , (delay y) ])) , (\x y -> - force ifThenElse - (lessThanEqualsInteger - x - y) - x - y) ]) + force + (case + (lessThanEqualsInteger + x + y) + [ (delay y) + , (delay + x) ])) ]) preds (unIData eta))) , (\paramValues -> @@ -1063,24 +1062,22 @@ program [ (\n' d' -> force - (force - ifThenElse + (case (equalsInteger n n') - (delay - (force - ifThenElse - (equalsInteger - d - d') - (constr 0 - [ ]) - (constr 1 - [ ]))) - (delay - (constr 1 - [ ])))) ]) ]) + [ (delay + (constr 1 + [ ])) + , (delay + (case + (equalsInteger + d + d') + [ (constr 1 + [ ]) + , (constr 0 + [ ]) ])) ])) ]) ]) , (\ds ds -> case ds @@ -1104,8 +1101,7 @@ program ds [ (\n' d' -> - force - ifThenElse + case (lessThanInteger (multiplyInteger n @@ -1113,10 +1109,10 @@ program (multiplyInteger n' d)) - (constr 0 - [ ]) - (constr 1 - [ ])) ]) ]) + [ (constr 1 + [ ]) + , (constr 0 + [ ]) ]) ]) ]) , `$fOrdRational0_$c<=` , (\ds ds -> case @@ -1126,8 +1122,7 @@ program ds [ (\n' d' -> - force - ifThenElse + case (lessThanEqualsInteger (multiplyInteger n @@ -1135,10 +1130,10 @@ program (multiplyInteger n' d)) - (constr 1 - [ ]) - (constr 0 - [ ])) ]) ]) + [ (constr 0 + [ ]) + , (constr 1 + [ ]) ]) ]) ]) , (\ds ds -> case ds @@ -1147,8 +1142,7 @@ program ds [ (\n' d' -> - force - ifThenElse + case (lessThanInteger (multiplyInteger n @@ -1156,10 +1150,10 @@ program (multiplyInteger n' d)) - (constr 1 - [ ]) - (constr 0 - [ ])) ]) ]) + [ (constr 0 + [ ]) + , (constr 1 + [ ]) ]) ]) ]) , (\x y -> force (case @@ -1180,21 +1174,21 @@ program preds ((\bl -> (\bl' -> - force ifThenElse + case (force nullList (force tailList bl')) - (\ds -> - unsafeRatio - (unIData - (force - headList - bl)) - (unIData - (force - headList - bl'))) - (\ds -> error) + [ (\ds -> error) + , (\ds -> + unsafeRatio + (unIData + (force + headList + bl)) + (unIData + (force + headList + bl'))) ] (constr 0 [])) (force tailList bl)) (unListData eta)))) ])) @@ -1202,10 +1196,9 @@ program case ds [ (\eta -> - force ifThenElse + case (force nullList eta) - (constr 0 []) - (constr 1 [])) + [(constr 1 []), (constr 0 [])]) , (\paramValueHd paramValueTl actualValueData -> @@ -1225,30 +1218,29 @@ program ((\s -> s s) (\s n d -> force - (force ifThenElse + (case (equalsInteger 0 d) - (delay error) - (delay - (force - (force ifThenElse - (lessThanInteger d 0) - (delay - ((\x -> s s x) - (subtractInteger 0 n) - (subtractInteger 0 d))) - (delay - ((\gcd' -> - constr 0 - [ (quotientInteger n gcd') - , (quotientInteger d gcd') ]) - (euclid n d)))))))))) + [ (delay + (force + (case + (lessThanInteger d 0) + [ (delay + ((\gcd' -> + constr 0 + [ (quotientInteger n gcd') + , (quotientInteger d gcd') ]) + (euclid n d))) + , (delay + ((\x -> s s x) + (subtractInteger 0 n) + (subtractInteger 0 d))) ]))) + , (delay error) ])))) ((\s -> s s) (\s x y -> force - (force ifThenElse + (case (equalsInteger 0 y) - (delay x) - (delay (s s y (modInteger x y))))))) + [(delay (s s y (modInteger x y))), (delay x)])))) (\`$dOrd` ds ds -> (\s -> s s) (\s ds -> @@ -1317,14 +1309,14 @@ program ds)) (\eta eta -> force - (force ifThenElse + (case (equalsInteger eta eta) - (delay (constr 0 [])) - (delay - (force ifThenElse - (lessThanEqualsInteger eta eta) - (constr 2 []) - (constr 1 [])))))) + [ (delay + (force + (case + (lessThanEqualsInteger eta eta) + [(delay (constr 1 [])), (delay (constr 2 []))]))) + , (delay (constr 0 [])) ]))) (\ds ds -> case ds @@ -1332,9 +1324,8 @@ program case ds [ (\n' d' -> - force ifThenElse + case (lessThanEqualsInteger (multiplyInteger n d') (multiplyInteger n' d)) - (constr 0 []) - (constr 1 [])) ]) ])) \ No newline at end of file + [(constr 1 []), (constr 0 [])]) ]) ])) \ No newline at end of file diff --git a/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/unsorted.cbor.size.golden b/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/unsorted.cbor.size.golden index df124cff2e7..1c412146757 100644 --- a/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/unsorted.cbor.size.golden +++ b/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/unsorted.cbor.size.golden @@ -1 +1 @@ -2137 \ No newline at end of file +2082 \ No newline at end of file diff --git a/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/unsorted.large.budget.golden b/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/unsorted.large.budget.golden index 922461e7d55..7a4d0e64f15 100644 --- a/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/unsorted.large.budget.golden +++ b/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/unsorted.large.budget.golden @@ -1 +1 @@ -ExBudget {exBudgetCPU = ExCPU 857610341, exBudgetMemory = ExMemory 4224488} \ No newline at end of file +ExBudget {exBudgetCPU = ExCPU 661811564, exBudgetMemory = ExMemory 3414815} \ No newline at end of file diff --git a/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/unsorted.pir.golden b/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/unsorted.pir.golden index c91e54997c3..4c3d0fa342b 100644 --- a/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/unsorted.pir.golden +++ b/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/unsorted.pir.golden @@ -136,18 +136,15 @@ program {all dead. dead} in go ds - !equalsInteger : integer -> integer -> Bool - = \(x : integer) (y : integer) -> - ifThenElse {Bool} (equalsInteger x y) True False !`$fOrdInteger_$ccompare` : integer -> integer -> Ordering = \(eta : integer) (eta : integer) -> Bool_match - (ifThenElse {Bool} (equalsInteger eta eta) True False) + (case Bool (equalsInteger eta eta) [False, True]) {all dead. Ordering} (/\dead -> EQ) (/\dead -> Bool_match - (ifThenElse {Bool} (lessThanEqualsInteger eta eta) True False) + (case Bool (lessThanEqualsInteger eta eta) [False, True]) {all dead. Ordering} (/\dead -> LT) (/\dead -> GT) @@ -165,19 +162,18 @@ program ds {Bool} (\(n' : integer) (d' : integer) -> - ifThenElse - {Bool} + case + Bool (lessThanEqualsInteger (multiplyInteger n d') (multiplyInteger n' d)) - True - False)) + [False, True])) in letrec !euclid : integer -> integer -> integer = \(x : integer) (y : integer) -> Bool_match - (ifThenElse {Bool} (equalsInteger 0 y) True False) + (case Bool (equalsInteger 0 y) [False, True]) {all dead. integer} (/\dead -> x) (/\dead -> euclid y (modInteger x y)) @@ -187,12 +183,12 @@ program !unsafeRatio : integer -> integer -> Rational = \(n : integer) (d : integer) -> Bool_match - (ifThenElse {Bool} (equalsInteger 0 d) True False) + (case Bool (equalsInteger 0 d) [False, True]) {all dead. Rational} (/\dead -> error {Rational}) (/\dead -> Bool_match - (ifThenElse {Bool} (lessThanInteger d 0) True False) + (case Bool (lessThanInteger d 0) [False, True]) {all dead. Rational} (/\dead -> unsafeRatio (subtractInteger 0 n) (subtractInteger 0 d)) @@ -216,6 +212,8 @@ program let data Unit | Unit_match where Unit : Unit + !ifThenElse : all a. bool -> a -> a -> a + = /\a -> \(b : bool) (x : a) (y : a) -> case a b [y, x] in letrec !validateParamValue : ParamValue -> data -> Bool @@ -230,16 +228,13 @@ program {integer} (CConsOrd {integer} - equalsInteger + (\(x : integer) (y : integer) -> + case Bool (equalsInteger x y) [False, True]) `$fOrdInteger_$ccompare` (\(x : integer) (y : integer) -> - ifThenElse {Bool} (lessThanInteger x y) True False) + case Bool (lessThanInteger x y) [False, True]) (\(x : integer) (y : integer) -> - ifThenElse - {Bool} - (lessThanEqualsInteger x y) - True - False) + case Bool (lessThanEqualsInteger x y) [False, True]) (\(x : integer) (y : integer) -> ifThenElse {Bool} @@ -250,22 +245,14 @@ program ifThenElse {Bool} (lessThanInteger x y) False True) (\(x : integer) (y : integer) -> Bool_match - (ifThenElse - {Bool} - (lessThanEqualsInteger x y) - True - False) + (case Bool (lessThanEqualsInteger x y) [False, True]) {all dead. integer} (/\dead -> y) (/\dead -> x) {all dead. dead}) (\(x : integer) (y : integer) -> Bool_match - (ifThenElse - {Bool} - (lessThanEqualsInteger x y) - True - False) + (case Bool (lessThanEqualsInteger x y) [False, True]) {all dead. integer} (/\dead -> x) (/\dead -> y) @@ -290,18 +277,16 @@ program {Bool} (\(n' : integer) (d' : integer) -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger n n') - True - False) + [False, True]) {all dead. Bool} (/\dead -> - ifThenElse - {Bool} + case + Bool (equalsInteger d d') - True - False) + [False, True]) (/\dead -> False) {all dead. dead}))) (\(ds : Rational) (ds : Rational) -> @@ -325,13 +310,12 @@ program ds {Bool} (\(n' : integer) (d' : integer) -> - ifThenElse - {Bool} + case + Bool (lessThanInteger (multiplyInteger n d') (multiplyInteger n' d)) - True - False))) + [False, True]))) `$fOrdRational0_$c<=` (\(ds : Rational) (ds : Rational) -> Rational_match @@ -342,11 +326,13 @@ program ds {Bool} (\(n' : integer) (d' : integer) -> + let + !x : integer = multiplyInteger n d' + !y : integer = multiplyInteger n' d + in ifThenElse {Bool} - (lessThanEqualsInteger - (multiplyInteger n d') - (multiplyInteger n' d)) + (lessThanEqualsInteger x y) False True))) (\(ds : Rational) (ds : Rational) -> @@ -358,11 +344,13 @@ program ds {Bool} (\(n' : integer) (d' : integer) -> + let + !x : integer = multiplyInteger n d' + !y : integer = multiplyInteger n' d + in ifThenElse {Bool} - (lessThanInteger - (multiplyInteger n d') - (multiplyInteger n' d)) + (lessThanInteger x y) False True))) (\(x : Rational) (y : Rational) -> @@ -401,7 +389,7 @@ program ds {list data -> Bool} (\(eta : list data) -> - ifThenElse {Bool} (nullList {data} eta) True False) + case Bool (nullList {data} eta) [False, True]) (\(paramValueHd : ParamValue) (paramValueTl : List ParamValue) (actualValueData : list data) -> @@ -5201,7 +5189,10 @@ program {ParamValue} (\(k' : integer) (i : ParamValue) -> Bool_match - (equalsInteger k k') + (case + Bool + (equalsInteger k k') + [False, True]) {all dead. ParamValue} (/\dead -> i) (/\dead -> go xs') @@ -5243,13 +5234,12 @@ program (unConstrData ds))))) in Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 5 (fstPair {integer} {list data} si)) - True - False) + [False, True]) {all dead. data} (/\dead -> headList @@ -5262,7 +5252,7 @@ program !x : integer = fstPair {integer} {list data} ds in Bool_match - (ifThenElse {Bool} (equalsInteger 0 x) True False) + (case Bool (equalsInteger 0 x) [False, True]) {all dead. Maybe (List (Tuple2 data data))} (/\dead -> Just @@ -5276,7 +5266,7 @@ program caseData_go (unMapData d))) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 2 x) True False) + (case Bool (equalsInteger 2 x) [False, True]) {all dead. Maybe (List (Tuple2 data data))} (/\dead -> Nothing {List (Tuple2 data data)}) (/\dead -> error {Maybe (List (Tuple2 data data))}) diff --git a/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/unsorted.small.budget.golden b/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/unsorted.small.budget.golden index a538941653b..9202f180128 100644 --- a/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/unsorted.small.budget.golden +++ b/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/unsorted.small.budget.golden @@ -1 +1 @@ -ExBudget {exBudgetCPU = ExCPU 80879267, exBudgetMemory = ExMemory 349603} \ No newline at end of file +ExBudget {exBudgetCPU = ExCPU 64714367, exBudgetMemory = ExMemory 296003} \ No newline at end of file diff --git a/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/unsorted.uplc.golden b/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/unsorted.uplc.golden index 35b5d34cc5f..1b7a69dbef8 100644 --- a/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/unsorted.uplc.golden +++ b/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/unsorted.uplc.golden @@ -2,14 +2,14 @@ program 1.1.0 ((\`$fOrdRational0_$c<=` -> (\`$fOrdInteger_$ccompare` -> - (\equalsInteger -> - (\validatePreds -> - (\euclid -> - (\unsafeRatio -> - (\cse -> - (\validateParamValue -> - (\validateParamValues -> - (\caseData_go -> + (\validatePreds -> + (\euclid -> + (\unsafeRatio -> + (\cse -> + (\validateParamValue -> + (\validateParamValues -> + (\caseData_go -> + (\cse -> (\cse -> (\cse -> (\cse -> @@ -39,828 +39,817 @@ program (\cse -> (\cse -> (\cse -> - (\cse -> - (\cfg -> - (\fun - ds -> - force - (case - ((\ds -> - (\x -> - force - (force - ifThenElse - (equalsInteger - 0 - x) - (delay - (constr 0 - [ ((\d -> - force - caseData_go - (unMapData - d)) - (force - headList - (force - tailList - (force - (force - sndPair) - ds)))) ])) - (delay - (force - (force - ifThenElse - (equalsInteger - 2 - x) - (delay - (constr 1 - [ ])) - (delay - error)))))) + (\cfg -> + (\fun + ds -> + force + (case + ((\ds -> + (\x -> + force + (case + (equalsInteger + 0 + x) + [ (delay + (force + (case + (equalsInteger + 2 + x) + [ (delay + error) + , (delay + (constr 1 + [ ])) ]))) + , (delay + (constr 0 + [ ((\d -> + force + caseData_go + (unMapData + d)) + (force + headList + (force + tailList + (force + (force + sndPair) + ds)))) ])) ])) + (force (force - (force - fstPair) - ds)) - (unConstrData + fstPair) + ds)) + (unConstrData + (force + headList (force - headList + tailList (force tailList (force - tailList (force - (force - sndPair) - (unConstrData - ((\si -> - force - (force - ifThenElse - (equalsInteger - 5 - (force - (force - fstPair) - si)) - (delay + sndPair) + (unConstrData + ((\si -> + force + (case + (equalsInteger + 5 + (force (force - headList - (force - tailList - (force - (force - sndPair) - si)))) - (delay - error))) - (unConstrData + fstPair) + si)) + [ (delay + error) + , (delay + (force + headList + (force + tailList + (force + (force + sndPair) + si)))) ])) + (unConstrData + (force + headList (force - headList + tailList (force tailList (force - tailList (force - (force - sndPair) - (unConstrData - ds)))))))))))))) - [ (\cparams -> - delay - (force - (case - (fun - cparams) - [ (delay - ()) - , (delay - error) ]))) - , (delay - ()) ])) - ((\go - eta -> - go - eta) - ((\s -> - s - s) - (\s - ds -> - force - (case - ds - [ (delay - (constr 0 - [ ])) - , (\x - xs -> - delay - (force + sndPair) + (unConstrData + ds)))))))))))))) + [ (\cparams -> + delay + (force + (case + (fun + cparams) + [ (delay + ()) + , (delay + error) ]))) + , (delay + ()) ])) + ((\go + eta -> + go + eta) + ((\s -> + s + s) + (\s + ds -> + force + (case + ds + [ (delay + (constr 0 + [ ])) + , (\x + xs -> + delay + (force + (case (case - (case - x - [ (\ds - actualValueData -> - validateParamValue - ((\k -> - (\s -> - s - s) - (\s - ds -> - force - (case - ds - [ (delay - error) - , (\ds - xs' -> - delay - (case - ds - [ (\k' - i -> - force - (case - (equalsInteger - k - k') - [ (delay - i) - , (delay - (s - s - xs')) ])) ])) ]))) - (unIData - ds) - cfg) - actualValueData) ]) - [ (delay - (s - s - xs)) - , (delay - (constr 1 - [ ])) ]))) ]))))) - (constr 1 - [ (constr 0 - [ 0 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 30 - , cse ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 1000 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 1 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 100000 - , cse ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 10000000 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 2 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 24576 - , (constr 0 - [ ]) ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 122880 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 3 - , (constr 1 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 32768 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 4 - , (constr 1 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 5000 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 5 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 1000000 - , cse ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 5000000 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 6 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 250000000 - , cse ]) ]) - , cse ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 7 - , (constr 1 - [ (constr 1 - [ cse - , (constr 0 - [ ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 8 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 250 - , cse ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 2000 - , (constr 0 - [ ]) ]) ]) - , cse ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 9 - , (constr 3 - [ (constr 1 - [ cse - , cse ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 10 - , (constr 3 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ (cse - 1000) - , cse ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ (cse - 200) - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 11 - , (constr 3 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ (cse - 10) - , cse ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 16 - , (constr 1 - [ (constr 1 - [ cse - , cse ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 17 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 3000 - , cse ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 6500 - , (constr 0 - [ ]) ]) ]) - , cse ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 18 - , (constr 0 - [ ]) ]) - , (constr 1 - [ (constr 0 - [ 19 - , (constr 2 - [ (constr 1 - [ (constr 3 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ (cse - 25) - , (constr 0 - [ ]) ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ (cse - 5) - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) - , (constr 1 - [ (constr 3 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ (cse - 20000) - , (constr 0 - [ ]) ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ (cse - 5000) - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 20 - , (constr 2 - [ (constr 1 - [ (constr 1 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 40000000 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) - , (constr 1 - [ (constr 1 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 15000000000 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 21 - , (constr 2 - [ (constr 1 - [ (constr 1 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 120000000 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) - , (constr 1 - [ (constr 1 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 40000000000 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 22 - , (constr 1 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 12288 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 23 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 100 - , cse ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 200 - , (constr 0 - [ ]) ]) ]) - , cse ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 24 - , (constr 1 - [ (constr 1 - [ cse - , (constr 0 - [ ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 25 - , (constr 2 - [ (constr 1 - [ cse - , (constr 1 - [ cse - , (constr 1 - [ cse - , (constr 1 - [ cse - , cse ]) ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 26 - , (constr 2 - [ (constr 1 - [ cse - , (constr 1 - [ cse - , (constr 1 - [ cse - , (constr 1 - [ (constr 3 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ cse - , (constr 1 - [ (unsafeRatio - 13 - 20) - , (constr 0 - [ ]) ]) ]) ]) - , cse ]) ]) - , (constr 1 - [ cse - , (constr 1 - [ cse - , (constr 1 - [ cse - , (constr 1 - [ cse - , (constr 1 - [ (constr 3 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ cse - , cse ]) ]) - , cse ]) ]) - , cse ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 27 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 0 - , (constr 1 - [ 3 - , (constr 0 - [ ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 10 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 28 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 0 - , (constr 1 - [ 18 - , (constr 0 - [ ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 293 - , (constr 0 - [ ]) ]) ]) - , cse ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 29 - , (constr 1 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 15 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 30 - , (constr 1 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 10000000000000 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 31 - , (constr 1 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 100000000000 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 32 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 13 - , cse ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 37 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 33 - , (constr 3 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , cse ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ (unsafeRatio - 1000 - 1) - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ])) - (constr 3 - [ (constr 1 - [ cse + x + [ (\ds + actualValueData -> + validateParamValue + ((\k -> + (\s -> + s + s) + (\s + ds -> + force + (case + ds + [ (delay + error) + , (\ds + xs' -> + delay + (case + ds + [ (\k' + i -> + force + (case + (equalsInteger + k + k') + [ (delay + (s + s + xs')) + , (delay + i) ])) ])) ]))) + (unIData + ds) + cfg) + actualValueData) ]) + [ (delay + (s + s + xs)) + , (delay + (constr 1 + [ ])) ]))) ]))))) + (constr 1 + [ (constr 0 + [ 0 , (constr 1 - [ (constr 0 + [ (constr 1 [ (constr 0 - [ ]) + [ (constr 1 + [ ]) + , (constr 1 + [ 30 + , cse ]) ]) , (constr 1 - [ cse + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 1000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 1 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 100000 + , cse ]) ]) , (constr 1 - [ (cse - 5) + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 10000000 + , (constr 0 + [ ]) ]) ]) , (constr 0 - [ ]) ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ])) + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 2 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 24576 + , (constr 0 + [ ]) ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 122880 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 3 + , (constr 1 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 32768 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 4 + , (constr 1 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 5000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 5 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 1000000 + , cse ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 5000000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 6 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 250000000 + , cse ]) ]) + , cse ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 7 + , (constr 1 + [ (constr 1 + [ cse + , (constr 0 + [ ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 8 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 250 + , cse ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 2000 + , (constr 0 + [ ]) ]) ]) + , cse ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 9 + , (constr 3 + [ (constr 1 + [ cse + , cse ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 10 + , (constr 3 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ (cse + 1000) + , cse ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ (cse + 200) + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 11 + , (constr 3 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ (cse + 10) + , cse ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 16 + , (constr 1 + [ (constr 1 + [ cse + , cse ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 17 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 3000 + , cse ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 6500 + , (constr 0 + [ ]) ]) ]) + , cse ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 18 + , (constr 0 + [ ]) ]) + , (constr 1 + [ (constr 0 + [ 19 + , (constr 2 + [ (constr 1 + [ (constr 3 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ (cse + 25) + , (constr 0 + [ ]) ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ (cse + 5) + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) + , (constr 1 + [ (constr 3 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ (cse + 20000) + , (constr 0 + [ ]) ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ (cse + 5000) + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 20 + , (constr 2 + [ (constr 1 + [ (constr 1 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 40000000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) + , (constr 1 + [ (constr 1 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 15000000000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 21 + , (constr 2 + [ (constr 1 + [ (constr 1 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 120000000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) + , (constr 1 + [ (constr 1 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 40000000000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 22 + , (constr 1 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 12288 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 23 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 100 + , cse ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 200 + , (constr 0 + [ ]) ]) ]) + , cse ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 24 + , (constr 1 + [ (constr 1 + [ cse + , (constr 0 + [ ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 25 + , (constr 2 + [ (constr 1 + [ cse + , (constr 1 + [ cse + , (constr 1 + [ cse + , (constr 1 + [ cse + , cse ]) ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 26 + , (constr 2 + [ (constr 1 + [ cse + , (constr 1 + [ cse + , (constr 1 + [ cse + , (constr 1 + [ (constr 3 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ cse + , (constr 1 + [ (unsafeRatio + 13 + 20) + , (constr 0 + [ ]) ]) ]) ]) + , cse ]) ]) + , (constr 1 + [ cse + , (constr 1 + [ cse + , (constr 1 + [ cse + , (constr 1 + [ cse + , (constr 1 + [ (constr 3 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ cse + , cse ]) ]) + , cse ]) ]) + , cse ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 27 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 0 + , (constr 1 + [ 3 + , (constr 0 + [ ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 10 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 28 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 0 + , (constr 1 + [ 18 + , (constr 0 + [ ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 293 + , (constr 0 + [ ]) ]) ]) + , cse ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 29 + , (constr 1 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 15 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 30 + , (constr 1 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 10000000000000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 31 + , (constr 1 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 100000000000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 32 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 13 + , cse ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 37 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 33 + , (constr 3 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , cse ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ (unsafeRatio + 1000 + 1) + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ])) (constr 3 [ (constr 1 [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ cse - , cse ]) ]) - , (constr 0 - [ ]) ]) ]) ])) + , cse ]) ])) (constr 3 [ (constr 1 [ cse - , cse ]) ])) - (constr 1 - [ (constr 3 - [ (constr 1 + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ cse + , (constr 1 + [ cse + , (constr 0 + [ ]) ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ])) + (constr 3 + [ (constr 1 + [ cse + , (constr 1 [ (constr 0 - [ (constr 1 + [ (constr 0 [ ]) , (constr 1 [ cse - , (constr 0 - [ ]) ]) ]) - , cse ]) ]) - , (constr 0 - [ ]) ])) + , cse ]) ]) + , (constr 0 + [ ]) ]) ]) ])) (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ cse - , (constr 1 - [ cse - , (constr 0 - [ ]) ]) ]) ]) + [ (constr 3 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ cse + , (constr 0 + [ ]) ]) ]) + , cse ]) ]) , (constr 0 [ ]) ])) - (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ cse - , cse ]) ])) + (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ cse + , (constr 1 + [ cse + , (constr 0 + [ ]) ]) ]) ]) + , (constr 0 + [ ]) ])) (constr 0 [ (constr 1 [ ]) @@ -870,41 +859,44 @@ program [ cse , (constr 0 [ ]) ]) ]) ])) - (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , cse ]) - , (constr 0 - [ ]) ])) - (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 0 - , (constr 1 - [ 1000000 - , (constr 0 - [ ]) ]) ]) ])) - (constr 1 - [ (constr 0 - [ (constr 2 - [ ]) - , cse ]) - , (constr 0 - [ ]) ])) + (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ (cse + 10) + , cse ]) ])) + (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , cse ]) + , (constr 0 + [ ]) ])) + (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 0 + , (constr 1 + [ 1000000 + , (constr 0 + [ ]) ]) ]) ])) (constr 1 [ (constr 0 - [ (constr 0 + [ (constr 2 [ ]) - , (constr 1 - [ 500000000 - , (constr 0 - [ ]) ]) ]) + , cse ]) , (constr 0 [ ]) ])) (constr 1 - [ cse + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 500000000 + , (constr 0 + [ ]) ]) ]) , (constr 0 [ ]) ])) (constr 1 @@ -915,426 +907,414 @@ program [ cse , (constr 0 [ ]) ])) - (cse - 1)) - (constr 0 - [ (constr 1 - [ ]) - , cse ])) + (constr 1 + [ cse + , (constr 0 + [ ]) ])) + (cse + 2)) (cse - 2)) - (cse 10)) - (cse 1)) - (constr 0 - [ (constr 1 - []) - , (constr 1 - [ 1 - , (constr 0 - [ ]) ]) ])) - (cse 100)) - (cse 4)) - (cse 10)) - (unsafeRatio 1)) - (unsafeRatio 9)) + 1)) + (cse 4)) + (constr 0 + [ (constr 1 + []) + , cse ])) + (cse 100)) + (cse 10)) + (cse 1)) + (constr 0 + [ (constr 1 []) + , (constr 1 + [ 1 + , (constr 0 + []) ]) ])) + (cse 5)) + (unsafeRatio 0)) (unsafeRatio 4)) - (unsafeRatio 0)) - (unsafeRatio 3)) - (unsafeRatio 51)) - (constr 1 [0, (constr 0 [])])) - ((\s -> s s) - (\s arg -> - delay - (\xs -> - force - (force (force chooseList) - xs - (delay (constr 0 [])) - (delay - ((\x xs -> - constr 1 - [ (constr 0 - [ (force - (force - fstPair) - x) - , (force - (force - sndPair) - x) ]) - , (force - (s - s - (delay - (\x -> x))) - xs) ]) - (force headList xs) - (force tailList xs)))))) - (delay (\x -> x)))) - (cse (\arg_0 arg_1 -> arg_1))) - (cse (\arg_0 arg_1 -> arg_0))) - (force - ((\s -> s s) - (\s h -> - delay - (\fr -> - (\k -> - fr - (\x -> k (\f_0 f_1 -> f_0 x)) - (\x -> k (\f_0 f_1 -> f_1 x))) - (\fq -> force (s s h) (force h fq)))) - (delay - (\choose - validateParamValue - validateParamValues -> - choose - (\eta eta -> + (unsafeRatio 51)) + (constr 1 [0, (constr 0 [])])) + (unsafeRatio 9)) + (unsafeRatio 3)) + (unsafeRatio 1)) + ((\s -> s s) + (\s arg -> + delay + (\xs -> force - (case - eta - [ (delay (constr 0 [])) - , (\preds -> - delay - (validatePreds - (constr 0 - [ equalsInteger - , `$fOrdInteger_$ccompare` - , (\x y -> - force ifThenElse - (lessThanInteger - x - y) - (constr 0 []) - (constr 1 [])) - , (\x y -> - force ifThenElse - (lessThanEqualsInteger - x - y) - (constr 0 []) - (constr 1 [])) - , (\x y -> - force ifThenElse - (lessThanEqualsInteger - x - y) - (constr 1 []) - (constr 0 [])) - , (\x y -> - force ifThenElse - (lessThanInteger - x - y) - (constr 1 []) - (constr 0 [])) - , (\x y -> - force ifThenElse + (force (force chooseList) + xs + (delay (constr 0 [])) + (delay + ((\x xs -> + constr 1 + [ (constr 0 + [ (force + (force fstPair) + x) + , (force + (force sndPair) + x) ]) + , (force + (s + s + (delay (\x -> x))) + xs) ]) + (force headList xs) + (force tailList xs)))))) + (delay (\x -> x)))) + (cse (\arg_0 arg_1 -> arg_1))) + (cse (\arg_0 arg_1 -> arg_0))) + (force + ((\s -> s s) + (\s h -> + delay + (\fr -> + (\k -> + fr + (\x -> k (\f_0 f_1 -> f_0 x)) + (\x -> k (\f_0 f_1 -> f_1 x))) + (\fq -> force (s s h) (force h fq)))) + (delay + (\choose validateParamValue validateParamValues -> + choose + (\eta eta -> + force + (case + eta + [ (delay (constr 0 [])) + , (\preds -> + delay + (validatePreds + (constr 0 + [ (\x y -> + case + (equalsInteger + x + y) + [ (constr 1 []) + , (constr 0 []) ]) + , `$fOrdInteger_$ccompare` + , (\x y -> + case + (lessThanInteger + x + y) + [ (constr 1 []) + , (constr 0 []) ]) + , (\x y -> + case + (lessThanEqualsInteger + x + y) + [ (constr 1 []) + , (constr 0 []) ]) + , (\x y -> + case + (lessThanEqualsInteger + x + y) + [ (constr 0 []) + , (constr 1 []) ]) + , (\x y -> + case + (lessThanInteger + x + y) + [ (constr 0 []) + , (constr 1 []) ]) + , (\x y -> + force + (case (lessThanEqualsInteger x y) - y - x) - , (\x y -> - force ifThenElse + [ (delay x) + , (delay y) ])) + , (\x y -> + force + (case (lessThanEqualsInteger x y) - x - y) ]) - preds - (unIData eta))) - , (\paramValues -> - delay - (validateParamValues - paramValues - (unListData eta))) - , (\preds -> - delay - (validatePreds - (constr 0 - [ (\ds ds -> - case - ds - [ (\n d -> - case - ds - [ (\n' - d' -> - force - (force - ifThenElse - (equalsInteger - n - n') - (delay - (force - ifThenElse - (equalsInteger - d - d') - (constr 0 - [ ]) - (constr 1 - [ ]))) - (delay - (constr 1 - [ ])))) ]) ]) - , (\ds ds -> - case - ds - [ (\n d -> - case - ds - [ (\n' - d' -> - `$fOrdInteger_$ccompare` + [ (delay y) + , (delay + x) ])) ]) + preds + (unIData eta))) + , (\paramValues -> + delay + (validateParamValues + paramValues + (unListData eta))) + , (\preds -> + delay + (validatePreds + (constr 0 + [ (\ds ds -> + case + ds + [ (\n d -> + case + ds + [ (\n' + d' -> + force + (case + (equalsInteger + n + n') + [ (delay + (constr 1 + [ ])) + , (delay + (case + (equalsInteger + d + d') + [ (constr 1 + [ ]) + , (constr 0 + [ ]) ])) ])) ]) ]) + , (\ds ds -> + case + ds + [ (\n d -> + case + ds + [ (\n' + d' -> + `$fOrdInteger_$ccompare` + (multiplyInteger + n + d') + (multiplyInteger + n' + d)) ]) ]) + , (\ds ds -> + case + ds + [ (\n d -> + case + ds + [ (\n' + d' -> + case + (lessThanInteger (multiplyInteger n d') (multiplyInteger n' - d)) ]) ]) - , (\ds ds -> - case - ds - [ (\n d -> - case - ds - [ (\n' - d' -> - force - ifThenElse - (lessThanInteger - (multiplyInteger - n - d') - (multiplyInteger - n' - d)) - (constr 0 - [ ]) - (constr 1 - [ ])) ]) ]) - , `$fOrdRational0_$c<=` - , (\ds ds -> - case - ds - [ (\n d -> - case - ds - [ (\n' - d' -> - force - ifThenElse - (lessThanEqualsInteger - (multiplyInteger - n - d') - (multiplyInteger - n' - d)) - (constr 1 - [ ]) - (constr 0 - [ ])) ]) ]) - , (\ds ds -> - case - ds - [ (\n d -> - case - ds - [ (\n' - d' -> - force - ifThenElse - (lessThanInteger - (multiplyInteger - n - d') - (multiplyInteger - n' - d)) - (constr 1 - [ ]) - (constr 0 - [ ])) ]) ]) - , (\x y -> - force - (case - (`$fOrdRational0_$c<=` - x - y) - [ (delay y) - , (delay - x) ])) - , (\x y -> - force - (case - (`$fOrdRational0_$c<=` - x - y) - [ (delay x) - , (delay - y) ])) ]) - preds - ((\bl -> - (\bl' -> - force ifThenElse - (force nullList - (force - tailList - bl')) - (\ds -> - unsafeRatio - (unIData - (force - headList - bl)) - (unIData - (force - headList - bl'))) - (\ds -> error) - (constr 0 [])) - (force tailList - bl)) - (unListData - eta)))) ])) - (\ds -> - case - ds - [ (\eta -> - force ifThenElse - (force nullList eta) - (constr 0 []) - (constr 1 [])) - , (\paramValueHd - paramValueTl - actualValueData -> - force - (case - (validateParamValue - paramValueHd - (force headList - actualValueData)) - [ (delay - (validateParamValues - paramValueTl - (force tailList - actualValueData))) - , (delay - (constr 1 - [])) ])) ])))))) - ((\s -> s s) - (\s n d -> - force - (force ifThenElse - (equalsInteger 0 d) - (delay error) - (delay - (force - (force ifThenElse - (lessThanInteger d 0) - (delay - ((\x -> s s x) - (subtractInteger 0 n) - (subtractInteger 0 d))) - (delay - ((\gcd' -> - constr 0 - [ (quotientInteger n gcd') - , (quotientInteger d gcd') ]) - (euclid n d)))))))))) + d)) + [ (constr 1 + [ ]) + , (constr 0 + [ ]) ]) ]) ]) + , `$fOrdRational0_$c<=` + , (\ds ds -> + case + ds + [ (\n d -> + case + ds + [ (\n' + d' -> + case + (lessThanEqualsInteger + (multiplyInteger + n + d') + (multiplyInteger + n' + d)) + [ (constr 0 + [ ]) + , (constr 1 + [ ]) ]) ]) ]) + , (\ds ds -> + case + ds + [ (\n d -> + case + ds + [ (\n' + d' -> + case + (lessThanInteger + (multiplyInteger + n + d') + (multiplyInteger + n' + d)) + [ (constr 0 + [ ]) + , (constr 1 + [ ]) ]) ]) ]) + , (\x y -> + force + (case + (`$fOrdRational0_$c<=` + x + y) + [ (delay y) + , (delay x) ])) + , (\x y -> + force + (case + (`$fOrdRational0_$c<=` + x + y) + [ (delay x) + , (delay + y) ])) ]) + preds + ((\bl -> + (\bl' -> + case + (force nullList + (force tailList + bl')) + [ (\ds -> error) + , (\ds -> + unsafeRatio + (unIData + (force + headList + bl)) + (unIData + (force + headList + bl'))) ] + (constr 0 [])) + (force tailList bl)) + (unListData eta)))) ])) + (\ds -> + case + ds + [ (\eta -> + case + (force nullList eta) + [(constr 1 []), (constr 0 [])]) + , (\paramValueHd + paramValueTl + actualValueData -> + force + (case + (validateParamValue + paramValueHd + (force headList + actualValueData)) + [ (delay + (validateParamValues + paramValueTl + (force tailList + actualValueData))) + , (delay + (constr 1 [])) ])) ])))))) ((\s -> s s) - (\s x y -> + (\s n d -> force - (force ifThenElse - (equalsInteger 0 y) - (delay x) - (delay (s s y (modInteger x y))))))) - (\`$dOrd` ds ds -> - (\s -> s s) - (\s ds -> - force - (case - ds - [ (delay (constr 0 [])) - , (\x xs -> - delay - (case - x - [ (\predKey expectedPredValues -> - (\meaning -> - (\s -> s s) - (\s ds -> - force + (case + (equalsInteger 0 d) + [ (delay + (force + (case + (lessThanInteger d 0) + [ (delay + ((\gcd' -> + constr 0 + [ (quotientInteger n gcd') + , (quotientInteger d gcd') ]) + (euclid n d))) + , (delay + ((\x -> s s x) + (subtractInteger 0 n) + (subtractInteger 0 d))) ]))) + , (delay error) ])))) + ((\s -> s s) + (\s x y -> + force + (case + (equalsInteger 0 y) + [(delay (s s y (modInteger x y))), (delay x)])))) + (\`$dOrd` ds ds -> + (\s -> s s) + (\s ds -> + force + (case + ds + [ (delay (constr 0 [])) + , (\x xs -> + delay + (case + x + [ (\predKey expectedPredValues -> + (\meaning -> + (\s -> s s) + (\s ds -> + force + (case + ds + [ (delay (s s xs)) + , (\x xs -> + delay + (force + (case + (meaning x ds) + [ (delay + (s s xs)) + , (delay + (constr 1 + [ ])) ]))) ])) + expectedPredValues) + (force + (case + predKey + [ (delay + (case + `$dOrd` + [ (\v v v v v v v v -> + v) ])) + , (delay (case - ds - [ (delay (s s xs)) - , (\x xs -> - delay - (force - (case - (meaning - x - ds) - [ (delay - (s - s - xs)) - , (delay - (constr 1 - [ ])) ]))) ])) - expectedPredValues) - (force - (case - predKey - [ (delay - (case - `$dOrd` - [ (\v v v v v v v v -> - v) ])) - , (delay - (case - `$dOrd` - [ (\v v v v v v v v -> - v) ])) - , (delay - (\x y -> - force + `$dOrd` + [ (\v v v v v v v v -> + v) ])) + , (delay + (\x y -> + force + (case (case - (case - `$dOrd` - [ (\v - v - v - v - v - v - v - v -> - v) ] - x - y) - [ (delay - (constr 1 - [])) - , (delay - (constr 0 - [ ])) ]))) ]))) ])) ])) - ds)) - (\x y -> - force ifThenElse (equalsInteger x y) (constr 0 []) (constr 1 []))) + `$dOrd` + [ (\v + v + v + v + v + v + v + v -> + v) ] + x + y) + [ (delay + (constr 1 [])) + , (delay + (constr 0 + [ ])) ]))) ]))) ])) ])) + ds)) (\eta eta -> force - (force ifThenElse + (case (equalsInteger eta eta) - (delay (constr 0 [])) - (delay - (force ifThenElse - (lessThanEqualsInteger eta eta) - (constr 2 []) - (constr 1 [])))))) + [ (delay + (force + (case + (lessThanEqualsInteger eta eta) + [(delay (constr 1 [])), (delay (constr 2 []))]))) + , (delay (constr 0 [])) ]))) (\ds ds -> case ds @@ -1342,9 +1322,8 @@ program case ds [ (\n' d' -> - force ifThenElse + case (lessThanEqualsInteger (multiplyInteger n d') (multiplyInteger n' d)) - (constr 0 []) - (constr 1 [])) ]) ])) \ No newline at end of file + [(constr 1 []), (constr 0 [])]) ]) ])) \ No newline at end of file diff --git a/plutus-benchmark/bitwise/test/9.6/8 queens.eval.golden b/plutus-benchmark/bitwise/test/9.6/8 queens.eval.golden index 8f3a0738dd3..e786925684e 100644 --- a/plutus-benchmark/bitwise/test/9.6/8 queens.eval.golden +++ b/plutus-benchmark/bitwise/test/9.6/8 queens.eval.golden @@ -1,6 +1,6 @@ -CPU: 381_725_318_016 -Memory: 1_403_857_547 -Size: 380 +CPU: 327_658_552_839 +Memory: 1_230_274_574 +Size: 352 (constr 1 diff --git a/plutus-benchmark/bitwise/test/9.6/8 queens.pir.golden b/plutus-benchmark/bitwise/test/9.6/8 queens.pir.golden index 05c8b04779c..97dfc71de7d 100644 --- a/plutus-benchmark/bitwise/test/9.6/8 queens.pir.golden +++ b/plutus-benchmark/bitwise/test/9.6/8 queens.pir.golden @@ -9,7 +9,7 @@ !selectByteString : integer -> bytestring -> integer = \(which : integer) (bs : bytestring) -> Bool_match - (ifThenElse {Bool} (lessThanEqualsInteger which 0) True False) + (case Bool (lessThanEqualsInteger which 0) [False, True]) {all dead. integer} (/\dead -> findFirstSetBit bs) (/\dead -> @@ -17,7 +17,7 @@ !i : integer = selectByteString (subtractInteger which 1) bs in Bool_match - (ifThenElse {Bool} (equalsInteger -1 i) True False) + (case Bool (equalsInteger -1 i) [False, True]) {all dead. integer} (/\dead -> -1) (/\dead -> @@ -80,7 +80,7 @@ (right : bytestring) (control : bytestring) -> Bool_match - (ifThenElse {Bool} (equalsInteger selectIx dim) True False) + (case Bool (equalsInteger selectIx dim) [False, True]) {all dead. List (Tuple2 integer integer)} (/\dead -> Nil {Tuple2 integer integer}) (/\dead -> @@ -88,16 +88,12 @@ !available : integer = selectByteString selectIx control in Bool_match - (ifThenElse {Bool} (equalsInteger -1 available) True False) + (case Bool (equalsInteger -1 available) [False, True]) {all dead. List (Tuple2 integer integer)} (/\dead -> Nil {Tuple2 integer integer}) (/\dead -> Bool_match - (ifThenElse - {Bool} - (equalsInteger row lastRow) - True - False) + (case Bool (equalsInteger row lastRow) [False, True]) {all dead. List (Tuple2 integer integer)} (/\dead -> (let @@ -198,16 +194,12 @@ !bytesNeeded : integer = quotientInteger dim 8 in Bool_match - (ifThenElse {Bool} (lessThanInteger dim 8) True False) + (case Bool (lessThanInteger dim 8) [False, True]) {all dead. List (Tuple2 integer integer)} (/\dead -> Nil {Tuple2 integer integer}) (/\dead -> Bool_match - (ifThenElse - {Bool} - (equalsInteger 0 (remainderInteger dim 8)) - True - False) + (case Bool (equalsInteger 0 (remainderInteger dim 8)) [False, True]) {all dead. List (Tuple2 integer integer)} (/\dead -> let diff --git a/plutus-benchmark/bitwise/test/9.6/Ed25519.eval.golden b/plutus-benchmark/bitwise/test/9.6/Ed25519.eval.golden index d2805f2dbe5..ee2bd985286 100644 --- a/plutus-benchmark/bitwise/test/9.6/Ed25519.eval.golden +++ b/plutus-benchmark/bitwise/test/9.6/Ed25519.eval.golden @@ -1,5 +1,5 @@ -CPU: 2_025_744_495_066 -Memory: 6_392_763_186 -Size: 3_415 +CPU: 1_754_030_727_874 +Memory: 5_520_417_978 +Size: 3_371 (constr 1) \ No newline at end of file diff --git a/plutus-benchmark/bitwise/test/9.6/Ed25519.pir.golden b/plutus-benchmark/bitwise/test/9.6/Ed25519.pir.golden index c0eb6f42614..0f1aff41379 100644 --- a/plutus-benchmark/bitwise/test/9.6/Ed25519.pir.golden +++ b/plutus-benchmark/bitwise/test/9.6/Ed25519.pir.golden @@ -36,13 +36,13 @@ {all dead. dead}) !even : integer -> Bool = \(n : integer) -> - ifThenElse {Bool} (equalsInteger 0 (modInteger n 2)) True False + case Bool (equalsInteger 0 (modInteger n 2)) [False, True] in letrec !expModManual : integer -> integer -> integer -> integer = \(b' : integer) (e : integer) (m : integer) -> Bool_match - (ifThenElse {Bool} (equalsInteger 0 e) True False) + (case Bool (equalsInteger 0 e) [False, True]) {all dead. integer} (/\dead -> 1) (/\dead -> @@ -178,15 +178,14 @@ {all dead. dead} in Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 0 (modInteger (subtractInteger (multiplyInteger x x) xx) 57896044618658097711785492504343953926634992332820282019728792003956564819949)) - True - False) + [False, True]) {all dead. integer} (/\dead -> `$j` False) (/\dead -> `$j` True) @@ -208,7 +207,7 @@ (Nil {integer})) False) !x : integer = xRecover yInt - !x_ : Bool = ifThenElse {Bool} (readBit bs 7) True False + !x_ : Bool = case Bool (readBit bs 7) [False, True] in Bool_match (even x) @@ -372,11 +371,10 @@ (next : bytestring -> SHA512State -> Tuple2 SHA512State bytestring) (input : bytestring) -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 0 (lengthOfByteString input)) - True - False) + [False, True]) {all dead. SHA512State} (/\dead -> state) (/\dead -> @@ -459,7 +457,7 @@ !scalarMult : Tuple2 integer integer -> integer -> Tuple2 integer integer = \(p : Tuple2 integer integer) (e : integer) -> Bool_match - (ifThenElse {Bool} (equalsInteger 0 e) True False) + (case Bool (equalsInteger 0 e) [False, True]) {all dead. Tuple2 integer integer} (/\dead -> Tuple2 {integer} {integer} 0 1) (/\dead -> @@ -484,11 +482,10 @@ !added : integer = addInteger (byteStringToInteger True x) yI in Bool_match - (ifThenElse - {Bool} + (case + Bool (lessThanInteger 18446744073709551615 added) - True - False) + [False, True]) {all dead. bytestring} (/\dead -> g @@ -582,11 +579,10 @@ (\(x : integer) (y : integer) -> let !xLSBVal : Bool - = ifThenElse - {Bool} + = case + Bool (readBit (integerToByteString False 32 x) 248) - True - False + [False, True] in writeBits (integerToByteString False 32 y) @@ -2232,7 +2228,7 @@ 1 in Bool_match - (ifThenElse {Bool} (lessThanEqualsInteger r -1) True False) + (case Bool (lessThanEqualsInteger r -1) [False, True]) {all dead. bytestring} (/\dead -> `$j` (addInteger 1024 r)) (/\dead -> `$j` r) @@ -2285,9 +2281,9 @@ {Bool} (\(x : integer) (y : integer) -> Bool_match - (ifThenElse {Bool} (equalsInteger x x) True False) + (case Bool (equalsInteger x x) [False, True]) {all dead. Bool} - (/\dead -> ifThenElse {Bool} (equalsInteger y y) True False) + (/\dead -> case Bool (equalsInteger y y) [False, True]) (/\dead -> False) {all dead. dead}))) (B #c080c2932178c2adc2a7c3917a6009c3b37cc383245824c3a9c2a6c3aac080c286c2986c14c3b334c39915c298c2b47b244dc3a352c396c39a25c3b1c29d050e0509c298c28cc2abc3b0c38866c2b8c285c38bc3a37ac2a3c080c2b9c29b59c28bc2b2c3b902) diff --git a/plutus-benchmark/bls12-381-costs/test/9.6/bls12-381-costs.golden b/plutus-benchmark/bls12-381-costs/test/9.6/bls12-381-costs.golden index b7c83c50f33..13bf92d7f2f 100644 --- a/plutus-benchmark/bls12-381-costs/test/9.6/bls12-381-costs.golden +++ b/plutus-benchmark/bls12-381-costs/test/9.6/bls12-381-costs.golden @@ -90,56 +90,56 @@ Apply pairing to two pairs of points in G1 x G2 and run finalVerify on the resul n Script size CPU usage Memory usage ---------------------------------------------------------------------- - - 342 (2.1%) 1097919597 (11.0%) 4654 (0.0%) + - 339 (2.1%) 1097763548 (11.0%) 4153 (0.0%) Groth16 verification example n Script size CPU usage Memory usage ---------------------------------------------------------------------- - - 779 (4.8%) 1996880342 (20.0%) 10904 (0.1%) + - 777 (4.7%) 1996724293 (20.0%) 10403 (0.1%) VRF example n Script size CPU usage Memory usage ---------------------------------------------------------------------- - - 673 (4.1%) 1218837236 (12.2%) 35849 (0.3%) + - 668 (4.1%) 1218525138 (12.2%) 34847 (0.2%) G1 Verify n Script size CPU usage Memory usage ---------------------------------------------------------------------- - - 332 (2.0%) 1190332196 (11.9%) 5754 (0.0%) + - 330 (2.0%) 1190176147 (11.9%) 5253 (0.0%) G2 Verify n Script size CPU usage Memory usage ---------------------------------------------------------------------- - - 380 (2.3%) 1097700554 (11.0%) 5754 (0.0%) + - 378 (2.3%) 1097544505 (11.0%) 5253 (0.0%) Aggregate Single Key n Script size CPU usage Memory usage ---------------------------------------------------------------------- - - 813 (5.0%) 2717766359 (27.2%) 50502 (0.4%) + - 811 (4.9%) 2717610310 (27.2%) 50001 (0.4%) Aggregate Multi Key n Script size CPU usage Memory usage ---------------------------------------------------------------------- - - 1820 (11.1%) 3431651236 (34.3%) 330386 (2.4%) + - 1815 (11.1%) 3430870991 (34.3%) 327881 (2.3%) Schnorr Signature G1 n Script size CPU usage Memory usage ---------------------------------------------------------------------- - - 352 (2.1%) 319894564 (3.2%) 11996 (0.1%) + - 347 (2.1%) 319582466 (3.2%) 10994 (0.1%) Schnorr Signature G2 n Script size CPU usage Memory usage ---------------------------------------------------------------------- - - 496 (3.0%) 552105171 (5.5%) 12164 (0.1%) + - 491 (3.0%) 551793073 (5.5%) 11162 (0.1%) Groth16Verify succeeded Simple Verify succeeded diff --git a/plutus-benchmark/ed25519-costs/test/9.6/ed25519-costs.golden b/plutus-benchmark/ed25519-costs/test/9.6/ed25519-costs.golden index f266e847c54..c825bcfb724 100644 --- a/plutus-benchmark/ed25519-costs/test/9.6/ed25519-costs.golden +++ b/plutus-benchmark/ed25519-costs/test/9.6/ed25519-costs.golden @@ -1,20 +1,20 @@ n Script size CPU usage Memory usage ---------------------------------------------------------------------- - 0 437 (2.7%) 4778441 (0.0%) 23522 (0.2%) - 10 2164 (13.2%) 642523741 (6.4%) 489352 (3.5%) - 20 3891 (23.7%) 1280269041 (12.8%) 955182 (6.8%) - 30 5618 (34.3%) 1918014341 (19.2%) 1421012 (10.2%) - 40 7345 (44.8%) 2555759641 (25.6%) 1886842 (13.5%) - 50 9071 (55.4%) 3193504941 (31.9%) 2352672 (16.8%) - 60 10798 (65.9%) 3831250241 (38.3%) 2818502 (20.1%) - 70 12525 (76.4%) 4468995541 (44.7%) 3284332 (23.5%) - 80 14251 (87.0%) 5106740841 (51.1%) 3750162 (26.8%) - 90 15978 (97.5%) 5744486141 (57.4%) 4215992 (30.1%) - 100 17705 (108.1%) 6382231441 (63.8%) 4681822 (33.4%) - 110 19432 (118.6%) 7019976741 (70.2%) 5147652 (36.8%) - 120 21158 (129.1%) 7657722041 (76.6%) 5613482 (40.1%) - 130 22885 (139.7%) 8295467341 (83.0%) 6079312 (43.4%) - 140 24612 (150.2%) 8933212641 (89.3%) 6545142 (46.8%) - 150 26339 (160.8%) 9570957941 (95.7%) 7010972 (50.1%) + 0 428 (2.6%) 4622392 (0.0%) 23021 (0.2%) + 10 2155 (13.2%) 638006222 (6.4%) 475821 (3.4%) + 20 3882 (23.7%) 1271390052 (12.7%) 928621 (6.6%) + 30 5609 (34.2%) 1904773882 (19.0%) 1381421 (9.9%) + 40 7336 (44.8%) 2538157712 (25.4%) 1834221 (13.1%) + 50 9062 (55.3%) 3171541542 (31.7%) 2287021 (16.3%) + 60 10789 (65.9%) 3804925372 (38.0%) 2739821 (19.6%) + 70 12516 (76.4%) 4438309202 (44.4%) 3192621 (22.8%) + 80 14242 (86.9%) 5071693032 (50.7%) 3645421 (26.0%) + 90 15969 (97.5%) 5705076862 (57.1%) 4098221 (29.3%) + 100 17696 (108.0%) 6338460692 (63.4%) 4551021 (32.5%) + 110 19423 (118.5%) 6971844522 (69.7%) 5003821 (35.7%) + 120 21149 (129.1%) 7605228352 (76.1%) 5456621 (39.0%) + 130 22876 (139.6%) 8238612182 (82.4%) 5909421 (42.2%) + 140 24603 (150.2%) 8871996012 (88.7%) 6362221 (45.4%) + 150 26330 (160.7%) 9505379842 (95.1%) 6815021 (48.7%) Off-chain version succeeded on 100 inputs diff --git a/plutus-benchmark/lists/test/Lookup/9.6/match-builtin-list-10.eval.golden b/plutus-benchmark/lists/test/Lookup/9.6/match-builtin-list-10.eval.golden index 3727d1390fa..df87db5e5b4 100644 --- a/plutus-benchmark/lists/test/Lookup/9.6/match-builtin-list-10.eval.golden +++ b/plutus-benchmark/lists/test/Lookup/9.6/match-builtin-list-10.eval.golden @@ -1,5 +1,5 @@ -CPU: 182_838_904 -Memory: 755_152 -Size: 151 +CPU: 165_673_514 +Memory: 700_042 +Size: 147 (con integer 155) \ No newline at end of file diff --git a/plutus-benchmark/lists/test/Lookup/9.6/match-builtin-list-100.eval.golden b/plutus-benchmark/lists/test/Lookup/9.6/match-builtin-list-100.eval.golden index 3afafcc7eab..5aac0f6f521 100644 --- a/plutus-benchmark/lists/test/Lookup/9.6/match-builtin-list-100.eval.golden +++ b/plutus-benchmark/lists/test/Lookup/9.6/match-builtin-list-100.eval.golden @@ -1,5 +1,5 @@ -CPU: 15_206_420_194 -Memory: 62_404_432 -Size: 151 +CPU: 13_630_325_294 +Memory: 57_344_332 +Size: 147 (con integer 15050) \ No newline at end of file diff --git a/plutus-benchmark/lists/test/Lookup/9.6/match-builtin-list-5.eval.golden b/plutus-benchmark/lists/test/Lookup/9.6/match-builtin-list-5.eval.golden index 225552bf5e9..8b31af35d99 100644 --- a/plutus-benchmark/lists/test/Lookup/9.6/match-builtin-list-5.eval.golden +++ b/plutus-benchmark/lists/test/Lookup/9.6/match-builtin-list-5.eval.golden @@ -1,5 +1,5 @@ -CPU: 54_709_074 -Memory: 227_692 -Size: 151 +CPU: 50_027_604 +Memory: 212_662 +Size: 147 (con integer 40) \ No newline at end of file diff --git a/plutus-benchmark/lists/test/Lookup/9.6/match-builtin-list-50.eval.golden b/plutus-benchmark/lists/test/Lookup/9.6/match-builtin-list-50.eval.golden index 504c0c501db..b8ac706248b 100644 --- a/plutus-benchmark/lists/test/Lookup/9.6/match-builtin-list-50.eval.golden +++ b/plutus-benchmark/lists/test/Lookup/9.6/match-builtin-list-50.eval.golden @@ -1,5 +1,5 @@ -CPU: 3_885_192_144 -Memory: 15_954_832 -Size: 151 +CPU: 3_487_267_194 +Memory: 14_677_282 +Size: 147 (con integer 3775) \ No newline at end of file diff --git a/plutus-benchmark/lists/test/Lookup/9.6/match-scott-list-10.eval.golden b/plutus-benchmark/lists/test/Lookup/9.6/match-scott-list-10.eval.golden index fd99e12d754..8d56d5cc311 100644 --- a/plutus-benchmark/lists/test/Lookup/9.6/match-scott-list-10.eval.golden +++ b/plutus-benchmark/lists/test/Lookup/9.6/match-scott-list-10.eval.golden @@ -1,5 +1,5 @@ -CPU: 101_489_780 -Memory: 461_880 -Size: 234 +CPU: 81_203_410 +Memory: 396_750 +Size: 226 (con integer 155) \ No newline at end of file diff --git a/plutus-benchmark/lists/test/Lookup/9.6/match-scott-list-100.eval.golden b/plutus-benchmark/lists/test/Lookup/9.6/match-scott-list-100.eval.golden index f023e4c9970..2320d7b011c 100644 --- a/plutus-benchmark/lists/test/Lookup/9.6/match-scott-list-100.eval.golden +++ b/plutus-benchmark/lists/test/Lookup/9.6/match-scott-list-100.eval.golden @@ -1,5 +1,5 @@ -CPU: 8_116_454_900 -Memory: 36_124_200 -Size: 954 +CPU: 6_509_150_200 +Memory: 30_963_900 +Size: 946 (con integer 15050) \ No newline at end of file diff --git a/plutus-benchmark/lists/test/Lookup/9.6/match-scott-list-5.eval.golden b/plutus-benchmark/lists/test/Lookup/9.6/match-scott-list-5.eval.golden index f6fe7fe9279..c4f9ec5c97a 100644 --- a/plutus-benchmark/lists/test/Lookup/9.6/match-scott-list-5.eval.golden +++ b/plutus-benchmark/lists/test/Lookup/9.6/match-scott-list-5.eval.golden @@ -1,5 +1,5 @@ -CPU: 31_269_190 -Memory: 145_040 -Size: 194 +CPU: 25_027_230 +Memory: 125_000 +Size: 186 (con integer 40) \ No newline at end of file diff --git a/plutus-benchmark/lists/test/Lookup/9.6/match-scott-list-50.eval.golden b/plutus-benchmark/lists/test/Lookup/9.6/match-scott-list-50.eval.golden index bd0b57d1071..0778baed1b7 100644 --- a/plutus-benchmark/lists/test/Lookup/9.6/match-scott-list-50.eval.golden +++ b/plutus-benchmark/lists/test/Lookup/9.6/match-scott-list-50.eval.golden @@ -1,5 +1,5 @@ -CPU: 2_084_516_500 -Memory: 9_303_800 -Size: 554 +CPU: 1_670_986_650 +Memory: 7_976_150 +Size: 546 (con integer 3775) \ No newline at end of file diff --git a/plutus-benchmark/lists/test/Sum/9.6/left-fold-data.eval.golden b/plutus-benchmark/lists/test/Sum/9.6/left-fold-data.eval.golden index 3ca9307edf6..158b6ea18be 100644 --- a/plutus-benchmark/lists/test/Sum/9.6/left-fold-data.eval.golden +++ b/plutus-benchmark/lists/test/Sum/9.6/left-fold-data.eval.golden @@ -1,5 +1,5 @@ -CPU: 309_967_632 -Memory: 1_237_030 -Size: 173 +CPU: 278_601_783 +Memory: 1_136_329 +Size: 165 (con integer 5050) \ No newline at end of file diff --git a/plutus-benchmark/lists/test/Sum/9.6/right-fold-data.eval.golden b/plutus-benchmark/lists/test/Sum/9.6/right-fold-data.eval.golden index 6c424e1ef7d..12d64d5277d 100644 --- a/plutus-benchmark/lists/test/Sum/9.6/right-fold-data.eval.golden +++ b/plutus-benchmark/lists/test/Sum/9.6/right-fold-data.eval.golden @@ -1,5 +1,5 @@ -CPU: 314_767_632 -Memory: 1_267_030 -Size: 176 +CPU: 283_401_783 +Memory: 1_166_329 +Size: 168 (con integer 5050) \ No newline at end of file diff --git a/plutus-benchmark/nofib/test/9.6/clausify-F5.eval.golden b/plutus-benchmark/nofib/test/9.6/clausify-F5.eval.golden index 9827abe937f..0d1ebf161a1 100644 --- a/plutus-benchmark/nofib/test/9.6/clausify-F5.eval.golden +++ b/plutus-benchmark/nofib/test/9.6/clausify-F5.eval.golden @@ -1,5 +1,5 @@ -CPU: 50_150_307_160 -Memory: 293_209_180 -Size: 1_615 +CPU: 45_969_754_450 +Memory: 279_787_390 +Size: 1_584 (constr 0) \ No newline at end of file diff --git a/plutus-benchmark/nofib/test/9.6/clausify-F5.pir.golden b/plutus-benchmark/nofib/test/9.6/clausify-F5.pir.golden index 799184ba655..647f2314239 100644 --- a/plutus-benchmark/nofib/test/9.6/clausify-F5.pir.golden +++ b/plutus-benchmark/nofib/test/9.6/clausify-F5.pir.golden @@ -42,46 +42,44 @@ Ord a !equalsInteger : integer -> integer -> Bool = \(x : integer) (y : integer) -> - ifThenElse {Bool} (equalsInteger x y) True False + case Bool (equalsInteger x y) [False, True] + !ifThenElse : all a. bool -> a -> a -> a + = /\a -> \(b : bool) (x : a) (y : a) -> case a b [y, x] !`$fOrdInteger` : Ord integer = CConsOrd {integer} equalsInteger (\(eta : integer) (eta : integer) -> Bool_match - (ifThenElse {Bool} (equalsInteger eta eta) True False) + (case Bool (equalsInteger eta eta) [False, True]) {all dead. Ordering} (/\dead -> EQ) (/\dead -> Bool_match - (ifThenElse - {Bool} - (lessThanEqualsInteger eta eta) - True - False) + (case Bool (lessThanEqualsInteger eta eta) [False, True]) {all dead. Ordering} (/\dead -> LT) (/\dead -> GT) {all dead. dead}) {all dead. dead}) (\(x : integer) (y : integer) -> - ifThenElse {Bool} (lessThanInteger x y) True False) + case Bool (lessThanInteger x y) [False, True]) (\(x : integer) (y : integer) -> - ifThenElse {Bool} (lessThanEqualsInteger x y) True False) + case Bool (lessThanEqualsInteger x y) [False, True]) (\(x : integer) (y : integer) -> ifThenElse {Bool} (lessThanEqualsInteger x y) False True) (\(x : integer) (y : integer) -> ifThenElse {Bool} (lessThanInteger x y) False True) (\(x : integer) (y : integer) -> Bool_match - (ifThenElse {Bool} (lessThanEqualsInteger x y) True False) + (case Bool (lessThanEqualsInteger x y) [False, True]) {all dead. integer} (/\dead -> y) (/\dead -> x) {all dead. dead}) (\(x : integer) (y : integer) -> Bool_match - (ifThenElse {Bool} (lessThanEqualsInteger x y) True False) + (case Bool (lessThanEqualsInteger x y) [False, True]) {all dead. integer} (/\dead -> x) (/\dead -> y) @@ -438,13 +436,13 @@ List integer) -> /\dead -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger y x) - True - False) + [ False + , True ]) {all dead. Bool} (/\dead -> diff --git a/plutus-benchmark/nofib/test/9.6/knights10-4x4.eval.golden b/plutus-benchmark/nofib/test/9.6/knights10-4x4.eval.golden index 2177eba9034..1d3fe9b76e7 100644 --- a/plutus-benchmark/nofib/test/9.6/knights10-4x4.eval.golden +++ b/plutus-benchmark/nofib/test/9.6/knights10-4x4.eval.golden @@ -1,5 +1,5 @@ -CPU: 1_395_086_000 -Memory: 7_028_012 -Size: 2_021 +CPU: 1_168_462_754 +Memory: 6_301_258 +Size: 1_934 (constr 0) \ No newline at end of file diff --git a/plutus-benchmark/nofib/test/9.6/knights10-4x4.pir.golden b/plutus-benchmark/nofib/test/9.6/knights10-4x4.pir.golden index cc25a8c7b52..3e3385c990d 100644 --- a/plutus-benchmark/nofib/test/9.6/knights10-4x4.pir.golden +++ b/plutus-benchmark/nofib/test/9.6/knights10-4x4.pir.golden @@ -49,48 +49,44 @@ `$fEqChessSet_$c==` (\(x : ChessSet) (y : ChessSet) -> y) (\(x : ChessSet) (y : ChessSet) -> x) - !equalsInteger : integer -> integer -> Bool - = \(x : integer) (y : integer) -> - ifThenElse {Bool} (equalsInteger x y) True False + !ifThenElse : all a. bool -> a -> a -> a + = /\a -> \(b : bool) (x : a) (y : a) -> case a b [y, x] !v : Ord integer = CConsOrd {integer} - equalsInteger + (\(x : integer) (y : integer) -> + case Bool (equalsInteger x y) [False, True]) (\(eta : integer) (eta : integer) -> Bool_match - (ifThenElse {Bool} (equalsInteger eta eta) True False) + (case Bool (equalsInteger eta eta) [False, True]) {all dead. Ordering} (/\dead -> EQ) (/\dead -> Bool_match - (ifThenElse - {Bool} - (lessThanEqualsInteger eta eta) - True - False) + (case Bool (lessThanEqualsInteger eta eta) [False, True]) {all dead. Ordering} (/\dead -> LT) (/\dead -> GT) {all dead. dead}) {all dead. dead}) (\(x : integer) (y : integer) -> - ifThenElse {Bool} (lessThanInteger x y) True False) + case Bool (lessThanInteger x y) [False, True]) (\(x : integer) (y : integer) -> - ifThenElse {Bool} (lessThanEqualsInteger x y) True False) + case Bool (lessThanEqualsInteger x y) [False, True]) (\(x : integer) (y : integer) -> ifThenElse {Bool} (lessThanEqualsInteger x y) False True) (\(x : integer) (y : integer) -> ifThenElse {Bool} (lessThanInteger x y) False True) (\(x : integer) (y : integer) -> Bool_match - (ifThenElse {Bool} (lessThanEqualsInteger x y) True False) + (case Bool (lessThanEqualsInteger x y) [False, True]) {all dead. integer} (/\dead -> y) (/\dead -> x) {all dead. dead}) (\(x : integer) (y : integer) -> Bool_match - (ifThenElse {Bool} (lessThanEqualsInteger x y) True False) + (case Bool (lessThanEqualsInteger x y) [False, True]) {all dead. integer} (/\dead -> x) (/\dead -> y) @@ -171,7 +167,7 @@ (growFn : a -> List a) (finFn : a -> Bool) -> Bool_match - (ifThenElse {Bool} (equalsInteger 0 depth) True False) + (case Bool (equalsInteger 0 depth) [False, True]) {all dead. List a} (/\dead -> Nil {a}) (/\dead -> @@ -625,11 +621,10 @@ {all dead. Bool} (/\dead -> Bool_match - (ifThenElse - {Bool} + (case + Bool (lessThanEqualsInteger x ipv) - True - False) + [False, True]) {all dead. Bool} (/\dead -> Bool_match @@ -641,11 +636,10 @@ {all dead. Bool} (/\dead -> Bool_match - (ifThenElse - {Bool} + (case + Bool (lessThanEqualsInteger y ipv) - True - False) + [False, True]) {all dead. Bool} (/\dead -> notIn @@ -666,20 +660,18 @@ (\(a' : integer) (b' : integer) -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger a a') - True - False) + [False, True]) {all dead. Bool} (/\dead -> - ifThenElse - {Bool} + case + Bool (equalsInteger b b') - True - False) + [False, True]) (/\dead -> False) {all dead. dead}))) t @@ -932,7 +924,7 @@ {Bool} (\(a' : integer) (b' : ChessSet) -> Bool_match - (equalsInteger a a') + (case Bool (equalsInteger a a') [False, True]) {all dead. Bool} (/\dead -> True) (/\dead -> False) @@ -989,15 +981,14 @@ in c (Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 0 (remainderInteger boardSize 2)) - True - False) + [False, True]) {all dead. ChessSet} (/\dead -> Board @@ -1069,11 +1060,7 @@ !go : integer -> List integer = \(n : integer) -> Bool_match - (ifThenElse - {Bool} - (lessThanEqualsInteger n 0) - True - False) + (case Bool (lessThanEqualsInteger n 0) [False, True]) {all dead. List integer} (/\dead -> Nil {integer}) (/\dead -> Cons {integer} x (go (subtractInteger n 1))) @@ -1151,11 +1138,10 @@ {a} (\(y : integer) (x : ChessSet) -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 1 y) - True - False) + [False, True]) {all dead. a} (/\dead -> c x ds) (/\dead -> ds) @@ -1211,13 +1197,12 @@ ipv)) {all dead. dead} in - ifThenElse - {Bool} + case + Bool (equalsInteger 0 (length {Direction} (possibleMoves board))) - True - False) + [False, True]) (/\dead -> False) {all dead. dead}) {all dead. List ChessSet} @@ -1227,7 +1212,7 @@ !l : integer = length {ChessSet} singles in Bool_match - (ifThenElse {Bool} (equalsInteger 0 l) True False) + (case Bool (equalsInteger 0 l) [False, True]) {all dead. List ChessSet} (/\dead -> go @@ -1547,11 +1532,7 @@ (descAndNo y))) (/\dead -> Bool_match - (ifThenElse - {Bool} - (equalsInteger 1 l) - True - False) + (case Bool (equalsInteger 1 l) [False, True]) {all dead. List ChessSet} (/\dead -> singles) (/\dead -> Nil {ChessSet}) @@ -1573,11 +1554,10 @@ (ipv : Maybe (Tuple2 integer integer)) (ipv : List (Tuple2 integer integer)) -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger ipv (multiplyInteger ipv ipv)) - True - False) + [False, True]) {all dead. Bool} (/\dead -> canMoveTo diff --git a/plutus-benchmark/nofib/test/9.6/queens4-bt.eval.golden b/plutus-benchmark/nofib/test/9.6/queens4-bt.eval.golden index 2f75a757bf8..93b0264aa81 100644 --- a/plutus-benchmark/nofib/test/9.6/queens4-bt.eval.golden +++ b/plutus-benchmark/nofib/test/9.6/queens4-bt.eval.golden @@ -1,6 +1,6 @@ -CPU: 4_302_046_267 -Memory: 22_978_130 -Size: 2_067 +CPU: 3_857_821_578 +Memory: 21_795_869 +Size: 2_036 (constr 1 diff --git a/plutus-benchmark/nofib/test/9.6/queens4-bt.pir.golden b/plutus-benchmark/nofib/test/9.6/queens4-bt.pir.golden index 6facf188db3..25fbeb37816 100644 --- a/plutus-benchmark/nofib/test/9.6/queens4-bt.pir.golden +++ b/plutus-benchmark/nofib/test/9.6/queens4-bt.pir.golden @@ -136,7 +136,7 @@ Fc : Algorithm !equalsInteger : integer -> integer -> Bool = \(x : integer) (y : integer) -> - ifThenElse {Bool} (equalsInteger x y) True False + case Bool (equalsInteger x y) [False, True] data Unit | Unit_match where Unit : Unit in @@ -281,11 +281,10 @@ (xs : List integer) -> /\dead -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger a x) - True - False) + [False, True]) {all dead. Bool} (/\dead -> False) (/\dead -> go xs) @@ -336,8 +335,8 @@ (ipv : integer) (ipv : Assign -> Assign -> Bool) -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger (List_match {Assign} @@ -350,8 +349,7 @@ {integer} (\(var : integer) (val : integer) -> var))) ipv) - True - False) + [False, True]) {all dead. ConflictSet} (/\dead -> Known (Nil {integer})) (/\dead -> Unknown) @@ -556,7 +554,7 @@ !interval : integer -> integer -> List integer = \(a : integer) (b : integer) -> Bool_match - (ifThenElse {Bool} (lessThanEqualsInteger a b) False True) + (case Bool (lessThanEqualsInteger a b) [True, False]) {all dead. List integer} (/\dead -> Nil {integer}) (/\dead -> Cons {integer} a (interval (addInteger 1 a) b)) @@ -1000,7 +998,7 @@ (\(x : ConflictSet) (xs : List ConflictSet) -> /\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 0 ds) True False) + (case Bool (equalsInteger 0 ds) [False, True]) {all dead. ConflictSet} (/\dead -> x) (/\dead -> go (subtractInteger ds 1) xs) @@ -1072,11 +1070,7 @@ 1 in Bool_match - (ifThenElse - {Bool} - (lessThanInteger n 0) - True - False) + (case Bool (lessThanInteger n 0) [False, True]) {all dead. ConflictSet} (/\dead -> traceError {ConflictSet} "PT6") (/\dead -> go n ds) @@ -1101,7 +1095,7 @@ !abs : integer -> integer = \(n : integer) -> Bool_match - (ifThenElse {Bool} (lessThanInteger n 0) True False) + (case Bool (lessThanInteger n 0) [False, True]) {all dead. integer} (/\dead -> subtractInteger 0 n) (/\dead -> n) @@ -1240,7 +1234,7 @@ (\(j : integer) (n : integer) -> Bool_match (Bool_match - (ifThenElse {Bool} (equalsInteger m n) True False) + (case Bool (equalsInteger m n) [False, True]) {all dead. Bool} (/\dead -> False) (/\dead -> True) @@ -1248,13 +1242,12 @@ {all dead. Bool} (/\dead -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger (abs (subtractInteger i j)) (abs (subtractInteger m n))) - True - False) + [False, True]) {all dead. Bool} (/\dead -> False) (/\dead -> True) @@ -1683,8 +1676,8 @@ {all dead. dead} in Bool_match - (ifThenElse - {Bool} + (case + Bool (lessThanInteger (List_match {Assign} @@ -1700,8 +1693,7 @@ (val : integer) -> var))) ds) - True - False) + [False, True]) {all dead. a} (/\dead -> go vallist) (/\dead -> n) diff --git a/plutus-benchmark/nofib/test/9.6/queens5-fc.eval.golden b/plutus-benchmark/nofib/test/9.6/queens5-fc.eval.golden index b29f7c19dc9..6561a3aead1 100644 --- a/plutus-benchmark/nofib/test/9.6/queens5-fc.eval.golden +++ b/plutus-benchmark/nofib/test/9.6/queens5-fc.eval.golden @@ -1,6 +1,6 @@ -CPU: 153_231_070_621 -Memory: 860_817_866 -Size: 2_067 +CPU: 137_974_261_782 +Memory: 812_282_055 +Size: 2_036 (constr 1 diff --git a/plutus-benchmark/nofib/test/9.6/queens5-fc.pir.golden b/plutus-benchmark/nofib/test/9.6/queens5-fc.pir.golden index 31e830ed914..7770ae155eb 100644 --- a/plutus-benchmark/nofib/test/9.6/queens5-fc.pir.golden +++ b/plutus-benchmark/nofib/test/9.6/queens5-fc.pir.golden @@ -136,7 +136,7 @@ Fc : Algorithm !equalsInteger : integer -> integer -> Bool = \(x : integer) (y : integer) -> - ifThenElse {Bool} (equalsInteger x y) True False + case Bool (equalsInteger x y) [False, True] data Unit | Unit_match where Unit : Unit in @@ -281,11 +281,10 @@ (xs : List integer) -> /\dead -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger a x) - True - False) + [False, True]) {all dead. Bool} (/\dead -> False) (/\dead -> go xs) @@ -336,8 +335,8 @@ (ipv : integer) (ipv : Assign -> Assign -> Bool) -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger (List_match {Assign} @@ -350,8 +349,7 @@ {integer} (\(var : integer) (val : integer) -> var))) ipv) - True - False) + [False, True]) {all dead. ConflictSet} (/\dead -> Known (Nil {integer})) (/\dead -> Unknown) @@ -556,7 +554,7 @@ !interval : integer -> integer -> List integer = \(a : integer) (b : integer) -> Bool_match - (ifThenElse {Bool} (lessThanEqualsInteger a b) False True) + (case Bool (lessThanEqualsInteger a b) [True, False]) {all dead. List integer} (/\dead -> Nil {integer}) (/\dead -> Cons {integer} a (interval (addInteger 1 a) b)) @@ -1000,7 +998,7 @@ (\(x : ConflictSet) (xs : List ConflictSet) -> /\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 0 ds) True False) + (case Bool (equalsInteger 0 ds) [False, True]) {all dead. ConflictSet} (/\dead -> x) (/\dead -> go (subtractInteger ds 1) xs) @@ -1072,11 +1070,7 @@ 1 in Bool_match - (ifThenElse - {Bool} - (lessThanInteger n 0) - True - False) + (case Bool (lessThanInteger n 0) [False, True]) {all dead. ConflictSet} (/\dead -> traceError {ConflictSet} "PT6") (/\dead -> go n ds) @@ -1101,7 +1095,7 @@ !abs : integer -> integer = \(n : integer) -> Bool_match - (ifThenElse {Bool} (lessThanInteger n 0) True False) + (case Bool (lessThanInteger n 0) [False, True]) {all dead. integer} (/\dead -> subtractInteger 0 n) (/\dead -> n) @@ -1240,7 +1234,7 @@ (\(j : integer) (n : integer) -> Bool_match (Bool_match - (ifThenElse {Bool} (equalsInteger m n) True False) + (case Bool (equalsInteger m n) [False, True]) {all dead. Bool} (/\dead -> False) (/\dead -> True) @@ -1248,13 +1242,12 @@ {all dead. Bool} (/\dead -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger (abs (subtractInteger i j)) (abs (subtractInteger m n))) - True - False) + [False, True]) {all dead. Bool} (/\dead -> False) (/\dead -> True) @@ -1683,8 +1676,8 @@ {all dead. dead} in Bool_match - (ifThenElse - {Bool} + (case + Bool (lessThanInteger (List_match {Assign} @@ -1700,8 +1693,7 @@ (val : integer) -> var))) ds) - True - False) + [False, True]) {all dead. a} (/\dead -> go vallist) (/\dead -> n) diff --git a/plutus-benchmark/script-contexts/test/V1/9.6/checkScriptContext1-20.eval.golden b/plutus-benchmark/script-contexts/test/V1/9.6/checkScriptContext1-20.eval.golden index 37d7c52a747..aed5b0a61da 100644 --- a/plutus-benchmark/script-contexts/test/V1/9.6/checkScriptContext1-20.eval.golden +++ b/plutus-benchmark/script-contexts/test/V1/9.6/checkScriptContext1-20.eval.golden @@ -1,5 +1,5 @@ -CPU: 261_922_639 -Memory: 989_819 -Size: 1_626 +CPU: 243_352_808 +Memory: 930_200 +Size: 1_490 (constr 0) \ No newline at end of file diff --git a/plutus-benchmark/script-contexts/test/V1/9.6/checkScriptContext1-4.eval.golden b/plutus-benchmark/script-contexts/test/V1/9.6/checkScriptContext1-4.eval.golden index df6f643cfaf..38550cb35bb 100644 --- a/plutus-benchmark/script-contexts/test/V1/9.6/checkScriptContext1-4.eval.golden +++ b/plutus-benchmark/script-contexts/test/V1/9.6/checkScriptContext1-4.eval.golden @@ -1,5 +1,5 @@ -CPU: 74_418_943 -Memory: 283_387 -Size: 1_626 +CPU: 68_333_032 +Memory: 263_848 +Size: 1_490 (constr 0) \ No newline at end of file diff --git a/plutus-benchmark/script-contexts/test/V1/9.6/checkScriptContext1.pir.golden b/plutus-benchmark/script-contexts/test/V1/9.6/checkScriptContext1.pir.golden index f8d322e253a..7eb166d9bf0 100644 --- a/plutus-benchmark/script-contexts/test/V1/9.6/checkScriptContext1.pir.golden +++ b/plutus-benchmark/script-contexts/test/V1/9.6/checkScriptContext1.pir.golden @@ -59,7 +59,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. Tuple2 a b} (/\dead -> Tuple2 @@ -78,12 +78,12 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. Credential} (/\dead -> PubKeyCredential (unBData (headList {data} args))) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 1 index) True False) + (case Bool (equalsInteger 1 index) [False, True]) {all dead. Credential} (/\dead -> ScriptCredential (unBData (headList {data} args))) (/\dead -> traceError {Credential} "PT1") @@ -98,7 +98,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. StakingCredential} (/\dead -> StakingHash @@ -106,7 +106,7 @@ (headList {data} args))) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 1 index) True False) + (case Bool (equalsInteger 1 index) [False, True]) {all dead. StakingCredential} (/\dead -> let @@ -136,7 +136,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. DCert} (/\dead -> DCertDelegRegKey @@ -144,7 +144,7 @@ (headList {data} args))) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 1 index) True False) + (case Bool (equalsInteger 1 index) [False, True]) {all dead. DCert} (/\dead -> DCertDelegDeRegKey @@ -152,7 +152,7 @@ (headList {data} args))) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 2 index) True False) + (case Bool (equalsInteger 2 index) [False, True]) {all dead. DCert} (/\dead -> DCertDelegDelegate @@ -161,11 +161,7 @@ (unBData (headList {data} (tailList {data} args)))) (/\dead -> Bool_match - (ifThenElse - {Bool} - (equalsInteger 3 index) - True - False) + (case Bool (equalsInteger 3 index) [False, True]) {all dead. DCert} (/\dead -> DCertPoolRegister @@ -174,11 +170,10 @@ (headList {data} (tailList {data} args)))) (/\dead -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 4 index) - True - False) + [False, True]) {all dead. DCert} (/\dead -> DCertPoolRetire @@ -189,20 +184,18 @@ (tailList {data} args)))) (/\dead -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 5 index) - True - False) + [False, True]) {all dead. DCert} (/\dead -> DCertGenesis) (/\dead -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 6 index) - True - False) + [False, True]) {all dead. DCert} (/\dead -> DCertMir) (/\dead -> traceError {DCert} "PT1") @@ -221,12 +214,12 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. Bool} (/\dead -> False) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 1 index) True False) + (case Bool (equalsInteger 1 index) [False, True]) {all dead. Bool} (/\dead -> True) (/\dead -> traceError {Bool} "PT1") @@ -246,18 +239,18 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. Extended a} (/\dead -> NegInf {a}) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 1 index) True False) + (case Bool (equalsInteger 1 index) [False, True]) {all dead. Extended a} (/\dead -> Finite {a} (`$dUnsafeFromData` (headList {data} args))) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 2 index) True False) + (case Bool (equalsInteger 2 index) [False, True]) {all dead. Extended a} (/\dead -> PosInf {a}) (/\dead -> traceError {Extended a} "PT1") @@ -272,7 +265,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. bytestring} (/\dead -> unBData (headList {data} args)) (/\dead -> traceError {bytestring} "PT1") @@ -287,7 +280,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. TxOutRef} (/\dead -> TxOutRef @@ -306,12 +299,12 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 1 index) True False) + (case Bool (equalsInteger 1 index) [False, True]) {all dead. Maybe a} (/\dead -> Nothing {a}) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. Maybe a} (/\dead -> Just {a} (`$dUnsafeFromData` (headList {data} args))) @@ -371,7 +364,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. TxOut} (/\dead -> let @@ -385,7 +378,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. Address} (/\dead -> Address @@ -450,7 +443,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. ScriptContext} (/\dead -> ScriptContext @@ -461,7 +454,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. TxInfo} (/\dead -> let @@ -498,11 +491,10 @@ = sndPair {integer} {list data} tup in Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 0 index) - True - False) + [False, True]) {all dead. TxInInfo} (/\dead -> TxInInfo @@ -597,7 +589,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. Interval integer} (/\dead -> Interval @@ -611,11 +603,7 @@ = sndPair {integer} {list data} tup in Bool_match - (ifThenElse - {Bool} - (equalsInteger 0 index) - True - False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. LowerBound integer} (/\dead -> LowerBound @@ -638,11 +626,7 @@ = sndPair {integer} {list data} tup in Bool_match - (ifThenElse - {Bool} - (equalsInteger 0 index) - True - False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. UpperBound integer} (/\dead -> UpperBound @@ -704,12 +688,12 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. ScriptPurpose} (/\dead -> Minting (unBData (headList {data} args))) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 1 index) True False) + (case Bool (equalsInteger 1 index) [False, True]) {all dead. ScriptPurpose} (/\dead -> Spending @@ -717,7 +701,7 @@ (headList {data} args))) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 2 index) True False) + (case Bool (equalsInteger 2 index) [False, True]) {all dead. ScriptPurpose} (/\dead -> Rewarding @@ -725,11 +709,7 @@ (headList {data} args))) (/\dead -> Bool_match - (ifThenElse - {Bool} - (equalsInteger 3 index) - True - False) + (case Bool (equalsInteger 3 index) [False, True]) {all dead. ScriptPurpose} (/\dead -> Certifying @@ -745,8 +725,8 @@ {Unit} (\(ipv : TxInfo) (ipv : ScriptPurpose) -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 0 (modInteger @@ -779,8 +759,7 @@ in go eta) 2)) - True - False) + [False, True]) {all dead. Unit} (/\dead -> Unit) (/\dead -> diff --git a/plutus-benchmark/script-contexts/test/V1/9.6/checkScriptContext1.size.golden b/plutus-benchmark/script-contexts/test/V1/9.6/checkScriptContext1.size.golden index 49d66a8bd35..b5526d659a5 100644 --- a/plutus-benchmark/script-contexts/test/V1/9.6/checkScriptContext1.size.golden +++ b/plutus-benchmark/script-contexts/test/V1/9.6/checkScriptContext1.size.golden @@ -1 +1 @@ -1626 \ No newline at end of file +1490 \ No newline at end of file diff --git a/plutus-benchmark/script-contexts/test/V1/9.6/checkScriptContext2-20.eval.golden b/plutus-benchmark/script-contexts/test/V1/9.6/checkScriptContext2-20.eval.golden index 4812e337f5e..0d52057a1f1 100644 --- a/plutus-benchmark/script-contexts/test/V1/9.6/checkScriptContext2-20.eval.golden +++ b/plutus-benchmark/script-contexts/test/V1/9.6/checkScriptContext2-20.eval.golden @@ -1,5 +1,5 @@ -CPU: 253_542_167 -Memory: 951_676 -Size: 1_562 +CPU: 235_128_385 +Memory: 892_558 +Size: 1_430 (constr 0) \ No newline at end of file diff --git a/plutus-benchmark/script-contexts/test/V1/9.6/checkScriptContext2-4.eval.golden b/plutus-benchmark/script-contexts/test/V1/9.6/checkScriptContext2-4.eval.golden index ecf47d22d31..7feb9a1620f 100644 --- a/plutus-benchmark/script-contexts/test/V1/9.6/checkScriptContext2-4.eval.golden +++ b/plutus-benchmark/script-contexts/test/V1/9.6/checkScriptContext2-4.eval.golden @@ -1,5 +1,5 @@ -CPU: 72_009_799 -Memory: 272_476 -Size: 1_562 +CPU: 66_079_937 +Memory: 253_438 +Size: 1_430 (constr 0) \ No newline at end of file diff --git a/plutus-benchmark/script-contexts/test/V1/9.6/checkScriptContext2.pir.golden b/plutus-benchmark/script-contexts/test/V1/9.6/checkScriptContext2.pir.golden index 8cfdc3fc4de..e135b6c0f56 100644 --- a/plutus-benchmark/script-contexts/test/V1/9.6/checkScriptContext2.pir.golden +++ b/plutus-benchmark/script-contexts/test/V1/9.6/checkScriptContext2.pir.golden @@ -21,7 +21,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. Tuple2 a b} (/\dead -> Tuple2 @@ -43,12 +43,12 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. Credential} (/\dead -> PubKeyCredential (unBData (headList {data} args))) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 1 index) True False) + (case Bool (equalsInteger 1 index) [False, True]) {all dead. Credential} (/\dead -> ScriptCredential (unBData (headList {data} args))) (/\dead -> traceError {Credential} "PT1") @@ -66,7 +66,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. StakingCredential} (/\dead -> StakingHash @@ -74,7 +74,7 @@ (headList {data} args))) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 1 index) True False) + (case Bool (equalsInteger 1 index) [False, True]) {all dead. StakingCredential} (/\dead -> let @@ -104,7 +104,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. DCert} (/\dead -> DCertDelegRegKey @@ -112,7 +112,7 @@ (headList {data} args))) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 1 index) True False) + (case Bool (equalsInteger 1 index) [False, True]) {all dead. DCert} (/\dead -> DCertDelegDeRegKey @@ -120,7 +120,7 @@ (headList {data} args))) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 2 index) True False) + (case Bool (equalsInteger 2 index) [False, True]) {all dead. DCert} (/\dead -> DCertDelegDelegate @@ -129,11 +129,7 @@ (unBData (headList {data} (tailList {data} args)))) (/\dead -> Bool_match - (ifThenElse - {Bool} - (equalsInteger 3 index) - True - False) + (case Bool (equalsInteger 3 index) [False, True]) {all dead. DCert} (/\dead -> DCertPoolRegister @@ -142,11 +138,10 @@ (headList {data} (tailList {data} args)))) (/\dead -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 4 index) - True - False) + [False, True]) {all dead. DCert} (/\dead -> DCertPoolRetire @@ -157,20 +152,18 @@ (tailList {data} args)))) (/\dead -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 5 index) - True - False) + [False, True]) {all dead. DCert} (/\dead -> DCertGenesis) (/\dead -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 6 index) - True - False) + [False, True]) {all dead. DCert} (/\dead -> DCertMir) (/\dead -> traceError {DCert} "PT1") @@ -189,12 +182,12 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. Bool} (/\dead -> False) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 1 index) True False) + (case Bool (equalsInteger 1 index) [False, True]) {all dead. Bool} (/\dead -> True) (/\dead -> traceError {Bool} "PT1") @@ -214,18 +207,18 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. Extended a} (/\dead -> NegInf {a}) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 1 index) True False) + (case Bool (equalsInteger 1 index) [False, True]) {all dead. Extended a} (/\dead -> Finite {a} (`$dUnsafeFromData` (headList {data} args))) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 2 index) True False) + (case Bool (equalsInteger 2 index) [False, True]) {all dead. Extended a} (/\dead -> PosInf {a}) (/\dead -> traceError {Extended a} "PT1") @@ -240,7 +233,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. bytestring} (/\dead -> unBData (headList {data} args)) (/\dead -> traceError {bytestring} "PT1") @@ -255,7 +248,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. TxOutRef} (/\dead -> TxOutRef @@ -277,12 +270,12 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 1 index) True False) + (case Bool (equalsInteger 1 index) [False, True]) {all dead. Maybe a} (/\dead -> Nothing {a}) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. Maybe a} (/\dead -> Just {a} (`$dUnsafeFromData` (headList {data} args))) @@ -359,7 +352,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. TxOut} (/\dead -> let @@ -373,7 +366,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. Address} (/\dead -> Address @@ -440,7 +433,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. ScriptContext} (/\dead -> ScriptContext @@ -451,7 +444,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. TxInfo} (/\dead -> let @@ -488,11 +481,10 @@ = sndPair {integer} {list data} tup in Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 0 index) - True - False) + [False, True]) {all dead. TxInInfo} (/\dead -> TxInInfo @@ -587,7 +579,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. Interval integer} (/\dead -> Interval @@ -601,11 +593,7 @@ = sndPair {integer} {list data} tup in Bool_match - (ifThenElse - {Bool} - (equalsInteger 0 index) - True - False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. LowerBound integer} (/\dead -> LowerBound @@ -630,11 +618,7 @@ = sndPair {integer} {list data} tup in Bool_match - (ifThenElse - {Bool} - (equalsInteger 0 index) - True - False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. UpperBound integer} (/\dead -> UpperBound @@ -698,12 +682,12 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. ScriptPurpose} (/\dead -> Minting (unBData (headList {data} args))) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 1 index) True False) + (case Bool (equalsInteger 1 index) [False, True]) {all dead. ScriptPurpose} (/\dead -> Spending @@ -711,11 +695,7 @@ (headList {data} args))) (/\dead -> Bool_match - (ifThenElse - {Bool} - (equalsInteger 2 index) - True - False) + (case Bool (equalsInteger 2 index) [False, True]) {all dead. ScriptPurpose} (/\dead -> Rewarding @@ -723,11 +703,10 @@ (headList {data} args))) (/\dead -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 3 index) - True - False) + [False, True]) {all dead. ScriptPurpose} (/\dead -> Certifying diff --git a/plutus-benchmark/script-contexts/test/V1/9.6/checkScriptContext2.size.golden b/plutus-benchmark/script-contexts/test/V1/9.6/checkScriptContext2.size.golden index 123408875a3..96047da228c 100644 --- a/plutus-benchmark/script-contexts/test/V1/9.6/checkScriptContext2.size.golden +++ b/plutus-benchmark/script-contexts/test/V1/9.6/checkScriptContext2.size.golden @@ -1 +1 @@ -1562 \ No newline at end of file +1430 \ No newline at end of file diff --git a/plutus-benchmark/script-contexts/test/V1/9.6/checkScriptContextEqualityData-20.eval.golden b/plutus-benchmark/script-contexts/test/V1/9.6/checkScriptContextEqualityData-20.eval.golden index 49c10a812db..2e2992db855 100644 --- a/plutus-benchmark/script-contexts/test/V1/9.6/checkScriptContextEqualityData-20.eval.golden +++ b/plutus-benchmark/script-contexts/test/V1/9.6/checkScriptContextEqualityData-20.eval.golden @@ -1,5 +1,5 @@ -CPU: 34_774_758 -Memory: 30_802 -Size: 316 +CPU: 34_618_709 +Memory: 30_301 +Size: 312 (constr 0) \ No newline at end of file diff --git a/plutus-benchmark/script-contexts/test/V1/Data/9.6/checkScriptContext1-20.eval.golden b/plutus-benchmark/script-contexts/test/V1/Data/9.6/checkScriptContext1-20.eval.golden index c5749282844..876de0069a2 100644 --- a/plutus-benchmark/script-contexts/test/V1/Data/9.6/checkScriptContext1-20.eval.golden +++ b/plutus-benchmark/script-contexts/test/V1/Data/9.6/checkScriptContext1-20.eval.golden @@ -1,5 +1,5 @@ -CPU: 20_276_762 -Memory: 72_951 -Size: 96 +CPU: 20_120_713 +Memory: 72_450 +Size: 92 (constr 0) \ No newline at end of file diff --git a/plutus-benchmark/script-contexts/test/V1/Data/9.6/checkScriptContext1-4.eval.golden b/plutus-benchmark/script-contexts/test/V1/Data/9.6/checkScriptContext1-4.eval.golden index aa930186a93..860eecec37d 100644 --- a/plutus-benchmark/script-contexts/test/V1/Data/9.6/checkScriptContext1-4.eval.golden +++ b/plutus-benchmark/script-contexts/test/V1/Data/9.6/checkScriptContext1-4.eval.golden @@ -1,5 +1,5 @@ -CPU: 5_700_522 -Memory: 20_183 -Size: 96 +CPU: 5_544_473 +Memory: 19_682 +Size: 92 (constr 0) \ No newline at end of file diff --git a/plutus-benchmark/script-contexts/test/V1/Data/9.6/checkScriptContext1.pir.golden b/plutus-benchmark/script-contexts/test/V1/Data/9.6/checkScriptContext1.pir.golden index d763d363386..3c245bbf1b1 100644 --- a/plutus-benchmark/script-contexts/test/V1/Data/9.6/checkScriptContext1.pir.golden +++ b/plutus-benchmark/script-contexts/test/V1/Data/9.6/checkScriptContext1.pir.golden @@ -23,8 +23,8 @@ in \(d : data) -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 0 (modInteger @@ -90,11 +90,7 @@ = sndPair {integer} {list data} tup in Bool_match - (ifThenElse - {Bool} - (equalsInteger 0 index) - True - False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. bytestring} (/\dead -> unBData (headList {data} args)) (/\dead -> @@ -131,8 +127,7 @@ in go ds) 2)) - True - False) + [False, True]) {all dead. Unit} (/\dead -> Unit) (/\dead -> diff --git a/plutus-benchmark/script-contexts/test/V1/Data/9.6/checkScriptContext1.size.golden b/plutus-benchmark/script-contexts/test/V1/Data/9.6/checkScriptContext1.size.golden index 56749c830e6..69226f7293a 100644 --- a/plutus-benchmark/script-contexts/test/V1/Data/9.6/checkScriptContext1.size.golden +++ b/plutus-benchmark/script-contexts/test/V1/Data/9.6/checkScriptContext1.size.golden @@ -1 +1 @@ -96 \ No newline at end of file +92 \ No newline at end of file diff --git a/plutus-benchmark/script-contexts/test/V1/Data/9.6/checkScriptContextEqualityData-20.eval.golden b/plutus-benchmark/script-contexts/test/V1/Data/9.6/checkScriptContextEqualityData-20.eval.golden index 9a60fd8cbd4..505751227f6 100644 --- a/plutus-benchmark/script-contexts/test/V1/Data/9.6/checkScriptContextEqualityData-20.eval.golden +++ b/plutus-benchmark/script-contexts/test/V1/Data/9.6/checkScriptContextEqualityData-20.eval.golden @@ -1,5 +1,5 @@ -CPU: 30_182_758 -Memory: 2_102 -Size: 29 +CPU: 30_026_709 +Memory: 1_601 +Size: 25 (constr 0) \ No newline at end of file diff --git a/plutus-benchmark/script-contexts/test/V2/9.6/checkScriptContext1-20.eval.golden b/plutus-benchmark/script-contexts/test/V2/9.6/checkScriptContext1-20.eval.golden index fb50a089932..03e2e3187d0 100644 --- a/plutus-benchmark/script-contexts/test/V2/9.6/checkScriptContext1-20.eval.golden +++ b/plutus-benchmark/script-contexts/test/V2/9.6/checkScriptContext1-20.eval.golden @@ -1,5 +1,5 @@ -CPU: 289_927_589 -Memory: 1_089_115 -Size: 1_683 +CPU: 268_236_778 +Memory: 1_019_476 +Size: 1_539 (constr 0) \ No newline at end of file diff --git a/plutus-benchmark/script-contexts/test/V2/9.6/checkScriptContext1-4.eval.golden b/plutus-benchmark/script-contexts/test/V2/9.6/checkScriptContext1-4.eval.golden index cfea6f896c7..fb91282084b 100644 --- a/plutus-benchmark/script-contexts/test/V2/9.6/checkScriptContext1-4.eval.golden +++ b/plutus-benchmark/script-contexts/test/V2/9.6/checkScriptContext1-4.eval.golden @@ -1,5 +1,5 @@ -CPU: 82_045_173 -Memory: 312_891 -Size: 1_683 +CPU: 75_335_066 +Memory: 291_348 +Size: 1_539 (constr 0) \ No newline at end of file diff --git a/plutus-benchmark/script-contexts/test/V2/9.6/checkScriptContext1.pir.golden b/plutus-benchmark/script-contexts/test/V2/9.6/checkScriptContext1.pir.golden index 937039aa728..b5807377331 100644 --- a/plutus-benchmark/script-contexts/test/V2/9.6/checkScriptContext1.pir.golden +++ b/plutus-benchmark/script-contexts/test/V2/9.6/checkScriptContext1.pir.golden @@ -62,12 +62,12 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. Bool} (/\dead -> False) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 1 index) True False) + (case Bool (equalsInteger 1 index) [False, True]) {all dead. Bool} (/\dead -> True) (/\dead -> traceError {Bool} "PT1") @@ -87,18 +87,18 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. Extended a} (/\dead -> NegInf {a}) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 1 index) True False) + (case Bool (equalsInteger 1 index) [False, True]) {all dead. Extended a} (/\dead -> Finite {a} (`$dUnsafeFromData` (headList {data} args))) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 2 index) True False) + (case Bool (equalsInteger 2 index) [False, True]) {all dead. Extended a} (/\dead -> PosInf {a}) (/\dead -> traceError {Extended a} "PT1") @@ -113,12 +113,12 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. Credential} (/\dead -> PubKeyCredential (unBData (headList {data} args))) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 1 index) True False) + (case Bool (equalsInteger 1 index) [False, True]) {all dead. Credential} (/\dead -> ScriptCredential (unBData (headList {data} args))) (/\dead -> traceError {Credential} "PT1") @@ -133,7 +133,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. StakingCredential} (/\dead -> StakingHash @@ -141,7 +141,7 @@ (headList {data} args))) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 1 index) True False) + (case Bool (equalsInteger 1 index) [False, True]) {all dead. StakingCredential} (/\dead -> let @@ -171,7 +171,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. DCert} (/\dead -> DCertDelegRegKey @@ -179,7 +179,7 @@ (headList {data} args))) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 1 index) True False) + (case Bool (equalsInteger 1 index) [False, True]) {all dead. DCert} (/\dead -> DCertDelegDeRegKey @@ -187,7 +187,7 @@ (headList {data} args))) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 2 index) True False) + (case Bool (equalsInteger 2 index) [False, True]) {all dead. DCert} (/\dead -> DCertDelegDelegate @@ -196,11 +196,7 @@ (unBData (headList {data} (tailList {data} args)))) (/\dead -> Bool_match - (ifThenElse - {Bool} - (equalsInteger 3 index) - True - False) + (case Bool (equalsInteger 3 index) [False, True]) {all dead. DCert} (/\dead -> DCertPoolRegister @@ -209,11 +205,10 @@ (headList {data} (tailList {data} args)))) (/\dead -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 4 index) - True - False) + [False, True]) {all dead. DCert} (/\dead -> DCertPoolRetire @@ -224,20 +219,18 @@ (tailList {data} args)))) (/\dead -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 5 index) - True - False) + [False, True]) {all dead. DCert} (/\dead -> DCertGenesis) (/\dead -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 6 index) - True - False) + [False, True]) {all dead. DCert} (/\dead -> DCertMir) (/\dead -> traceError {DCert} "PT1") @@ -256,7 +249,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. bytestring} (/\dead -> unBData (headList {data} args)) (/\dead -> traceError {bytestring} "PT1") @@ -271,7 +264,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. TxOutRef} (/\dead -> TxOutRef @@ -294,12 +287,12 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. ScriptPurpose} (/\dead -> Minting (unBData (headList {data} args))) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 1 index) True False) + (case Bool (equalsInteger 1 index) [False, True]) {all dead. ScriptPurpose} (/\dead -> Spending @@ -307,7 +300,7 @@ (headList {data} args))) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 2 index) True False) + (case Bool (equalsInteger 2 index) [False, True]) {all dead. ScriptPurpose} (/\dead -> Rewarding @@ -315,11 +308,7 @@ (headList {data} args))) (/\dead -> Bool_match - (ifThenElse - {Bool} - (equalsInteger 3 index) - True - False) + (case Bool (equalsInteger 3 index) [False, True]) {all dead. ScriptPurpose} (/\dead -> Certifying @@ -340,12 +329,12 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 1 index) True False) + (case Bool (equalsInteger 1 index) [False, True]) {all dead. Maybe a} (/\dead -> Nothing {a}) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. Maybe a} (/\dead -> Just {a} (`$dUnsafeFromData` (headList {data} args))) @@ -405,7 +394,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. TxOut} (/\dead -> let @@ -420,7 +409,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. Address} (/\dead -> Address @@ -445,22 +434,18 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. OutputDatum} (/\dead -> NoOutputDatum) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 1 index) True False) + (case Bool (equalsInteger 1 index) [False, True]) {all dead. OutputDatum} (/\dead -> OutputDatumHash (unBData (headList {data} args))) (/\dead -> Bool_match - (ifThenElse - {Bool} - (equalsInteger 2 index) - True - False) + (case Bool (equalsInteger 2 index) [False, True]) {all dead. OutputDatum} (/\dead -> OutputDatum (headList {data} args)) (/\dead -> traceError {OutputDatum} "PT1") @@ -483,7 +468,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. TxInInfo} (/\dead -> TxInInfo @@ -529,7 +514,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. ScriptContext} (/\dead -> ScriptContext @@ -540,7 +525,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. TxInfo} (/\dead -> let @@ -657,7 +642,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. Interval integer} (/\dead -> Interval @@ -671,11 +656,7 @@ = sndPair {integer} {list data} tup in Bool_match - (ifThenElse - {Bool} - (equalsInteger 0 index) - True - False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. LowerBound integer} (/\dead -> LowerBound @@ -698,11 +679,7 @@ = sndPair {integer} {list data} tup in Bool_match - (ifThenElse - {Bool} - (equalsInteger 0 index) - True - False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. UpperBound integer} (/\dead -> UpperBound @@ -753,8 +730,8 @@ {Unit} (\(ipv : TxInfo) (ipv : ScriptPurpose) -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 0 (modInteger @@ -793,8 +770,7 @@ in go eta) 2)) - True - False) + [False, True]) {all dead. Unit} (/\dead -> Unit) (/\dead -> diff --git a/plutus-benchmark/script-contexts/test/V2/9.6/checkScriptContext1.size.golden b/plutus-benchmark/script-contexts/test/V2/9.6/checkScriptContext1.size.golden index 62cab397cc0..e4a36c3722d 100644 --- a/plutus-benchmark/script-contexts/test/V2/9.6/checkScriptContext1.size.golden +++ b/plutus-benchmark/script-contexts/test/V2/9.6/checkScriptContext1.size.golden @@ -1 +1 @@ -1683 \ No newline at end of file +1539 \ No newline at end of file diff --git a/plutus-benchmark/script-contexts/test/V2/9.6/checkScriptContext2-20.eval.golden b/plutus-benchmark/script-contexts/test/V2/9.6/checkScriptContext2-20.eval.golden index aea59aba152..7bcd640fef3 100644 --- a/plutus-benchmark/script-contexts/test/V2/9.6/checkScriptContext2-20.eval.golden +++ b/plutus-benchmark/script-contexts/test/V2/9.6/checkScriptContext2-20.eval.golden @@ -1,5 +1,5 @@ -CPU: 281_515_117 -Memory: 1_050_772 -Size: 1_617 +CPU: 259_980_355 +Memory: 981_634 +Size: 1_477 (constr 0) \ No newline at end of file diff --git a/plutus-benchmark/script-contexts/test/V2/9.6/checkScriptContext2-4.eval.golden b/plutus-benchmark/script-contexts/test/V2/9.6/checkScriptContext2-4.eval.golden index d57fcacab65..f22a0cf6f98 100644 --- a/plutus-benchmark/script-contexts/test/V2/9.6/checkScriptContext2-4.eval.golden +++ b/plutus-benchmark/script-contexts/test/V2/9.6/checkScriptContext2-4.eval.golden @@ -1,5 +1,5 @@ -CPU: 79_604_029 -Memory: 301_780 -Size: 1_617 +CPU: 73_049_971 +Memory: 280_738 +Size: 1_477 (constr 0) \ No newline at end of file diff --git a/plutus-benchmark/script-contexts/test/V2/9.6/checkScriptContext2.pir.golden b/plutus-benchmark/script-contexts/test/V2/9.6/checkScriptContext2.pir.golden index ac8e034fbff..e42cd7f5b64 100644 --- a/plutus-benchmark/script-contexts/test/V2/9.6/checkScriptContext2.pir.golden +++ b/plutus-benchmark/script-contexts/test/V2/9.6/checkScriptContext2.pir.golden @@ -17,12 +17,12 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. Bool} (/\dead -> False) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 1 index) True False) + (case Bool (equalsInteger 1 index) [False, True]) {all dead. Bool} (/\dead -> True) (/\dead -> traceError {Bool} "PT1") @@ -42,18 +42,18 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. Extended a} (/\dead -> NegInf {a}) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 1 index) True False) + (case Bool (equalsInteger 1 index) [False, True]) {all dead. Extended a} (/\dead -> Finite {a} (`$dUnsafeFromData` (headList {data} args))) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 2 index) True False) + (case Bool (equalsInteger 2 index) [False, True]) {all dead. Extended a} (/\dead -> PosInf {a}) (/\dead -> traceError {Extended a} "PT1") @@ -71,12 +71,12 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. Credential} (/\dead -> PubKeyCredential (unBData (headList {data} args))) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 1 index) True False) + (case Bool (equalsInteger 1 index) [False, True]) {all dead. Credential} (/\dead -> ScriptCredential (unBData (headList {data} args))) (/\dead -> traceError {Credential} "PT1") @@ -94,7 +94,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. StakingCredential} (/\dead -> StakingHash @@ -102,7 +102,7 @@ (headList {data} args))) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 1 index) True False) + (case Bool (equalsInteger 1 index) [False, True]) {all dead. StakingCredential} (/\dead -> let @@ -132,7 +132,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. DCert} (/\dead -> DCertDelegRegKey @@ -140,7 +140,7 @@ (headList {data} args))) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 1 index) True False) + (case Bool (equalsInteger 1 index) [False, True]) {all dead. DCert} (/\dead -> DCertDelegDeRegKey @@ -148,7 +148,7 @@ (headList {data} args))) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 2 index) True False) + (case Bool (equalsInteger 2 index) [False, True]) {all dead. DCert} (/\dead -> DCertDelegDelegate @@ -157,11 +157,7 @@ (unBData (headList {data} (tailList {data} args)))) (/\dead -> Bool_match - (ifThenElse - {Bool} - (equalsInteger 3 index) - True - False) + (case Bool (equalsInteger 3 index) [False, True]) {all dead. DCert} (/\dead -> DCertPoolRegister @@ -170,11 +166,10 @@ (headList {data} (tailList {data} args)))) (/\dead -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 4 index) - True - False) + [False, True]) {all dead. DCert} (/\dead -> DCertPoolRetire @@ -185,20 +180,18 @@ (tailList {data} args)))) (/\dead -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 5 index) - True - False) + [False, True]) {all dead. DCert} (/\dead -> DCertGenesis) (/\dead -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 6 index) - True - False) + [False, True]) {all dead. DCert} (/\dead -> DCertMir) (/\dead -> traceError {DCert} "PT1") @@ -217,7 +210,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. bytestring} (/\dead -> unBData (headList {data} args)) (/\dead -> traceError {bytestring} "PT1") @@ -232,7 +225,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. TxOutRef} (/\dead -> TxOutRef @@ -255,12 +248,12 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. ScriptPurpose} (/\dead -> Minting (unBData (headList {data} args))) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 1 index) True False) + (case Bool (equalsInteger 1 index) [False, True]) {all dead. ScriptPurpose} (/\dead -> Spending @@ -268,7 +261,7 @@ (headList {data} args))) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 2 index) True False) + (case Bool (equalsInteger 2 index) [False, True]) {all dead. ScriptPurpose} (/\dead -> Rewarding @@ -276,11 +269,7 @@ (headList {data} args))) (/\dead -> Bool_match - (ifThenElse - {Bool} - (equalsInteger 3 index) - True - False) + (case Bool (equalsInteger 3 index) [False, True]) {all dead. ScriptPurpose} (/\dead -> Certifying @@ -304,12 +293,12 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 1 index) True False) + (case Bool (equalsInteger 1 index) [False, True]) {all dead. Maybe a} (/\dead -> Nothing {a}) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. Maybe a} (/\dead -> Just {a} (`$dUnsafeFromData` (headList {data} args))) @@ -393,7 +382,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. TxOut} (/\dead -> let @@ -408,7 +397,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. Address} (/\dead -> Address @@ -433,22 +422,18 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. OutputDatum} (/\dead -> NoOutputDatum) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 1 index) True False) + (case Bool (equalsInteger 1 index) [False, True]) {all dead. OutputDatum} (/\dead -> OutputDatumHash (unBData (headList {data} args))) (/\dead -> Bool_match - (ifThenElse - {Bool} - (equalsInteger 2 index) - True - False) + (case Bool (equalsInteger 2 index) [False, True]) {all dead. OutputDatum} (/\dead -> OutputDatum (headList {data} args)) (/\dead -> traceError {OutputDatum} "PT1") @@ -471,7 +456,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. TxInInfo} (/\dead -> TxInInfo @@ -519,7 +504,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. ScriptContext} (/\dead -> ScriptContext @@ -530,7 +515,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. TxInfo} (/\dead -> let @@ -647,7 +632,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. Interval integer} (/\dead -> Interval @@ -661,11 +646,7 @@ = sndPair {integer} {list data} tup in Bool_match - (ifThenElse - {Bool} - (equalsInteger 0 index) - True - False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. LowerBound integer} (/\dead -> LowerBound @@ -690,11 +671,7 @@ = sndPair {integer} {list data} tup in Bool_match - (ifThenElse - {Bool} - (equalsInteger 0 index) - True - False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. UpperBound integer} (/\dead -> UpperBound diff --git a/plutus-benchmark/script-contexts/test/V2/9.6/checkScriptContext2.size.golden b/plutus-benchmark/script-contexts/test/V2/9.6/checkScriptContext2.size.golden index f84ccb28c6b..3559f242bc4 100644 --- a/plutus-benchmark/script-contexts/test/V2/9.6/checkScriptContext2.size.golden +++ b/plutus-benchmark/script-contexts/test/V2/9.6/checkScriptContext2.size.golden @@ -1 +1 @@ -1617 \ No newline at end of file +1477 \ No newline at end of file diff --git a/plutus-benchmark/script-contexts/test/V2/9.6/checkScriptContextEqualityData-20.eval.golden b/plutus-benchmark/script-contexts/test/V2/9.6/checkScriptContextEqualityData-20.eval.golden index 99475b040ae..991ec211150 100644 --- a/plutus-benchmark/script-contexts/test/V2/9.6/checkScriptContextEqualityData-20.eval.golden +++ b/plutus-benchmark/script-contexts/test/V2/9.6/checkScriptContextEqualityData-20.eval.golden @@ -1,5 +1,5 @@ -CPU: 37_527_310 -Memory: 33_002 -Size: 338 +CPU: 37_371_261 +Memory: 32_501 +Size: 334 (constr 0) \ No newline at end of file diff --git a/plutus-benchmark/script-contexts/test/V2/9.6/dataFwdStakeTrick.eval.golden b/plutus-benchmark/script-contexts/test/V2/9.6/dataFwdStakeTrick.eval.golden index 80e6461cf0e..abe210745d5 100644 --- a/plutus-benchmark/script-contexts/test/V2/9.6/dataFwdStakeTrick.eval.golden +++ b/plutus-benchmark/script-contexts/test/V2/9.6/dataFwdStakeTrick.eval.golden @@ -1,5 +1,5 @@ -CPU: 5_890_120 -Memory: 10_880 -Size: 170 +CPU: 5_578_022 +Memory: 9_878 +Size: 158 (constr 0) \ No newline at end of file diff --git a/plutus-benchmark/script-contexts/test/V2/9.6/dataFwdStakeTrick.pir.golden b/plutus-benchmark/script-contexts/test/V2/9.6/dataFwdStakeTrick.pir.golden index a88a404d5e2..cf67ce98a2f 100644 --- a/plutus-benchmark/script-contexts/test/V2/9.6/dataFwdStakeTrick.pir.golden +++ b/plutus-benchmark/script-contexts/test/V2/9.6/dataFwdStakeTrick.pir.golden @@ -38,12 +38,12 @@ in !wdrlAtOne : data = fstPair {data} {data} (headList {pair data data} rest) in Bool_match - (ifThenElse {Bool} (equalsData obsScriptCred wdrlAtZero) True False) + (case Bool (equalsData obsScriptCred wdrlAtZero) [False, True]) {all dead. Unit} (/\dead -> Unit) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsData obsScriptCred wdrlAtOne) True False) + (case Bool (equalsData obsScriptCred wdrlAtOne) [False, True]) {all dead. Unit} (/\dead -> Unit) (/\dead -> @@ -71,11 +71,10 @@ in in go) (\(x : pair data data) -> - ifThenElse - {Bool} + case + Bool (equalsData obsScriptCred (fstPair {data} {data} x)) - True - False) + [False, True]) rest) {all dead. Unit} (/\dead -> Unit) diff --git a/plutus-benchmark/script-contexts/test/V2/9.6/dataFwdStakeTrick.uplc.golden b/plutus-benchmark/script-contexts/test/V2/9.6/dataFwdStakeTrick.uplc.golden index 4d859a4c39c..340884f9e60 100644 --- a/plutus-benchmark/script-contexts/test/V2/9.6/dataFwdStakeTrick.uplc.golden +++ b/plutus-benchmark/script-contexts/test/V2/9.6/dataFwdStakeTrick.uplc.golden @@ -1,53 +1,59 @@ (program 1.1.0 - (\obsScriptCred ctx -> + (\obsScriptCred + ctx -> (\ds -> (\wdrlAtZero -> (\rest -> (\wdrlAtOne -> force - (force ifThenElse + (case (equalsData obsScriptCred wdrlAtZero) - (delay (constr 0 [])) - (delay - (force - (force ifThenElse - (equalsData obsScriptCred wdrlAtOne) - (delay (constr 0 [])) - (delay - (force - (case - ((\s -> s s) - (\s xs -> - force - (force (force chooseList) - xs - (delay (constr 1 [])) - (delay - (force - (force ifThenElse - (equalsData - obsScriptCred - (force - (force - fstPair) - (force - headList - xs))) - (delay - (constr 0 [])) - (delay - ((\x -> s s x) - (force - tailList - xs)))))))) - rest) - [ (delay (constr 0 [])) - , (delay - ((\x -> error) - (force trace - "not found" - (constr 0 [])))) ])))))))) + [ (delay + (force + (case + (equalsData obsScriptCred wdrlAtOne) + [ (delay + (force + (case + ((\s -> + s s) + (\s + xs -> + force + (force + (force chooseList) + xs + (delay (constr 1 [])) + (delay + (force + (case + (equalsData + obsScriptCred + (force + (force + fstPair) + (force + headList + xs))) + [ (delay + ((\x -> + s s x) + (force + tailList + xs))) + , (delay + (constr 0 + [ ])) ]))))) + rest) + [ (delay (constr 0 [])) + , (delay + ((\x -> error) + (force trace + "not found" + (constr 0 [])))) ]))) + , (delay (constr 0 [])) ]))) + , (delay (constr 0 [])) ])) (force (force fstPair) (force headList rest))) (force tailList ds)) (force (force fstPair) (force headList ds))) diff --git a/plutus-benchmark/script-contexts/test/V2/9.6/dataFwdStakeTrickManual.eval.golden b/plutus-benchmark/script-contexts/test/V2/9.6/dataFwdStakeTrickManual.eval.golden index 82644c559cf..e7ec88a5471 100644 --- a/plutus-benchmark/script-contexts/test/V2/9.6/dataFwdStakeTrickManual.eval.golden +++ b/plutus-benchmark/script-contexts/test/V2/9.6/dataFwdStakeTrickManual.eval.golden @@ -1,5 +1,5 @@ -CPU: 6_082_120 -Memory: 12_080 -Size: 186 +CPU: 5_770_022 +Memory: 11_078 +Size: 174 (constr 0) \ No newline at end of file diff --git a/plutus-benchmark/script-contexts/test/V2/9.6/dataFwdStakeTrickManual.pir.golden b/plutus-benchmark/script-contexts/test/V2/9.6/dataFwdStakeTrickManual.pir.golden index 0c0bb1acee3..dda85fd0708 100644 --- a/plutus-benchmark/script-contexts/test/V2/9.6/dataFwdStakeTrickManual.pir.golden +++ b/plutus-benchmark/script-contexts/test/V2/9.6/dataFwdStakeTrickManual.pir.golden @@ -10,11 +10,10 @@ in !lookForCred : pair data data -> list (pair data data) -> Unit = \(p : pair data data) (tl : list (pair data data)) -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsData r_stake_cred (fstPair {data} {data} p)) - True - False) + [False, True]) {all dead. Unit} (/\dead -> Unit) (/\dead -> lookForCred tl) @@ -82,12 +81,12 @@ in !wdrlAtOne : data = fstPair {data} {data} (headList {pair data data} rest) in Bool_match - (ifThenElse {Bool} (equalsData r_stake_cred wdrlAtZero) True False) + (case Bool (equalsData r_stake_cred wdrlAtZero) [False, True]) {all dead. Unit} (/\dead -> Unit) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsData r_stake_cred wdrlAtOne) True False) + (case Bool (equalsData r_stake_cred wdrlAtOne) [False, True]) {all dead. Unit} (/\dead -> Unit) (/\dead -> lookForCred rest) diff --git a/plutus-benchmark/script-contexts/test/V2/9.6/dataFwdStakeTrickManual.uplc.golden b/plutus-benchmark/script-contexts/test/V2/9.6/dataFwdStakeTrickManual.uplc.golden index ab723fb2178..0e6d6c28ad4 100644 --- a/plutus-benchmark/script-contexts/test/V2/9.6/dataFwdStakeTrickManual.uplc.golden +++ b/plutus-benchmark/script-contexts/test/V2/9.6/dataFwdStakeTrickManual.uplc.golden @@ -10,16 +10,17 @@ (\rest -> (\wdrlAtOne -> force - (force ifThenElse + (case (equalsData r_stake_cred wdrlAtZero) - (delay (constr 0 [])) - (delay - (force - (force ifThenElse - (equalsData r_stake_cred wdrlAtOne) - (delay (constr 0 [])) - (delay - (force lookForCred rest))))))) + [ (delay + (force + (case + (equalsData + r_stake_cred + wdrlAtOne) + [ (delay (force lookForCred rest)) + , (delay (constr 0 [])) ]))) + , (delay (constr 0 [])) ])) (force (force fstPair) (force headList rest))) (force tailList wdrl)) (force (force fstPair) (force headList wdrl))) @@ -72,11 +73,10 @@ (constr 0 []))) (\p tl -> force - (force ifThenElse + (case (equalsData r_stake_cred (force (force fstPair) p)) - (delay (constr 0 [])) - (delay - (force (lookForCred (delay (\x -> x))) - tl)))))))))) \ No newline at end of file + [ (delay + (force (lookForCred (delay (\x -> x))) tl)) + , (delay (constr 0 [])) ])))))))) \ No newline at end of file diff --git a/plutus-benchmark/script-contexts/test/V2/9.6/sopFwdStakeTrick.eval.golden b/plutus-benchmark/script-contexts/test/V2/9.6/sopFwdStakeTrick.eval.golden index 12547e58d09..17ad564e739 100644 --- a/plutus-benchmark/script-contexts/test/V2/9.6/sopFwdStakeTrick.eval.golden +++ b/plutus-benchmark/script-contexts/test/V2/9.6/sopFwdStakeTrick.eval.golden @@ -1,5 +1,5 @@ -CPU: 364_372_993 -Memory: 1_352_932 -Size: 1_861 +CPU: 335_371_977 +Memory: 1_258_948 +Size: 1_699 (constr 0) \ No newline at end of file diff --git a/plutus-benchmark/script-contexts/test/V2/9.6/sopFwdStakeTrick.pir.golden b/plutus-benchmark/script-contexts/test/V2/9.6/sopFwdStakeTrick.pir.golden index df9b41312e9..b60f09d175c 100644 --- a/plutus-benchmark/script-contexts/test/V2/9.6/sopFwdStakeTrick.pir.golden +++ b/plutus-benchmark/script-contexts/test/V2/9.6/sopFwdStakeTrick.pir.golden @@ -2,9 +2,6 @@ let data Bool | Bool_match where True : Bool False : Bool - !equalsByteString : bytestring -> bytestring -> Bool - = \(x : bytestring) (y : bytestring) -> - ifThenElse {Bool} (equalsByteString x y) True False data Credential | Credential_match where PubKeyCredential : bytestring -> Credential ScriptCredential : bytestring -> Credential @@ -28,14 +25,16 @@ let Credential_match r {Bool} - (\(r : bytestring) -> equalsByteString l r) + (\(r : bytestring) -> + case Bool (equalsByteString l r) [False, True]) (\(ipv : bytestring) -> False)) (\(a : bytestring) -> Credential_match r {Bool} (\(ipv : bytestring) -> False) - (\(a' : bytestring) -> equalsByteString a a'))) + (\(a' : bytestring) -> + case Bool (equalsByteString a a') [False, True]))) (\(ipv : integer) (ipv : integer) (ipv : integer) -> False)) (\(a : integer) (b : integer) (c : integer) -> StakingCredential_match @@ -44,14 +43,14 @@ let (\(ipv : Credential) -> False) (\(a' : integer) (b' : integer) (c' : integer) -> Bool_match - (ifThenElse {Bool} (equalsInteger a a') True False) + (case Bool (equalsInteger a a') [False, True]) {all dead. Bool} (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger b b') True False) + (case Bool (equalsInteger b b') [False, True]) {all dead. Bool} (/\dead -> - ifThenElse {Bool} (equalsInteger c c') True False) + case Bool (equalsInteger c c') [False, True]) (/\dead -> False) {all dead. dead}) (/\dead -> False) @@ -71,12 +70,12 @@ let !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. Bool} (/\dead -> False) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 1 index) True False) + (case Bool (equalsInteger 1 index) [False, True]) {all dead. Bool} (/\dead -> True) (/\dead -> traceError {Bool} "PT1") @@ -96,18 +95,18 @@ let !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. Extended a} (/\dead -> NegInf {a}) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 1 index) True False) + (case Bool (equalsInteger 1 index) [False, True]) {all dead. Extended a} (/\dead -> Finite {a} (`$dUnsafeFromData` (headList {data} args))) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 2 index) True False) + (case Bool (equalsInteger 2 index) [False, True]) {all dead. Extended a} (/\dead -> PosInf {a}) (/\dead -> traceError {Extended a} "PT1") @@ -122,12 +121,12 @@ let !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. Credential} (/\dead -> PubKeyCredential (unBData (headList {data} args))) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 1 index) True False) + (case Bool (equalsInteger 1 index) [False, True]) {all dead. Credential} (/\dead -> ScriptCredential (unBData (headList {data} args))) (/\dead -> traceError {Credential} "PT1") @@ -142,7 +141,7 @@ let !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. StakingCredential} (/\dead -> StakingHash @@ -150,7 +149,7 @@ let (headList {data} args))) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 1 index) True False) + (case Bool (equalsInteger 1 index) [False, True]) {all dead. StakingCredential} (/\dead -> let @@ -180,7 +179,7 @@ let !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. DCert} (/\dead -> DCertDelegRegKey @@ -188,7 +187,7 @@ let (headList {data} args))) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 1 index) True False) + (case Bool (equalsInteger 1 index) [False, True]) {all dead. DCert} (/\dead -> DCertDelegDeRegKey @@ -196,7 +195,7 @@ let (headList {data} args))) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 2 index) True False) + (case Bool (equalsInteger 2 index) [False, True]) {all dead. DCert} (/\dead -> DCertDelegDelegate @@ -205,7 +204,7 @@ let (unBData (headList {data} (tailList {data} args)))) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 3 index) True False) + (case Bool (equalsInteger 3 index) [False, True]) {all dead. DCert} (/\dead -> DCertPoolRegister @@ -214,11 +213,7 @@ let (headList {data} (tailList {data} args)))) (/\dead -> Bool_match - (ifThenElse - {Bool} - (equalsInteger 4 index) - True - False) + (case Bool (equalsInteger 4 index) [False, True]) {all dead. DCert} (/\dead -> DCertPoolRetire @@ -227,20 +222,18 @@ let (headList {data} (tailList {data} args)))) (/\dead -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 5 index) - True - False) + [False, True]) {all dead. DCert} (/\dead -> DCertGenesis) (/\dead -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 6 index) - True - False) + [False, True]) {all dead. DCert} (/\dead -> DCertMir) (/\dead -> traceError {DCert} "PT1") @@ -259,7 +252,7 @@ let !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. bytestring} (/\dead -> unBData (headList {data} args)) (/\dead -> traceError {bytestring} "PT1") @@ -274,7 +267,7 @@ let !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. TxOutRef} (/\dead -> TxOutRef @@ -297,12 +290,12 @@ let !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. ScriptPurpose} (/\dead -> Minting (unBData (headList {data} args))) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 1 index) True False) + (case Bool (equalsInteger 1 index) [False, True]) {all dead. ScriptPurpose} (/\dead -> Spending @@ -310,7 +303,7 @@ let (headList {data} args))) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 2 index) True False) + (case Bool (equalsInteger 2 index) [False, True]) {all dead. ScriptPurpose} (/\dead -> Rewarding @@ -318,7 +311,7 @@ let (headList {data} args))) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 3 index) True False) + (case Bool (equalsInteger 3 index) [False, True]) {all dead. ScriptPurpose} (/\dead -> Certifying @@ -342,12 +335,12 @@ let !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 1 index) True False) + (case Bool (equalsInteger 1 index) [False, True]) {all dead. Maybe a} (/\dead -> Nothing {a}) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. Maybe a} (/\dead -> Just {a} (`$dUnsafeFromData` (headList {data} args))) @@ -431,7 +424,7 @@ let !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. TxOut} (/\dead -> let @@ -446,7 +439,7 @@ let !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. Address} (/\dead -> Address @@ -471,22 +464,18 @@ let !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. OutputDatum} (/\dead -> NoOutputDatum) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 1 index) True False) + (case Bool (equalsInteger 1 index) [False, True]) {all dead. OutputDatum} (/\dead -> OutputDatumHash (unBData (headList {data} args))) (/\dead -> Bool_match - (ifThenElse - {Bool} - (equalsInteger 2 index) - True - False) + (case Bool (equalsInteger 2 index) [False, True]) {all dead. OutputDatum} (/\dead -> OutputDatum (headList {data} args)) (/\dead -> traceError {OutputDatum} "PT1") @@ -509,7 +498,7 @@ let !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. TxInInfo} (/\dead -> TxInInfo @@ -556,7 +545,7 @@ in !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. ScriptContext} (/\dead -> ScriptContext @@ -567,7 +556,7 @@ in !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. TxInfo} (/\dead -> let @@ -680,7 +669,7 @@ in !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. Interval integer} (/\dead -> Interval @@ -692,11 +681,7 @@ in !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse - {Bool} - (equalsInteger 0 index) - True - False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. LowerBound integer} (/\dead -> LowerBound @@ -717,11 +702,7 @@ in !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse - {Bool} - (equalsInteger 0 index) - True - False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. UpperBound integer} (/\dead -> UpperBound diff --git a/plutus-benchmark/script-contexts/test/V2/9.6/sopFwdStakeTrick.uplc.golden b/plutus-benchmark/script-contexts/test/V2/9.6/sopFwdStakeTrick.uplc.golden index f963b2db107..785f1b1ae4f 100644 --- a/plutus-benchmark/script-contexts/test/V2/9.6/sopFwdStakeTrick.uplc.golden +++ b/plutus-benchmark/script-contexts/test/V2/9.6/sopFwdStakeTrick.uplc.golden @@ -20,557 +20,546 @@ (\index -> (\args -> force - (force - ifThenElse + (case (equalsInteger 0 index) - (delay - (constr 0 - [ ((\tup -> - (\index -> - (\args -> - force - (force - ifThenElse - (equalsInteger - 0 - index) - (delay - ((\l -> - (\l -> - (\l -> - (\l -> - (\l -> - (\l -> - (\l -> - (\l -> - (\l -> - (\l -> - (\`$fUnsafeFromDataMap_$cunsafeFromBuiltinData` -> - (\cse -> - (\cse -> - (\`$fUnsafeFromDataTxOut_$cunsafeFromBuiltinData` -> - (\`$fUnsafeFromDataScriptContext_$cunsafeFromBuiltinData` -> - (\arg_0 - arg_1 - arg_2 - arg_3 - arg_4 - arg_5 - arg_6 - arg_7 - arg_8 - arg_9 - arg_10 - arg_11 -> - constr 0 - [ arg_0 - , arg_1 - , arg_2 - , arg_3 - , arg_4 - , arg_5 - , arg_6 - , arg_7 - , arg_8 - , arg_9 - , arg_10 - , arg_11 ]) - ((\d -> - (\s -> - s - s) - (\s -> - caseList' - (constr 0 - [ ]) - (\x - xs -> - constr 1 - [ (`$fUnsafeFromDataScriptContext_$cunsafeFromBuiltinData` - x) - , (s - s - xs) ])) - (unListData - d)) - (force - headList - args)) - ((\d -> - (\s -> - s - s) - (\s -> - caseList' - (constr 0 - [ ]) - (\x - xs -> - constr 1 - [ (`$fUnsafeFromDataScriptContext_$cunsafeFromBuiltinData` - x) - , (s - s - xs) ])) - (unListData + [ (delay + (traceError + "PT1")) + , (delay + (constr 0 + [ ((\tup -> + (\index -> + (\args -> + force + (case + (equalsInteger + 0 + index) + [ (delay + (traceError + "PT1")) + , (delay + ((\l -> + (\l -> + (\l -> + (\l -> + (\l -> + (\l -> + (\l -> + (\l -> + (\l -> + (\l -> + (\`$fUnsafeFromDataMap_$cunsafeFromBuiltinData` -> + (\cse -> + (\cse -> + (\`$fUnsafeFromDataTxOut_$cunsafeFromBuiltinData` -> + (\`$fUnsafeFromDataScriptContext_$cunsafeFromBuiltinData` -> + (\arg_0 + arg_1 + arg_2 + arg_3 + arg_4 + arg_5 + arg_6 + arg_7 + arg_8 + arg_9 + arg_10 + arg_11 -> + constr 0 + [ arg_0 + , arg_1 + , arg_2 + , arg_3 + , arg_4 + , arg_5 + , arg_6 + , arg_7 + , arg_8 + , arg_9 + , arg_10 + , arg_11 ]) + ((\d -> + (\s -> + s + s) + (\s -> + caseList' + (constr 0 + [ ]) + (\x + xs -> + constr 1 + [ (`$fUnsafeFromDataScriptContext_$cunsafeFromBuiltinData` + x) + , (s + s + xs) ])) + (unListData + d)) + (force + headList + args)) + ((\d -> + (\s -> + s + s) + (\s -> + caseList' + (constr 0 + [ ]) + (\x + xs -> + constr 1 + [ (`$fUnsafeFromDataScriptContext_$cunsafeFromBuiltinData` + x) + , (s + s + xs) ])) + (unListData + d)) + (force + headList + l))) + (\d -> + (\tup -> + (\index -> + (\args -> + force + (case + (equalsInteger + 0 + index) + [ (delay + (traceError + "PT1")) + , (delay + (constr 0 + [ (`$fUnsafeFromDataTxOutRef_$cunsafeFromBuiltinData` + (force + headList + args)) + , (`$fUnsafeFromDataTxOut_$cunsafeFromBuiltinData` + (force + headList + (force + tailList + args))) ])) ])) + (force + (force + sndPair) + tup)) + (force + (force + fstPair) + tup)) + (unConstrData d)) - (force - headList - l))) - (\d -> - (\tup -> - (\index -> - (\args -> - force - (force - ifThenElse - (equalsInteger - 0 - index) - (delay - (constr 0 - [ (`$fUnsafeFromDataTxOutRef_$cunsafeFromBuiltinData` - (force - headList - args)) - , (`$fUnsafeFromDataTxOut_$cunsafeFromBuiltinData` - (force - headList - (force - tailList - args))) ])) - (delay - (traceError - "PT1")))) - (force - (force - sndPair) - tup)) - (force - (force - fstPair) - tup)) - (unConstrData - d)) - ((\d -> - (\s -> - s - s) - (\s -> - caseList' - (constr 0 - [ ]) - (\x - xs -> - constr 1 - [ (`$fUnsafeFromDataTxOut_$cunsafeFromBuiltinData` - x) - , (s - s - xs) ])) - (unListData - d)) - (force - headList - l))) - (\eta -> - (\tup -> - (\index -> - (\args -> - force - (force - ifThenElse - (equalsInteger - 0 - index) - (delay - ((\l -> - (\l -> - constr 0 - [ ((\tup -> - (\index -> - (\args -> - force + ((\d -> + (\s -> + s + s) + (\s -> + caseList' + (constr 0 + [ ]) + (\x + xs -> + constr 1 + [ (`$fUnsafeFromDataTxOut_$cunsafeFromBuiltinData` + x) + , (s + s + xs) ])) + (unListData + d)) + (force + headList + l))) + (\eta -> + (\tup -> + (\index -> + (\args -> + force + (case + (equalsInteger + 0 + index) + [ (delay + (traceError + "PT1")) + , (delay + ((\l -> + (\l -> + constr 0 + [ ((\tup -> + (\index -> + (\args -> + force + (case + (equalsInteger + 0 + index) + [ (delay + (traceError + "PT1")) + , (delay + (constr 0 + [ (`$fUnsafeFromDataCredential_$cunsafeFromBuiltinData` + (force + headList + args)) + , (`$fUnsafeFromDataMaybe_$cunsafeFromBuiltinData` + `$fUnsafeFromDataStakingCredential_$cunsafeFromBuiltinData` + (force + headList + (force + tailList + args))) ])) ])) + (force + (force + sndPair) + tup)) + (force + (force + fstPair) + tup)) + (unConstrData + (force + headList + args))) + , (cse + (force + headList + l)) + , ((\tup -> + (\index -> + (\args -> + force + (case + (equalsInteger + 0 + index) + [ (delay + (force + (case + (equalsInteger + 1 + index) + [ (delay + (force + (case + (equalsInteger + 2 + index) + [ (delay + (traceError + "PT1")) + , (delay + (constr 1 + [ (force + headList + args) ])) ]))) + , (delay + (constr 2 + [ (unBData + (force + headList + args)) ])) ]))) + , (delay + (constr 0 + [ ])) ])) + (force + (force + sndPair) + tup)) + (force + (force + fstPair) + tup)) + (unConstrData (force - ifThenElse - (equalsInteger - 0 - index) - (delay + headList + l))) + , (`$fUnsafeFromDataMaybe_$cunsafeFromBuiltinData` + unBData + (force + headList + (force + tailList + l))) ]) + (force + tailList + l)) + (force + tailList + args))) ])) + (force + (force + sndPair) + tup)) + (force + (force + fstPair) + tup)) + (unConstrData + eta)) + (cse + (force + headList + l)) + (cse + (force + headList + l)) + ((\d -> + (\s -> + s + s) + (\s -> + caseList' + (constr 0 + [ ]) + (\x + xs -> + constr 1 + [ (`$fUnsafeFromDataDCert_$cunsafeFromBuiltinData` + x) + , (s + s + xs) ])) + (unListData + d)) + (force + headList + l)) + (`$fUnsafeFromDataMap_$cunsafeFromBuiltinData` + `$fUnsafeFromDataStakingCredential_$cunsafeFromBuiltinData` + unIData + (force + headList + l)) + ((\tup -> + (\index -> + (\args -> + force + (case + (equalsInteger + 0 + index) + [ (delay + (traceError + "PT1")) + , (delay + (constr 0 + [ ((\tup -> + (\index -> + (\args -> + force + (case + (equalsInteger + 0 + index) + [ (delay + (traceError + "PT1")) + , (delay (constr 0 - [ (`$fUnsafeFromDataCredential_$cunsafeFromBuiltinData` + [ (`$fUnsafeFromDataExtended_$cunsafeFromBuiltinData` + unIData (force headList args)) - , (`$fUnsafeFromDataMaybe_$cunsafeFromBuiltinData` - `$fUnsafeFromDataStakingCredential_$cunsafeFromBuiltinData` + , (`$fUnsafeFromDataBool_$cunsafeFromBuiltinData` (force headList (force tailList - args))) ])) - (delay - (traceError - "PT1")))) - (force - (force - sndPair) - tup)) - (force - (force - fstPair) - tup)) - (unConstrData - (force - headList - args))) - , (cse - (force - headList - l)) - , ((\tup -> - (\index -> - (\args -> - force - (force - ifThenElse - (equalsInteger - 0 - index) - (delay - (constr 0 - [ ])) - (delay - (force - (force - ifThenElse - (equalsInteger - 1 - index) - (delay - (constr 2 - [ (unBData - (force - headList - args)) ])) - (delay - (force - (force - ifThenElse - (equalsInteger - 2 - index) - (delay - (constr 1 - [ (force - headList - args) ])) - (delay - (traceError - "PT1")))))))))) - (force - (force - sndPair) - tup)) - (force - (force - fstPair) - tup)) - (unConstrData - (force - headList - l))) - , (`$fUnsafeFromDataMaybe_$cunsafeFromBuiltinData` - unBData - (force - headList - (force - tailList - l))) ]) - (force - tailList - l)) - (force - tailList - args))) - (delay - (traceError - "PT1")))) - (force - (force - sndPair) - tup)) - (force - (force - fstPair) - tup)) - (unConstrData - eta)) - (cse - (force - headList - l)) - (cse - (force - headList - l)) - ((\d -> - (\s -> - s - s) - (\s -> - caseList' - (constr 0 - [ ]) - (\x - xs -> - constr 1 - [ (`$fUnsafeFromDataDCert_$cunsafeFromBuiltinData` - x) - , (s - s - xs) ])) - (unListData - d)) - (force - headList - l)) - (`$fUnsafeFromDataMap_$cunsafeFromBuiltinData` - `$fUnsafeFromDataStakingCredential_$cunsafeFromBuiltinData` - unIData - (force - headList - l)) - ((\tup -> - (\index -> - (\args -> - force - (force - ifThenElse - (equalsInteger - 0 - index) - (delay - (constr 0 - [ ((\tup -> - (\index -> - (\args -> - force + args))) ])) ])) + (force + (force + sndPair) + tup)) (force - ifThenElse - (equalsInteger - 0 - index) - (delay - (constr 0 - [ (`$fUnsafeFromDataExtended_$cunsafeFromBuiltinData` - unIData - (force - headList - args)) - , (`$fUnsafeFromDataBool_$cunsafeFromBuiltinData` - (force - headList - (force - tailList - args))) ])) - (delay - (traceError - "PT1")))) - (force + (force + fstPair) + tup)) + (unConstrData (force - sndPair) - tup)) - (force - (force - fstPair) - tup)) - (unConstrData - (force - headList - args))) - , ((\tup -> - (\index -> - (\args -> - force + headList + args))) + , ((\tup -> + (\index -> + (\args -> + force + (case + (equalsInteger + 0 + index) + [ (delay + (traceError + "PT1")) + , (delay + (constr 0 + [ (`$fUnsafeFromDataExtended_$cunsafeFromBuiltinData` + unIData + (force + headList + args)) + , (`$fUnsafeFromDataBool_$cunsafeFromBuiltinData` + (force + headList + (force + tailList + args))) ])) ])) + (force + (force + sndPair) + tup)) (force - ifThenElse - (equalsInteger - 0 - index) - (delay - (constr 0 - [ (`$fUnsafeFromDataExtended_$cunsafeFromBuiltinData` - unIData - (force - headList - args)) - , (`$fUnsafeFromDataBool_$cunsafeFromBuiltinData` - (force - headList - (force - tailList - args))) ])) - (delay - (traceError - "PT1")))) - (force + (force + fstPair) + tup)) + (unConstrData (force - sndPair) - tup)) - (force - (force - fstPair) - tup)) - (unConstrData - (force - headList - (force - tailList - args)))) ])) - (delay - (traceError - "PT1")))) - (force - (force - sndPair) - tup)) - (force - (force - fstPair) - tup)) - (unConstrData - (force - headList - l))) - ((\d -> - (\s -> - s - s) - (\s -> - caseList' - (constr 0 - [ ]) - (\x - xs -> - constr 1 - [ (unBData - x) - , (s - s - xs) ])) - (unListData - d)) - (force - headList - l)) - (`$fUnsafeFromDataMap_$cunsafeFromBuiltinData` - `$fUnsafeFromDataScriptContext_$cunsafeFromBuiltinData` - `$fUnsafeFromDataBuiltinData_$cunsafeFromBuiltinData` - (force - headList - l)) - (cse - `$fUnsafeFromDataBuiltinData_$cunsafeFromBuiltinData` - (force - headList - l))) - (cse - (cse - unIData))) - (`$fUnsafeFromDataMap_$cunsafeFromBuiltinData` - unBData)) - (\`$dUnsafeFromData` - `$dUnsafeFromData` - d -> - (\s -> - s - s) - (\s -> - caseList' - (constr 0 - [ ]) - (\tup - tups -> - constr 1 - [ (constr 0 - [ (`$dUnsafeFromData` + headList + (force + tailList + args)))) ])) ])) + (force (force - (force - fstPair) - tup)) - , (`$dUnsafeFromData` - (force - (force - sndPair) - tup)) ]) - , (s + sndPair) + tup)) + (force + (force + fstPair) + tup)) + (unConstrData + (force + headList + l))) + ((\d -> + (\s -> s - tups) ])) - (unMapData - d)) - (`$fUnsafeFromDataTxId_$cunsafeFromBuiltinData` - (force - headList - (force - tailList - l)))) - (force - tailList - l)) - (force - tailList - l)) - (force - tailList - l)) - (force - tailList - l)) - (force - tailList - l)) - (force - tailList - l)) - (force - tailList - l)) - (force - tailList - l)) - (force - tailList - l)) - (force - tailList - args))) - (delay - (traceError - "PT1")))) - (force - (force - sndPair) - tup)) - (force - (force - fstPair) - tup)) - (unConstrData - (force - headList - args))) - , (`$fUnsafeFromDataScriptContext_$cunsafeFromBuiltinData` - (force - headList - (force - tailList - args))) ])) - (delay - (traceError - "PT1")))) + s) + (\s -> + caseList' + (constr 0 + [ ]) + (\x + xs -> + constr 1 + [ (unBData + x) + , (s + s + xs) ])) + (unListData + d)) + (force + headList + l)) + (`$fUnsafeFromDataMap_$cunsafeFromBuiltinData` + `$fUnsafeFromDataScriptContext_$cunsafeFromBuiltinData` + `$fUnsafeFromDataBuiltinData_$cunsafeFromBuiltinData` + (force + headList + l)) + (cse + `$fUnsafeFromDataBuiltinData_$cunsafeFromBuiltinData` + (force + headList + l))) + (cse + (cse + unIData))) + (`$fUnsafeFromDataMap_$cunsafeFromBuiltinData` + unBData)) + (\`$dUnsafeFromData` + `$dUnsafeFromData` + d -> + (\s -> + s + s) + (\s -> + caseList' + (constr 0 + [ ]) + (\tup + tups -> + constr 1 + [ (constr 0 + [ (`$dUnsafeFromData` + (force + (force + fstPair) + tup)) + , (`$dUnsafeFromData` + (force + (force + sndPair) + tup)) ]) + , (s + s + tups) ])) + (unMapData + d)) + (`$fUnsafeFromDataTxId_$cunsafeFromBuiltinData` + (force + headList + (force + tailList + l)))) + (force + tailList + l)) + (force + tailList + l)) + (force + tailList + l)) + (force + tailList + l)) + (force + tailList + l)) + (force + tailList + l)) + (force + tailList + l)) + (force + tailList + l)) + (force + tailList + l)) + (force + tailList + args))) ])) + (force + (force + sndPair) + tup)) + (force + (force + fstPair) + tup)) + (unConstrData + (force + headList + args))) + , (`$fUnsafeFromDataScriptContext_$cunsafeFromBuiltinData` + (force + headList + (force + tailList + args))) ])) ])) (force (force sndPair) tup)) (force (force fstPair) tup)) @@ -733,39 +722,38 @@ case ds [ (\r -> - (\equalsByteString -> - case - l - [ (\l -> - case - r - [ (\r -> - equalsByteString + case + l + [ (\l -> + case + r + [ (\r -> + case + (equalsByteString l r) - , (\ipv -> - constr 1 - [ ]) ]) - , (\a -> - case - r - [ (\ipv -> - constr 1 - [ ]) - , (\a' -> - equalsByteString + [ (constr 1 + [ ]) + , (constr 0 + [ ]) ]) + , (\ipv -> + constr 1 + [ ]) ]) + , (\a -> + case + r + [ (\ipv -> + constr 1 + []) + , (\a' -> + case + (equalsByteString a - a') ]) ]) - (\x - y -> - force - ifThenElse - (equalsByteString - x - y) - (constr 0 []) - (constr 1 - []))) + a') + [ (constr 1 + [ ]) + , (constr 0 + [ ]) ]) ]) ]) , (\ipv ipv ipv -> constr 1 []) ]) , (\a @@ -778,54 +766,52 @@ b' c' -> force - (force - ifThenElse + (case (equalsInteger a a') - (delay - (force - (force - ifThenElse - (equalsInteger - b - b') - (delay - (force - ifThenElse - (equalsInteger - c - c') - (constr 0 - [ ]) - (constr 1 - [ ]))) - (delay - (constr 1 - [ ]))))) - (delay - (constr 1 - [ ])))) ]) ])) + [ (delay + (constr 1 + [])) + , (delay + (force + (case + (equalsInteger + b + b') + [ (delay + (constr 1 + [ ])) + , (delay + (case + (equalsInteger + c + c') + [ (constr 1 + [ ]) + , (constr 0 + [ ]) ])) ]))) ])) ]) ])) (\d -> d)) (\d -> (\tup -> (\index -> (\args -> force - (force ifThenElse + (case (equalsInteger 0 index) - (delay (constr 1 [])) - (delay - (force - (force ifThenElse - (equalsInteger - 1 - index) - (delay - (constr 0 [])) - (delay - (traceError - "PT1"))))))) + [ (delay + (force + (case + (equalsInteger + 1 + index) + [ (delay + (traceError + "PT1")) + , (delay + (constr 0 + [ ])) ]))) + , (delay (constr 1 [])) ])) (force (force sndPair) tup)) (force (force fstPair) tup)) (unConstrData d))) @@ -835,36 +821,33 @@ (\index -> (\args -> force - (force - ifThenElse + (case (equalsInteger 0 index) - (delay (constr 1 [])) - (delay - (force - (force - ifThenElse - (equalsInteger - 1 - index) - (delay - (constr 0 - [ (`$dUnsafeFromData` - (force - headList - args)) ])) - (delay - (force - (force - ifThenElse - (equalsInteger - 2 - index) - (delay - (constr 2 - [])) - (delay - (traceError - "PT1")))))))))) + [ (delay + (force + (case + (equalsInteger + 1 + index) + [ (delay + (force + (case + (equalsInteger + 2 + index) + [ (delay + (traceError + "PT1")) + , (delay + (constr 2 + [ ])) ]))) + , (delay + (constr 0 + [ (`$dUnsafeFromData` + (force + headList + args)) ])) ]))) + , (delay (constr 1 [])) ])) (force (force sndPair) tup)) (force (force fstPair) tup)) (unConstrData d))) @@ -873,54 +856,52 @@ (\index -> (\args -> force - (force - ifThenElse + (case (equalsInteger 0 index) - (delay - (constr 1 - [ (unBData - (force headList - args)) ])) - (delay - (force - (force - ifThenElse - (equalsInteger 1 index) - (delay - (constr 3 - [ (`$fUnsafeFromDataTxOutRef_$cunsafeFromBuiltinData` - (force - headList - args)) ])) - (delay - (force - (force - ifThenElse - (equalsInteger - 2 - index) - (delay - (constr 2 - [ (`$fUnsafeFromDataStakingCredential_$cunsafeFromBuiltinData` - (force - headList - args)) ])) - (delay - (force + [ (delay + (force + (case + (equalsInteger + 1 + index) + [ (delay + (force + (case + (equalsInteger + 2 + index) + [ (delay + (force + (case + (equalsInteger + 3 + index) + [ (delay + (traceError + "PT1")) + , (delay + (constr 0 + [ (`$fUnsafeFromDataDCert_$cunsafeFromBuiltinData` + (force + headList + args)) ])) ]))) + , (delay + (constr 2 + [ (`$fUnsafeFromDataStakingCredential_$cunsafeFromBuiltinData` + (force + headList + args)) ])) ]))) + , (delay + (constr 3 + [ (`$fUnsafeFromDataTxOutRef_$cunsafeFromBuiltinData` (force - ifThenElse - (equalsInteger - 3 - index) - (delay - (constr 0 - [ (`$fUnsafeFromDataDCert_$cunsafeFromBuiltinData` - (force - headList - args)) ])) - (delay - (traceError - "PT1"))))))))))))) + headList + args)) ])) ]))) + , (delay + (constr 1 + [ (unBData + (force headList + args)) ])) ])) (force (force sndPair) tup)) (force (force fstPair) tup)) (unConstrData d))) @@ -929,104 +910,98 @@ (\index -> (\args -> force - (force - ifThenElse + (case (equalsInteger 0 index) - (delay - (constr 2 - [ (`$fUnsafeFromDataStakingCredential_$cunsafeFromBuiltinData` - (force headList - args)) ])) - (delay - (force - (force - ifThenElse - (equalsInteger 1 index) - (delay - (constr 0 - [ (`$fUnsafeFromDataStakingCredential_$cunsafeFromBuiltinData` - (force headList - args)) ])) - (delay - (force - (force - ifThenElse - (equalsInteger - 2 - index) - (delay - (constr 1 - [ (`$fUnsafeFromDataStakingCredential_$cunsafeFromBuiltinData` - (force - headList - args)) - , (unBData - (force - headList - (force - tailList - args))) ])) - (delay - (force - (force - ifThenElse - (equalsInteger - 3 - index) - (delay - (constr 5 - [ (unBData + [ (delay + (force + (case + (equalsInteger 1 index) + [ (delay + (force + (case + (equalsInteger + 2 + index) + [ (delay + (force + (case + (equalsInteger + 3 + index) + [ (delay (force - headList - args)) - , (unBData + (case + (equalsInteger + 4 + index) + [ (delay + (force + (case + (equalsInteger + 5 + index) + [ (delay + (force + (case + (equalsInteger + 6 + index) + [ (delay + (traceError + "PT1")) + , (delay + (constr 4 + [ ])) ]))) + , (delay + (constr 3 + [ ])) ]))) + , (delay + (constr 6 + [ (unBData + (force + headList + args)) + , (unIData + (force + headList + (force + tailList + args))) ])) ]))) + , (delay + (constr 5 + [ (unBData + (force + headList + args)) + , (unBData + (force + headList + (force + tailList + args))) ])) ]))) + , (delay + (constr 1 + [ (`$fUnsafeFromDataStakingCredential_$cunsafeFromBuiltinData` + (force + headList + args)) + , (unBData + (force + headList (force - headList - (force - tailList - args))) ])) - (delay - (force - (force - ifThenElse - (equalsInteger - 4 - index) - (delay - (constr 6 - [ (unBData - (force - headList - args)) - , (unIData - (force - headList - (force - tailList - args))) ])) - (delay - (force - (force - ifThenElse - (equalsInteger - 5 - index) - (delay - (constr 3 - [ ])) - (delay - (force - (force - ifThenElse - (equalsInteger - 6 - index) - (delay - (constr 4 - [ ])) - (delay - (traceError - "PT1")))))))))))))))))))))) + tailList + args))) ])) ]))) + , (delay + (constr 0 + [ (`$fUnsafeFromDataStakingCredential_$cunsafeFromBuiltinData` + (force + headList + args)) ])) ]))) + , (delay + (constr 2 + [ (`$fUnsafeFromDataStakingCredential_$cunsafeFromBuiltinData` + (force headList + args)) ])) ])) (force (force sndPair) tup)) (force (force fstPair) tup)) (unConstrData d))) @@ -1035,34 +1010,37 @@ (\index -> (\args -> force - (force - ifThenElse + (case (equalsInteger 0 index) - (delay - (constr 0 - [ (`$fUnsafeFromDataCredential_$cunsafeFromBuiltinData` - (force headList args)) ])) - (delay - (force - (force ifThenElse - (equalsInteger 1 index) - (delay - ((\l -> - constr 1 - [ (unIData - (force headList - args)) - , (unIData - (force headList - l)) - , (unIData - (force headList - (force - tailList - l))) ]) - (force tailList args))) - (delay - (traceError "PT1"))))))) + [ (delay + (force + (case + (equalsInteger 1 index) + [ (delay (traceError "PT1")) + , (delay + ((\l -> + constr 1 + [ (unIData + (force + headList + args)) + , (unIData + (force + headList + l)) + , (unIData + (force + headList + (force + tailList + l))) ]) + (force tailList + args))) ]))) + , (delay + (constr 0 + [ (`$fUnsafeFromDataCredential_$cunsafeFromBuiltinData` + (force headList + args)) ])) ])) (force (force sndPair) tup)) (force (force fstPair) tup)) (unConstrData d))) @@ -1071,21 +1049,23 @@ (\index -> (\args -> force - (force ifThenElse + (case (equalsInteger 0 index) - (delay - (constr 0 - [(unBData (force headList args))])) - (delay - (force - (force ifThenElse - (equalsInteger 1 index) - (delay - (constr 1 - [ (unBData - (force headList - args)) ])) - (delay (traceError "PT1"))))))) + [ (delay + (force + (case + (equalsInteger 1 index) + [ (delay (traceError "PT1")) + , (delay + (constr 1 + [ (unBData + (force headList + args)) ])) ]))) + , (delay + (constr 0 + [ (unBData + (force headList + args)) ])) ])) (force (force sndPair) tup)) (force (force fstPair) tup)) (unConstrData d))) @@ -1094,17 +1074,17 @@ (\index -> (\args -> force - (force - ifThenElse + (case (equalsInteger 0 index) - (delay - (constr 0 - [ (`$fUnsafeFromDataTxId_$cunsafeFromBuiltinData` - (force headList args)) - , (unIData - (force headList - (force tailList args))) ])) - (delay (traceError "PT1")))) + [ (delay (traceError "PT1")) + , (delay + (constr 0 + [ (`$fUnsafeFromDataTxId_$cunsafeFromBuiltinData` + (force headList args)) + , (unIData + (force headList + (force tailList + args))) ])) ])) (force (force sndPair) tup)) (force (force fstPair) tup)) (unConstrData d))) @@ -1113,10 +1093,10 @@ (\index -> (\args -> force - (force ifThenElse + (case (equalsInteger 0 index) - (delay (unBData (force headList args))) - (delay (traceError "PT1")))) + [ (delay (traceError "PT1")) + , (delay (unBData (force headList args))) ])) (force (force sndPair) tup)) (force (force fstPair) tup)) (unConstrData d))) @@ -1125,18 +1105,19 @@ (\index -> (\args -> force - (force ifThenElse + (case (equalsInteger 1 index) - (delay (constr 1 [])) - (delay - (force - (force ifThenElse - (equalsInteger 0 index) - (delay - (constr 0 - [ (`$dUnsafeFromData` - (force headList args)) ])) - (delay (traceError "PT1"))))))) + [ (delay + (force + (case + (equalsInteger 0 index) + [ (delay (traceError "PT1")) + , (delay + (constr 0 + [ (`$dUnsafeFromData` + (force headList + args)) ])) ]))) + , (delay (constr 1 [])) ])) (force (force sndPair) tup)) (force (force fstPair) tup)) (unConstrData d))) diff --git a/plutus-benchmark/script-contexts/test/V2/Data/9.6/checkScriptContext1-20.eval.golden b/plutus-benchmark/script-contexts/test/V2/Data/9.6/checkScriptContext1-20.eval.golden index 3ae5cb3089e..7dc6d854033 100644 --- a/plutus-benchmark/script-contexts/test/V2/Data/9.6/checkScriptContext1-20.eval.golden +++ b/plutus-benchmark/script-contexts/test/V2/Data/9.6/checkScriptContext1-20.eval.golden @@ -1,5 +1,5 @@ -CPU: 20_406_425 -Memory: 73_283 -Size: 99 +CPU: 20_250_376 +Memory: 72_782 +Size: 95 (constr 0) \ No newline at end of file diff --git a/plutus-benchmark/script-contexts/test/V2/Data/9.6/checkScriptContext1-4.eval.golden b/plutus-benchmark/script-contexts/test/V2/Data/9.6/checkScriptContext1-4.eval.golden index 02b633f2c12..d519bd7b44e 100644 --- a/plutus-benchmark/script-contexts/test/V2/Data/9.6/checkScriptContext1-4.eval.golden +++ b/plutus-benchmark/script-contexts/test/V2/Data/9.6/checkScriptContext1-4.eval.golden @@ -1,5 +1,5 @@ -CPU: 5_830_185 -Memory: 20_515 -Size: 99 +CPU: 5_674_136 +Memory: 20_014 +Size: 95 (constr 0) \ No newline at end of file diff --git a/plutus-benchmark/script-contexts/test/V2/Data/9.6/checkScriptContext1.pir.golden b/plutus-benchmark/script-contexts/test/V2/Data/9.6/checkScriptContext1.pir.golden index d4afbd20d72..e712dccca43 100644 --- a/plutus-benchmark/script-contexts/test/V2/Data/9.6/checkScriptContext1.pir.golden +++ b/plutus-benchmark/script-contexts/test/V2/Data/9.6/checkScriptContext1.pir.golden @@ -22,8 +22,8 @@ in \(d : data) -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 0 (modInteger @@ -95,11 +95,7 @@ = sndPair {integer} {list data} tup in Bool_match - (ifThenElse - {Bool} - (equalsInteger 0 index) - True - False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. bytestring} (/\dead -> unBData (headList {data} args)) (/\dead -> @@ -138,8 +134,7 @@ in go ds) 2)) - True - False) + [False, True]) {all dead. Unit} (/\dead -> Unit) (/\dead -> diff --git a/plutus-benchmark/script-contexts/test/V2/Data/9.6/checkScriptContext1.size.golden b/plutus-benchmark/script-contexts/test/V2/Data/9.6/checkScriptContext1.size.golden index d97edbb29fa..90be1cdd8ee 100644 --- a/plutus-benchmark/script-contexts/test/V2/Data/9.6/checkScriptContext1.size.golden +++ b/plutus-benchmark/script-contexts/test/V2/Data/9.6/checkScriptContext1.size.golden @@ -1 +1 @@ -99 \ No newline at end of file +95 \ No newline at end of file diff --git a/plutus-benchmark/script-contexts/test/V2/Data/9.6/checkScriptContextEqualityData-20.eval.golden b/plutus-benchmark/script-contexts/test/V2/Data/9.6/checkScriptContextEqualityData-20.eval.golden index 7043bca7bed..8b66dabe303 100644 --- a/plutus-benchmark/script-contexts/test/V2/Data/9.6/checkScriptContextEqualityData-20.eval.golden +++ b/plutus-benchmark/script-contexts/test/V2/Data/9.6/checkScriptContextEqualityData-20.eval.golden @@ -1,5 +1,5 @@ -CPU: 32_583_310 -Memory: 2_102 -Size: 29 +CPU: 32_427_261 +Memory: 1_601 +Size: 25 (constr 0) \ No newline at end of file diff --git a/plutus-benchmark/script-contexts/test/V3/9.6/checkScriptContext1-20.eval.golden b/plutus-benchmark/script-contexts/test/V3/9.6/checkScriptContext1-20.eval.golden index de126d9e9ce..47843d84835 100644 --- a/plutus-benchmark/script-contexts/test/V3/9.6/checkScriptContext1-20.eval.golden +++ b/plutus-benchmark/script-contexts/test/V3/9.6/checkScriptContext1-20.eval.golden @@ -1,5 +1,5 @@ -CPU: 293_286_695 -Memory: 1_101_629 -Size: 3_086 +CPU: 271_439_835 +Memory: 1_031_489 +Size: 2_790 (constr 0) \ No newline at end of file diff --git a/plutus-benchmark/script-contexts/test/V3/9.6/checkScriptContext1-4.eval.golden b/plutus-benchmark/script-contexts/test/V3/9.6/checkScriptContext1-4.eval.golden index 1c700e66f99..504706cdd32 100644 --- a/plutus-benchmark/script-contexts/test/V3/9.6/checkScriptContext1-4.eval.golden +++ b/plutus-benchmark/script-contexts/test/V3/9.6/checkScriptContext1-4.eval.golden @@ -1,5 +1,5 @@ -CPU: 86_172_279 -Memory: 330_205 -Size: 3_086 +CPU: 79_306_123 +Memory: 308_161 +Size: 2_790 (constr 0) \ No newline at end of file diff --git a/plutus-benchmark/script-contexts/test/V3/9.6/checkScriptContext1.pir.golden b/plutus-benchmark/script-contexts/test/V3/9.6/checkScriptContext1.pir.golden index 24194021d0d..7d0ac0355dd 100644 --- a/plutus-benchmark/script-contexts/test/V3/9.6/checkScriptContext1.pir.golden +++ b/plutus-benchmark/script-contexts/test/V3/9.6/checkScriptContext1.pir.golden @@ -62,12 +62,12 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. Bool} (/\dead -> False) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 1 index) True False) + (case Bool (equalsInteger 1 index) [False, True]) {all dead. Bool} (/\dead -> True) (/\dead -> traceError {Bool} "PT1") @@ -87,18 +87,18 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. Extended a} (/\dead -> NegInf {a}) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 1 index) True False) + (case Bool (equalsInteger 1 index) [False, True]) {all dead. Extended a} (/\dead -> Finite {a} (`$dUnsafeFromData` (headList {data} args))) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 2 index) True False) + (case Bool (equalsInteger 2 index) [False, True]) {all dead. Extended a} (/\dead -> PosInf {a}) (/\dead -> traceError {Extended a} "PT1") @@ -116,7 +116,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. GovernanceActionId} (/\dead -> GovernanceActionId @@ -156,12 +156,12 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. Credential} (/\dead -> PubKeyCredential (unBData (headList {data} args))) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 1 index) True False) + (case Bool (equalsInteger 1 index) [False, True]) {all dead. Credential} (/\dead -> ScriptCredential (unBData (headList {data} args))) (/\dead -> traceError {Credential} "PT1") @@ -177,12 +177,12 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 1 index) True False) + (case Bool (equalsInteger 1 index) [False, True]) {all dead. Maybe a} (/\dead -> Nothing {a}) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. Maybe a} (/\dead -> Just {a} (`$dUnsafeFromData` (headList {data} args))) @@ -247,7 +247,7 @@ !euclid : integer -> integer -> integer = \(x : integer) (y : integer) -> Bool_match - (ifThenElse {Bool} (equalsInteger 0 y) True False) + (case Bool (equalsInteger 0 y) [False, True]) {all dead. integer} (/\dead -> x) (/\dead -> euclid y (modInteger x y)) @@ -257,12 +257,12 @@ !unsafeRatio : integer -> integer -> Rational = \(n : integer) (d : integer) -> Bool_match - (ifThenElse {Bool} (equalsInteger 0 d) True False) + (case Bool (equalsInteger 0 d) [False, True]) {all dead. Rational} (/\dead -> traceError {Rational} "PT3") (/\dead -> Bool_match - (ifThenElse {Bool} (lessThanInteger d 0) True False) + (case Bool (lessThanInteger d 0) [False, True]) {all dead. Rational} (/\dead -> unsafeRatio (subtractInteger 0 n) (subtractInteger 0 d)) @@ -284,7 +284,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. ProposalProcedure} (/\dead -> let @@ -301,7 +301,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. GovernanceAction} (/\dead -> let @@ -319,7 +319,7 @@ (headList {data} (tailList {data} l)))) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 1 index) True False) + (case Bool (equalsInteger 1 index) [False, True]) {all dead. GovernanceAction} (/\dead -> HardForkInitiation @@ -337,11 +337,7 @@ = sndPair {integer} {list data} tup in Bool_match - (ifThenElse - {Bool} - (equalsInteger 0 index) - True - False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. ProtocolVersion} (/\dead -> ProtocolVersion @@ -354,11 +350,7 @@ {all dead. dead})) (/\dead -> Bool_match - (ifThenElse - {Bool} - (equalsInteger 2 index) - True - False) + (case Bool (equalsInteger 2 index) [False, True]) {all dead. GovernanceAction} (/\dead -> TreasuryWithdrawals @@ -374,11 +366,10 @@ (headList {data} (tailList {data} args)))) (/\dead -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 3 index) - True - False) + [False, True]) {all dead. GovernanceAction} (/\dead -> NoConfidence @@ -388,11 +379,10 @@ (headList {data} args))) (/\dead -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 4 index) - True - False) + [False, True]) {all dead. GovernanceAction} (/\dead -> let @@ -439,11 +429,10 @@ tup in Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 0 index) - True - False) + [False, True]) {all dead. Tuple2 integer integer} (/\dead -> @@ -468,11 +457,10 @@ unsafeRatio a b))) (/\dead -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 5 index) - True - False) + [False, True]) {all dead. GovernanceAction} (/\dead -> NewConstitution @@ -501,11 +489,10 @@ tup in Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 0 index) - True - False) + [False, True]) {all dead. Maybe bytestring} (/\dead -> `$fUnsafeFromDataMaybe_$cunsafeFromBuiltinData` @@ -519,11 +506,10 @@ {all dead. dead})) (/\dead -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 6 index) - True - False) + [False, True]) {all dead. GovernanceAction} (/\dead -> InfoAction) (/\dead -> @@ -551,7 +537,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. DRep} (/\dead -> DRep @@ -559,12 +545,12 @@ (headList {data} args))) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 1 index) True False) + (case Bool (equalsInteger 1 index) [False, True]) {all dead. DRep} (/\dead -> DRepAlwaysAbstain) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 2 index) True False) + (case Bool (equalsInteger 2 index) [False, True]) {all dead. DRep} (/\dead -> DRepAlwaysNoConfidence) (/\dead -> traceError {DRep} "PT1") @@ -583,12 +569,12 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. Delegatee} (/\dead -> DelegStake (unBData (headList {data} args))) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 1 index) True False) + (case Bool (equalsInteger 1 index) [False, True]) {all dead. Delegatee} (/\dead -> DelegVote @@ -596,7 +582,7 @@ (headList {data} args))) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 2 index) True False) + (case Bool (equalsInteger 2 index) [False, True]) {all dead. Delegatee} (/\dead -> DelegStakeVote @@ -628,7 +614,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. TxCert} (/\dead -> TxCertRegStaking @@ -640,7 +626,7 @@ (headList {data} (tailList {data} args)))) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 1 index) True False) + (case Bool (equalsInteger 1 index) [False, True]) {all dead. TxCert} (/\dead -> TxCertUnRegStaking @@ -652,7 +638,7 @@ (headList {data} (tailList {data} args)))) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 2 index) True False) + (case Bool (equalsInteger 2 index) [False, True]) {all dead. TxCert} (/\dead -> TxCertDelegStaking @@ -662,11 +648,7 @@ (headList {data} (tailList {data} args)))) (/\dead -> Bool_match - (ifThenElse - {Bool} - (equalsInteger 3 index) - True - False) + (case Bool (equalsInteger 3 index) [False, True]) {all dead. TxCert} (/\dead -> let @@ -680,11 +662,10 @@ (unIData (headList {data} (tailList {data} l)))) (/\dead -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 4 index) - True - False) + [False, True]) {all dead. TxCert} (/\dead -> TxCertRegDRep @@ -696,11 +677,10 @@ (tailList {data} args)))) (/\dead -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 5 index) - True - False) + [False, True]) {all dead. TxCert} (/\dead -> TxCertUpdateDRep @@ -708,11 +688,10 @@ (headList {data} args))) (/\dead -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 6 index) - True - False) + [False, True]) {all dead. TxCert} (/\dead -> TxCertUnRegDRep @@ -724,11 +703,10 @@ (tailList {data} args)))) (/\dead -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 7 index) - True - False) + [False, True]) {all dead. TxCert} (/\dead -> TxCertPoolRegister @@ -742,11 +720,10 @@ args)))) (/\dead -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 8 index) - True - False) + [False, True]) {all dead. TxCert} (/\dead -> TxCertPoolRetire @@ -762,13 +739,12 @@ args)))) (/\dead -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 9 index) - True - False) + [False, True]) {all dead. TxCert} (/\dead -> TxCertAuthHotCommittee @@ -784,13 +760,12 @@ args)))) (/\dead -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 10 index) - True - False) + [False, True]) {all dead. TxCert} (/\dead -> TxCertResignColdCommittee @@ -825,7 +800,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. Voter} (/\dead -> CommitteeVoter @@ -833,7 +808,7 @@ (headList {data} args))) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 1 index) True False) + (case Bool (equalsInteger 1 index) [False, True]) {all dead. Voter} (/\dead -> DRepVoter @@ -841,7 +816,7 @@ (headList {data} args))) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 2 index) True False) + (case Bool (equalsInteger 2 index) [False, True]) {all dead. Voter} (/\dead -> StakePoolVoter (unBData (headList {data} args))) @@ -859,7 +834,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. TxOutRef} (/\dead -> TxOutRef @@ -876,7 +851,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. TxOut} (/\dead -> let @@ -891,7 +866,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. Address} (/\dead -> Address @@ -908,11 +883,10 @@ = sndPair {integer} {list data} tup in Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 0 index) - True - False) + [False, True]) {all dead. StakingCredential} (/\dead -> StakingHash @@ -920,11 +894,10 @@ (headList {data} args))) (/\dead -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 1 index) - True - False) + [False, True]) {all dead. StakingCredential} (/\dead -> let @@ -961,22 +934,18 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. OutputDatum} (/\dead -> NoOutputDatum) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 1 index) True False) + (case Bool (equalsInteger 1 index) [False, True]) {all dead. OutputDatum} (/\dead -> OutputDatumHash (unBData (headList {data} args))) (/\dead -> Bool_match - (ifThenElse - {Bool} - (equalsInteger 2 index) - True - False) + (case Bool (equalsInteger 2 index) [False, True]) {all dead. OutputDatum} (/\dead -> OutputDatum (headList {data} args)) (/\dead -> traceError {OutputDatum} "PT1") @@ -999,7 +968,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. TxInInfo} (/\dead -> TxInInfo @@ -1067,7 +1036,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. ScriptContext} (/\dead -> let @@ -1081,7 +1050,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. TxInfo} (/\dead -> let @@ -1201,7 +1170,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. Interval integer} (/\dead -> Interval @@ -1215,11 +1184,7 @@ = sndPair {integer} {list data} tup in Bool_match - (ifThenElse - {Bool} - (equalsInteger 0 index) - True - False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. LowerBound integer} (/\dead -> LowerBound @@ -1242,11 +1207,7 @@ = sndPair {integer} {list data} tup in Bool_match - (ifThenElse - {Bool} - (equalsInteger 0 index) - True - False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. UpperBound integer} (/\dead -> UpperBound @@ -1276,20 +1237,15 @@ = sndPair {integer} {list data} tup in Bool_match - (ifThenElse - {Bool} - (equalsInteger 0 index) - True - False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. ScriptPurpose} (/\dead -> Minting (unBData (headList {data} args))) (/\dead -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 1 index) - True - False) + [False, True]) {all dead. ScriptPurpose} (/\dead -> Spending @@ -1297,11 +1253,10 @@ (headList {data} args))) (/\dead -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 2 index) - True - False) + [False, True]) {all dead. ScriptPurpose} (/\dead -> Rewarding @@ -1309,11 +1264,10 @@ (headList {data} args))) (/\dead -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 3 index) - True - False) + [False, True]) {all dead. ScriptPurpose} (/\dead -> Certifying @@ -1324,11 +1278,10 @@ (tailList {data} args)))) (/\dead -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 4 index) - True - False) + [False, True]) {all dead. ScriptPurpose} (/\dead -> Voting @@ -1336,11 +1289,10 @@ (headList {data} args))) (/\dead -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 5 index) - True - False) + [False, True]) {all dead. ScriptPurpose} (/\dead -> Proposing @@ -1390,29 +1342,23 @@ = sndPair {integer} {list data} tup in Bool_match - (ifThenElse - {Bool} - (equalsInteger 0 index) - True - False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. Vote} (/\dead -> VoteNo) (/\dead -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 1 index) - True - False) + [False, True]) {all dead. Vote} (/\dead -> VoteYes) (/\dead -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 2 index) - True - False) + [False, True]) {all dead. Vote} (/\dead -> Abstain) (/\dead -> traceError {Vote} "PT1") @@ -1457,12 +1403,12 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. ScriptInfo} (/\dead -> MintingScript (unBData (headList {data} args))) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 1 index) True False) + (case Bool (equalsInteger 1 index) [False, True]) {all dead. ScriptInfo} (/\dead -> SpendingScript @@ -1474,7 +1420,7 @@ (headList {data} (tailList {data} args)))) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 2 index) True False) + (case Bool (equalsInteger 2 index) [False, True]) {all dead. ScriptInfo} (/\dead -> RewardingScript @@ -1482,11 +1428,7 @@ (headList {data} args))) (/\dead -> Bool_match - (ifThenElse - {Bool} - (equalsInteger 3 index) - True - False) + (case Bool (equalsInteger 3 index) [False, True]) {all dead. ScriptInfo} (/\dead -> CertifyingScript @@ -1495,11 +1437,10 @@ (headList {data} (tailList {data} args)))) (/\dead -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 4 index) - True - False) + [False, True]) {all dead. ScriptInfo} (/\dead -> VotingScript @@ -1507,11 +1448,10 @@ (headList {data} args))) (/\dead -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 5 index) - True - False) + [False, True]) {all dead. ScriptInfo} (/\dead -> ProposingScript @@ -1533,8 +1473,8 @@ {Unit} (\(ipv : TxInfo) (ipv : data) (ipv : ScriptInfo) -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 0 (modInteger @@ -1575,8 +1515,7 @@ in go eta) 2)) - True - False) + [False, True]) {all dead. Unit} (/\dead -> Unit) (/\dead -> diff --git a/plutus-benchmark/script-contexts/test/V3/9.6/checkScriptContext1.size.golden b/plutus-benchmark/script-contexts/test/V3/9.6/checkScriptContext1.size.golden index 83fb37b52fa..78c295b5b83 100644 --- a/plutus-benchmark/script-contexts/test/V3/9.6/checkScriptContext1.size.golden +++ b/plutus-benchmark/script-contexts/test/V3/9.6/checkScriptContext1.size.golden @@ -1 +1 @@ -3086 \ No newline at end of file +2790 \ No newline at end of file diff --git a/plutus-benchmark/script-contexts/test/V3/9.6/checkScriptContext2-20.eval.golden b/plutus-benchmark/script-contexts/test/V3/9.6/checkScriptContext2-20.eval.golden index c35e43f1524..e0a3aa65905 100644 --- a/plutus-benchmark/script-contexts/test/V3/9.6/checkScriptContext2-20.eval.golden +++ b/plutus-benchmark/script-contexts/test/V3/9.6/checkScriptContext2-20.eval.golden @@ -1,5 +1,5 @@ -CPU: 285_706_223 -Memory: 1_068_486 -Size: 3_015 +CPU: 264_015_412 +Memory: 998_847 +Size: 2_723 (constr 0) \ No newline at end of file diff --git a/plutus-benchmark/script-contexts/test/V3/9.6/checkScriptContext2-4.eval.golden b/plutus-benchmark/script-contexts/test/V3/9.6/checkScriptContext2-4.eval.golden index e8bd14fd354..14824786289 100644 --- a/plutus-benchmark/script-contexts/test/V3/9.6/checkScriptContext2-4.eval.golden +++ b/plutus-benchmark/script-contexts/test/V3/9.6/checkScriptContext2-4.eval.golden @@ -1,5 +1,5 @@ -CPU: 83_795_135 -Memory: 319_494 -Size: 3_015 +CPU: 77_085_028 +Memory: 297_951 +Size: 2_723 (constr 0) \ No newline at end of file diff --git a/plutus-benchmark/script-contexts/test/V3/9.6/checkScriptContext2.pir.golden b/plutus-benchmark/script-contexts/test/V3/9.6/checkScriptContext2.pir.golden index 5c170c5a611..332fc18c5d3 100644 --- a/plutus-benchmark/script-contexts/test/V3/9.6/checkScriptContext2.pir.golden +++ b/plutus-benchmark/script-contexts/test/V3/9.6/checkScriptContext2.pir.golden @@ -17,12 +17,12 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. Bool} (/\dead -> False) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 1 index) True False) + (case Bool (equalsInteger 1 index) [False, True]) {all dead. Bool} (/\dead -> True) (/\dead -> traceError {Bool} "PT1") @@ -42,18 +42,18 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. Extended a} (/\dead -> NegInf {a}) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 1 index) True False) + (case Bool (equalsInteger 1 index) [False, True]) {all dead. Extended a} (/\dead -> Finite {a} (`$dUnsafeFromData` (headList {data} args))) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 2 index) True False) + (case Bool (equalsInteger 2 index) [False, True]) {all dead. Extended a} (/\dead -> PosInf {a}) (/\dead -> traceError {Extended a} "PT1") @@ -71,7 +71,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. GovernanceActionId} (/\dead -> GovernanceActionId @@ -121,12 +121,12 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. Credential} (/\dead -> PubKeyCredential (unBData (headList {data} args))) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 1 index) True False) + (case Bool (equalsInteger 1 index) [False, True]) {all dead. Credential} (/\dead -> ScriptCredential (unBData (headList {data} args))) (/\dead -> traceError {Credential} "PT1") @@ -145,12 +145,12 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 1 index) True False) + (case Bool (equalsInteger 1 index) [False, True]) {all dead. Maybe a} (/\dead -> Nothing {a}) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. Maybe a} (/\dead -> Just {a} (`$dUnsafeFromData` (headList {data} args))) @@ -217,7 +217,7 @@ !euclid : integer -> integer -> integer = \(x : integer) (y : integer) -> Bool_match - (ifThenElse {Bool} (equalsInteger 0 y) True False) + (case Bool (equalsInteger 0 y) [False, True]) {all dead. integer} (/\dead -> x) (/\dead -> euclid y (modInteger x y)) @@ -227,12 +227,12 @@ !unsafeRatio : integer -> integer -> Rational = \(n : integer) (d : integer) -> Bool_match - (ifThenElse {Bool} (equalsInteger 0 d) True False) + (case Bool (equalsInteger 0 d) [False, True]) {all dead. Rational} (/\dead -> traceError {Rational} "PT3") (/\dead -> Bool_match - (ifThenElse {Bool} (lessThanInteger d 0) True False) + (case Bool (lessThanInteger d 0) [False, True]) {all dead. Rational} (/\dead -> unsafeRatio (subtractInteger 0 n) (subtractInteger 0 d)) @@ -254,7 +254,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. ProposalProcedure} (/\dead -> let @@ -271,7 +271,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. GovernanceAction} (/\dead -> let @@ -289,7 +289,7 @@ (headList {data} (tailList {data} l)))) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 1 index) True False) + (case Bool (equalsInteger 1 index) [False, True]) {all dead. GovernanceAction} (/\dead -> HardForkInitiation @@ -307,11 +307,7 @@ = sndPair {integer} {list data} tup in Bool_match - (ifThenElse - {Bool} - (equalsInteger 0 index) - True - False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. ProtocolVersion} (/\dead -> ProtocolVersion @@ -324,11 +320,7 @@ {all dead. dead})) (/\dead -> Bool_match - (ifThenElse - {Bool} - (equalsInteger 2 index) - True - False) + (case Bool (equalsInteger 2 index) [False, True]) {all dead. GovernanceAction} (/\dead -> TreasuryWithdrawals @@ -344,11 +336,10 @@ (headList {data} (tailList {data} args)))) (/\dead -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 3 index) - True - False) + [False, True]) {all dead. GovernanceAction} (/\dead -> NoConfidence @@ -358,11 +349,10 @@ (headList {data} args))) (/\dead -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 4 index) - True - False) + [False, True]) {all dead. GovernanceAction} (/\dead -> let @@ -409,11 +399,10 @@ tup in Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 0 index) - True - False) + [False, True]) {all dead. Tuple2 integer integer} (/\dead -> @@ -438,11 +427,10 @@ unsafeRatio a b))) (/\dead -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 5 index) - True - False) + [False, True]) {all dead. GovernanceAction} (/\dead -> NewConstitution @@ -471,11 +459,10 @@ tup in Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 0 index) - True - False) + [False, True]) {all dead. Maybe bytestring} (/\dead -> `$fUnsafeFromDataMaybe_$cunsafeFromBuiltinData` @@ -489,11 +476,10 @@ {all dead. dead})) (/\dead -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 6 index) - True - False) + [False, True]) {all dead. GovernanceAction} (/\dead -> InfoAction) (/\dead -> @@ -521,7 +507,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. DRep} (/\dead -> DRep @@ -529,12 +515,12 @@ (headList {data} args))) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 1 index) True False) + (case Bool (equalsInteger 1 index) [False, True]) {all dead. DRep} (/\dead -> DRepAlwaysAbstain) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 2 index) True False) + (case Bool (equalsInteger 2 index) [False, True]) {all dead. DRep} (/\dead -> DRepAlwaysNoConfidence) (/\dead -> traceError {DRep} "PT1") @@ -553,12 +539,12 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. Delegatee} (/\dead -> DelegStake (unBData (headList {data} args))) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 1 index) True False) + (case Bool (equalsInteger 1 index) [False, True]) {all dead. Delegatee} (/\dead -> DelegVote @@ -566,7 +552,7 @@ (headList {data} args))) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 2 index) True False) + (case Bool (equalsInteger 2 index) [False, True]) {all dead. Delegatee} (/\dead -> DelegStakeVote @@ -598,7 +584,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. TxCert} (/\dead -> TxCertRegStaking @@ -610,7 +596,7 @@ (headList {data} (tailList {data} args)))) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 1 index) True False) + (case Bool (equalsInteger 1 index) [False, True]) {all dead. TxCert} (/\dead -> TxCertUnRegStaking @@ -622,7 +608,7 @@ (headList {data} (tailList {data} args)))) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 2 index) True False) + (case Bool (equalsInteger 2 index) [False, True]) {all dead. TxCert} (/\dead -> TxCertDelegStaking @@ -632,11 +618,7 @@ (headList {data} (tailList {data} args)))) (/\dead -> Bool_match - (ifThenElse - {Bool} - (equalsInteger 3 index) - True - False) + (case Bool (equalsInteger 3 index) [False, True]) {all dead. TxCert} (/\dead -> let @@ -650,11 +632,10 @@ (unIData (headList {data} (tailList {data} l)))) (/\dead -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 4 index) - True - False) + [False, True]) {all dead. TxCert} (/\dead -> TxCertRegDRep @@ -666,11 +647,10 @@ (tailList {data} args)))) (/\dead -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 5 index) - True - False) + [False, True]) {all dead. TxCert} (/\dead -> TxCertUpdateDRep @@ -678,11 +658,10 @@ (headList {data} args))) (/\dead -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 6 index) - True - False) + [False, True]) {all dead. TxCert} (/\dead -> TxCertUnRegDRep @@ -694,11 +673,10 @@ (tailList {data} args)))) (/\dead -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 7 index) - True - False) + [False, True]) {all dead. TxCert} (/\dead -> TxCertPoolRegister @@ -712,11 +690,10 @@ args)))) (/\dead -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 8 index) - True - False) + [False, True]) {all dead. TxCert} (/\dead -> TxCertPoolRetire @@ -732,13 +709,12 @@ args)))) (/\dead -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 9 index) - True - False) + [False, True]) {all dead. TxCert} (/\dead -> TxCertAuthHotCommittee @@ -754,13 +730,12 @@ args)))) (/\dead -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 10 index) - True - False) + [False, True]) {all dead. TxCert} (/\dead -> TxCertResignColdCommittee @@ -795,7 +770,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. Voter} (/\dead -> CommitteeVoter @@ -803,7 +778,7 @@ (headList {data} args))) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 1 index) True False) + (case Bool (equalsInteger 1 index) [False, True]) {all dead. Voter} (/\dead -> DRepVoter @@ -811,7 +786,7 @@ (headList {data} args))) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 2 index) True False) + (case Bool (equalsInteger 2 index) [False, True]) {all dead. Voter} (/\dead -> StakePoolVoter (unBData (headList {data} args))) @@ -829,7 +804,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. TxOutRef} (/\dead -> TxOutRef @@ -864,7 +839,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. TxOut} (/\dead -> let @@ -879,7 +854,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. Address} (/\dead -> Address @@ -896,11 +871,10 @@ = sndPair {integer} {list data} tup in Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 0 index) - True - False) + [False, True]) {all dead. StakingCredential} (/\dead -> StakingHash @@ -908,11 +882,10 @@ (headList {data} args))) (/\dead -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 1 index) - True - False) + [False, True]) {all dead. StakingCredential} (/\dead -> let @@ -949,22 +922,18 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. OutputDatum} (/\dead -> NoOutputDatum) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 1 index) True False) + (case Bool (equalsInteger 1 index) [False, True]) {all dead. OutputDatum} (/\dead -> OutputDatumHash (unBData (headList {data} args))) (/\dead -> Bool_match - (ifThenElse - {Bool} - (equalsInteger 2 index) - True - False) + (case Bool (equalsInteger 2 index) [False, True]) {all dead. OutputDatum} (/\dead -> OutputDatum (headList {data} args)) (/\dead -> traceError {OutputDatum} "PT1") @@ -987,7 +956,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. TxInInfo} (/\dead -> TxInInfo @@ -1057,7 +1026,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. ScriptContext} (/\dead -> let @@ -1071,7 +1040,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. TxInfo} (/\dead -> let @@ -1191,7 +1160,7 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. Interval integer} (/\dead -> Interval @@ -1205,11 +1174,7 @@ = sndPair {integer} {list data} tup in Bool_match - (ifThenElse - {Bool} - (equalsInteger 0 index) - True - False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. LowerBound integer} (/\dead -> LowerBound @@ -1234,11 +1199,7 @@ = sndPair {integer} {list data} tup in Bool_match - (ifThenElse - {Bool} - (equalsInteger 0 index) - True - False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. UpperBound integer} (/\dead -> UpperBound @@ -1271,21 +1232,16 @@ = sndPair {integer} {list data} tup in Bool_match - (ifThenElse - {Bool} - (equalsInteger 0 index) - True - False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. ScriptPurpose} (/\dead -> Minting (unBData (headList {data} args))) (/\dead -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 1 index) - True - False) + [False, True]) {all dead. ScriptPurpose} (/\dead -> Spending @@ -1293,11 +1249,10 @@ (headList {data} args))) (/\dead -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 2 index) - True - False) + [False, True]) {all dead. ScriptPurpose} (/\dead -> Rewarding @@ -1305,11 +1260,10 @@ (headList {data} args))) (/\dead -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 3 index) - True - False) + [False, True]) {all dead. ScriptPurpose} (/\dead -> Certifying @@ -1323,11 +1277,10 @@ args)))) (/\dead -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 4 index) - True - False) + [False, True]) {all dead. ScriptPurpose} (/\dead -> Voting @@ -1337,13 +1290,12 @@ args))) (/\dead -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 5 index) - True - False) + [False, True]) {all dead. ScriptPurpose} (/\dead -> Proposing @@ -1394,29 +1346,26 @@ = sndPair {integer} {list data} tup in Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 0 index) - True - False) + [False, True]) {all dead. Vote} (/\dead -> VoteNo) (/\dead -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 1 index) - True - False) + [False, True]) {all dead. Vote} (/\dead -> VoteYes) (/\dead -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 2 index) - True - False) + [False, True]) {all dead. Vote} (/\dead -> Abstain) (/\dead -> traceError {Vote} "PT1") @@ -1461,12 +1410,12 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. ScriptInfo} (/\dead -> MintingScript (unBData (headList {data} args))) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 1 index) True False) + (case Bool (equalsInteger 1 index) [False, True]) {all dead. ScriptInfo} (/\dead -> SpendingScript @@ -1478,11 +1427,7 @@ (headList {data} (tailList {data} args)))) (/\dead -> Bool_match - (ifThenElse - {Bool} - (equalsInteger 2 index) - True - False) + (case Bool (equalsInteger 2 index) [False, True]) {all dead. ScriptInfo} (/\dead -> RewardingScript @@ -1490,11 +1435,10 @@ (headList {data} args))) (/\dead -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 3 index) - True - False) + [False, True]) {all dead. ScriptInfo} (/\dead -> CertifyingScript @@ -1505,11 +1449,10 @@ (tailList {data} args)))) (/\dead -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 4 index) - True - False) + [False, True]) {all dead. ScriptInfo} (/\dead -> VotingScript @@ -1517,11 +1460,10 @@ (headList {data} args))) (/\dead -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 5 index) - True - False) + [False, True]) {all dead. ScriptInfo} (/\dead -> ProposingScript diff --git a/plutus-benchmark/script-contexts/test/V3/9.6/checkScriptContext2.size.golden b/plutus-benchmark/script-contexts/test/V3/9.6/checkScriptContext2.size.golden index 966f606261a..70372d03eb0 100644 --- a/plutus-benchmark/script-contexts/test/V3/9.6/checkScriptContext2.size.golden +++ b/plutus-benchmark/script-contexts/test/V3/9.6/checkScriptContext2.size.golden @@ -1 +1 @@ -3015 \ No newline at end of file +2723 \ No newline at end of file diff --git a/plutus-benchmark/script-contexts/test/V3/9.6/checkScriptContextEqualityData-20.eval.golden b/plutus-benchmark/script-contexts/test/V3/9.6/checkScriptContextEqualityData-20.eval.golden index 0704e87df44..89b0bc7cfc7 100644 --- a/plutus-benchmark/script-contexts/test/V3/9.6/checkScriptContextEqualityData-20.eval.golden +++ b/plutus-benchmark/script-contexts/test/V3/9.6/checkScriptContextEqualityData-20.eval.golden @@ -1,5 +1,5 @@ -CPU: 38_114_332 -Memory: 33_602 -Size: 344 +CPU: 37_958_283 +Memory: 33_101 +Size: 340 (constr 0) \ No newline at end of file diff --git a/plutus-benchmark/script-contexts/test/V3/Data/9.6/checkScriptContext1-20.eval.golden b/plutus-benchmark/script-contexts/test/V3/Data/9.6/checkScriptContext1-20.eval.golden index 3ae5cb3089e..7dc6d854033 100644 --- a/plutus-benchmark/script-contexts/test/V3/Data/9.6/checkScriptContext1-20.eval.golden +++ b/plutus-benchmark/script-contexts/test/V3/Data/9.6/checkScriptContext1-20.eval.golden @@ -1,5 +1,5 @@ -CPU: 20_406_425 -Memory: 73_283 -Size: 99 +CPU: 20_250_376 +Memory: 72_782 +Size: 95 (constr 0) \ No newline at end of file diff --git a/plutus-benchmark/script-contexts/test/V3/Data/9.6/checkScriptContext1-4.eval.golden b/plutus-benchmark/script-contexts/test/V3/Data/9.6/checkScriptContext1-4.eval.golden index 02b633f2c12..d519bd7b44e 100644 --- a/plutus-benchmark/script-contexts/test/V3/Data/9.6/checkScriptContext1-4.eval.golden +++ b/plutus-benchmark/script-contexts/test/V3/Data/9.6/checkScriptContext1-4.eval.golden @@ -1,5 +1,5 @@ -CPU: 5_830_185 -Memory: 20_515 -Size: 99 +CPU: 5_674_136 +Memory: 20_014 +Size: 95 (constr 0) \ No newline at end of file diff --git a/plutus-benchmark/script-contexts/test/V3/Data/9.6/checkScriptContext1.pir.golden b/plutus-benchmark/script-contexts/test/V3/Data/9.6/checkScriptContext1.pir.golden index 8c08dfde09a..ed79ee0d629 100644 --- a/plutus-benchmark/script-contexts/test/V3/Data/9.6/checkScriptContext1.pir.golden +++ b/plutus-benchmark/script-contexts/test/V3/Data/9.6/checkScriptContext1.pir.golden @@ -32,12 +32,12 @@ !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 1 index) True False) + (case Bool (equalsInteger 1 index) [False, True]) {all dead. Maybe a} (/\dead -> Nothing {a}) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. Maybe a} (/\dead -> Just {a} (`$dUnsafeFromData` (headList {data} args))) @@ -78,8 +78,8 @@ {Unit} (\(ipv : data) -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 0 (modInteger @@ -194,8 +194,7 @@ in go ds) 2)) - True - False) + [False, True]) {all dead. Unit} (/\dead -> Unit) (/\dead -> diff --git a/plutus-benchmark/script-contexts/test/V3/Data/9.6/checkScriptContext1.size.golden b/plutus-benchmark/script-contexts/test/V3/Data/9.6/checkScriptContext1.size.golden index d97edbb29fa..90be1cdd8ee 100644 --- a/plutus-benchmark/script-contexts/test/V3/Data/9.6/checkScriptContext1.size.golden +++ b/plutus-benchmark/script-contexts/test/V3/Data/9.6/checkScriptContext1.size.golden @@ -1 +1 @@ -99 \ No newline at end of file +95 \ No newline at end of file diff --git a/plutus-benchmark/script-contexts/test/V3/Data/9.6/checkScriptContextEqualityData-20.eval.golden b/plutus-benchmark/script-contexts/test/V3/Data/9.6/checkScriptContextEqualityData-20.eval.golden index b8cda418940..fa7df59243b 100644 --- a/plutus-benchmark/script-contexts/test/V3/Data/9.6/checkScriptContextEqualityData-20.eval.golden +++ b/plutus-benchmark/script-contexts/test/V3/Data/9.6/checkScriptContextEqualityData-20.eval.golden @@ -1,5 +1,5 @@ -CPU: 33_074_332 -Memory: 2_102 -Size: 29 +CPU: 32_918_283 +Memory: 1_601 +Size: 25 (constr 0) \ No newline at end of file diff --git a/plutus-benchmark/script-contexts/test/V3/Data/9.6/purposeIsWellFormed-4.eval.golden b/plutus-benchmark/script-contexts/test/V3/Data/9.6/purposeIsWellFormed-4.eval.golden index b8f3523b13f..8d7f1388139 100644 --- a/plutus-benchmark/script-contexts/test/V3/Data/9.6/purposeIsWellFormed-4.eval.golden +++ b/plutus-benchmark/script-contexts/test/V3/Data/9.6/purposeIsWellFormed-4.eval.golden @@ -1,5 +1,5 @@ -CPU: 38_049_927 -Memory: 136_213 -Size: 2_273 +CPU: 35_837_192 +Memory: 129_498 +Size: 2_078 (con unit ()) \ No newline at end of file diff --git a/plutus-benchmark/script-contexts/test/V3/Data/9.6/purposeIsWellFormed.pir.golden b/plutus-benchmark/script-contexts/test/V3/Data/9.6/purposeIsWellFormed.pir.golden index 70078312786..2d11e620f65 100644 --- a/plutus-benchmark/script-contexts/test/V3/Data/9.6/purposeIsWellFormed.pir.golden +++ b/plutus-benchmark/script-contexts/test/V3/Data/9.6/purposeIsWellFormed.pir.golden @@ -11,26 +11,24 @@ let !tup : pair integer (list data) = unConstrData ds in Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 1 (fstPair {integer} {list data} tup)) - True - False) + [False, True]) {all dead. Bool} (/\dead -> let !tup : pair integer (list data) = unConstrData ds in Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 1 (fstPair {integer} {list data} tup)) - True - False) + [False, True]) {all dead. Bool} (/\dead -> - ifThenElse - {Bool} + case + Bool (equalsByteString (unBData (headList @@ -40,8 +38,7 @@ let (headList {data} (sndPair {integer} {list data} tup)))) - True - False) + [False, True]) (/\dead -> False) {all dead. dead}) (/\dead -> False) @@ -49,26 +46,24 @@ let !tup : pair integer (list data) = unConstrData ds in Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 0 (fstPair {integer} {list data} tup)) - True - False) + [False, True]) {all dead. Bool} (/\dead -> let !tup : pair integer (list data) = unConstrData ds in Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 0 (fstPair {integer} {list data} tup)) - True - False) + [False, True]) {all dead. Bool} (/\dead -> - ifThenElse - {Bool} + case + Bool (equalsByteString (unBData (headList {data} (sndPair {integer} {list data} tup))) @@ -76,8 +71,7 @@ let (headList {data} (sndPair {integer} {list data} tup)))) - True - False) + [False, True]) (/\dead -> fail ()) {all dead. dead}) (/\dead -> fail ()) @@ -88,44 +82,40 @@ let !fail : unit -> Bool = \(ds : unit) -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 2 (fstPair {integer} {list data} (unConstrData ds))) - True - False) + [False, True]) {all dead. Bool} (/\dead -> - ifThenElse - {Bool} + case + Bool (equalsInteger 2 (fstPair {integer} {list data} (unConstrData ds))) - True - False) + [False, True]) (/\dead -> False) {all dead. dead} !fail : unit -> Bool = \(ds : unit) -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 1 (fstPair {integer} {list data} (unConstrData ds))) - True - False) + [False, True]) {all dead. Bool} (/\dead -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 1 (fstPair {integer} {list data} (unConstrData ds))) - True - False) + [False, True]) {all dead. Bool} (/\dead -> True) (/\dead -> fail ()) @@ -135,22 +125,20 @@ let !tup : pair integer (list data) = unConstrData ds in Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 0 (fstPair {integer} {list data} tup)) - True - False) + [False, True]) {all dead. Bool} (/\dead -> let !tup : pair integer (list data) = unConstrData ds in Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 0 (fstPair {integer} {list data} tup)) - True - False) + [False, True]) {all dead. Bool} (/\dead -> `$fEqCredential_$c==` @@ -168,11 +156,10 @@ let !tup : pair integer (list data) = unConstrData scrut in Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 2 (fstPair {integer} {list data} tup)) - True - False) + [False, True]) {all dead. r} (/\dead -> let @@ -197,11 +184,7 @@ let ds (\(a' : bytestring) (b' : data) -> Bool_match - (ifThenElse - {Bool} - (equalsByteString a a') - True - False) + (case Bool (equalsByteString a a') [False, True]) {all dead. Bool} (/\dead -> `$fEqDRep0_$c==` b b') (/\dead -> False) @@ -214,22 +197,20 @@ let !tup : pair integer (list data) = unConstrData ds in Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 1 (fstPair {integer} {list data} tup)) - True - False) + [False, True]) {all dead. Bool} (/\dead -> let !tup : pair integer (list data) = unConstrData ds in Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 1 (fstPair {integer} {list data} tup)) - True - False) + [False, True]) {all dead. Bool} (/\dead -> `$fEqDRep0_$c==` @@ -246,26 +227,24 @@ let !tup : pair integer (list data) = unConstrData ds in Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 0 (fstPair {integer} {list data} tup)) - True - False) + [False, True]) {all dead. Bool} (/\dead -> let !tup : pair integer (list data) = unConstrData ds in Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 0 (fstPair {integer} {list data} tup)) - True - False) + [False, True]) {all dead. Bool} (/\dead -> - ifThenElse - {Bool} + case + Bool (equalsByteString (unBData (headList {data} (sndPair {integer} {list data} tup))) @@ -273,8 +252,7 @@ let (headList {data} (sndPair {integer} {list data} tup)))) - True - False) + [False, True]) (/\dead -> fail ()) {all dead. dead}) (/\dead -> fail ()) @@ -287,11 +265,10 @@ let !tup : pair integer (list data) = unConstrData scrut in Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 9 (fstPair {integer} {list data} tup)) - True - False) + [False, True]) {all dead. r} (/\dead -> let @@ -308,11 +285,10 @@ let !tup : pair integer (list data) = unConstrData scrut in Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 2 (fstPair {integer} {list data} tup)) - True - False) + [False, True]) {all dead. r} (/\dead -> let @@ -328,11 +304,10 @@ let !tup : pair integer (list data) = unConstrData scrut in Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 4 (fstPair {integer} {list data} tup)) - True - False) + [False, True]) {all dead. r} (/\dead -> let @@ -353,11 +328,10 @@ let !tup : pair integer (list data) = unConstrData scrut in Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 3 (fstPair {integer} {list data} tup)) - True - False) + [False, True]) {all dead. r} (/\dead -> let @@ -388,12 +362,12 @@ let !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 1 index) True False) + (case Bool (equalsInteger 1 index) [False, True]) {all dead. Maybe a} (/\dead -> Nothing {a}) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. Maybe a} (/\dead -> Just {a} (`$dUnsafeFromData` (headList {data} args))) @@ -410,11 +384,10 @@ let !tup : pair integer (list data) = unConstrData scrut in Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 0 (fstPair {integer} {list data} tup)) - True - False) + [False, True]) {all dead. r} (/\dead -> let @@ -436,11 +409,10 @@ let !tup : pair integer (list data) = unConstrData scrut in Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 6 (fstPair {integer} {list data} tup)) - True - False) + [False, True]) {all dead. r} (/\dead -> let @@ -461,11 +433,10 @@ let !tup : pair integer (list data) = unConstrData scrut in Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 1 (fstPair {integer} {list data} tup)) - True - False) + [False, True]) {all dead. r} (/\dead -> let @@ -541,13 +512,12 @@ let False (\(hd : pair data data) -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsData (`$dToData` ds) (fstPair {data} {data} hd)) - True - False) + [False, True]) {all dead. list (pair data data) -> Bool} (/\dead -> \(ds : list (pair data data)) -> True) (/\dead -> go) @@ -593,7 +563,7 @@ let !null : all a. (\a -> list data) a -> Bool = /\a -> \(eta : (\a -> list data) a) -> - ifThenElse {Bool} (nullList {data} eta) True False + case Bool (nullList {data} eta) [False, True] !txOutRefId : data -> bytestring = \(ds : data) -> unBData @@ -623,11 +593,10 @@ in !tup : pair integer (list data) = unConstrData scriptInfo in Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 0 (fstPair {integer} {list data} tup)) - True - False) + [False, True]) {all dead. Bool} (/\dead -> (let @@ -678,11 +647,10 @@ in (\(i : integer) -> iData i) (\(x : integer) -> Bool_match - (ifThenElse - {Bool} + (case + Bool (lessThanEqualsInteger x 0) - False - True) + [True, False]) {all dead. Maybe integer} (/\dead -> Just {integer} x) (/\dead -> Nothing {integer}) @@ -690,7 +658,7 @@ in map in Bool_match - (ifThenElse {Bool} (nullList {pair data data} l) True False) + (case Bool (nullList {pair data data} l) [False, True]) {all dead. Maybe ((\k a -> list (pair data data)) bytestring integer)} @@ -708,11 +676,10 @@ in !tup : pair integer (list data) = unConstrData scriptInfo in Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 1 (fstPair {integer} {list data} tup)) - True - False) + [False, True]) {all dead. Bool} (/\dead -> let @@ -749,20 +716,18 @@ in !l : data = headList {data} l in Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsByteString (txOutRefId l) (txOutRefId v)) - True - False) + [False, True]) {all dead. Bool} (/\dead -> - ifThenElse - {Bool} + case + Bool (equalsInteger (txOutRefIdx l) (txOutRefIdx v)) - True - False) + [False, True]) (/\dead -> False) {all dead. dead}) (unListData (headList {data} l)))) @@ -772,11 +737,10 @@ in !tup : pair integer (list data) = unConstrData scriptInfo in Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 2 (fstPair {integer} {list data} tup)) - True - False) + [False, True]) {all dead. Bool} (/\dead -> member @@ -790,11 +754,10 @@ in !tup : pair integer (list data) = unConstrData scriptInfo in Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 3 (fstPair {integer} {list data} tup)) - True - False) + [False, True]) {all dead. Bool} (/\dead -> let @@ -821,16 +784,15 @@ in = unConstrData eta in Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 10 (fstPair {integer} {list data} tup)) - True - False) + [False, True]) {all dead. Bool} (/\dead -> let @@ -838,16 +800,15 @@ in = unConstrData v in Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 10 (fstPair {integer} {list data} tup)) - True - False) + [False, True]) {all dead. Bool} (/\dead -> `$fEqCredential_$c==` @@ -902,11 +863,10 @@ in (`$fEqCredential_$c==` a a') {all dead. Bool} (/\dead -> - ifThenElse - {Bool} + case + Bool (equalsInteger b b') - True - False) + [False, True]) (/\dead -> False) {all dead. dead}) (\(void : unit) -> fail ())) @@ -918,16 +878,15 @@ in = unConstrData eta in Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 5 (fstPair {integer} {list data} tup)) - True - False) + [False, True]) {all dead. Bool} (/\dead -> let @@ -935,16 +894,15 @@ in = unConstrData v in Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 5 (fstPair {integer} {list data} tup)) - True - False) + [False, True]) {all dead. Bool} (/\dead -> `$fEqCredential_$c==` @@ -978,11 +936,10 @@ in (`$fEqCredential_$c==` a a') {all dead. Bool} (/\dead -> - ifThenElse - {Bool} + case + Bool (equalsInteger b b') - True - False) + [False, True]) (/\dead -> False) {all dead. dead}) (\(void : unit) -> fail ())) @@ -1011,13 +968,12 @@ in b') {all dead. Bool} (/\dead -> - ifThenElse - {Bool} + case + Bool (equalsInteger c c') - True - False) + [False, True]) (/\dead -> False) {all dead. dead}) (/\dead -> False) @@ -1075,13 +1031,13 @@ in (\(a : integer) -> /\dead -> - ifThenElse - {Bool} + case + Bool (equalsInteger a a) - True - False) + [ False + , True ]) (/\dead -> False) {all dead. @@ -1127,13 +1083,12 @@ in {all dead. Bool} (\(a : integer) -> /\dead -> - ifThenElse - {Bool} + case + Bool (equalsInteger a a) - True - False) + [False, True]) (/\dead -> False) {all dead. dead}) (/\dead -> @@ -1157,13 +1112,12 @@ in = unConstrData scriptInfo in Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 4 (fstPair {integer} {list data} tup)) - True - False) + [False, True]) {all dead. Bool} (/\dead -> member @@ -1193,13 +1147,12 @@ in = unConstrData scriptInfo in Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 5 (fstPair {integer} {list data} tup)) - True - False) + [False, True]) {all dead. Bool} (/\dead -> let diff --git a/plutus-benchmark/script-contexts/test/V3/Data/9.6/purposeIsWellFormed.size.golden b/plutus-benchmark/script-contexts/test/V3/Data/9.6/purposeIsWellFormed.size.golden index 673819deb0e..a5bb2393473 100644 --- a/plutus-benchmark/script-contexts/test/V3/Data/9.6/purposeIsWellFormed.size.golden +++ b/plutus-benchmark/script-contexts/test/V3/Data/9.6/purposeIsWellFormed.size.golden @@ -1 +1 @@ -2271 \ No newline at end of file +2076 \ No newline at end of file diff --git a/plutus-core/plutus-core/src/PlutusCore/Evaluation/Machine/MachineParameters.hs b/plutus-core/plutus-core/src/PlutusCore/Evaluation/Machine/MachineParameters.hs index 7de415e258b..948196cd786 100644 --- a/plutus-core/plutus-core/src/PlutusCore/Evaluation/Machine/MachineParameters.hs +++ b/plutus-core/plutus-core/src/PlutusCore/Evaluation/Machine/MachineParameters.hs @@ -34,6 +34,11 @@ data CostModel machinecosts builtincosts = makeLenses ''CostModel -- | The part of 'MachineParameters' that is individual for each semantics variant of 'DefaultFun'. +-- +-- 'CaserBuiltin' isn't included, because it only explicitly depends on the protocol version and not +-- the language version (even though there's an implicit dependency on the language version: older +-- languages don't support 'Case' in general, but it's safe to ignore that, because support for +-- 'Case' is controlled by the AST version, which is a separate check during deserialisation). data MachineVariantParameters machineCosts fun val = MachineVariantParameters { machineCosts :: machineCosts diff --git a/plutus-core/plutus-core/src/PlutusCore/Evaluation/Machine/MachineParameters/Default.hs b/plutus-core/plutus-core/src/PlutusCore/Evaluation/Machine/MachineParameters/Default.hs index 0b2073f7c49..82304a21698 100644 --- a/plutus-core/plutus-core/src/PlutusCore/Evaluation/Machine/MachineParameters/Default.hs +++ b/plutus-core/plutus-core/src/PlutusCore/Evaluation/Machine/MachineParameters/Default.hs @@ -1,4 +1,3 @@ -{-# OPTIONS_GHC -ddump-prep -ddump-to-file -dsuppress-all -dno-suppress-type-signatures -dppr-case-as-let -fforce-recomp -dumpdir /home/effectfully/code/iohk/plutus/junk/GHC-Core-dumps #-} -- | Defines the type of default machine parameters and a function for creating a value of the type. -- We keep them separate, because the function unfolds into multiple thousands of lines of Core that -- we need to be able to visually inspect, hence we dedicate a separate file to it. diff --git a/plutus-core/untyped-plutus-core/test/Evaluation/Golden/caseInteger.plc.golden b/plutus-core/untyped-plutus-core/test/Evaluation/Golden/caseInteger.plc.golden new file mode 100644 index 00000000000..2d18b6497e3 --- /dev/null +++ b/plutus-core/untyped-plutus-core/test/Evaluation/Golden/caseInteger.plc.golden @@ -0,0 +1,3 @@ +(Left An error has occurred: +A non-constructor/non-builtin value was scrutinized in a case expression +Caused by: (con integer 1)) \ No newline at end of file diff --git a/plutus-core/untyped-plutus-core/test/Evaluation/Golden/caseInteger.type.golden b/plutus-core/untyped-plutus-core/test/Evaluation/Golden/caseInteger.type.golden new file mode 100644 index 00000000000..557f8ffd629 --- /dev/null +++ b/plutus-core/untyped-plutus-core/test/Evaluation/Golden/caseInteger.type.golden @@ -0,0 +1 @@ +(Right (con integer)) \ No newline at end of file diff --git a/plutus-core/untyped-plutus-core/test/Evaluation/Golden/caseInteger.uplc.golden b/plutus-core/untyped-plutus-core/test/Evaluation/Golden/caseInteger.uplc.golden new file mode 100644 index 00000000000..315273b1b83 --- /dev/null +++ b/plutus-core/untyped-plutus-core/test/Evaluation/Golden/caseInteger.uplc.golden @@ -0,0 +1,4 @@ +(Left An error has occurred: +'case' over a value of a built-in type failed with +'case 1' is out of bounds for the given number of branches: 0 +Caused by: (con integer 1)) \ No newline at end of file diff --git a/plutus-ledger-api/test-plugin/Spec/Budget/9.6/currencySymbolValueOf.eval.golden b/plutus-ledger-api/test-plugin/Spec/Budget/9.6/currencySymbolValueOf.eval.golden index d211db54239..0002a35289e 100644 --- a/plutus-ledger-api/test-plugin/Spec/Budget/9.6/currencySymbolValueOf.eval.golden +++ b/plutus-ledger-api/test-plugin/Spec/Budget/9.6/currencySymbolValueOf.eval.golden @@ -1,5 +1,5 @@ -CPU: 8_088_858 -Memory: 42_924 -Size: 186 +CPU: 7_152_564 +Memory: 39_918 +Size: 182 (con integer 3636) \ No newline at end of file diff --git a/plutus-ledger-api/test-plugin/Spec/Budget/9.6/currencySymbolValueOf.pir.golden b/plutus-ledger-api/test-plugin/Spec/Budget/9.6/currencySymbolValueOf.pir.golden index 8da8925e8d2..a5119220bf7 100644 --- a/plutus-ledger-api/test-plugin/Spec/Budget/9.6/currencySymbolValueOf.pir.golden +++ b/plutus-ledger-api/test-plugin/Spec/Budget/9.6/currencySymbolValueOf.pir.golden @@ -69,7 +69,7 @@ in (\(c' : bytestring) (i : (\k v -> List (Tuple2 k v)) bytestring integer) -> Bool_match - (ifThenElse {Bool} (equalsByteString c' cur) True False) + (case Bool (equalsByteString c' cur) [False, True]) {all dead. integer} (/\dead -> go i) (/\dead -> go xs') diff --git a/plutus-ledger-api/test-plugin/Spec/Budget/9.6/geq1.eval.golden b/plutus-ledger-api/test-plugin/Spec/Budget/9.6/geq1.eval.golden index 45b496415c8..f066a6106a1 100644 --- a/plutus-ledger-api/test-plugin/Spec/Budget/9.6/geq1.eval.golden +++ b/plutus-ledger-api/test-plugin/Spec/Budget/9.6/geq1.eval.golden @@ -1,5 +1,5 @@ -CPU: 118_186_685 -Memory: 661_630 -Size: 611 +CPU: 98_753_050 +Memory: 594_715 +Size: 600 (constr 0) \ No newline at end of file diff --git a/plutus-ledger-api/test-plugin/Spec/Budget/9.6/geq2.eval.golden b/plutus-ledger-api/test-plugin/Spec/Budget/9.6/geq2.eval.golden index 8baddbd59b3..bf3dcb6e596 100644 --- a/plutus-ledger-api/test-plugin/Spec/Budget/9.6/geq2.eval.golden +++ b/plutus-ledger-api/test-plugin/Spec/Budget/9.6/geq2.eval.golden @@ -1,5 +1,5 @@ -CPU: 126_563_949 -Memory: 709_942 -Size: 639 +CPU: 106_098_020 +Memory: 639_421 +Size: 628 (constr 1) \ No newline at end of file diff --git a/plutus-ledger-api/test-plugin/Spec/Budget/9.6/geq3.eval.golden b/plutus-ledger-api/test-plugin/Spec/Budget/9.6/geq3.eval.golden index b428644f626..7a1b2aaab46 100644 --- a/plutus-ledger-api/test-plugin/Spec/Budget/9.6/geq3.eval.golden +++ b/plutus-ledger-api/test-plugin/Spec/Budget/9.6/geq3.eval.golden @@ -1,5 +1,5 @@ -CPU: 130_466_644 -Memory: 730_552 -Size: 639 +CPU: 108_740_470 +Memory: 654_526 +Size: 628 (constr 0) \ No newline at end of file diff --git a/plutus-ledger-api/test-plugin/Spec/Budget/9.6/geq4.eval.golden b/plutus-ledger-api/test-plugin/Spec/Budget/9.6/geq4.eval.golden index 72a15b839e7..bdd26196c7f 100644 --- a/plutus-ledger-api/test-plugin/Spec/Budget/9.6/geq4.eval.golden +++ b/plutus-ledger-api/test-plugin/Spec/Budget/9.6/geq4.eval.golden @@ -1,5 +1,5 @@ -CPU: 113_756_728 -Memory: 638_020 -Size: 615 +CPU: 95_871_338 +Memory: 578_410 +Size: 604 (constr 1) \ No newline at end of file diff --git a/plutus-ledger-api/test-plugin/Spec/Budget/9.6/geq5.eval.golden b/plutus-ledger-api/test-plugin/Spec/Budget/9.6/geq5.eval.golden index 7ecd04286e6..51a606cfd85 100644 --- a/plutus-ledger-api/test-plugin/Spec/Budget/9.6/geq5.eval.golden +++ b/plutus-ledger-api/test-plugin/Spec/Budget/9.6/geq5.eval.golden @@ -1,5 +1,5 @@ -CPU: 121_872_779 -Memory: 681_938 -Size: 615 +CPU: 101_718_948 +Memory: 612_419 +Size: 604 (constr 0) \ No newline at end of file diff --git a/plutus-ledger-api/test-plugin/Spec/Budget/9.6/gt.pir.golden b/plutus-ledger-api/test-plugin/Spec/Budget/9.6/gt.pir.golden index 249f98ee29d..47612889de1 100644 --- a/plutus-ledger-api/test-plugin/Spec/Budget/9.6/gt.pir.golden +++ b/plutus-ledger-api/test-plugin/Spec/Budget/9.6/gt.pir.golden @@ -28,7 +28,7 @@ letrec {Bool} (\(ds : bytestring) (x : integer) -> Bool_match - (ifThenElse {Bool} (equalsInteger 0 x) True False) + (case Bool (equalsInteger 0 x) [False, True]) {all dead. Bool} (/\dead -> go xs) (/\dead -> False) @@ -36,6 +36,8 @@ letrec {all dead. dead} in let + !ifThenElse : all a. bool -> a -> a -> a + = /\a -> \(b : bool) (x : a) (y : a) -> case a b [y, x] data (These :: * -> * -> *) a b | These_match where That : b -> These a b These : a -> b -> These a b @@ -200,7 +202,7 @@ in let !equalsByteString : bytestring -> bytestring -> Bool = \(x : bytestring) (y : bytestring) -> - ifThenElse {Bool} (equalsByteString x y) True False + case Bool (equalsByteString x y) [False, True] !union : all k v r. (\a -> a -> a -> Bool) k -> @@ -796,10 +798,9 @@ in {bytestring} {integer} equalsByteString - (\(v : integer) -> - ifThenElse {Bool} (equalsInteger 0 v) True False) + (\(v : integer) -> case Bool (equalsInteger 0 v) [False, True]) (\(x : integer) (y : integer) -> - ifThenElse {Bool} (equalsInteger x y) True False)) + case Bool (equalsInteger x y) [False, True])) l r) {all dead. Bool} diff --git a/plutus-ledger-api/test-plugin/Spec/Budget/9.6/gt1.eval.golden b/plutus-ledger-api/test-plugin/Spec/Budget/9.6/gt1.eval.golden index 918e447b8b9..f697920e5aa 100644 --- a/plutus-ledger-api/test-plugin/Spec/Budget/9.6/gt1.eval.golden +++ b/plutus-ledger-api/test-plugin/Spec/Budget/9.6/gt1.eval.golden @@ -1,5 +1,5 @@ -CPU: 148_560_115 -Memory: 826_300 -Size: 979 +CPU: 122_592_765 +Memory: 735_150 +Size: 951 (constr 1) \ No newline at end of file diff --git a/plutus-ledger-api/test-plugin/Spec/Budget/9.6/gt2.eval.golden b/plutus-ledger-api/test-plugin/Spec/Budget/9.6/gt2.eval.golden index d4d7125e056..95846877b65 100644 --- a/plutus-ledger-api/test-plugin/Spec/Budget/9.6/gt2.eval.golden +++ b/plutus-ledger-api/test-plugin/Spec/Budget/9.6/gt2.eval.golden @@ -1,5 +1,5 @@ -CPU: 125_187_949 -Memory: 701_342 -Size: 1_007 +CPU: 106_306_020 +Memory: 640_721 +Size: 979 (constr 1) \ No newline at end of file diff --git a/plutus-ledger-api/test-plugin/Spec/Budget/9.6/gt3.eval.golden b/plutus-ledger-api/test-plugin/Spec/Budget/9.6/gt3.eval.golden index 669024f4cd1..12ae590015f 100644 --- a/plutus-ledger-api/test-plugin/Spec/Budget/9.6/gt3.eval.golden +++ b/plutus-ledger-api/test-plugin/Spec/Budget/9.6/gt3.eval.golden @@ -1,5 +1,5 @@ -CPU: 161_112_456 -Memory: 896_124 -Size: 1_007 +CPU: 133_272_518 +Memory: 798_962 +Size: 979 (constr 0) \ No newline at end of file diff --git a/plutus-ledger-api/test-plugin/Spec/Budget/9.6/gt4.eval.golden b/plutus-ledger-api/test-plugin/Spec/Budget/9.6/gt4.eval.golden index d762e2b0213..38efebc6e5f 100644 --- a/plutus-ledger-api/test-plugin/Spec/Budget/9.6/gt4.eval.golden +++ b/plutus-ledger-api/test-plugin/Spec/Budget/9.6/gt4.eval.golden @@ -1,5 +1,5 @@ -CPU: 113_244_728 -Memory: 634_820 -Size: 983 +CPU: 96_079_338 +Memory: 579_710 +Size: 955 (constr 1) \ No newline at end of file diff --git a/plutus-ledger-api/test-plugin/Spec/Budget/9.6/gt5.eval.golden b/plutus-ledger-api/test-plugin/Spec/Budget/9.6/gt5.eval.golden index 6cd4788ffcf..6307bab5266 100644 --- a/plutus-ledger-api/test-plugin/Spec/Budget/9.6/gt5.eval.golden +++ b/plutus-ledger-api/test-plugin/Spec/Budget/9.6/gt5.eval.golden @@ -1,5 +1,5 @@ -CPU: 135_849_718 -Memory: 757_770 -Size: 983 +CPU: 113_631_103 +Memory: 682_935 +Size: 955 (constr 0) \ No newline at end of file diff --git a/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/currencySymbolValueOf.eval.golden b/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/currencySymbolValueOf.eval.golden index 4626ad3c710..2b76cb4c649 100644 --- a/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/currencySymbolValueOf.eval.golden +++ b/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/currencySymbolValueOf.eval.golden @@ -1,5 +1,5 @@ -CPU: 22_759_162 -Memory: 63_080 -Size: 112 +CPU: 22_014_868 +Memory: 61_274 +Size: 111 (con integer 3636) \ No newline at end of file diff --git a/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/currencySymbolValueOf.pir.golden b/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/currencySymbolValueOf.pir.golden index c333ff8a270..432a9f19aa5 100644 --- a/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/currencySymbolValueOf.pir.golden +++ b/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/currencySymbolValueOf.pir.golden @@ -34,11 +34,10 @@ in (Nothing {data}) (\(hd : pair data data) -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsData k (fstPair {data} {data} hd)) - True - False) + [False, True]) {all dead. list (pair data data) -> Maybe data} (/\dead -> \(ds : list (pair data data)) -> diff --git a/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/geq1.eval.golden b/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/geq1.eval.golden index 27595412342..4a052d9564d 100644 --- a/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/geq1.eval.golden +++ b/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/geq1.eval.golden @@ -1,5 +1,5 @@ -CPU: 613_090_560 -Memory: 1_824_850 -Size: 764 +CPU: 581_291_535 +Memory: 1_732_825 +Size: 743 (constr 0) \ No newline at end of file diff --git a/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/geq2.eval.golden b/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/geq2.eval.golden index 8f88401ada9..92760a88086 100644 --- a/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/geq2.eval.golden +++ b/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/geq2.eval.golden @@ -1,5 +1,5 @@ -CPU: 647_706_509 -Memory: 1_941_370 -Size: 764 +CPU: 614_410_994 +Memory: 1_844_735 +Size: 743 (constr 1) \ No newline at end of file diff --git a/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/geq3.eval.golden b/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/geq3.eval.golden index 3dfaf98e0a7..8cf590eb892 100644 --- a/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/geq3.eval.golden +++ b/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/geq3.eval.golden @@ -1,5 +1,5 @@ -CPU: 677_017_054 -Memory: 2_036_956 -Size: 764 +CPU: 641_372_902 +Memory: 1_931_808 +Size: 743 (constr 0) \ No newline at end of file diff --git a/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/geq4.eval.golden b/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/geq4.eval.golden index 9d916c1608d..8b136c7a431 100644 --- a/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/geq4.eval.golden +++ b/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/geq4.eval.golden @@ -1,5 +1,5 @@ -CPU: 587_374_155 -Memory: 1_714_642 -Size: 764 +CPU: 561_120_600 +Memory: 1_643_047 +Size: 743 (constr 1) \ No newline at end of file diff --git a/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/geq5.eval.golden b/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/geq5.eval.golden index ac1b6b75b50..53e713ef5a1 100644 --- a/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/geq5.eval.golden +++ b/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/geq5.eval.golden @@ -1,5 +1,5 @@ -CPU: 635_615_047 -Memory: 1_890_258 -Size: 764 +CPU: 602_663_630 +Memory: 1_794_825 +Size: 743 (constr 0) \ No newline at end of file diff --git a/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/gt.pir.golden b/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/gt.pir.golden index 4fab3774cbd..10436aa49d6 100644 --- a/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/gt.pir.golden +++ b/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/gt.pir.golden @@ -48,18 +48,18 @@ let !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. These a b} (/\dead -> This {a} {b} (`$dUnsafeFromData` (headList {data} args))) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 1 index) True False) + (case Bool (equalsInteger 1 index) [False, True]) {all dead. These a b} (/\dead -> That {a} {b} (`$dUnsafeFromData` (headList {data} args))) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 2 index) True False) + (case Bool (equalsInteger 2 index) [False, True]) {all dead. These a b} (/\dead -> These @@ -143,11 +143,10 @@ letrec nilCase (\(hd : pair data data) -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsData k (fstPair {data} {data} hd)) - True - False) + [False, True]) {all dead. list (pair data data) -> list (pair data data)} (/\dead -> mkCons {pair data data} (mkPairData k v)) @@ -173,11 +172,10 @@ let (Nothing {data}) (\(hd : pair data data) -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsData k (fstPair {data} {data} hd)) - True - False) + [False, True]) {all dead. list (pair data data) -> Maybe data} (/\dead -> \(ds : list (pair data data)) -> @@ -407,13 +405,12 @@ let (/\dead -> goRight acc xs) (/\dead -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsData (fstPair {data} {data} x) d) - True - False) + [False, True]) {all dead. Bool} (/\dead -> Bool_match @@ -441,11 +438,10 @@ let Unit in Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsData d (fstPair {data} {data} x)) - True - False) + [False, True]) {all dead. Bool} (/\dead -> Bool_match @@ -478,6 +474,8 @@ let in \(eta : list (pair data data)) (eta : list (pair data data)) -> goBoth eta eta + !ifThenElse : all a. bool -> a -> a -> a + = /\a -> \(b : bool) (x : a) (y : a) -> case a b [y, x] in \(l : (\k a -> list (pair data data)) @@ -612,13 +610,12 @@ in True (\(hd : pair data data) -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 0 (unIData (sndPair {data} {data} hd))) - True - False) + [False, True]) {all dead. list (pair data data) -> Bool} (/\dead -> go) (/\dead -> \(ds : list (pair data data)) -> False) @@ -629,13 +626,12 @@ in (\(v : data) (v : data) -> unordEqWith (\(v : data) -> - ifThenElse {Bool} (equalsInteger 0 (unIData v)) True False) + case Bool (equalsInteger 0 (unIData v)) [False, True]) (\(v : data) (v : data) -> - ifThenElse - {Bool} + case + Bool (equalsInteger (unIData v) (unIData v)) - True - False) + [False, True]) (unMapData v) (unMapData v)) l diff --git a/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/gt1.eval.golden b/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/gt1.eval.golden index b089c70480f..14be1808662 100644 --- a/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/gt1.eval.golden +++ b/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/gt1.eval.golden @@ -1,5 +1,5 @@ -CPU: 713_536_368 -Memory: 2_149_084 -Size: 1_227 +CPU: 677_763_628 +Memory: 2_048_824 +Size: 1_184 (constr 1) \ No newline at end of file diff --git a/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/gt2.eval.golden b/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/gt2.eval.golden index 15e73780ffe..2fecb4b3510 100644 --- a/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/gt2.eval.golden +++ b/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/gt2.eval.golden @@ -1,5 +1,5 @@ -CPU: 646_378_509 -Memory: 1_933_070 -Size: 1_227 +CPU: 614_666_994 +Memory: 1_846_335 +Size: 1_184 (constr 1) \ No newline at end of file diff --git a/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/gt3.eval.golden b/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/gt3.eval.golden index 204457dd015..8a635ddbaf9 100644 --- a/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/gt3.eval.golden +++ b/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/gt3.eval.golden @@ -1,5 +1,5 @@ -CPU: 779_961_022 -Memory: 2_369_576 -Size: 1_227 +CPU: 740_795_106 +Memory: 2_259_492 +Size: 1_184 (constr 0) \ No newline at end of file diff --git a/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/gt4.eval.golden b/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/gt4.eval.golden index 026ad4b91c4..a0eff4a4cbc 100644 --- a/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/gt4.eval.golden +++ b/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/gt4.eval.golden @@ -1,5 +1,5 @@ -CPU: 586_910_155 -Memory: 1_711_742 -Size: 1_227 +CPU: 561_376_600 +Memory: 1_644_647 +Size: 1_184 (constr 1) \ No newline at end of file diff --git a/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/gt5.eval.golden b/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/gt5.eval.golden index 003437e21f8..6729b8adfc1 100644 --- a/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/gt5.eval.golden +++ b/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/gt5.eval.golden @@ -1,5 +1,5 @@ -CPU: 682_511_527 -Memory: 2_042_362 -Size: 1_227 +CPU: 648_647_326 +Memory: 1_948_813 +Size: 1_184 (constr 0) \ No newline at end of file diff --git a/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/mintValueBurned.eval.golden b/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/mintValueBurned.eval.golden index 3b9ee3abcca..85d6b1c2e1d 100644 --- a/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/mintValueBurned.eval.golden +++ b/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/mintValueBurned.eval.golden @@ -1,6 +1,6 @@ -CPU: 46_450_172 -Memory: 180_868 -Size: 152 +CPU: 42_200_702 +Memory: 168_538 +Size: 143 (con (list (pair data data)) diff --git a/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/mintValueMinted.eval.golden b/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/mintValueMinted.eval.golden index 26056b1f624..a969ba55b11 100644 --- a/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/mintValueMinted.eval.golden +++ b/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/mintValueMinted.eval.golden @@ -1,6 +1,6 @@ -CPU: 40_273_309 -Memory: 158_529 -Size: 138 +CPU: 36_996_280 +Memory: 148_008 +Size: 130 (con (list (pair data data)) diff --git a/plutus-ledger-api/test-plugin/Spec/Data/ScriptContext/9.6/succeedsIfHasDatum.pir.golden b/plutus-ledger-api/test-plugin/Spec/Data/ScriptContext/9.6/succeedsIfHasDatum.pir.golden index 77342b99c62..10175783576 100644 --- a/plutus-ledger-api/test-plugin/Spec/Data/ScriptContext/9.6/succeedsIfHasDatum.pir.golden +++ b/plutus-ledger-api/test-plugin/Spec/Data/ScriptContext/9.6/succeedsIfHasDatum.pir.golden @@ -25,11 +25,10 @@ in (sndPair {integer} {list data} (unConstrData d))))) in Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 1 (fstPair {integer} {list data} tup)) - True - False) + [False, True]) {all dead. Bool} (/\dead -> let @@ -44,12 +43,12 @@ in !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 1 index) True False) + (case Bool (equalsInteger 1 index) [False, True]) {all dead. Maybe data} (/\dead -> Nothing {data}) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. Maybe data} (/\dead -> Just {data} (headList {data} args)) (/\dead -> traceError {Maybe data} "PT1") diff --git a/plutus-ledger-api/test-plugin/Spec/Data/ScriptContext/9.6/succeedsIfHasDatum.uplc.golden b/plutus-ledger-api/test-plugin/Spec/Data/ScriptContext/9.6/succeedsIfHasDatum.uplc.golden index e8561618329..b45d679ea4f 100644 --- a/plutus-ledger-api/test-plugin/Spec/Data/ScriptContext/9.6/succeedsIfHasDatum.uplc.golden +++ b/plutus-ledger-api/test-plugin/Spec/Data/ScriptContext/9.6/succeedsIfHasDatum.uplc.golden @@ -6,38 +6,41 @@ case ((\tup -> force - (force ifThenElse + (case (equalsInteger 1 (force (force fstPair) tup)) - (delay - (force - (case - ((\tup -> - (\index -> - (\args -> - force - (force ifThenElse - (equalsInteger 1 index) - (delay (constr 1 [])) - (delay - (force - (force ifThenElse - (equalsInteger 0 index) - (delay - (constr 0 - [ (force headList - args) ])) - (delay - (traceError - "PT1"))))))) - (force (force sndPair) tup)) - (force (force fstPair) tup)) - (unConstrData - (force headList - (force tailList - (force (force sndPair) tup))))) - [ (\ds -> delay (constr 0 [])) - , (delay (constr 1 [])) ]))) - (delay (constr 1 [])))) + [ (delay (constr 1 [])) + , (delay + (force + (case + ((\tup -> + (\index -> + (\args -> + force + (case + (equalsInteger 1 index) + [ (delay + (force + (case + (equalsInteger + 0 + index) + [ (delay + (traceError + "PT1")) + , (delay + (constr 0 + [ (force + headList + args) ])) ]))) + , (delay (constr 1 [])) ])) + (force (force sndPair) tup)) + (force (force fstPair) tup)) + (unConstrData + (force headList + (force tailList + (force (force sndPair) tup))))) + [ (\ds -> delay (constr 0 [])) + , (delay (constr 1 [])) ]))) ])) (unConstrData (force headList (force tailList diff --git a/plutus-ledger-api/test-plugin/Spec/Data/Value/9.6/Long.stat.golden b/plutus-ledger-api/test-plugin/Spec/Data/Value/9.6/Long.stat.golden index 6e5cf8e5562..abbabe1df3f 100644 --- a/plutus-ledger-api/test-plugin/Spec/Data/Value/9.6/Long.stat.golden +++ b/plutus-ledger-api/test-plugin/Spec/Data/Value/9.6/Long.stat.golden @@ -1,15 +1,15 @@ -({cpu: 8426472589 | mem: 12757058}) -({cpu: 8511052 | mem: 33076}) -({cpu: 5994100712 | mem: 8906458}) -({cpu: 8511052 | mem: 33076}) -({cpu: 5994100712 | mem: 8906458}) -({cpu: 8511052 | mem: 33076}) -({cpu: 3561728835 | mem: 5055858}) -({cpu: 8511052 | mem: 33076}) -({cpu: 5994100712 | mem: 8906458}) -({cpu: 8511052 | mem: 33076}) -({cpu: 3561728835 | mem: 5055858}) -({cpu: 8511052 | mem: 33076}) -({cpu: 3561728835 | mem: 5055858}) -({cpu: 8511052 | mem: 33076}) -({cpu: 1129356958 | mem: 1205258}) \ No newline at end of file +({cpu: 8196924510 | mem: 12020087}) +({cpu: 8198954 | mem: 32074}) +({cpu: 5833838389 | mem: 8391931}) +({cpu: 8198954 | mem: 32074}) +({cpu: 5833838389 | mem: 8391931}) +({cpu: 8198954 | mem: 32074}) +({cpu: 3470752268 | mem: 4763775}) +({cpu: 8198954 | mem: 32074}) +({cpu: 5833838389 | mem: 8391931}) +({cpu: 8198954 | mem: 32074}) +({cpu: 3470752268 | mem: 4763775}) +({cpu: 8198954 | mem: 32074}) +({cpu: 3470752268 | mem: 4763775}) +({cpu: 8198954 | mem: 32074}) +({cpu: 1107666147 | mem: 1135619}) \ No newline at end of file diff --git a/plutus-ledger-api/test-plugin/Spec/Data/Value/9.6/Short.stat.golden b/plutus-ledger-api/test-plugin/Spec/Data/Value/9.6/Short.stat.golden index ee2c0b0d112..f815ea339c9 100644 --- a/plutus-ledger-api/test-plugin/Spec/Data/Value/9.6/Short.stat.golden +++ b/plutus-ledger-api/test-plugin/Spec/Data/Value/9.6/Short.stat.golden @@ -1,21 +1,21 @@ ({cpu: 1866088 | mem: 10164}) ({cpu: 4505311 | mem: 21352}) -({cpu: 7703302 | mem: 30914}) -({cpu: 10110034 | mem: 40672}) -({cpu: 12435152 | mem: 45602}) -({cpu: 15509312 | mem: 57588}) -({cpu: 23195169 | mem: 81040}) -({cpu: 24914199 | mem: 92560}) -({cpu: 29032383 | mem: 101790}) -({cpu: 18091460 | mem: 62918}) -({cpu: 44715203 | mem: 151916}) -({cpu: 13433855 | mem: 47764}) -({cpu: 65129873 | mem: 216730}) -({cpu: 76468749 | mem: 259686}) -({cpu: 92758782 | mem: 296232}) -({cpu: 104097658 | mem: 339188}) -({cpu: 125310494 | mem: 390422}) -({cpu: 128384654 | mem: 402408}) -({cpu: 162785009 | mem: 499300}) -({cpu: 60490101 | mem: 209192}) -({cpu: 1129356958 | mem: 1205258}) \ No newline at end of file +({cpu: 7547253 | mem: 30413}) +({cpu: 9797936 | mem: 39670}) +({cpu: 11967005 | mem: 44099}) +({cpu: 14917116 | mem: 55784}) +({cpu: 22258875 | mem: 78034}) +({cpu: 24009905 | mem: 89754}) +({cpu: 27940040 | mem: 98283}) +({cpu: 17311215 | mem: 60413}) +({cpu: 42842615 | mem: 145904}) +({cpu: 12809659 | mem: 45760}) +({cpu: 62164942 | mem: 207211}) +({cpu: 72791524 | mem: 248561}) +({cpu: 88389410 | mem: 282204}) +({cpu: 99015992 | mem: 323554}) +({cpu: 119224583 | mem: 370883}) +({cpu: 122174694 | mem: 382568}) +({cpu: 154670461 | mem: 473248}) +({cpu: 57593121 | mem: 200572}) +({cpu: 1107666147 | mem: 1135619}) \ No newline at end of file diff --git a/plutus-ledger-api/test-plugin/Spec/Value/9.6/Long.stat.golden b/plutus-ledger-api/test-plugin/Spec/Value/9.6/Long.stat.golden index 8332fcf76b2..1b75a818d08 100644 --- a/plutus-ledger-api/test-plugin/Spec/Value/9.6/Long.stat.golden +++ b/plutus-ledger-api/test-plugin/Spec/Value/9.6/Long.stat.golden @@ -1,15 +1,15 @@ -({cpu: 1248344408 | mem: 6701342}) -({cpu: 23834067 | mem: 147604}) -({cpu: 875833026 | mem: 4704454}) -({cpu: 22522067 | mem: 139404}) -({cpu: 875833026 | mem: 4704454}) -({cpu: 19434067 | mem: 120104}) -({cpu: 500153644 | mem: 2687766}) -({cpu: 19530067 | mem: 120704}) -({cpu: 875833026 | mem: 4704454}) -({cpu: 19434067 | mem: 120104}) -({cpu: 500153644 | mem: 2687766}) -({cpu: 16538067 | mem: 102004}) -({cpu: 500153644 | mem: 2687766}) -({cpu: 13114067 | mem: 80604}) -({cpu: 123802262 | mem: 666878}) \ No newline at end of file +({cpu: 915324329 | mem: 5317671}) +({cpu: 23345969 | mem: 145502}) +({cpu: 643330703 | mem: 3738427}) +({cpu: 22033969 | mem: 137302}) +({cpu: 643330703 | mem: 3738427}) +({cpu: 18945969 | mem: 118002}) +({cpu: 368169077 | mem: 2139383}) +({cpu: 19041969 | mem: 118602}) +({cpu: 643330703 | mem: 3738427}) +({cpu: 18945969 | mem: 118002}) +({cpu: 368169077 | mem: 2139383}) +({cpu: 16049969 | mem: 99902}) +({cpu: 368169077 | mem: 2139383}) +({cpu: 12625969 | mem: 78502}) +({cpu: 92335451 | mem: 536139}) \ No newline at end of file diff --git a/plutus-ledger-api/test-plugin/Spec/Value/9.6/Short.stat.golden b/plutus-ledger-api/test-plugin/Spec/Value/9.6/Short.stat.golden index 599846e2664..0a302a98523 100644 --- a/plutus-ledger-api/test-plugin/Spec/Value/9.6/Short.stat.golden +++ b/plutus-ledger-api/test-plugin/Spec/Value/9.6/Short.stat.golden @@ -1,21 +1,21 @@ -({cpu: 1840100 | mem: 11600}) -({cpu: 2384100 | mem: 15000}) -({cpu: 3449685 | mem: 21002}) -({cpu: 4186067 | mem: 24804}) -({cpu: 5091652 | mem: 29806}) -({cpu: 5972034 | mem: 34508}) -({cpu: 8343470 | mem: 48012}) -({cpu: 8734267 | mem: 50312}) -({cpu: 9953055 | mem: 57414}) -({cpu: 7144897 | mem: 41210}) -({cpu: 14879106 | mem: 84624}) -({cpu: 6452300 | mem: 37508}) -({cpu: 21447124 | mem: 120638}) -({cpu: 25647440 | mem: 142150}) -({cpu: 29340567 | mem: 163456}) -({cpu: 33636883 | mem: 185568}) -({cpu: 38940243 | mem: 215478}) -({cpu: 39964625 | mem: 221080}) -({cpu: 50054152 | mem: 275504}) -({cpu: 23820401 | mem: 134340}) -({cpu: 123802262 | mem: 666878}) \ No newline at end of file +({cpu: 1792100 | mem: 11300}) +({cpu: 2336100 | mem: 14700}) +({cpu: 3117636 | mem: 19401}) +({cpu: 3697969 | mem: 22702}) +({cpu: 4319505 | mem: 26403}) +({cpu: 5043838 | mem: 30604}) +({cpu: 6847176 | mem: 41506}) +({cpu: 7365973 | mem: 44606}) +({cpu: 8172712 | mem: 49607}) +({cpu: 5932652 | mem: 36005}) +({cpu: 11934518 | mem: 71912}) +({cpu: 5524104 | mem: 33604}) +({cpu: 16898193 | mem: 101219}) +({cpu: 20162215 | mem: 119725}) +({cpu: 22747195 | mem: 135528}) +({cpu: 26107217 | mem: 154634}) +({cpu: 29862332 | mem: 177239}) +({cpu: 30730665 | mem: 182340}) +({cpu: 38051604 | mem: 225152}) +({cpu: 19499421 | mem: 116820}) +({cpu: 92335451 | mem: 536139}) \ No newline at end of file diff --git a/plutus-tx-plugin/src/PlutusTx/Options.hs b/plutus-tx-plugin/src/PlutusTx/Options.hs index 1dfff648b79..be6468d6023 100644 --- a/plutus-tx-plugin/src/PlutusTx/Options.hs +++ b/plutus-tx-plugin/src/PlutusTx/Options.hs @@ -23,6 +23,7 @@ import Control.Applicative (many, optional, (<|>)) import Control.Exception import Control.Lens import Data.Bifunctor (first) +import Data.Coerce (coerce) import Data.Either.Validation import Data.Foldable (foldl', toList) import Data.List qualified as List @@ -243,7 +244,14 @@ pluginOptions = ) , let k = "datatypes" desc = "Set datatype encoding style" - in (k, PluginOption typeRep (readOption k) posDatatypes desc []) + in ( k + , PluginOption + typeRep + (coerce <$> readOption @PIR.DatatypeStyle k) + posDatatypes + desc + [] + ) , let k = "max-simplifier-iterations-pir" desc = "Set the max iterations for the PIR simplifier" in (k, PluginOption typeRep (readOption k) posMaxSimplifierIterationsPir desc []) diff --git a/plutus-tx-plugin/src/PlutusTx/Plugin.hs b/plutus-tx-plugin/src/PlutusTx/Plugin.hs index 813d9e51721..3ea39748473 100644 --- a/plutus-tx-plugin/src/PlutusTx/Plugin.hs +++ b/plutus-tx-plugin/src/PlutusTx/Plugin.hs @@ -428,7 +428,7 @@ compileMarkedExpr locStr codeTy origE = do , coDatatypeStyle = if _posPlcTargetVersion opts < PLC.plcVersion110 then PIR.ScottEncoding - else PIR.SumsOfProducts + else PIR._dcoStyle $ _posDatatypes opts , coRemoveTrace = _posRemoveTrace opts , coInlineFix = _posInlineFix opts } diff --git a/plutus-tx-plugin/test/AsData/Budget/9.6/destructSum-manual.eval.golden b/plutus-tx-plugin/test/AsData/Budget/9.6/destructSum-manual.eval.golden index 6104b499fc7..760d73942d9 100644 --- a/plutus-tx-plugin/test/AsData/Budget/9.6/destructSum-manual.eval.golden +++ b/plutus-tx-plugin/test/AsData/Budget/9.6/destructSum-manual.eval.golden @@ -1,5 +1,5 @@ -CPU: 7_305_268 -Memory: 26_325 -Size: 220 +CPU: 6_917_121 +Memory: 25_322 +Size: 221 (con data (Constr 0 [I 20, I 40, I 60, I 80])) \ No newline at end of file diff --git a/plutus-tx-plugin/test/AsData/Budget/9.6/destructSum-manual.pir.golden b/plutus-tx-plugin/test/AsData/Budget/9.6/destructSum-manual.pir.golden index a06e657948e..987fca82c30 100644 --- a/plutus-tx-plugin/test/AsData/Budget/9.6/destructSum-manual.pir.golden +++ b/plutus-tx-plugin/test/AsData/Budget/9.6/destructSum-manual.pir.golden @@ -36,11 +36,10 @@ in !tup : pair integer (list data) = unConstrData d in Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 0 (fstPair {integer} {list data} tup)) - True - False) + [False, True]) {all dead. data} (/\dead -> headList {data} (sndPair {integer} {list data} tup)) (/\dead -> @@ -48,11 +47,10 @@ in !tup : pair integer (list data) = unConstrData d in Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 0 (fstPair {integer} {list data} tup)) - True - False) + [False, True]) {all dead. data} (/\dead -> headList {data} (sndPair {integer} {list data} tup)) (/\dead -> @@ -60,11 +58,10 @@ in !tup : pair integer (list data) = unConstrData d in Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 2 (fstPair {integer} {list data} tup)) - True - False) + [False, True]) {all dead. data} (/\dead -> let diff --git a/plutus-tx-plugin/test/AsData/Budget/9.6/destructSum-manual.uplc.golden b/plutus-tx-plugin/test/AsData/Budget/9.6/destructSum-manual.uplc.golden index c3e3e810593..050cbb7978c 100644 --- a/plutus-tx-plugin/test/AsData/Budget/9.6/destructSum-manual.uplc.golden +++ b/plutus-tx-plugin/test/AsData/Budget/9.6/destructSum-manual.uplc.golden @@ -5,102 +5,113 @@ (\cse -> (\cse -> force - (cse - (delay - (force - (cse - (delay - (force - (force - ifThenElse - (equalsInteger 2 cse) - (delay - ((\args -> - (\y -> - (\`$mInts` -> - `$mInts` - (force headList args) - (\x - y - z - w -> - `$mInts` - y - (\x - y - z - w -> - constrData - 0 - (force - mkCons - (iData - (addInteger - x - x)) - (force - mkCons - (iData - (addInteger - y - y)) + (case + cse + [ (delay + (force + (case + cse + [ (delay + (force + (case + (equalsInteger 2 cse) + [ (delay + ((\cse -> case cse [cse]) error)) + , (delay + ((\args -> + (\y -> + (\`$mInts` -> + `$mInts` + (force headList args) + (\x + y + z + w -> + `$mInts` + y + (\x + y + z + w -> + constrData + 0 (force mkCons (iData (addInteger - z - z)) + x + x)) (force mkCons (iData (addInteger - w - w)) - [ ]))))) - (\void -> - (\cse -> - case cse [cse]) - error))) - (\scrut - cont - fail -> - (\l -> - (\l -> + y + y)) + (force + mkCons + (iData + (addInteger + z + z)) + (force + mkCons + (iData + (addInteger + w + w)) + [ ]))))) + (\void -> + (\cse -> + case + cse + [cse]) + error))) + (\scrut + cont + fail -> (\l -> - cont - (unIData + (\l -> + (\l -> + cont + (unIData + (force + headList + l)) + (unIData + (force + headList + l)) + (unIData + (force + headList + l)) + (unIData + (force + headList + (force + tailList + l)))) (force - headList + tailList l)) - (unIData - (force - headList - l)) - (unIData - (force - headList - l)) - (unIData - (force - headList - (force - tailList - l)))) - (force tailList l)) - (force tailList l)) - (force (force sndPair) - (unConstrData scrut))) - (\void -> - (\cse -> case cse [cse]) - error)) - (force headList - (force tailList args))) - (force (force sndPair) cse))) - (delay - ((\cse -> case cse [cse]) - error)))))))))) - (force ifThenElse - (equalsInteger 0 cse) - (delay (force headList (force (force sndPair) cse))))) + (force tailList + l)) + (force + (force sndPair) + (unConstrData + scrut))) + (\void -> + (\cse -> + case cse [cse]) + error)) + (force headList + (force tailList args))) + (force (force sndPair) + cse))) ]))) + , (delay + (force headList + (force (force sndPair) cse))) ]))) + , (delay (force headList (force (force sndPair) cse))) ])) + (equalsInteger 0 cse)) (force (force fstPair) cse)) (unConstrData d))) \ No newline at end of file diff --git a/plutus-tx-plugin/test/AsData/Budget/9.6/destructSum.eval.golden b/plutus-tx-plugin/test/AsData/Budget/9.6/destructSum.eval.golden index 521f74d7bc8..007b52d3d4d 100644 --- a/plutus-tx-plugin/test/AsData/Budget/9.6/destructSum.eval.golden +++ b/plutus-tx-plugin/test/AsData/Budget/9.6/destructSum.eval.golden @@ -1,5 +1,5 @@ -CPU: 7_405_601 -Memory: 26_626 -Size: 231 +CPU: 6_937_454 +Memory: 25_123 +Size: 219 (con data (Constr 0 [I 20, I 40, I 60, I 80])) \ No newline at end of file diff --git a/plutus-tx-plugin/test/AsData/Budget/9.6/destructSum.pir.golden b/plutus-tx-plugin/test/AsData/Budget/9.6/destructSum.pir.golden index 5900b9a5345..e036328185f 100644 --- a/plutus-tx-plugin/test/AsData/Budget/9.6/destructSum.pir.golden +++ b/plutus-tx-plugin/test/AsData/Budget/9.6/destructSum.pir.golden @@ -36,11 +36,10 @@ in !tup : pair integer (list data) = unConstrData d in Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 0 (fstPair {integer} {list data} tup)) - True - False) + [False, True]) {all dead. data} (/\dead -> headList {data} (sndPair {integer} {list data} tup)) (/\dead -> @@ -48,11 +47,10 @@ in !tup : pair integer (list data) = unConstrData d in Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 1 (fstPair {integer} {list data} tup)) - True - False) + [False, True]) {all dead. data} (/\dead -> headList {data} (sndPair {integer} {list data} tup)) (/\dead -> @@ -60,11 +58,10 @@ in !tup : pair integer (list data) = unConstrData d in Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 2 (fstPair {integer} {list data} tup)) - True - False) + [False, True]) {all dead. data} (/\dead -> let diff --git a/plutus-tx-plugin/test/AsData/Budget/9.6/destructSum.uplc.golden b/plutus-tx-plugin/test/AsData/Budget/9.6/destructSum.uplc.golden index f4aa24c5e50..799da5ca6c5 100644 --- a/plutus-tx-plugin/test/AsData/Budget/9.6/destructSum.uplc.golden +++ b/plutus-tx-plugin/test/AsData/Budget/9.6/destructSum.uplc.golden @@ -4,88 +4,102 @@ (\cse -> (\cse -> force - (force - ifThenElse + (case (equalsInteger 0 cse) - (delay (force headList (force (force sndPair) cse))) - (delay - (force - (force - ifThenElse - (equalsInteger 1 cse) - (delay (force headList (force (force sndPair) cse))) - (delay - (force - (force - ifThenElse - (equalsInteger 2 cse) - (delay - ((\l -> - (\`$mInts` -> - `$mInts` - (force headList l) - (\x - y - z - w -> - `$mInts` - (force headList - (force tailList l)) - (\x - y - z - w -> - constrData - 0 - (force - mkCons - (iData - (addInteger x x)) - (force - mkCons - (iData - (addInteger - y - y)) + [ (delay + (force + (case + (equalsInteger 1 cse) + [ (delay + (force + (case + (equalsInteger 2 cse) + [ (delay + ((\cse -> case cse [cse]) error)) + , (delay + ((\l -> + (\`$mInts` -> + `$mInts` + (force headList l) + (\x + y + z + w -> + `$mInts` + (force headList + (force tailList l)) + (\x + y + z + w -> + constrData + 0 (force mkCons (iData (addInteger - z - z)) + x + x)) (force mkCons (iData (addInteger - w - w)) - []))))) - (\void -> - (\cse -> case cse [cse]) - error))) - (\scrut cont fail -> - (\l -> - (\l -> + y + y)) + (force + mkCons + (iData + (addInteger + z + z)) + (force + mkCons + (iData + (addInteger + w + w)) + [ ]))))) + (\void -> + (\cse -> + case cse [cse]) + error))) + (\scrut + cont + fail -> (\l -> - cont - (unIData - (force headList l)) - (unIData - (force headList l)) - (unIData - (force headList l)) - (unIData - (force headList - (force tailList - l)))) - (force tailList l)) - (force tailList l)) - (force (force sndPair) - (unConstrData scrut))) - (\void -> - (\cse -> case cse [cse]) error)) - (force (force sndPair) cse))) - (delay - ((\cse -> case cse [cse]) error)))))))))) + (\l -> + (\l -> + cont + (unIData + (force + headList + l)) + (unIData + (force + headList + l)) + (unIData + (force + headList + l)) + (unIData + (force + headList + (force + tailList + l)))) + (force tailList l)) + (force tailList l)) + (force (force sndPair) + (unConstrData scrut))) + (\void -> + (\cse -> case cse [cse]) + error)) + (force (force sndPair) + cse))) ]))) + , (delay + (force headList + (force (force sndPair) cse))) ]))) + , (delay (force headList (force (force sndPair) cse))) ])) (force (force fstPair) cse)) (unConstrData d))) \ No newline at end of file diff --git a/plutus-tx-plugin/test/AsData/Budget/9.6/patternMatching.eval.golden b/plutus-tx-plugin/test/AsData/Budget/9.6/patternMatching.eval.golden index c41cc3fb275..2cd5d52b370 100644 --- a/plutus-tx-plugin/test/AsData/Budget/9.6/patternMatching.eval.golden +++ b/plutus-tx-plugin/test/AsData/Budget/9.6/patternMatching.eval.golden @@ -1,5 +1,5 @@ -CPU: 4_567_211 -Memory: 15_442 -Size: 148 +CPU: 3_951_113 +Memory: 12_540 +Size: 132 (con integer 220) \ No newline at end of file diff --git a/plutus-tx-plugin/test/AsData/Budget/9.6/patternMatching.pir.golden b/plutus-tx-plugin/test/AsData/Budget/9.6/patternMatching.pir.golden index 8124d6e9593..7a46b352306 100644 --- a/plutus-tx-plugin/test/AsData/Budget/9.6/patternMatching.pir.golden +++ b/plutus-tx-plugin/test/AsData/Budget/9.6/patternMatching.pir.golden @@ -8,7 +8,7 @@ let False : Bool !lessThanInteger : integer -> integer -> Bool = \(x : integer) (y : integer) -> - ifThenElse {Bool} (lessThanInteger x y) True False + case Bool (lessThanInteger x y) [False, True] in \(d : data) -> let diff --git a/plutus-tx-plugin/test/AsData/Budget/9.6/patternMatching.uplc.golden b/plutus-tx-plugin/test/AsData/Budget/9.6/patternMatching.uplc.golden index 58c9ad4cde5..8636717fe5c 100644 --- a/plutus-tx-plugin/test/AsData/Budget/9.6/patternMatching.uplc.golden +++ b/plutus-tx-plugin/test/AsData/Budget/9.6/patternMatching.uplc.golden @@ -8,31 +8,23 @@ (\y -> (\z -> (\w -> - (\lessThanInteger -> - addInteger - (addInteger - (addInteger - (addInteger (addInteger x y) z) - w) - (force - (case - (lessThanInteger - (addInteger y z) - (addInteger x w)) - [ (delay (addInteger x z)) - , (delay (addInteger y w)) ]))) + addInteger + (addInteger + (addInteger (addInteger (addInteger x y) z) w) (force (case (lessThanInteger - (addInteger z y) - (addInteger w x)) - [ (delay (addInteger z x)) - , (delay (addInteger w y)) ]))) - (\x y -> - force ifThenElse - (lessThanInteger x y) - (constr 0 []) - (constr 1 []))) + (addInteger y z) + (addInteger x w)) + [ (delay (addInteger y w)) + , (delay (addInteger x z)) ]))) + (force + (case + (lessThanInteger + (addInteger z y) + (addInteger w x)) + [ (delay (addInteger w y)) + , (delay (addInteger z x)) ]))) (unIData (force headList (force tailList l)))) (unIData (force headList l))) (unIData (force headList l))) diff --git a/plutus-tx-plugin/test/AsData/Budget/9.6/recordFields.eval.golden b/plutus-tx-plugin/test/AsData/Budget/9.6/recordFields.eval.golden index 7e0432d4dc1..c494b710631 100644 --- a/plutus-tx-plugin/test/AsData/Budget/9.6/recordFields.eval.golden +++ b/plutus-tx-plugin/test/AsData/Budget/9.6/recordFields.eval.golden @@ -1,5 +1,5 @@ -CPU: 10_360_646 -Memory: 37_390 -Size: 197 +CPU: 9_744_548 +Memory: 34_488 +Size: 181 (con integer 220) \ No newline at end of file diff --git a/plutus-tx-plugin/test/AsData/Budget/9.6/recordFields.pir.golden b/plutus-tx-plugin/test/AsData/Budget/9.6/recordFields.pir.golden index 86294e2bf7e..d5d777a70c9 100644 --- a/plutus-tx-plugin/test/AsData/Budget/9.6/recordFields.pir.golden +++ b/plutus-tx-plugin/test/AsData/Budget/9.6/recordFields.pir.golden @@ -54,7 +54,7 @@ let False : Bool !lessThanInteger : integer -> integer -> Bool = \(x : integer) (y : integer) -> - ifThenElse {Bool} (lessThanInteger x y) True False + case Bool (lessThanInteger x y) [False, True] in \(d : data) -> let diff --git a/plutus-tx-plugin/test/AsData/Budget/9.6/recordFields.uplc.golden b/plutus-tx-plugin/test/AsData/Budget/9.6/recordFields.uplc.golden index 5574b26769f..83341fcc3f9 100644 --- a/plutus-tx-plugin/test/AsData/Budget/9.6/recordFields.uplc.golden +++ b/plutus-tx-plugin/test/AsData/Budget/9.6/recordFields.uplc.golden @@ -6,19 +6,9 @@ (\cse -> (\cse -> (\cse -> - (\lessThanInteger -> - addInteger - (addInteger - (addInteger - (addInteger (addInteger cse cse) cse) - cse) - (force - (case - (lessThanInteger - (addInteger cse cse) - (addInteger cse cse)) - [ (delay (addInteger cse cse)) - , (delay (addInteger cse cse)) ]))) + addInteger + (addInteger + (addInteger (addInteger (addInteger cse cse) cse) cse) (force (case (lessThanInteger @@ -26,11 +16,13 @@ (addInteger cse cse)) [ (delay (addInteger cse cse)) , (delay (addInteger cse cse)) ]))) - (\x y -> - force ifThenElse - (lessThanInteger x y) - (constr 0 []) - (constr 1 []))) + (force + (case + (lessThanInteger + (addInteger cse cse) + (addInteger cse cse)) + [ (delay (addInteger cse cse)) + , (delay (addInteger cse cse)) ]))) (cse (\ds ds ds ds -> ds) (\void -> error))) (cse (\ds ds ds ds -> ds) (\void -> error))) (cse (\ds ds ds ds -> ds) (\void -> error))) diff --git a/plutus-tx-plugin/test/AsData/Budget/9.6/recursive.pir.golden b/plutus-tx-plugin/test/AsData/Budget/9.6/recursive.pir.golden index f08566f884b..70b5fd19012 100644 --- a/plutus-tx-plugin/test/AsData/Budget/9.6/recursive.pir.golden +++ b/plutus-tx-plugin/test/AsData/Budget/9.6/recursive.pir.golden @@ -7,7 +7,7 @@ letrec !factorial : integer -> integer = \(x : integer) -> Bool_match - (ifThenElse {Bool} (equalsInteger 0 x) True False) + (case Bool (equalsInteger 0 x) [False, True]) {all dead. integer} (/\dead -> 1) (/\dead -> multiplyInteger x (factorial (subtractInteger x 1))) diff --git a/plutus-tx-plugin/test/AsData/Budget/9.6/recursive.uplc.golden b/plutus-tx-plugin/test/AsData/Budget/9.6/recursive.uplc.golden index 3b99c8b1335..618108a1ee0 100644 --- a/plutus-tx-plugin/test/AsData/Budget/9.6/recursive.uplc.golden +++ b/plutus-tx-plugin/test/AsData/Budget/9.6/recursive.uplc.golden @@ -7,10 +7,8 @@ ((\s -> s s) (\s x -> force - (force ifThenElse + (case (equalsInteger 0 x) - (delay 1) - (delay - (multiplyInteger - x - ((\x -> s s x) (subtractInteger x 1))))))))) \ No newline at end of file + [ (delay + (multiplyInteger x ((\x -> s s x) (subtractInteger x 1)))) + , (delay 1) ]))))) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/allCheap.eval.golden b/plutus-tx-plugin/test/Budget/9.6/allCheap.eval.golden index 4166c289e3c..be973e6fc16 100644 --- a/plutus-tx-plugin/test/Budget/9.6/allCheap.eval.golden +++ b/plutus-tx-plugin/test/Budget/9.6/allCheap.eval.golden @@ -1,5 +1,5 @@ -CPU: 903_986 -Memory: 5_002 -Size: 56 +CPU: 747_937 +Memory: 4_501 +Size: 52 (constr 1) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/allCheap.pir.golden b/plutus-tx-plugin/test/Budget/9.6/allCheap.pir.golden index b3641241f20..0e28570d15e 100644 --- a/plutus-tx-plugin/test/Budget/9.6/allCheap.pir.golden +++ b/plutus-tx-plugin/test/Budget/9.6/allCheap.pir.golden @@ -19,7 +19,7 @@ letrec (\(x : integer) (xs : List integer) -> /\dead -> Bool_match - (ifThenElse {Bool} (lessThanEqualsInteger 1 x) False True) + (case Bool (lessThanEqualsInteger 1 x) [True, False]) {all dead. Bool} (/\dead -> go xs) (/\dead -> False) diff --git a/plutus-tx-plugin/test/Budget/9.6/allCheap.uplc.golden b/plutus-tx-plugin/test/Budget/9.6/allCheap.uplc.golden index 0f3a669fee0..e8c8fab9613 100644 --- a/plutus-tx-plugin/test/Budget/9.6/allCheap.uplc.golden +++ b/plutus-tx-plugin/test/Budget/9.6/allCheap.uplc.golden @@ -10,10 +10,9 @@ , (\x xs -> delay (force - (force ifThenElse + (case (lessThanEqualsInteger 1 x) - (delay (constr 1 [])) - (delay (s s xs))))) ])) + [(delay (s s xs)), (delay (constr 1 []))]))) ])) (constr 1 [ 1 , (constr 1 diff --git a/plutus-tx-plugin/test/Budget/9.6/allEmptyList.eval.golden b/plutus-tx-plugin/test/Budget/9.6/allEmptyList.eval.golden index ed7ba30b4cb..2b90b5dd948 100644 --- a/plutus-tx-plugin/test/Budget/9.6/allEmptyList.eval.golden +++ b/plutus-tx-plugin/test/Budget/9.6/allEmptyList.eval.golden @@ -1,5 +1,5 @@ CPU: 224_100 Memory: 1_500 -Size: 36 +Size: 32 (constr 0) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/allEmptyList.pir.golden b/plutus-tx-plugin/test/Budget/9.6/allEmptyList.pir.golden index 465487cc399..34ea745ca03 100644 --- a/plutus-tx-plugin/test/Budget/9.6/allEmptyList.pir.golden +++ b/plutus-tx-plugin/test/Budget/9.6/allEmptyList.pir.golden @@ -19,7 +19,7 @@ letrec (\(x : integer) (xs : List integer) -> /\dead -> Bool_match - (ifThenElse {Bool} (lessThanEqualsInteger 1 x) False True) + (case Bool (lessThanEqualsInteger 1 x) [True, False]) {all dead. Bool} (/\dead -> go xs) (/\dead -> False) diff --git a/plutus-tx-plugin/test/Budget/9.6/allEmptyList.uplc.golden b/plutus-tx-plugin/test/Budget/9.6/allEmptyList.uplc.golden index 28a30ae0b26..6a4d705bc97 100644 --- a/plutus-tx-plugin/test/Budget/9.6/allEmptyList.uplc.golden +++ b/plutus-tx-plugin/test/Budget/9.6/allEmptyList.uplc.golden @@ -9,8 +9,7 @@ , (\x xs -> delay (force - (force ifThenElse + (case (lessThanEqualsInteger 1 x) - (delay (constr 1 [])) - (delay (s s xs))))) ])) + [(delay (s s xs)), (delay (constr 1 []))]))) ])) (constr 0 []))) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/allExpensive.eval.golden b/plutus-tx-plugin/test/Budget/9.6/allExpensive.eval.golden index aba840bb41a..e4c0c3dc2bc 100644 --- a/plutus-tx-plugin/test/Budget/9.6/allExpensive.eval.golden +++ b/plutus-tx-plugin/test/Budget/9.6/allExpensive.eval.golden @@ -1,5 +1,5 @@ -CPU: 5_742_960 -Memory: 28_520 -Size: 56 +CPU: 4_182_470 +Memory: 23_510 +Size: 52 (constr 0) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/allExpensive.pir.golden b/plutus-tx-plugin/test/Budget/9.6/allExpensive.pir.golden index e04d471f59a..68a4611925f 100644 --- a/plutus-tx-plugin/test/Budget/9.6/allExpensive.pir.golden +++ b/plutus-tx-plugin/test/Budget/9.6/allExpensive.pir.golden @@ -19,7 +19,7 @@ letrec (\(x : integer) (xs : List integer) -> /\dead -> Bool_match - (ifThenElse {Bool} (lessThanEqualsInteger 11 x) False True) + (case Bool (lessThanEqualsInteger 11 x) [True, False]) {all dead. Bool} (/\dead -> go xs) (/\dead -> False) diff --git a/plutus-tx-plugin/test/Budget/9.6/allExpensive.uplc.golden b/plutus-tx-plugin/test/Budget/9.6/allExpensive.uplc.golden index aee3881f5b1..07c92796bcb 100644 --- a/plutus-tx-plugin/test/Budget/9.6/allExpensive.uplc.golden +++ b/plutus-tx-plugin/test/Budget/9.6/allExpensive.uplc.golden @@ -10,10 +10,9 @@ , (\x xs -> delay (force - (force ifThenElse + (case (lessThanEqualsInteger 11 x) - (delay (constr 1 [])) - (delay (s s xs))))) ])) + [(delay (s s xs)), (delay (constr 1 []))]))) ])) (constr 1 [ 1 , (constr 1 diff --git a/plutus-tx-plugin/test/Budget/9.6/andWithGHCOpts.eval.golden b/plutus-tx-plugin/test/Budget/9.6/andWithGHCOpts.eval.golden index 4178f1cc277..17240933c4f 100644 --- a/plutus-tx-plugin/test/Budget/9.6/andWithGHCOpts.eval.golden +++ b/plutus-tx-plugin/test/Budget/9.6/andWithGHCOpts.eval.golden @@ -1,5 +1,5 @@ -CPU: 441_439 -Memory: 2_102 -Size: 32 +CPU: 285_390 +Memory: 1_601 +Size: 24 (constr 1) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/andWithGHCOpts.pir.golden b/plutus-tx-plugin/test/Budget/9.6/andWithGHCOpts.pir.golden index 7fcc2da7cfc..07539e0e01a 100644 --- a/plutus-tx-plugin/test/Budget/9.6/andWithGHCOpts.pir.golden +++ b/plutus-tx-plugin/test/Budget/9.6/andWithGHCOpts.pir.golden @@ -5,9 +5,9 @@ in \(x : integer) (y : integer) -> Bool_match - (ifThenElse {Bool} (lessThanInteger x 3) True False) + (case Bool (lessThanInteger x 3) [False, True]) {all dead. Bool} - (/\dead -> ifThenElse {Bool} (lessThanInteger y 3) True False) + (/\dead -> case Bool (lessThanInteger y 3) [False, True]) (/\dead -> False) {all dead. dead}) 4 diff --git a/plutus-tx-plugin/test/Budget/9.6/andWithGHCOpts.uplc.golden b/plutus-tx-plugin/test/Budget/9.6/andWithGHCOpts.uplc.golden index 32888513da2..d651596113f 100644 --- a/plutus-tx-plugin/test/Budget/9.6/andWithGHCOpts.uplc.golden +++ b/plutus-tx-plugin/test/Budget/9.6/andWithGHCOpts.uplc.golden @@ -2,13 +2,12 @@ 1.1.0 ((\x y -> force - (force ifThenElse + (case (lessThanInteger x 3) - (delay - (force ifThenElse - (lessThanInteger y 3) - (constr 0 []) - (constr 1 []))) - (delay (constr 1 [])))) + [ (delay (constr 1 [])) + , (delay + (case + (lessThanInteger y 3) + [(constr 1 []), (constr 0 [])])) ])) 4 4)) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/andWithLocal.eval.golden b/plutus-tx-plugin/test/Budget/9.6/andWithLocal.eval.golden index 01421ace464..17240933c4f 100644 --- a/plutus-tx-plugin/test/Budget/9.6/andWithLocal.eval.golden +++ b/plutus-tx-plugin/test/Budget/9.6/andWithLocal.eval.golden @@ -1,5 +1,5 @@ -CPU: 617_439 -Memory: 3_202 -Size: 37 +CPU: 285_390 +Memory: 1_601 +Size: 24 (constr 1) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/andWithLocal.pir.golden b/plutus-tx-plugin/test/Budget/9.6/andWithLocal.pir.golden index 805dfd6aed2..07539e0e01a 100644 --- a/plutus-tx-plugin/test/Budget/9.6/andWithLocal.pir.golden +++ b/plutus-tx-plugin/test/Budget/9.6/andWithLocal.pir.golden @@ -2,15 +2,12 @@ data Bool | Bool_match where True : Bool False : Bool - !lessThanInteger : integer -> integer -> Bool - = \(x : integer) (y : integer) -> - ifThenElse {Bool} (lessThanInteger x y) True False in \(x : integer) (y : integer) -> Bool_match - (lessThanInteger x 3) + (case Bool (lessThanInteger x 3) [False, True]) {all dead. Bool} - (/\dead -> lessThanInteger y 3) + (/\dead -> case Bool (lessThanInteger y 3) [False, True]) (/\dead -> False) {all dead. dead}) 4 diff --git a/plutus-tx-plugin/test/Budget/9.6/andWithLocal.uplc.golden b/plutus-tx-plugin/test/Budget/9.6/andWithLocal.uplc.golden index 94abf5891ab..d651596113f 100644 --- a/plutus-tx-plugin/test/Budget/9.6/andWithLocal.uplc.golden +++ b/plutus-tx-plugin/test/Budget/9.6/andWithLocal.uplc.golden @@ -2,14 +2,12 @@ 1.1.0 ((\x y -> force - ((\lessThanInteger -> - case - (lessThanInteger x 3) - [(delay (lessThanInteger y 3)), (delay (constr 1 []))]) - (\x y -> - force ifThenElse - (lessThanInteger x y) - (constr 0 []) - (constr 1 [])))) + (case + (lessThanInteger x 3) + [ (delay (constr 1 [])) + , (delay + (case + (lessThanInteger y 3) + [(constr 1 []), (constr 0 [])])) ])) 4 4)) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/andWithoutGHCOpts.eval.golden b/plutus-tx-plugin/test/Budget/9.6/andWithoutGHCOpts.eval.golden index c42ce105a1d..e84a83f898f 100644 --- a/plutus-tx-plugin/test/Budget/9.6/andWithoutGHCOpts.eval.golden +++ b/plutus-tx-plugin/test/Budget/9.6/andWithoutGHCOpts.eval.golden @@ -1,5 +1,5 @@ -CPU: 473_439 -Memory: 2_302 -Size: 35 +CPU: 317_390 +Memory: 1_801 +Size: 27 (constr 1) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/andWithoutGHCOpts.pir.golden b/plutus-tx-plugin/test/Budget/9.6/andWithoutGHCOpts.pir.golden index 03e2f3fb3ad..8bb760d8caf 100644 --- a/plutus-tx-plugin/test/Budget/9.6/andWithoutGHCOpts.pir.golden +++ b/plutus-tx-plugin/test/Budget/9.6/andWithoutGHCOpts.pir.golden @@ -17,46 +17,44 @@ (a -> a -> a) -> (a -> a -> a) -> Ord a + !ifThenElse : all a. bool -> a -> a -> a + = /\a -> \(b : bool) (x : a) (y : a) -> case a b [y, x] !`$fOrdInteger` : Ord integer = CConsOrd {integer} (\(x : integer) (y : integer) -> - ifThenElse {Bool} (equalsInteger x y) True False) + case Bool (equalsInteger x y) [False, True]) (\(eta : integer) (eta : integer) -> Bool_match - (ifThenElse {Bool} (equalsInteger eta eta) True False) + (case Bool (equalsInteger eta eta) [False, True]) {all dead. Ordering} (/\dead -> EQ) (/\dead -> Bool_match - (ifThenElse - {Bool} - (lessThanEqualsInteger eta eta) - True - False) + (case Bool (lessThanEqualsInteger eta eta) [False, True]) {all dead. Ordering} (/\dead -> LT) (/\dead -> GT) {all dead. dead}) {all dead. dead}) (\(x : integer) (y : integer) -> - ifThenElse {Bool} (lessThanInteger x y) True False) + case Bool (lessThanInteger x y) [False, True]) (\(x : integer) (y : integer) -> - ifThenElse {Bool} (lessThanEqualsInteger x y) True False) + case Bool (lessThanEqualsInteger x y) [False, True]) (\(x : integer) (y : integer) -> ifThenElse {Bool} (lessThanEqualsInteger x y) False True) (\(x : integer) (y : integer) -> ifThenElse {Bool} (lessThanInteger x y) False True) (\(x : integer) (y : integer) -> Bool_match - (ifThenElse {Bool} (lessThanEqualsInteger x y) True False) + (case Bool (lessThanEqualsInteger x y) [False, True]) {all dead. integer} (/\dead -> y) (/\dead -> x) {all dead. dead}) (\(x : integer) (y : integer) -> Bool_match - (ifThenElse {Bool} (lessThanEqualsInteger x y) True False) + (case Bool (lessThanEqualsInteger x y) [False, True]) {all dead. integer} (/\dead -> x) (/\dead -> y) diff --git a/plutus-tx-plugin/test/Budget/9.6/andWithoutGHCOpts.uplc.golden b/plutus-tx-plugin/test/Budget/9.6/andWithoutGHCOpts.uplc.golden index 85a233cb9d1..2471e38142e 100644 --- a/plutus-tx-plugin/test/Budget/9.6/andWithoutGHCOpts.uplc.golden +++ b/plutus-tx-plugin/test/Budget/9.6/andWithoutGHCOpts.uplc.golden @@ -3,12 +3,9 @@ ((\x y -> force (case - (force ifThenElse (lessThanInteger x 3) (constr 0 []) (constr 1 [])) + (case (lessThanInteger x 3) [(constr 1 []), (constr 0 [])]) [ (delay - (force ifThenElse - (lessThanInteger y 3) - (constr 0 []) - (constr 1 []))) + (case (lessThanInteger y 3) [(constr 1 []), (constr 0 [])])) , (delay (constr 1 [])) ])) 4 4)) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/anyCheap.eval.golden b/plutus-tx-plugin/test/Budget/9.6/anyCheap.eval.golden index 2709cec1d8f..f2d67f920bd 100644 --- a/plutus-tx-plugin/test/Budget/9.6/anyCheap.eval.golden +++ b/plutus-tx-plugin/test/Budget/9.6/anyCheap.eval.golden @@ -1,5 +1,5 @@ -CPU: 903_986 -Memory: 5_002 -Size: 56 +CPU: 747_937 +Memory: 4_501 +Size: 52 (constr 0) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/anyCheap.pir.golden b/plutus-tx-plugin/test/Budget/9.6/anyCheap.pir.golden index 18b0845a444..edef1fd6728 100644 --- a/plutus-tx-plugin/test/Budget/9.6/anyCheap.pir.golden +++ b/plutus-tx-plugin/test/Budget/9.6/anyCheap.pir.golden @@ -19,7 +19,7 @@ letrec (\(x : integer) (xs : List integer) -> /\dead -> Bool_match - (ifThenElse {Bool} (lessThanEqualsInteger 10 x) False True) + (case Bool (lessThanEqualsInteger 10 x) [True, False]) {all dead. Bool} (/\dead -> True) (/\dead -> go xs) diff --git a/plutus-tx-plugin/test/Budget/9.6/anyCheap.uplc.golden b/plutus-tx-plugin/test/Budget/9.6/anyCheap.uplc.golden index 9cdd8514e36..6b6ae95b67c 100644 --- a/plutus-tx-plugin/test/Budget/9.6/anyCheap.uplc.golden +++ b/plutus-tx-plugin/test/Budget/9.6/anyCheap.uplc.golden @@ -10,10 +10,9 @@ , (\x xs -> delay (force - (force ifThenElse + (case (lessThanEqualsInteger 10 x) - (delay (s s xs)) - (delay (constr 0 []))))) ])) + [(delay (constr 0 [])), (delay (s s xs))]))) ])) (constr 1 [ 1 , (constr 1 diff --git a/plutus-tx-plugin/test/Budget/9.6/anyEmptyList.eval.golden b/plutus-tx-plugin/test/Budget/9.6/anyEmptyList.eval.golden index 43ace8c83f7..c13fdf456f0 100644 --- a/plutus-tx-plugin/test/Budget/9.6/anyEmptyList.eval.golden +++ b/plutus-tx-plugin/test/Budget/9.6/anyEmptyList.eval.golden @@ -1,5 +1,5 @@ CPU: 224_100 Memory: 1_500 -Size: 36 +Size: 32 (constr 1) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/anyEmptyList.pir.golden b/plutus-tx-plugin/test/Budget/9.6/anyEmptyList.pir.golden index b476d418c66..f1aa7db5931 100644 --- a/plutus-tx-plugin/test/Budget/9.6/anyEmptyList.pir.golden +++ b/plutus-tx-plugin/test/Budget/9.6/anyEmptyList.pir.golden @@ -19,7 +19,7 @@ letrec (\(x : integer) (xs : List integer) -> /\dead -> Bool_match - (ifThenElse {Bool} (lessThanEqualsInteger 1 x) False True) + (case Bool (lessThanEqualsInteger 1 x) [True, False]) {all dead. Bool} (/\dead -> True) (/\dead -> go xs) diff --git a/plutus-tx-plugin/test/Budget/9.6/anyEmptyList.uplc.golden b/plutus-tx-plugin/test/Budget/9.6/anyEmptyList.uplc.golden index 7c520e61681..2d8192471bc 100644 --- a/plutus-tx-plugin/test/Budget/9.6/anyEmptyList.uplc.golden +++ b/plutus-tx-plugin/test/Budget/9.6/anyEmptyList.uplc.golden @@ -9,8 +9,7 @@ , (\x xs -> delay (force - (force ifThenElse + (case (lessThanEqualsInteger 1 x) - (delay (s s xs)) - (delay (constr 0 []))))) ])) + [(delay (constr 0 [])), (delay (s s xs))]))) ])) (constr 0 []))) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/anyExpensive.eval.golden b/plutus-tx-plugin/test/Budget/9.6/anyExpensive.eval.golden index f4f60664b92..3cd273db815 100644 --- a/plutus-tx-plugin/test/Budget/9.6/anyExpensive.eval.golden +++ b/plutus-tx-plugin/test/Budget/9.6/anyExpensive.eval.golden @@ -1,5 +1,5 @@ -CPU: 5_742_960 -Memory: 28_520 -Size: 56 +CPU: 4_182_470 +Memory: 23_510 +Size: 52 (constr 1) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/anyExpensive.pir.golden b/plutus-tx-plugin/test/Budget/9.6/anyExpensive.pir.golden index d9c1b3a0257..ed82fc95fb4 100644 --- a/plutus-tx-plugin/test/Budget/9.6/anyExpensive.pir.golden +++ b/plutus-tx-plugin/test/Budget/9.6/anyExpensive.pir.golden @@ -19,7 +19,7 @@ letrec (\(x : integer) (xs : List integer) -> /\dead -> Bool_match - (ifThenElse {Bool} (lessThanEqualsInteger 1 x) False True) + (case Bool (lessThanEqualsInteger 1 x) [True, False]) {all dead. Bool} (/\dead -> True) (/\dead -> go xs) diff --git a/plutus-tx-plugin/test/Budget/9.6/anyExpensive.uplc.golden b/plutus-tx-plugin/test/Budget/9.6/anyExpensive.uplc.golden index bb92dd301c7..332c7ea6904 100644 --- a/plutus-tx-plugin/test/Budget/9.6/anyExpensive.uplc.golden +++ b/plutus-tx-plugin/test/Budget/9.6/anyExpensive.uplc.golden @@ -10,10 +10,9 @@ , (\x xs -> delay (force - (force ifThenElse + (case (lessThanEqualsInteger 1 x) - (delay (s s xs)) - (delay (constr 0 []))))) ])) + [(delay (constr 0 [])), (delay (s s xs))]))) ])) (constr 1 [ 1 , (constr 1 diff --git a/plutus-tx-plugin/test/Budget/9.6/constAccL.eval.golden b/plutus-tx-plugin/test/Budget/9.6/constAccL.eval.golden index 8773a7aaa33..eea1389eb6b 100644 --- a/plutus-tx-plugin/test/Budget/9.6/constAccL.eval.golden +++ b/plutus-tx-plugin/test/Budget/9.6/constAccL.eval.golden @@ -1,5 +1,5 @@ -CPU: 909_933_986 -Memory: 4_308_602 -Size: 69 +CPU: 753_728_937 +Memory: 3_807_101 +Size: 65 (con integer 42) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/constAccL.pir.golden b/plutus-tx-plugin/test/Budget/9.6/constAccL.pir.golden index a1cc5a80c47..59f3d1fe69c 100644 --- a/plutus-tx-plugin/test/Budget/9.6/constAccL.pir.golden +++ b/plutus-tx-plugin/test/Budget/9.6/constAccL.pir.golden @@ -23,7 +23,7 @@ letrec !go : integer -> List integer = \(n : integer) -> Bool_match - (ifThenElse {Bool} (lessThanEqualsInteger n 0) True False) + (case Bool (lessThanEqualsInteger n 0) [False, True]) {all dead. List integer} (/\dead -> Nil {integer}) (/\dead -> Cons {integer} 1 (go (subtractInteger n 1))) diff --git a/plutus-tx-plugin/test/Budget/9.6/constAccL.uplc.golden b/plutus-tx-plugin/test/Budget/9.6/constAccL.uplc.golden index 19dc0c2dc59..7bae0f8146c 100644 --- a/plutus-tx-plugin/test/Budget/9.6/constAccL.uplc.golden +++ b/plutus-tx-plugin/test/Budget/9.6/constAccL.uplc.golden @@ -5,11 +5,11 @@ ((\s -> s s) (\s n -> force - (force ifThenElse + (case (lessThanEqualsInteger n 0) - (delay (constr 0 [])) - (delay - (constr 1 [1, ((\x -> s s x) (subtractInteger n 1))])))) + [ (delay + (constr 1 [1, ((\x -> s s x) (subtractInteger n 1))])) + , (delay (constr 0 [])) ])) 1000)) ((\s -> s s) (\s acc ds -> diff --git a/plutus-tx-plugin/test/Budget/9.6/constAccR.eval.golden b/plutus-tx-plugin/test/Budget/9.6/constAccR.eval.golden index 40134a73eee..723aa195e2b 100644 --- a/plutus-tx-plugin/test/Budget/9.6/constAccR.eval.golden +++ b/plutus-tx-plugin/test/Budget/9.6/constAccR.eval.golden @@ -1,5 +1,5 @@ -CPU: 861_789_986 -Memory: 4_007_702 -Size: 58 +CPU: 705_584_937 +Memory: 3_506_201 +Size: 54 (con integer 42) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/constAccR.pir.golden b/plutus-tx-plugin/test/Budget/9.6/constAccR.pir.golden index c6123acd46d..cc3ae7a2967 100644 --- a/plutus-tx-plugin/test/Budget/9.6/constAccR.pir.golden +++ b/plutus-tx-plugin/test/Budget/9.6/constAccR.pir.golden @@ -23,7 +23,7 @@ letrec !go : integer -> List integer = \(n : integer) -> Bool_match - (ifThenElse {Bool} (lessThanEqualsInteger n 0) True False) + (case Bool (lessThanEqualsInteger n 0) [False, True]) {all dead. List integer} (/\dead -> Nil {integer}) (/\dead -> Cons {integer} 1 (go (subtractInteger n 1))) diff --git a/plutus-tx-plugin/test/Budget/9.6/constAccR.uplc.golden b/plutus-tx-plugin/test/Budget/9.6/constAccR.uplc.golden index be287c8841f..aacac5bb489 100644 --- a/plutus-tx-plugin/test/Budget/9.6/constAccR.uplc.golden +++ b/plutus-tx-plugin/test/Budget/9.6/constAccR.uplc.golden @@ -5,8 +5,8 @@ ((\s -> s s) (\s n -> force - (force ifThenElse + (case (lessThanEqualsInteger n 0) - (delay (constr 0 [])) - (delay (constr 1 [1, ((\x -> s s x) (subtractInteger n 1))])))) + [ (delay (constr 1 [1, ((\x -> s s x) (subtractInteger n 1))])) + , (delay (constr 0 [])) ])) 1000))) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/constElL.eval.golden b/plutus-tx-plugin/test/Budget/9.6/constElL.eval.golden index 42b935c976c..85b537d7705 100644 --- a/plutus-tx-plugin/test/Budget/9.6/constElL.eval.golden +++ b/plutus-tx-plugin/test/Budget/9.6/constElL.eval.golden @@ -1,5 +1,5 @@ -CPU: 909_933_986 -Memory: 4_308_602 -Size: 69 +CPU: 753_728_937 +Memory: 3_807_101 +Size: 65 (con integer 1) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/constElL.pir.golden b/plutus-tx-plugin/test/Budget/9.6/constElL.pir.golden index 00e07b5f2f0..01856f77c01 100644 --- a/plutus-tx-plugin/test/Budget/9.6/constElL.pir.golden +++ b/plutus-tx-plugin/test/Budget/9.6/constElL.pir.golden @@ -23,7 +23,7 @@ letrec !go : integer -> List integer = \(n : integer) -> Bool_match - (ifThenElse {Bool} (lessThanEqualsInteger n 0) True False) + (case Bool (lessThanEqualsInteger n 0) [False, True]) {all dead. List integer} (/\dead -> Nil {integer}) (/\dead -> Cons {integer} 1 (go (subtractInteger n 1))) diff --git a/plutus-tx-plugin/test/Budget/9.6/constElL.uplc.golden b/plutus-tx-plugin/test/Budget/9.6/constElL.uplc.golden index 56f50d5ab27..966bef99b3e 100644 --- a/plutus-tx-plugin/test/Budget/9.6/constElL.uplc.golden +++ b/plutus-tx-plugin/test/Budget/9.6/constElL.uplc.golden @@ -5,11 +5,11 @@ ((\s -> s s) (\s n -> force - (force ifThenElse + (case (lessThanEqualsInteger n 0) - (delay (constr 0 [])) - (delay - (constr 1 [1, ((\x -> s s x) (subtractInteger n 1))])))) + [ (delay + (constr 1 [1, ((\x -> s s x) (subtractInteger n 1))])) + , (delay (constr 0 [])) ])) 1000)) ((\s -> s s) (\s acc ds -> diff --git a/plutus-tx-plugin/test/Budget/9.6/constElR.eval.golden b/plutus-tx-plugin/test/Budget/9.6/constElR.eval.golden index 4b7ebdcf027..249f8b93238 100644 --- a/plutus-tx-plugin/test/Budget/9.6/constElR.eval.golden +++ b/plutus-tx-plugin/test/Budget/9.6/constElR.eval.golden @@ -1,5 +1,5 @@ -CPU: 909_789_986 -Memory: 4_307_702 -Size: 61 +CPU: 753_584_937 +Memory: 3_806_201 +Size: 57 (con integer 1) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/constElR.pir.golden b/plutus-tx-plugin/test/Budget/9.6/constElR.pir.golden index ce7fe4cdd5e..fb4fb6e04f2 100644 --- a/plutus-tx-plugin/test/Budget/9.6/constElR.pir.golden +++ b/plutus-tx-plugin/test/Budget/9.6/constElR.pir.golden @@ -24,7 +24,7 @@ letrec !go : integer -> List integer = \(n : integer) -> Bool_match - (ifThenElse {Bool} (lessThanEqualsInteger n 0) True False) + (case Bool (lessThanEqualsInteger n 0) [False, True]) {all dead. List integer} (/\dead -> Nil {integer}) (/\dead -> Cons {integer} 1 (go (subtractInteger n 1))) diff --git a/plutus-tx-plugin/test/Budget/9.6/constElR.uplc.golden b/plutus-tx-plugin/test/Budget/9.6/constElR.uplc.golden index 4053c73d8d3..4a14c6ccee0 100644 --- a/plutus-tx-plugin/test/Budget/9.6/constElR.uplc.golden +++ b/plutus-tx-plugin/test/Budget/9.6/constElR.uplc.golden @@ -6,8 +6,8 @@ ((\s -> s s) (\s n -> force - (force ifThenElse + (case (lessThanEqualsInteger n 0) - (delay (constr 0 [])) - (delay (constr 1 [1, ((\x -> s s x) (subtractInteger n 1))])))) + [ (delay (constr 1 [1, ((\x -> s s x) (subtractInteger n 1))])) + , (delay (constr 0 [])) ])) 1000))) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/elemCheap.eval.golden b/plutus-tx-plugin/test/Budget/9.6/elemCheap.eval.golden index 9a91777cf9a..38781912c44 100644 --- a/plutus-tx-plugin/test/Budget/9.6/elemCheap.eval.golden +++ b/plutus-tx-plugin/test/Budget/9.6/elemCheap.eval.golden @@ -1,5 +1,5 @@ -CPU: 912_482 -Memory: 5_002 -Size: 56 +CPU: 756_433 +Memory: 4_501 +Size: 52 (constr 0) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/elemCheap.pir.golden b/plutus-tx-plugin/test/Budget/9.6/elemCheap.pir.golden index 9141c23e19e..70776a7aff6 100644 --- a/plutus-tx-plugin/test/Budget/9.6/elemCheap.pir.golden +++ b/plutus-tx-plugin/test/Budget/9.6/elemCheap.pir.golden @@ -19,7 +19,7 @@ letrec (\(x : integer) (xs : List integer) -> /\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 1 x) True False) + (case Bool (equalsInteger 1 x) [False, True]) {all dead. Bool} (/\dead -> True) (/\dead -> go xs) diff --git a/plutus-tx-plugin/test/Budget/9.6/elemCheap.uplc.golden b/plutus-tx-plugin/test/Budget/9.6/elemCheap.uplc.golden index bda649f1b2d..cd1fa66f96f 100644 --- a/plutus-tx-plugin/test/Budget/9.6/elemCheap.uplc.golden +++ b/plutus-tx-plugin/test/Budget/9.6/elemCheap.uplc.golden @@ -10,10 +10,9 @@ , (\x xs -> delay (force - (force ifThenElse + (case (equalsInteger 1 x) - (delay (constr 0 [])) - (delay (s s xs))))) ])) + [(delay (s s xs)), (delay (constr 0 []))]))) ])) (constr 1 [ 1 , (constr 1 diff --git a/plutus-tx-plugin/test/Budget/9.6/elemExpensive.eval.golden b/plutus-tx-plugin/test/Budget/9.6/elemExpensive.eval.golden index 1ce9ea3a5ce..6981e971b9b 100644 --- a/plutus-tx-plugin/test/Budget/9.6/elemExpensive.eval.golden +++ b/plutus-tx-plugin/test/Budget/9.6/elemExpensive.eval.golden @@ -1,5 +1,5 @@ -CPU: 5_827_920 -Memory: 28_520 -Size: 56 +CPU: 4_267_430 +Memory: 23_510 +Size: 52 (constr 1) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/elemExpensive.pir.golden b/plutus-tx-plugin/test/Budget/9.6/elemExpensive.pir.golden index d056d7efa25..e244ebe84ed 100644 --- a/plutus-tx-plugin/test/Budget/9.6/elemExpensive.pir.golden +++ b/plutus-tx-plugin/test/Budget/9.6/elemExpensive.pir.golden @@ -19,7 +19,7 @@ letrec (\(x : integer) (xs : List integer) -> /\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 0 x) True False) + (case Bool (equalsInteger 0 x) [False, True]) {all dead. Bool} (/\dead -> True) (/\dead -> go xs) diff --git a/plutus-tx-plugin/test/Budget/9.6/elemExpensive.uplc.golden b/plutus-tx-plugin/test/Budget/9.6/elemExpensive.uplc.golden index 369596bc737..a7f7b09f87b 100644 --- a/plutus-tx-plugin/test/Budget/9.6/elemExpensive.uplc.golden +++ b/plutus-tx-plugin/test/Budget/9.6/elemExpensive.uplc.golden @@ -10,10 +10,9 @@ , (\x xs -> delay (force - (force ifThenElse + (case (equalsInteger 0 x) - (delay (constr 0 [])) - (delay (s s xs))))) ])) + [(delay (s s xs)), (delay (constr 0 []))]))) ])) (constr 1 [ 1 , (constr 1 diff --git a/plutus-tx-plugin/test/Budget/9.6/filter.eval.golden b/plutus-tx-plugin/test/Budget/9.6/filter.eval.golden index 246b7e089a4..a29f0e1bf2f 100644 --- a/plutus-tx-plugin/test/Budget/9.6/filter.eval.golden +++ b/plutus-tx-plugin/test/Budget/9.6/filter.eval.golden @@ -1,6 +1,6 @@ -CPU: 8_427_220 -Memory: 36_530 -Size: 65 +CPU: 6_866_730 +Memory: 31_520 +Size: 61 (constr 1 diff --git a/plutus-tx-plugin/test/Budget/9.6/filter.pir.golden b/plutus-tx-plugin/test/Budget/9.6/filter.pir.golden index 638425f5f85..f827f744b6a 100644 --- a/plutus-tx-plugin/test/Budget/9.6/filter.pir.golden +++ b/plutus-tx-plugin/test/Budget/9.6/filter.pir.golden @@ -22,11 +22,7 @@ letrec !xs : List integer = go xs in Bool_match - (ifThenElse - {Bool} - (equalsInteger 0 (modInteger x 2)) - True - False) + (case Bool (equalsInteger 0 (modInteger x 2)) [False, True]) {all dead. List integer} (/\dead -> Cons {integer} x xs) (/\dead -> xs) diff --git a/plutus-tx-plugin/test/Budget/9.6/filter.uplc.golden b/plutus-tx-plugin/test/Budget/9.6/filter.uplc.golden index 1e750c23490..62aed773fab 100644 --- a/plutus-tx-plugin/test/Budget/9.6/filter.uplc.golden +++ b/plutus-tx-plugin/test/Budget/9.6/filter.uplc.golden @@ -11,10 +11,9 @@ delay ((\xs -> force - (force ifThenElse + (case (equalsInteger 0 (modInteger x 2)) - (delay (constr 1 [x, xs])) - (delay xs))) + [(delay xs), (delay (constr 1 [x, xs]))])) (s s xs))) ])) (constr 1 [ 1 diff --git a/plutus-tx-plugin/test/Budget/9.6/findCheap.eval.golden b/plutus-tx-plugin/test/Budget/9.6/findCheap.eval.golden index 7a6f57020d5..dcfd7fb1ff9 100644 --- a/plutus-tx-plugin/test/Budget/9.6/findCheap.eval.golden +++ b/plutus-tx-plugin/test/Budget/9.6/findCheap.eval.golden @@ -1,5 +1,5 @@ -CPU: 919_986 -Memory: 5_102 -Size: 57 +CPU: 763_937 +Memory: 4_601 +Size: 53 (constr 0 (con integer 1)) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/findCheap.pir.golden b/plutus-tx-plugin/test/Budget/9.6/findCheap.pir.golden index 4434e6d5856..a1f19cdefaa 100644 --- a/plutus-tx-plugin/test/Budget/9.6/findCheap.pir.golden +++ b/plutus-tx-plugin/test/Budget/9.6/findCheap.pir.golden @@ -22,7 +22,7 @@ letrec (\(x : integer) (xs : List integer) -> /\dead -> Bool_match - (ifThenElse {Bool} (lessThanEqualsInteger 10 x) False True) + (case Bool (lessThanEqualsInteger 10 x) [True, False]) {all dead. Maybe integer} (/\dead -> Just {integer} x) (/\dead -> go xs) diff --git a/plutus-tx-plugin/test/Budget/9.6/findCheap.uplc.golden b/plutus-tx-plugin/test/Budget/9.6/findCheap.uplc.golden index ffb50bcac32..1ae4b338350 100644 --- a/plutus-tx-plugin/test/Budget/9.6/findCheap.uplc.golden +++ b/plutus-tx-plugin/test/Budget/9.6/findCheap.uplc.golden @@ -10,10 +10,9 @@ , (\x xs -> delay (force - (force ifThenElse + (case (lessThanEqualsInteger 10 x) - (delay (s s xs)) - (delay (constr 0 [x]))))) ])) + [(delay (constr 0 [x])), (delay (s s xs))]))) ])) (constr 1 [ 1 , (constr 1 diff --git a/plutus-tx-plugin/test/Budget/9.6/findEmptyList.eval.golden b/plutus-tx-plugin/test/Budget/9.6/findEmptyList.eval.golden index da81d77fdc0..86dc1aeead0 100644 --- a/plutus-tx-plugin/test/Budget/9.6/findEmptyList.eval.golden +++ b/plutus-tx-plugin/test/Budget/9.6/findEmptyList.eval.golden @@ -1,5 +1,5 @@ CPU: 224_100 Memory: 1_500 -Size: 37 +Size: 33 (constr 1) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/findEmptyList.pir.golden b/plutus-tx-plugin/test/Budget/9.6/findEmptyList.pir.golden index e56630b3ddb..d6c1031c87f 100644 --- a/plutus-tx-plugin/test/Budget/9.6/findEmptyList.pir.golden +++ b/plutus-tx-plugin/test/Budget/9.6/findEmptyList.pir.golden @@ -22,7 +22,7 @@ letrec (\(x : integer) (xs : List integer) -> /\dead -> Bool_match - (ifThenElse {Bool} (lessThanEqualsInteger 1 x) False True) + (case Bool (lessThanEqualsInteger 1 x) [True, False]) {all dead. Maybe integer} (/\dead -> Just {integer} x) (/\dead -> go xs) diff --git a/plutus-tx-plugin/test/Budget/9.6/findEmptyList.uplc.golden b/plutus-tx-plugin/test/Budget/9.6/findEmptyList.uplc.golden index 6a111cc553d..bd964773e0f 100644 --- a/plutus-tx-plugin/test/Budget/9.6/findEmptyList.uplc.golden +++ b/plutus-tx-plugin/test/Budget/9.6/findEmptyList.uplc.golden @@ -9,8 +9,7 @@ , (\x xs -> delay (force - (force ifThenElse + (case (lessThanEqualsInteger 1 x) - (delay (s s xs)) - (delay (constr 0 [x]))))) ])) + [(delay (constr 0 [x])), (delay (s s xs))]))) ])) (constr 0 []))) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/findExpensive.eval.golden b/plutus-tx-plugin/test/Budget/9.6/findExpensive.eval.golden index 46ac91981bb..3c7cccf6330 100644 --- a/plutus-tx-plugin/test/Budget/9.6/findExpensive.eval.golden +++ b/plutus-tx-plugin/test/Budget/9.6/findExpensive.eval.golden @@ -1,5 +1,5 @@ -CPU: 5_742_960 -Memory: 28_520 -Size: 57 +CPU: 4_182_470 +Memory: 23_510 +Size: 53 (constr 1) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/findExpensive.pir.golden b/plutus-tx-plugin/test/Budget/9.6/findExpensive.pir.golden index a94f48deade..d9b7e6cf136 100644 --- a/plutus-tx-plugin/test/Budget/9.6/findExpensive.pir.golden +++ b/plutus-tx-plugin/test/Budget/9.6/findExpensive.pir.golden @@ -22,7 +22,7 @@ letrec (\(x : integer) (xs : List integer) -> /\dead -> Bool_match - (ifThenElse {Bool} (lessThanEqualsInteger 1 x) False True) + (case Bool (lessThanEqualsInteger 1 x) [True, False]) {all dead. Maybe integer} (/\dead -> Just {integer} x) (/\dead -> go xs) diff --git a/plutus-tx-plugin/test/Budget/9.6/findExpensive.uplc.golden b/plutus-tx-plugin/test/Budget/9.6/findExpensive.uplc.golden index c6e674f1d57..28788be611b 100644 --- a/plutus-tx-plugin/test/Budget/9.6/findExpensive.uplc.golden +++ b/plutus-tx-plugin/test/Budget/9.6/findExpensive.uplc.golden @@ -10,10 +10,9 @@ , (\x xs -> delay (force - (force ifThenElse + (case (lessThanEqualsInteger 1 x) - (delay (s s xs)) - (delay (constr 0 [x]))))) ])) + [(delay (constr 0 [x])), (delay (s s xs))]))) ])) (constr 1 [ 1 , (constr 1 diff --git a/plutus-tx-plugin/test/Budget/9.6/findIndexCheap.eval.golden b/plutus-tx-plugin/test/Budget/9.6/findIndexCheap.eval.golden index 977563b56e3..5dd69373016 100644 --- a/plutus-tx-plugin/test/Budget/9.6/findIndexCheap.eval.golden +++ b/plutus-tx-plugin/test/Budget/9.6/findIndexCheap.eval.golden @@ -1,5 +1,5 @@ -CPU: 967_986 -Memory: 5_402 -Size: 69 +CPU: 811_937 +Memory: 4_901 +Size: 65 (constr 0 (con integer 0)) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/findIndexCheap.pir.golden b/plutus-tx-plugin/test/Budget/9.6/findIndexCheap.pir.golden index 2dbcb61f82c..880cd5eb2ce 100644 --- a/plutus-tx-plugin/test/Budget/9.6/findIndexCheap.pir.golden +++ b/plutus-tx-plugin/test/Budget/9.6/findIndexCheap.pir.golden @@ -22,7 +22,7 @@ letrec (\(x : integer) (xs : List integer) -> /\dead -> Bool_match - (ifThenElse {Bool} (lessThanEqualsInteger 10 x) False True) + (case Bool (lessThanEqualsInteger 10 x) [True, False]) {all dead. Maybe integer} (/\dead -> Just {integer} i) (/\dead -> go (addInteger 1 i) xs) diff --git a/plutus-tx-plugin/test/Budget/9.6/findIndexCheap.uplc.golden b/plutus-tx-plugin/test/Budget/9.6/findIndexCheap.uplc.golden index c63e207afbe..96ee66a12ce 100644 --- a/plutus-tx-plugin/test/Budget/9.6/findIndexCheap.uplc.golden +++ b/plutus-tx-plugin/test/Budget/9.6/findIndexCheap.uplc.golden @@ -10,10 +10,11 @@ , (\x xs -> delay (force - (force ifThenElse + (case (lessThanEqualsInteger 10 x) - (delay ((\x -> s s x) (addInteger 1 i) xs)) - (delay (constr 0 [i]))))) ])) + [ (delay (constr 0 [i])) + , (delay + ((\x -> s s x) (addInteger 1 i) xs)) ]))) ])) 0 (constr 1 [ 1 diff --git a/plutus-tx-plugin/test/Budget/9.6/findIndexEmptyList.eval.golden b/plutus-tx-plugin/test/Budget/9.6/findIndexEmptyList.eval.golden index caa33b02340..7091ebc541f 100644 --- a/plutus-tx-plugin/test/Budget/9.6/findIndexEmptyList.eval.golden +++ b/plutus-tx-plugin/test/Budget/9.6/findIndexEmptyList.eval.golden @@ -1,5 +1,5 @@ CPU: 272_100 Memory: 1_800 -Size: 49 +Size: 45 (constr 1) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/findIndexEmptyList.pir.golden b/plutus-tx-plugin/test/Budget/9.6/findIndexEmptyList.pir.golden index cfdedbabc41..fa7ffec388f 100644 --- a/plutus-tx-plugin/test/Budget/9.6/findIndexEmptyList.pir.golden +++ b/plutus-tx-plugin/test/Budget/9.6/findIndexEmptyList.pir.golden @@ -22,7 +22,7 @@ letrec (\(x : integer) (xs : List integer) -> /\dead -> Bool_match - (ifThenElse {Bool} (lessThanEqualsInteger 1 x) False True) + (case Bool (lessThanEqualsInteger 1 x) [True, False]) {all dead. Maybe integer} (/\dead -> Just {integer} i) (/\dead -> go (addInteger 1 i) xs) diff --git a/plutus-tx-plugin/test/Budget/9.6/findIndexEmptyList.uplc.golden b/plutus-tx-plugin/test/Budget/9.6/findIndexEmptyList.uplc.golden index 24ff292df93..6de8dcd3902 100644 --- a/plutus-tx-plugin/test/Budget/9.6/findIndexEmptyList.uplc.golden +++ b/plutus-tx-plugin/test/Budget/9.6/findIndexEmptyList.uplc.golden @@ -9,9 +9,10 @@ , (\x xs -> delay (force - (force ifThenElse + (case (lessThanEqualsInteger 1 x) - (delay ((\x -> s s x) (addInteger 1 i) xs)) - (delay (constr 0 [i]))))) ])) + [ (delay (constr 0 [i])) + , (delay + ((\x -> s s x) (addInteger 1 i) xs)) ]))) ])) 0 (constr 0 []))) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/findIndexExpensive.eval.golden b/plutus-tx-plugin/test/Budget/9.6/findIndexExpensive.eval.golden index 7869f07f502..b7478d6cb8b 100644 --- a/plutus-tx-plugin/test/Budget/9.6/findIndexExpensive.eval.golden +++ b/plutus-tx-plugin/test/Budget/9.6/findIndexExpensive.eval.golden @@ -1,5 +1,5 @@ -CPU: 8_403_040 -Memory: 38_840 -Size: 69 +CPU: 6_842_550 +Memory: 33_830 +Size: 65 (constr 1) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/findIndexExpensive.pir.golden b/plutus-tx-plugin/test/Budget/9.6/findIndexExpensive.pir.golden index 5d03400d1a3..70b42ea0c4b 100644 --- a/plutus-tx-plugin/test/Budget/9.6/findIndexExpensive.pir.golden +++ b/plutus-tx-plugin/test/Budget/9.6/findIndexExpensive.pir.golden @@ -22,7 +22,7 @@ letrec (\(x : integer) (xs : List integer) -> /\dead -> Bool_match - (ifThenElse {Bool} (lessThanEqualsInteger 1 x) False True) + (case Bool (lessThanEqualsInteger 1 x) [True, False]) {all dead. Maybe integer} (/\dead -> Just {integer} i) (/\dead -> go (addInteger 1 i) xs) diff --git a/plutus-tx-plugin/test/Budget/9.6/findIndexExpensive.uplc.golden b/plutus-tx-plugin/test/Budget/9.6/findIndexExpensive.uplc.golden index 365d0d04d4b..e74c07cf93f 100644 --- a/plutus-tx-plugin/test/Budget/9.6/findIndexExpensive.uplc.golden +++ b/plutus-tx-plugin/test/Budget/9.6/findIndexExpensive.uplc.golden @@ -10,10 +10,11 @@ , (\x xs -> delay (force - (force ifThenElse + (case (lessThanEqualsInteger 1 x) - (delay ((\x -> s s x) (addInteger 1 i) xs)) - (delay (constr 0 [i]))))) ])) + [ (delay (constr 0 [i])) + , (delay + ((\x -> s s x) (addInteger 1 i) xs)) ]))) ])) 0 (constr 1 [ 1 diff --git a/plutus-tx-plugin/test/Budget/9.6/gte0.eval.golden b/plutus-tx-plugin/test/Budget/9.6/gte0.eval.golden index 6e086cf10dd..a73672246c6 100644 --- a/plutus-tx-plugin/test/Budget/9.6/gte0.eval.golden +++ b/plutus-tx-plugin/test/Budget/9.6/gte0.eval.golden @@ -1,5 +1,5 @@ -CPU: 1_191_128_986 -Memory: 5_309_702 -Size: 72 +CPU: 878_874_937 +Memory: 4_307_201 +Size: 64 (constr 0) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/gte0.pir.golden b/plutus-tx-plugin/test/Budget/9.6/gte0.pir.golden index ae6fab6255b..7f4dab70c4a 100644 --- a/plutus-tx-plugin/test/Budget/9.6/gte0.pir.golden +++ b/plutus-tx-plugin/test/Budget/9.6/gte0.pir.golden @@ -19,7 +19,7 @@ letrec (\(x : integer) (xs : List integer) -> /\dead -> Bool_match - (ifThenElse {Bool} (lessThanInteger x 0) False True) + (case Bool (lessThanInteger x 0) [True, False]) {all dead. Bool} (/\dead -> go xs) (/\dead -> False) @@ -30,7 +30,7 @@ letrec !go : integer -> List integer = \(n : integer) -> Bool_match - (ifThenElse {Bool} (lessThanEqualsInteger n 0) True False) + (case Bool (lessThanEqualsInteger n 0) [False, True]) {all dead. List integer} (/\dead -> Nil {integer}) (/\dead -> Cons {integer} 0 (go (subtractInteger n 1))) diff --git a/plutus-tx-plugin/test/Budget/9.6/gte0.uplc.golden b/plutus-tx-plugin/test/Budget/9.6/gte0.uplc.golden index e3539c57560..c7eb172dcf9 100644 --- a/plutus-tx-plugin/test/Budget/9.6/gte0.uplc.golden +++ b/plutus-tx-plugin/test/Budget/9.6/gte0.uplc.golden @@ -9,15 +9,14 @@ , (\x xs -> delay (force - (force ifThenElse + (case (lessThanInteger x 0) - (delay (constr 1 [])) - (delay (s s xs))))) ])) + [(delay (s s xs)), (delay (constr 1 []))]))) ])) ((\s -> s s) (\s n -> force - (force ifThenElse + (case (lessThanEqualsInteger n 0) - (delay (constr 0 [])) - (delay (constr 1 [0, ((\x -> s s x) (subtractInteger n 1))])))) + [ (delay (constr 1 [0, ((\x -> s s x) (subtractInteger n 1))])) + , (delay (constr 0 [])) ])) 1000))) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/listIndexing.eval.golden b/plutus-tx-plugin/test/Budget/9.6/listIndexing.eval.golden index d24d45e4e35..f3d7e3d21ed 100644 --- a/plutus-tx-plugin/test/Budget/9.6/listIndexing.eval.golden +++ b/plutus-tx-plugin/test/Budget/9.6/listIndexing.eval.golden @@ -1,5 +1,5 @@ -CPU: 5_004_432 -Memory: 23_422 -Size: 82 +CPU: 4_068_138 +Memory: 20_416 +Size: 78 (con data (I 6)) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/listIndexing.pir.golden b/plutus-tx-plugin/test/Budget/9.6/listIndexing.pir.golden index 55f70cdb9a9..70bd08080d2 100644 --- a/plutus-tx-plugin/test/Budget/9.6/listIndexing.pir.golden +++ b/plutus-tx-plugin/test/Budget/9.6/listIndexing.pir.golden @@ -23,7 +23,7 @@ letrec (\(x : data) (xs : List data) -> /\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 0 ds) True False) + (case Bool (equalsInteger 0 ds) [False, True]) {all dead. data} (/\dead -> x) (/\dead -> go (subtractInteger ds 1) xs) diff --git a/plutus-tx-plugin/test/Budget/9.6/listIndexing.uplc.golden b/plutus-tx-plugin/test/Budget/9.6/listIndexing.uplc.golden index 760ceef8e2f..84506410110 100644 --- a/plutus-tx-plugin/test/Budget/9.6/listIndexing.uplc.golden +++ b/plutus-tx-plugin/test/Budget/9.6/listIndexing.uplc.golden @@ -10,10 +10,8 @@ , (\x xs -> delay (force - (force ifThenElse + (case (equalsInteger 0 ds) - (delay x) - (delay - ((\x -> s s x) - (subtractInteger ds 1) - xs))))) ]))))) \ No newline at end of file + [ (delay + ((\x -> s s x) (subtractInteger ds 1) xs)) + , (delay x) ]))) ]))))) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/lte0.eval.golden b/plutus-tx-plugin/test/Budget/9.6/lte0.eval.golden index 11b3c7e2d53..62fbc23e3b3 100644 --- a/plutus-tx-plugin/test/Budget/9.6/lte0.eval.golden +++ b/plutus-tx-plugin/test/Budget/9.6/lte0.eval.golden @@ -1,5 +1,5 @@ -CPU: 1_189_675_986 -Memory: 5_309_702 -Size: 72 +CPU: 877_421_937 +Memory: 4_307_201 +Size: 64 (constr 0) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/lte0.pir.golden b/plutus-tx-plugin/test/Budget/9.6/lte0.pir.golden index a4a6d6405d1..464cd1c03ee 100644 --- a/plutus-tx-plugin/test/Budget/9.6/lte0.pir.golden +++ b/plutus-tx-plugin/test/Budget/9.6/lte0.pir.golden @@ -19,7 +19,7 @@ letrec (\(x : integer) (xs : List integer) -> /\dead -> Bool_match - (ifThenElse {Bool} (lessThanEqualsInteger x 0) True False) + (case Bool (lessThanEqualsInteger x 0) [False, True]) {all dead. Bool} (/\dead -> go xs) (/\dead -> False) @@ -30,7 +30,7 @@ letrec !go : integer -> List integer = \(n : integer) -> Bool_match - (ifThenElse {Bool} (lessThanEqualsInteger n 0) True False) + (case Bool (lessThanEqualsInteger n 0) [False, True]) {all dead. List integer} (/\dead -> Nil {integer}) (/\dead -> Cons {integer} 0 (go (subtractInteger n 1))) diff --git a/plutus-tx-plugin/test/Budget/9.6/lte0.uplc.golden b/plutus-tx-plugin/test/Budget/9.6/lte0.uplc.golden index 74656a13de3..c903be7b83b 100644 --- a/plutus-tx-plugin/test/Budget/9.6/lte0.uplc.golden +++ b/plutus-tx-plugin/test/Budget/9.6/lte0.uplc.golden @@ -9,15 +9,14 @@ , (\x xs -> delay (force - (force ifThenElse + (case (lessThanEqualsInteger x 0) - (delay (s s xs)) - (delay (constr 1 []))))) ])) + [(delay (constr 1 [])), (delay (s s xs))]))) ])) ((\s -> s s) (\s n -> force - (force ifThenElse + (case (lessThanEqualsInteger n 0) - (delay (constr 0 [])) - (delay (constr 1 [0, ((\x -> s s x) (subtractInteger n 1))])))) + [ (delay (constr 1 [0, ((\x -> s s x) (subtractInteger n 1))])) + , (delay (constr 0 [])) ])) 1000))) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/map1.eval.golden b/plutus-tx-plugin/test/Budget/9.6/map1.eval.golden index c863dc9699b..006848e7cb8 100644 --- a/plutus-tx-plugin/test/Budget/9.6/map1.eval.golden +++ b/plutus-tx-plugin/test/Budget/9.6/map1.eval.golden @@ -1,6 +1,6 @@ -CPU: 255_988_667 -Memory: 642_158 -Size: 384 +CPU: 240_975_571 +Memory: 597_654 +Size: 374 (constr 0 diff --git a/plutus-tx-plugin/test/Budget/9.6/map1.pir.golden b/plutus-tx-plugin/test/Budget/9.6/map1.pir.golden index 9cd4c60a72c..970ca1c2d48 100644 --- a/plutus-tx-plugin/test/Budget/9.6/map1.pir.golden +++ b/plutus-tx-plugin/test/Budget/9.6/map1.pir.golden @@ -12,7 +12,7 @@ letrec !`$fEnumBool_$cenumFromTo` : integer -> integer -> List integer = \(x : integer) (lim : integer) -> Bool_match - (ifThenElse {Bool} (lessThanEqualsInteger x lim) False True) + (case Bool (lessThanEqualsInteger x lim) [True, False]) {all dead. List integer} (/\dead -> Nil {integer}) (/\dead -> @@ -60,11 +60,10 @@ let (Nothing {data}) (\(hd : pair data data) -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsData k (fstPair {data} {data} hd)) - True - False) + [False, True]) {all dead. list (pair data data) -> Maybe data} (/\dead -> \(ds : list (pair data data)) -> @@ -118,11 +117,10 @@ in nilCase (\(hd : pair data data) -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsData k (fstPair {data} {data} hd)) - True - False) + [False, True]) {all dead. list (pair data data) -> list (pair data data)} (/\dead -> mkCons {pair data data} (mkPairData k a)) @@ -146,11 +144,10 @@ in [] (\(hd : pair data data) -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsData k (fstPair {data} {data} hd)) - True - False) + [False, True]) {all dead. list (pair data data) -> list (pair data data)} (/\dead -> \(x : list (pair data data)) -> x) diff --git a/plutus-tx-plugin/test/Budget/9.6/map1.uplc.golden b/plutus-tx-plugin/test/Budget/9.6/map1.uplc.golden index aa0c95cbf35..82a1551fbd2 100644 --- a/plutus-tx-plugin/test/Budget/9.6/map1.uplc.golden +++ b/plutus-tx-plugin/test/Budget/9.6/map1.uplc.golden @@ -21,14 +21,17 @@ caseList' (constr 1 []) (\hd -> - force ifThenElse - (equalsData - k - (force (force fstPair) hd)) - (\ds -> - constr 0 - [(force (force sndPair) hd)]) - (\x -> s s x))) + force + (case + (equalsData + k + (force (force fstPair) hd)) + [ (delay (\x -> s s x)) + , (delay + (\ds -> + constr 0 + [ (force (force sndPair) + hd) ])) ]))) ds) (`$dToData` ds)) [ (\a -> delay (constr 0 [(`$dUnsafeFromData` a)])) @@ -39,10 +42,11 @@ caseList' [] (\hd -> - force ifThenElse - (equalsData k (force (force fstPair) hd)) - (\x -> x) - (\eta -> force mkCons hd (s s eta))))) + force + (case + (equalsData k (force (force fstPair) hd)) + [ (delay (\eta -> force mkCons hd (s s eta))) + , (delay (\x -> x)) ])))) (iData (addInteger 5 n)) nt)) ((\z -> @@ -70,28 +74,27 @@ nilCase (\hd -> force - (force - ifThenElse + (case (equalsData k (force (force fstPair) hd)) - (delay - (force - mkCons - (mkPairData - k - a))) - (delay - (\eta -> - force + [ (delay + (\eta -> + force + mkCons + hd + (s + s + eta))) + , (delay + (force mkCons - hd - (s - s - eta)))))) + (mkPairData + k + a))) ]))) ds) (force mkCons (mkPairData k a) @@ -110,7 +113,9 @@ ((\s -> s s) (\s x lim -> force - (force ifThenElse + (case (lessThanEqualsInteger x lim) - (delay (constr 1 [x, ((\x -> s s x) (addInteger 1 x) lim)])) - (delay (constr 0 []))))))) \ No newline at end of file + [ (delay (constr 0 [])) + , (delay + (constr 1 + [x, ((\x -> s s x) (addInteger 1 x) lim)])) ]))))) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/map2.eval.golden b/plutus-tx-plugin/test/Budget/9.6/map2.eval.golden index f5e032baa6d..6826bdf6e34 100644 --- a/plutus-tx-plugin/test/Budget/9.6/map2.eval.golden +++ b/plutus-tx-plugin/test/Budget/9.6/map2.eval.golden @@ -1,6 +1,6 @@ -CPU: 121_640_515 -Memory: 365_182 -Size: 466 +CPU: 117_670_947 +Memory: 355_550 +Size: 464 (constr 1 diff --git a/plutus-tx-plugin/test/Budget/9.6/map2.pir.golden b/plutus-tx-plugin/test/Budget/9.6/map2.pir.golden index e891394b41c..99d2c96dce2 100644 --- a/plutus-tx-plugin/test/Budget/9.6/map2.pir.golden +++ b/plutus-tx-plugin/test/Budget/9.6/map2.pir.golden @@ -162,11 +162,10 @@ in False (\(hd : pair data data) -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsData k (fstPair {data} {data} hd)) - True - False) + [False, True]) {all dead. list (pair data data) -> Bool} (/\dead -> \(ds : list (pair data data)) -> True) @@ -203,11 +202,10 @@ in (Nothing {data}) (\(hd : pair data data) -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsData k' (fstPair {data} {data} hd)) - True - False) + [False, True]) {all dead. list (pair data data) -> Maybe data} (/\dead -> diff --git a/plutus-tx-plugin/test/Budget/9.6/map2.uplc.golden b/plutus-tx-plugin/test/Budget/9.6/map2.uplc.golden index adb389bdaac..ce90617a12d 100644 --- a/plutus-tx-plugin/test/Budget/9.6/map2.uplc.golden +++ b/plutus-tx-plugin/test/Budget/9.6/map2.uplc.golden @@ -41,20 +41,25 @@ (constr 1 []) (\hd -> force - ifThenElse - (equalsData - k' - (force + (case + (equalsData + k' (force - fstPair) - hd)) - (\ds -> - constr 0 - [ (force - (force - sndPair) - hd) ]) - (\x -> s s x))) + (force + fstPair) + hd)) + [ (delay + (\x -> + s + s + x)) + , (delay + (\ds -> + constr 0 + [ (force + (force + sndPair) + hd) ])) ]))) nt) [ (\r -> delay @@ -75,30 +80,38 @@ (force (force fstPair) hd)) (force (force sndPair) hd))) nt)) - ((\s -> s s) + ((\s -> + s s) (\s -> caseList' [] - (\hd tl -> + (\hd + tl -> (\tl' -> force (case ((\k -> - (\s -> s s) + (\s -> + s s) (\s -> caseList' (constr 1 []) (\hd -> - force ifThenElse - (equalsData - k - (force + force + (case + (equalsData + k (force - fstPair) - hd)) - (\ds -> - constr 0 []) - (\x -> s s x))) + (force + fstPair) + hd)) + [ (delay + (\x -> + s s x)) + , (delay + (\ds -> + constr 0 + [ ])) ]))) nt) (force (force fstPair) hd)) [ (delay tl') diff --git a/plutus-tx-plugin/test/Budget/9.6/map3.eval.golden b/plutus-tx-plugin/test/Budget/9.6/map3.eval.golden index c80354d3dc2..62e00117366 100644 --- a/plutus-tx-plugin/test/Budget/9.6/map3.eval.golden +++ b/plutus-tx-plugin/test/Budget/9.6/map3.eval.golden @@ -1,6 +1,6 @@ -CPU: 194_866_927 -Memory: 589_080 -Size: 772 +CPU: 186_059_840 +Memory: 563_917 +Size: 755 (constr 1 diff --git a/plutus-tx-plugin/test/Budget/9.6/map3.pir.golden b/plutus-tx-plugin/test/Budget/9.6/map3.pir.golden index 92678106352..0747cc75c79 100644 --- a/plutus-tx-plugin/test/Budget/9.6/map3.pir.golden +++ b/plutus-tx-plugin/test/Budget/9.6/map3.pir.golden @@ -37,11 +37,10 @@ letrec nilCase (\(hd : pair data data) -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsData k (fstPair {data} {data} hd)) - True - False) + [False, True]) {all dead. list (pair data data) -> list (pair data data)} (/\dead -> mkCons {pair data data} (mkPairData k v)) @@ -95,11 +94,10 @@ let (Nothing {data}) (\(hd : pair data data) -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsData k (fstPair {data} {data} hd)) - True - False) + [False, True]) {all dead. list (pair data data) -> Maybe data} (/\dead -> \(ds : list (pair data data)) -> @@ -387,19 +385,19 @@ in !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. These integer integer} (/\dead -> This {integer} {integer} (unIData (headList {data} args))) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 1 index) True False) + (case Bool (equalsInteger 1 index) [False, True]) {all dead. These integer integer} (/\dead -> That {integer} {integer} (unIData (headList {data} args))) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 2 index) True False) + (case Bool (equalsInteger 2 index) [False, True]) {all dead. These integer integer} (/\dead -> These diff --git a/plutus-tx-plugin/test/Budget/9.6/map3.uplc.golden b/plutus-tx-plugin/test/Budget/9.6/map3.uplc.golden index e6fb2954b5d..87c057c7c9e 100644 --- a/plutus-tx-plugin/test/Budget/9.6/map3.uplc.golden +++ b/plutus-tx-plugin/test/Budget/9.6/map3.uplc.golden @@ -59,57 +59,54 @@ (\index -> (\args -> force - (force - ifThenElse + (case (equalsInteger 0 index) - (delay - (constr 2 - [ (unIData - (force - headList - args)) ])) - (delay - (force - (force - ifThenElse - (equalsInteger - 1 - index) - (delay - (constr 0 - [ (unIData - (force - headList - args)) ])) - (delay - (force - (force - ifThenElse - (equalsInteger - 2 - index) - (delay - (constr 1 - [ (unIData - (force - headList - args)) - , (unIData - (force - headList - (force - tailList - args))) ])) - (delay - ((\x -> - error) + [ (delay + (force + (case + (equalsInteger + 1 + index) + [ (delay + (force + (case + (equalsInteger + 2 + index) + [ (delay + ((\x -> + error) + (force + trace + "PT1" + (constr 0 + [ ])))) + , (delay + (constr 1 + [ (unIData + (force + headList + args)) + , (unIData + (force + headList + (force + tailList + args))) ])) ]))) + , (delay + (constr 0 + [ (unIData (force - trace - "PT1" - (constr 0 - [ ])))))))))))) + headList + args)) ])) ]))) + , (delay + (constr 2 + [ (unIData + (force + headList + args)) ])) ])) (force (force sndPair) @@ -308,10 +305,14 @@ caseList' (constr 1 []) (\hd -> - force ifThenElse - (equalsData k (force (force fstPair) hd)) - (\ds -> constr 0 [(force (force sndPair) hd)]) - (\x -> s s x))) + force + (case + (equalsData k (force (force fstPair) hd)) + [ (delay (\x -> s s x)) + , (delay + (\ds -> + constr 0 + [(force (force sndPair) hd)])) ]))) m)) ((\s -> s s) (\s xs xs -> @@ -328,18 +329,18 @@ nilCase (\hd -> force - (force ifThenElse + (case (equalsData k (force (force fstPair) hd)) - (delay - (force mkCons - (mkPairData k v))) - (delay - (\eta -> - force mkCons - hd - (s s eta)))))) + [ (delay + (\eta -> + force mkCons + hd + (s s eta))) + , (delay + (force mkCons + (mkPairData k v))) ]))) eta) (force mkCons (mkPairData k v) [])) (s s tl xs)) diff --git a/plutus-tx-plugin/test/Budget/9.6/matchAsDataE.eval.golden b/plutus-tx-plugin/test/Budget/9.6/matchAsDataE.eval.golden index 1dfe9ba7cba..570e5c789d4 100644 --- a/plutus-tx-plugin/test/Budget/9.6/matchAsDataE.eval.golden +++ b/plutus-tx-plugin/test/Budget/9.6/matchAsDataE.eval.golden @@ -1,5 +1,5 @@ -CPU: 1_196_851 -Memory: 4_362 -Size: 80 +CPU: 1_040_802 +Memory: 3_861 +Size: 72 (con integer 1) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/matchAsDataE.pir.golden b/plutus-tx-plugin/test/Budget/9.6/matchAsDataE.pir.golden index e87c17aa2ff..0477f24563f 100644 --- a/plutus-tx-plugin/test/Budget/9.6/matchAsDataE.pir.golden +++ b/plutus-tx-plugin/test/Budget/9.6/matchAsDataE.pir.golden @@ -24,7 +24,7 @@ {integer} (\(ds : integer) (ds : list data) -> Bool_match - (ifThenElse {Bool} (equalsInteger 0 ds) True False) + (case Bool (equalsInteger 0 ds) [False, True]) {all dead. integer} (/\dead -> unIData (headList {data} ds)) (/\dead -> @@ -44,7 +44,7 @@ {integer} (\(ds : integer) (ds : list data) -> Bool_match - (ifThenElse {Bool} (equalsInteger 1 ds) True False) + (case Bool (equalsInteger 1 ds) [False, True]) {all dead. integer} (/\dead -> 1) (/\dead -> diff --git a/plutus-tx-plugin/test/Budget/9.6/matchAsDataE.uplc.golden b/plutus-tx-plugin/test/Budget/9.6/matchAsDataE.uplc.golden index 434d3208f1d..7625e507255 100644 --- a/plutus-tx-plugin/test/Budget/9.6/matchAsDataE.uplc.golden +++ b/plutus-tx-plugin/test/Budget/9.6/matchAsDataE.uplc.golden @@ -8,22 +8,20 @@ (unConstrData ds)) [ (\ds ds -> force - (force ifThenElse + (case (equalsInteger 0 ds) - (delay (unIData (force headList ds))) - (delay - (case - ((\tup -> - constr 0 - [ (force (force fstPair) tup) - , (force (force sndPair) tup) ]) - (unConstrData ds)) - [ (\ds ds -> - force - (force ifThenElse - (equalsInteger 1 ds) - (delay 1) - (delay - ((\cse -> case cse [cse]) - error)))) ])))) ]) + [ (delay + (case + ((\tup -> + constr 0 + [ (force (force fstPair) tup) + , (force (force sndPair) tup) ]) + (unConstrData ds)) + [ (\ds ds -> + force + (case + (equalsInteger 1 ds) + [ (delay ((\cse -> case cse [cse]) error)) + , (delay 1) ])) ])) + , (delay (unIData (force headList ds))) ])) ]) (Constr 0 [I 1]))) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/not-not.eval.golden b/plutus-tx-plugin/test/Budget/9.6/not-not.eval.golden index 4fca5a9df26..e56712ff87e 100644 --- a/plutus-tx-plugin/test/Budget/9.6/not-not.eval.golden +++ b/plutus-tx-plugin/test/Budget/9.6/not-not.eval.golden @@ -1,5 +1,5 @@ -CPU: 361_439 -Memory: 1_602 -Size: 15 +CPU: 301_390 +Memory: 1_701 +Size: 20 (constr 0) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/not-not.pir.golden b/plutus-tx-plugin/test/Budget/9.6/not-not.pir.golden index 9d9f0d13406..3c6d2da9d63 100644 --- a/plutus-tx-plugin/test/Budget/9.6/not-not.pir.golden +++ b/plutus-tx-plugin/test/Budget/9.6/not-not.pir.golden @@ -6,7 +6,7 @@ \(x : integer) -> Bool_match (Bool_match - (ifThenElse {Bool} (lessThanInteger 0 x) True False) + (case Bool (lessThanInteger 0 x) [False, True]) {all dead. Bool} (/\dead -> False) (/\dead -> True) diff --git a/plutus-tx-plugin/test/Budget/9.6/not-not.uplc.golden b/plutus-tx-plugin/test/Budget/9.6/not-not.uplc.golden index 1e81e92e66d..b685840cffc 100644 --- a/plutus-tx-plugin/test/Budget/9.6/not-not.uplc.golden +++ b/plutus-tx-plugin/test/Budget/9.6/not-not.uplc.golden @@ -1,4 +1,11 @@ (program 1.1.0 - ((\x -> force ifThenElse (lessThanInteger 0 x) (constr 0 []) (constr 1 [])) + ((\x -> + force + (case + (force + (case + (lessThanInteger 0 x) + [(delay (constr 0 [])), (delay (constr 1 []))])) + [(delay (constr 1 [])), (delay (constr 0 []))])) 1)) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/notElemCheap.eval.golden b/plutus-tx-plugin/test/Budget/9.6/notElemCheap.eval.golden index 2d63fdeedbe..a7c1468228e 100644 --- a/plutus-tx-plugin/test/Budget/9.6/notElemCheap.eval.golden +++ b/plutus-tx-plugin/test/Budget/9.6/notElemCheap.eval.golden @@ -1,5 +1,5 @@ -CPU: 912_482 -Memory: 5_002 -Size: 56 +CPU: 756_433 +Memory: 4_501 +Size: 52 (constr 1) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/notElemCheap.pir.golden b/plutus-tx-plugin/test/Budget/9.6/notElemCheap.pir.golden index ed2bf7f4892..d10c251ce0b 100644 --- a/plutus-tx-plugin/test/Budget/9.6/notElemCheap.pir.golden +++ b/plutus-tx-plugin/test/Budget/9.6/notElemCheap.pir.golden @@ -19,7 +19,7 @@ letrec (\(x : integer) (xs : List integer) -> /\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 1 x) True False) + (case Bool (equalsInteger 1 x) [False, True]) {all dead. Bool} (/\dead -> False) (/\dead -> go xs) diff --git a/plutus-tx-plugin/test/Budget/9.6/notElemCheap.uplc.golden b/plutus-tx-plugin/test/Budget/9.6/notElemCheap.uplc.golden index b8693a889e2..b5c0b22f260 100644 --- a/plutus-tx-plugin/test/Budget/9.6/notElemCheap.uplc.golden +++ b/plutus-tx-plugin/test/Budget/9.6/notElemCheap.uplc.golden @@ -10,10 +10,9 @@ , (\x xs -> delay (force - (force ifThenElse + (case (equalsInteger 1 x) - (delay (constr 1 [])) - (delay (s s xs))))) ])) + [(delay (s s xs)), (delay (constr 1 []))]))) ])) (constr 1 [ 1 , (constr 1 diff --git a/plutus-tx-plugin/test/Budget/9.6/notElemExpensive.eval.golden b/plutus-tx-plugin/test/Budget/9.6/notElemExpensive.eval.golden index d688d72bff1..4774a7bf2fe 100644 --- a/plutus-tx-plugin/test/Budget/9.6/notElemExpensive.eval.golden +++ b/plutus-tx-plugin/test/Budget/9.6/notElemExpensive.eval.golden @@ -1,5 +1,5 @@ -CPU: 5_827_920 -Memory: 28_520 -Size: 56 +CPU: 4_267_430 +Memory: 23_510 +Size: 52 (constr 0) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/notElemExpensive.pir.golden b/plutus-tx-plugin/test/Budget/9.6/notElemExpensive.pir.golden index 6b8c94a91d8..87f74ef4226 100644 --- a/plutus-tx-plugin/test/Budget/9.6/notElemExpensive.pir.golden +++ b/plutus-tx-plugin/test/Budget/9.6/notElemExpensive.pir.golden @@ -19,7 +19,7 @@ letrec (\(x : integer) (xs : List integer) -> /\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 0 x) True False) + (case Bool (equalsInteger 0 x) [False, True]) {all dead. Bool} (/\dead -> False) (/\dead -> go xs) diff --git a/plutus-tx-plugin/test/Budget/9.6/notElemExpensive.uplc.golden b/plutus-tx-plugin/test/Budget/9.6/notElemExpensive.uplc.golden index bf82bf5d910..8b0e7018669 100644 --- a/plutus-tx-plugin/test/Budget/9.6/notElemExpensive.uplc.golden +++ b/plutus-tx-plugin/test/Budget/9.6/notElemExpensive.uplc.golden @@ -10,10 +10,9 @@ , (\x xs -> delay (force - (force ifThenElse + (case (equalsInteger 0 x) - (delay (constr 1 [])) - (delay (s s xs))))) ])) + [(delay (s s xs)), (delay (constr 1 []))]))) ])) (constr 1 [ 1 , (constr 1 diff --git a/plutus-tx-plugin/test/Budget/9.6/recursiveGte0.eval.golden b/plutus-tx-plugin/test/Budget/9.6/recursiveGte0.eval.golden index 3532b9cb84a..3bbdf85d0a9 100644 --- a/plutus-tx-plugin/test/Budget/9.6/recursiveGte0.eval.golden +++ b/plutus-tx-plugin/test/Budget/9.6/recursiveGte0.eval.golden @@ -1,5 +1,5 @@ -CPU: 1_399_400_986 -Memory: 6_611_402 -Size: 104 +CPU: 1_087_146_937 +Memory: 5_608_901 +Size: 96 (constr 0) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/recursiveGte0.pir.golden b/plutus-tx-plugin/test/Budget/9.6/recursiveGte0.pir.golden index cb0947f7a1e..629dad832dc 100644 --- a/plutus-tx-plugin/test/Budget/9.6/recursiveGte0.pir.golden +++ b/plutus-tx-plugin/test/Budget/9.6/recursiveGte0.pir.golden @@ -12,7 +12,7 @@ letrec !go : integer -> List integer = \(n : integer) -> Bool_match - (ifThenElse {Bool} (lessThanEqualsInteger n 0) True False) + (case Bool (lessThanEqualsInteger n 0) [False, True]) {all dead. List integer} (/\dead -> Nil {integer}) (/\dead -> Cons {integer} 0 (go (subtractInteger n 1))) @@ -42,5 +42,5 @@ let in recursiveAll {integer} - (\(v : integer) -> ifThenElse {Bool} (lessThanInteger v 0) False True) + (\(v : integer) -> case Bool (lessThanInteger v 0) [True, False]) ls \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/recursiveGte0.uplc.golden b/plutus-tx-plugin/test/Budget/9.6/recursiveGte0.uplc.golden index eed78ecdb2a..9402cc265b1 100644 --- a/plutus-tx-plugin/test/Budget/9.6/recursiveGte0.uplc.golden +++ b/plutus-tx-plugin/test/Budget/9.6/recursiveGte0.uplc.golden @@ -4,11 +4,7 @@ (\recursiveAll -> (\ls -> force recursiveAll - (\v -> - force ifThenElse - (lessThanInteger v 0) - (constr 1 []) - (constr 0 [])) + (\v -> case (lessThanInteger v 0) [(constr 0 []), (constr 1 [])]) ls) (go 1000)) ((\s -> s s) @@ -33,8 +29,7 @@ ((\s -> s s) (\s n -> force - (force ifThenElse + (case (lessThanEqualsInteger n 0) - (delay (constr 0 [])) - (delay - (constr 1 [0, ((\x -> s s x) (subtractInteger n 1))]))))))) \ No newline at end of file + [ (delay (constr 1 [0, ((\x -> s s x) (subtractInteger n 1))])) + , (delay (constr 0 [])) ]))))) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/recursiveLte0.eval.golden b/plutus-tx-plugin/test/Budget/9.6/recursiveLte0.eval.golden index 3da31a62628..0ab9bb21dcf 100644 --- a/plutus-tx-plugin/test/Budget/9.6/recursiveLte0.eval.golden +++ b/plutus-tx-plugin/test/Budget/9.6/recursiveLte0.eval.golden @@ -1,5 +1,5 @@ -CPU: 1_397_947_986 -Memory: 6_611_402 -Size: 104 +CPU: 1_085_693_937 +Memory: 5_608_901 +Size: 96 (constr 0) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/recursiveLte0.pir.golden b/plutus-tx-plugin/test/Budget/9.6/recursiveLte0.pir.golden index b2e44075448..225a32d499f 100644 --- a/plutus-tx-plugin/test/Budget/9.6/recursiveLte0.pir.golden +++ b/plutus-tx-plugin/test/Budget/9.6/recursiveLte0.pir.golden @@ -12,7 +12,7 @@ letrec !go : integer -> List integer = \(n : integer) -> Bool_match - (ifThenElse {Bool} (lessThanEqualsInteger n 0) True False) + (case Bool (lessThanEqualsInteger n 0) [False, True]) {all dead. List integer} (/\dead -> Nil {integer}) (/\dead -> Cons {integer} 0 (go (subtractInteger n 1))) @@ -42,5 +42,5 @@ let in recursiveAll {integer} - (\(v : integer) -> ifThenElse {Bool} (lessThanEqualsInteger v 0) True False) + (\(v : integer) -> case Bool (lessThanEqualsInteger v 0) [False, True]) ls \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/recursiveLte0.uplc.golden b/plutus-tx-plugin/test/Budget/9.6/recursiveLte0.uplc.golden index 27b3d8df727..7c79f1831ee 100644 --- a/plutus-tx-plugin/test/Budget/9.6/recursiveLte0.uplc.golden +++ b/plutus-tx-plugin/test/Budget/9.6/recursiveLte0.uplc.golden @@ -5,10 +5,9 @@ (\ls -> force recursiveAll (\v -> - force ifThenElse + case (lessThanEqualsInteger v 0) - (constr 0 []) - (constr 1 [])) + [(constr 1 []), (constr 0 [])]) ls) (go 1000)) ((\s -> s s) @@ -33,8 +32,7 @@ ((\s -> s s) (\s n -> force - (force ifThenElse + (case (lessThanEqualsInteger n 0) - (delay (constr 0 [])) - (delay - (constr 1 [0, ((\x -> s s x) (subtractInteger n 1))]))))))) \ No newline at end of file + [ (delay (constr 1 [0, ((\x -> s s x) (subtractInteger n 1))])) + , (delay (constr 0 [])) ]))))) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/show.eval.golden b/plutus-tx-plugin/test/Budget/9.6/show.eval.golden index 3980aefff84..9875c35db7e 100644 --- a/plutus-tx-plugin/test/Budget/9.6/show.eval.golden +++ b/plutus-tx-plugin/test/Budget/9.6/show.eval.golden @@ -1,5 +1,5 @@ -CPU: 1_358_901_555 -Memory: 5_829_124 -Size: 859 +CPU: 1_116_089_311 +Memory: 5_049_568 +Size: 767 (con integer -2469135780) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/show.pir.golden b/plutus-tx-plugin/test/Budget/9.6/show.pir.golden index 68f53f7af40..09b96057603 100644 --- a/plutus-tx-plugin/test/Budget/9.6/show.pir.golden +++ b/plutus-tx-plugin/test/Budget/9.6/show.pir.golden @@ -15,7 +15,7 @@ letrec !x : integer = quotientInteger n 10 in Bool_match - (ifThenElse {Bool} (equalsInteger 0 x) True False) + (case Bool (equalsInteger 0 x) [False, True]) {all dead. List integer} (/\dead -> Cons {integer} (remainderInteger n 10) acc) (/\dead -> go (Cons {integer} (remainderInteger n 10) acc) x) @@ -40,88 +40,78 @@ letrec Cons {string} (Bool_match - (ifThenElse {Bool} (equalsInteger 0 x) True False) + (case Bool (equalsInteger 0 x) [False, True]) {all dead. string} (/\dead -> "0") (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 1 x) True False) + (case Bool (equalsInteger 1 x) [False, True]) {all dead. string} (/\dead -> "1") (/\dead -> Bool_match - (ifThenElse - {Bool} - (equalsInteger 2 x) - True - False) + (case Bool (equalsInteger 2 x) [False, True]) {all dead. string} (/\dead -> "2") (/\dead -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 3 x) - True - False) + [False, True]) {all dead. string} (/\dead -> "3") (/\dead -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 4 x) - True - False) + [False, True]) {all dead. string} (/\dead -> "4") (/\dead -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 5 x) - True - False) + [False, True]) {all dead. string} (/\dead -> "5") (/\dead -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 6 x) - True - False) + [False, True]) {all dead. string} (/\dead -> "6") (/\dead -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 7 x) - True - False) + [False, True]) {all dead. string} (/\dead -> "7") (/\dead -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 8 x) - True - False) + [False, True]) {all dead. string} (/\dead -> "8") (/\dead -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 9 x) - True - False) + [ False + , True ]) {string} "9" "") @@ -142,7 +132,7 @@ letrec integer -> integer -> List string -> List string = \(p : integer) (n : integer) -> Bool_match - (ifThenElse {Bool} (lessThanInteger n 0) True False) + (case Bool (lessThanInteger n 0) [False, True]) {all dead. List string -> List string} (/\dead -> \(eta : List string) -> @@ -160,52 +150,46 @@ let !toHex : integer -> List string -> List string = \(x : integer) -> Bool_match - (ifThenElse {Bool} (lessThanEqualsInteger x 9) True False) + (case Bool (lessThanEqualsInteger x 9) [False, True]) {all dead. List string -> List string} (/\dead -> `$fShowBuiltinByteString_$cshowsPrec` 0 x) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 10 x) True False) + (case Bool (equalsInteger 10 x) [False, True]) {all dead. List string -> List string} (/\dead -> \(ds : List string) -> Cons {string} "a" ds) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 11 x) True False) + (case Bool (equalsInteger 11 x) [False, True]) {all dead. List string -> List string} (/\dead -> \(ds : List string) -> Cons {string} "b" ds) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 12 x) True False) + (case Bool (equalsInteger 12 x) [False, True]) {all dead. List string -> List string} (/\dead -> \(ds : List string) -> Cons {string} "c" ds) (/\dead -> Bool_match - (ifThenElse - {Bool} - (equalsInteger 13 x) - True - False) + (case Bool (equalsInteger 13 x) [False, True]) {all dead. List string -> List string} (/\dead -> \(ds : List string) -> Cons {string} "d" ds) (/\dead -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 14 x) - True - False) + [False, True]) {all dead. List string -> List string} (/\dead -> \(ds : List string) -> Cons {string} "e" ds) (/\dead -> Bool_match - (ifThenElse - {Bool} + (case + Bool (equalsInteger 15 x) - True - False) + [False, True]) {List string -> List string} (\(ds : List string) -> Cons {string} "f" ds) @@ -241,6 +225,10 @@ letrec (acc eta)) {all dead. dead} in +let + !ifThenElse : all a. bool -> a -> a -> a + = /\a -> \(b : bool) (x : a) (y : a) -> case a b [y, x] +in letrec !`$fEnumBool_$cenumFromTo` : integer -> integer -> List integer = \(x : integer) (lim : integer) -> @@ -268,7 +256,7 @@ letrec (\(y : string) (ys : List string) -> /\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 1 ds) True False) + (case Bool (equalsInteger 1 ds) [False, True]) {all dead. Tuple2 (List string) (List string)} (/\dead -> Tuple2 @@ -330,11 +318,7 @@ letrec !n : integer = divideInteger (go ds) 2 in Bool_match - (ifThenElse - {Bool} - (lessThanEqualsInteger n 0) - True - False) + (case Bool (lessThanEqualsInteger n 0) [False, True]) {all dead. Tuple2 (List string) (List string)} (/\dead -> Tuple2 {List string} {List string} (Nil {string}) ds) diff --git a/plutus-tx-plugin/test/Budget/9.6/show.uplc.golden b/plutus-tx-plugin/test/Budget/9.6/show.uplc.golden index f8b98c8e24a..7d8adcc03ce 100644 --- a/plutus-tx-plugin/test/Budget/9.6/show.uplc.golden +++ b/plutus-tx-plugin/test/Budget/9.6/show.uplc.golden @@ -123,12 +123,11 @@ (constr 0 []))) d)) (force trace - (force ifThenElse + (case (lessThanEqualsInteger c 0) - "False" - "True") + ["True", "False"]) c)) (force trace (concatBuiltinStrings @@ -170,20 +169,19 @@ (case ((\n -> force - (force - ifThenElse + (case (lessThanEqualsInteger n 0) - (delay - (constr 0 - [ (constr 0 - [ ]) - , ds ])) - (delay - (go - n - ds)))) + [ (delay + (go + n + ds)) + , (delay + (constr 0 + [ (constr 0 + [ ]) + , ds ])) ])) (divideInteger (go ds) 2)) @@ -200,50 +198,48 @@ case ds [0, (\ds xs -> addInteger 1 (s s xs))]))) - ((\s -> - s s) - (\s - ds - ds -> + ((\s -> s s) + (\s ds ds -> force (case ds [ (delay (constr 0 [(constr 0 []), (constr 0 [])])) - , (\y - ys -> + , (\y ys -> delay (force - (force - ifThenElse + (case (equalsInteger 1 ds) - (delay - (constr 0 - [ (constr 1 - [y, (constr 0 [])]) - , ys ])) - (delay - (case - ((\x -> s s x) - (subtractInteger ds 1) - ys) - [ (\zs - ws -> - constr 0 - [ (constr 1 - [y, zs]) - , ws ]) ]))))) ])))) + [ (delay + (case + ((\x -> s s x) + (subtractInteger + ds + 1) + ys) + [ (\zs ws -> + constr 0 + [ (constr 1 + [y, zs]) + , ws ]) ])) + , (delay + (constr 0 + [ (constr 1 + [y, (constr 0 [])]) + , ys ])) ]))) ])))) ((\s -> s s) (\s x lim -> force - (force ifThenElse + (case (lessThanEqualsInteger x lim) - (delay - (constr 1 - [ x - , ((\x -> s s x) (addInteger 1 x) lim) ])) - (delay (constr 0 [])))))) + [ (delay (constr 0 [])) + , (delay + (constr 1 + [ x + , ((\x -> s s x) + (addInteger 1 x) + lim) ])) ])))) ((\s -> s s) (\s @@ -268,74 +264,77 @@ (s s xs))) ])))) (\x -> force - (force - ifThenElse + (case (lessThanEqualsInteger x 9) - (delay (`$fShowBuiltinByteString_$cshowsPrec` 0 x)) - (delay - (force - (force - ifThenElse - (equalsInteger 10 x) - (delay (\ds -> constr 1 ["a", ds])) - (delay - (force - (force - ifThenElse - (equalsInteger 11 x) - (delay (\ds -> constr 1 ["b", ds])) - (delay - (force - (force - ifThenElse - (equalsInteger 12 x) - (delay - (\ds -> - constr 1 ["c", ds])) - (delay - (force - (force - ifThenElse - (equalsInteger 13 x) - (delay - (\ds -> - constr 1 - ["d", ds])) - (delay - (force - (force - ifThenElse - (equalsInteger - 14 - x) - (delay - (\ds -> - constr 1 - [ "e" - , ds ])) - (delay - (force - ifThenElse - (equalsInteger - 15 - x) - (\ds -> - constr 1 - [ "f" - , ds ]) - (\ds -> - constr 1 - [ "" - , ds ]))))))))))))))))))))) + [ (delay + (force + (case + (equalsInteger 10 x) + [ (delay + (force + (case + (equalsInteger 11 x) + [ (delay + (force + (case + (equalsInteger 12 x) + [ (delay + (force + (case + (equalsInteger + 13 + x) + [ (delay + (force + (case + (equalsInteger + 14 + x) + [ (delay + (case + (equalsInteger + 15 + x) + [ (\ds -> + constr 1 + [ "" + , ds ]) + , (\ds -> + constr 1 + [ "f" + , ds ]) ])) + , (delay + (\ds -> + constr 1 + [ "e" + , ds ])) ]))) + , (delay + (\ds -> + constr 1 + [ "d" + , ds ])) ]))) + , (delay + (\ds -> + constr 1 + [ "c" + , ds ])) ]))) + , (delay + (\ds -> + constr 1 ["b", ds])) ]))) + , (delay (\ds -> constr 1 ["a", ds])) ]))) + , (delay + (`$fShowBuiltinByteString_$cshowsPrec` 0 x)) ]))) ((\s -> s s) (\s p n -> force - (force ifThenElse + (case (lessThanInteger n 0) - (delay - (\eta -> - constr 1 ["-", (s s p (subtractInteger 0 n) eta)])) - (delay (go (go (constr 0 []) n))))))) + [ (delay (go (go (constr 0 []) n))) + , (delay + (\eta -> + constr 1 + [ "-" + , (s s p (subtractInteger 0 n) eta) ])) ])))) ((\s -> s s) (\s @@ -351,94 +350,88 @@ eta -> constr 1 [ (force - (force - ifThenElse + (case (equalsInteger 0 x) - (delay "0") - (delay - (force - (force - ifThenElse - (equalsInteger 1 x) - (delay "1") - (delay - (force - (force - ifThenElse - (equalsInteger 2 x) - (delay "2") - (delay - (force - (force - ifThenElse - (equalsInteger - 3 - x) - (delay "3") - (delay - (force - (force - ifThenElse - (equalsInteger - 4 - x) - (delay - "4") - (delay - (force - (force - ifThenElse - (equalsInteger - 5 - x) - (delay - "5") - (delay - (force - (force - ifThenElse - (equalsInteger - 6 - x) - (delay - "6") - (delay - (force + [ (delay + (force + (case + (equalsInteger 1 x) + [ (delay + (force + (case + (equalsInteger + 2 + x) + [ (delay + (force + (case + (equalsInteger + 3 + x) + [ (delay + (force + (case + (equalsInteger + 4 + x) + [ (delay + (force + (case + (equalsInteger + 5 + x) + [ (delay (force - ifThenElse - (equalsInteger - 7 - x) - (delay - "7") - (delay - (force - (force - ifThenElse - (equalsInteger - 8 - x) - (delay - "8") - (delay - (force - ifThenElse - (equalsInteger - 9 - x) - "9" - "")))))))))))))))))))))))))))) + (case + (equalsInteger + 6 + x) + [ (delay + (force + (case + (equalsInteger + 7 + x) + [ (delay + (force + (case + (equalsInteger + 8 + x) + [ (delay + (case + (equalsInteger + 9 + x) + [ "" + , "9" ])) + , (delay + "8") ]))) + , (delay + "7") ]))) + , (delay + "6") ]))) + , (delay + "5") ]))) + , (delay + "4") ]))) + , (delay + "3") ]))) + , (delay + "2") ]))) + , (delay "1") ]))) + , (delay "0") ])) , (acc eta) ]) (s s xs))) ])))) ((\s -> s s) (\s acc n -> (\x -> force - (force ifThenElse + (case (equalsInteger 0 x) - (delay (constr 1 [(remainderInteger n 10), acc])) - (delay - ((\x -> s s x) - (constr 1 [(remainderInteger n 10), acc]) - x)))) + [ (delay + ((\x -> s s x) + (constr 1 [(remainderInteger n 10), acc]) + x)) + , (delay (constr 1 [(remainderInteger n 10), acc])) ])) (quotientInteger n 10))))) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/sumL.eval.golden b/plutus-tx-plugin/test/Budget/9.6/sumL.eval.golden index 9ea4969cc5f..d9f17ff6997 100644 --- a/plutus-tx-plugin/test/Budget/9.6/sumL.eval.golden +++ b/plutus-tx-plugin/test/Budget/9.6/sumL.eval.golden @@ -1,5 +1,5 @@ -CPU: 1_171_189_986 -Memory: 5_310_902 -Size: 81 +CPU: 1_014_984_937 +Memory: 4_809_401 +Size: 77 (con integer 500500) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/sumL.pir.golden b/plutus-tx-plugin/test/Budget/9.6/sumL.pir.golden index 277ae9b0495..c5f1956105d 100644 --- a/plutus-tx-plugin/test/Budget/9.6/sumL.pir.golden +++ b/plutus-tx-plugin/test/Budget/9.6/sumL.pir.golden @@ -24,7 +24,7 @@ letrec !`$fEnumBool_$cenumFromTo` : integer -> integer -> List integer = \(x : integer) (lim : integer) -> Bool_match - (ifThenElse {Bool} (lessThanEqualsInteger x lim) False True) + (case Bool (lessThanEqualsInteger x lim) [True, False]) {all dead. List integer} (/\dead -> Nil {integer}) (/\dead -> diff --git a/plutus-tx-plugin/test/Budget/9.6/sumL.uplc.golden b/plutus-tx-plugin/test/Budget/9.6/sumL.uplc.golden index f8fa66f4d0b..b7d004b74d7 100644 --- a/plutus-tx-plugin/test/Budget/9.6/sumL.uplc.golden +++ b/plutus-tx-plugin/test/Budget/9.6/sumL.uplc.golden @@ -5,10 +5,12 @@ ((\s -> s s) (\s x lim -> force - (force ifThenElse + (case (lessThanEqualsInteger x lim) - (delay (constr 1 [x, ((\x -> s s x) (addInteger 1 x) lim)])) - (delay (constr 0 [])))) + [ (delay (constr 0 [])) + , (delay + (constr 1 + [x, ((\x -> s s x) (addInteger 1 x) lim)])) ])) 1 1000)) ((\s -> s s) diff --git a/plutus-tx-plugin/test/Budget/9.6/sumR.eval.golden b/plutus-tx-plugin/test/Budget/9.6/sumR.eval.golden index ab23933ab18..65c9af7f7ef 100644 --- a/plutus-tx-plugin/test/Budget/9.6/sumR.eval.golden +++ b/plutus-tx-plugin/test/Budget/9.6/sumR.eval.golden @@ -1,5 +1,5 @@ -CPU: 1_075_045_986 -Memory: 4_710_002 -Size: 67 +CPU: 918_840_937 +Memory: 4_208_501 +Size: 63 (con integer 500500) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/sumR.pir.golden b/plutus-tx-plugin/test/Budget/9.6/sumR.pir.golden index 32f4dfa023b..e07ca7b8878 100644 --- a/plutus-tx-plugin/test/Budget/9.6/sumR.pir.golden +++ b/plutus-tx-plugin/test/Budget/9.6/sumR.pir.golden @@ -23,7 +23,7 @@ letrec !`$fEnumBool_$cenumFromTo` : integer -> integer -> List integer = \(x : integer) (lim : integer) -> Bool_match - (ifThenElse {Bool} (lessThanEqualsInteger x lim) False True) + (case Bool (lessThanEqualsInteger x lim) [True, False]) {all dead. List integer} (/\dead -> Nil {integer}) (/\dead -> diff --git a/plutus-tx-plugin/test/Budget/9.6/sumR.uplc.golden b/plutus-tx-plugin/test/Budget/9.6/sumR.uplc.golden index ca82badc218..80d913d7951 100644 --- a/plutus-tx-plugin/test/Budget/9.6/sumR.uplc.golden +++ b/plutus-tx-plugin/test/Budget/9.6/sumR.uplc.golden @@ -6,9 +6,10 @@ ((\s -> s s) (\s x lim -> force - (force ifThenElse + (case (lessThanEqualsInteger x lim) - (delay (constr 1 [x, ((\x -> s s x) (addInteger 1 x) lim)])) - (delay (constr 0 [])))) + [ (delay (constr 0 [])) + , (delay + (constr 1 [x, ((\x -> s s x) (addInteger 1 x) lim)])) ])) 1 1000))) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/toFromData.eval.golden b/plutus-tx-plugin/test/Budget/9.6/toFromData.eval.golden index ff3cc67b951..c520300a87a 100644 --- a/plutus-tx-plugin/test/Budget/9.6/toFromData.eval.golden +++ b/plutus-tx-plugin/test/Budget/9.6/toFromData.eval.golden @@ -1,5 +1,5 @@ -CPU: 7_980_913 -Memory: 28_440 -Size: 320 +CPU: 6_732_521 +Memory: 24_432 +Size: 284 (constr 1 (constr 0 (constr 0 (constr 0) (con integer 1) (constr 1)))) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/toFromData.pir.golden b/plutus-tx-plugin/test/Budget/9.6/toFromData.pir.golden index 6a8d4b55809..4977a507caf 100644 --- a/plutus-tx-plugin/test/Budget/9.6/toFromData.pir.golden +++ b/plutus-tx-plugin/test/Budget/9.6/toFromData.pir.golden @@ -92,12 +92,12 @@ in !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. Either integer b} (/\dead -> Left {integer} {b} (`$dUnsafeFromData` (headList {data} args))) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 1 index) True False) + (case Bool (equalsInteger 1 index) [False, True]) {all dead. Either integer b} (/\dead -> Right {integer} {b} (`$dUnsafeFromData` (headList {data} args))) @@ -115,12 +115,12 @@ in !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 1 index) True False) + (case Bool (equalsInteger 1 index) [False, True]) {all dead. Maybe a} (/\dead -> Nothing {a}) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. Maybe a} (/\dead -> Just {a} (`$dUnsafeFromData` (headList {data} args))) (/\dead -> traceError {Maybe a} "PT1") @@ -133,7 +133,7 @@ in !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. Tuple3 Bool integer Bool} (/\dead -> let @@ -150,12 +150,12 @@ in !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. Bool} (/\dead -> False) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 1 index) True False) + (case Bool (equalsInteger 1 index) [False, True]) {all dead. Bool} (/\dead -> True) (/\dead -> traceError {Bool} "PT1") @@ -169,12 +169,12 @@ in !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. Bool} (/\dead -> False) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 1 index) True False) + (case Bool (equalsInteger 1 index) [False, True]) {all dead. Bool} (/\dead -> True) (/\dead -> traceError {Bool} "PT1") diff --git a/plutus-tx-plugin/test/Budget/9.6/toFromData.uplc.golden b/plutus-tx-plugin/test/Budget/9.6/toFromData.uplc.golden index 0ff6e703bc5..6c40e235c72 100644 --- a/plutus-tx-plugin/test/Budget/9.6/toFromData.uplc.golden +++ b/plutus-tx-plugin/test/Budget/9.6/toFromData.uplc.golden @@ -5,152 +5,144 @@ (\index -> (\args -> force - (force - ifThenElse + (case (equalsInteger 0 index) - (delay (constr 0 [(unIData (force headList args))])) - (delay - (force - (force - ifThenElse - (equalsInteger 1 index) - (delay - (constr 1 - [ ((\tup -> - (\index -> - (\args -> - force - (force - ifThenElse - (equalsInteger 1 index) - (delay (constr 1 [])) - (delay - (force - (force - ifThenElse - (equalsInteger - 0 - index) - (delay - (constr 0 - [ ((\tup -> - (\index -> - (\args -> - force - (force - ifThenElse - (equalsInteger - 0 - index) - (delay - ((\l -> - constr 0 - [ ((\tup -> - (\index -> - (\args -> - force - (force - ifThenElse - (equalsInteger - 0 - index) - (delay - (constr 1 - [ ])) - (delay - (force - (force - ifThenElse - (equalsInteger - 1 - index) - (delay - (constr 0 - [ ])) - (delay - (traceError - "PT1"))))))) - (force - (force - sndPair) - tup)) - (force - (force - fstPair) - tup)) - (unConstrData - (force - headList - args))) - , (unIData - (force - headList - l)) - , ((\tup -> - (\index -> - (\args -> - force - (force - ifThenElse - (equalsInteger - 0 - index) - (delay - (constr 1 - [ ])) - (delay - (force - (force - ifThenElse - (equalsInteger - 1 - index) - (delay - (constr 0 - [ ])) - (delay - (traceError - "PT1"))))))) - (force - (force - sndPair) - tup)) - (force - (force - fstPair) - tup)) - (unConstrData - (force - headList - (force - tailList - l)))) ]) - (force - tailList - args))) - (delay - (traceError - "PT1")))) - (force - (force - sndPair) - tup)) - (force - (force - fstPair) - tup)) - (unConstrData - (force - headList - args))) ])) - (delay - (traceError - "PT1"))))))) - (force (force sndPair) tup)) - (force (force fstPair) tup)) - (unConstrData - (force headList args))) ])) - (delay (traceError "PT1"))))))) + [ (delay + (force + (case + (equalsInteger 1 index) + [ (delay (traceError "PT1")) + , (delay + (constr 1 + [ ((\tup -> + (\index -> + (\args -> + force + (case + (equalsInteger 1 index) + [ (delay + (force + (case + (equalsInteger + 0 + index) + [ (delay + (traceError + "PT1")) + , (delay + (constr 0 + [ ((\tup -> + (\index -> + (\args -> + force + (case + (equalsInteger + 0 + index) + [ (delay + (traceError + "PT1")) + , (delay + ((\l -> + constr 0 + [ ((\tup -> + (\index -> + (\args -> + force + (case + (equalsInteger + 0 + index) + [ (delay + (force + (case + (equalsInteger + 1 + index) + [ (delay + (traceError + "PT1")) + , (delay + (constr 0 + [ ])) ]))) + , (delay + (constr 1 + [ ])) ])) + (force + (force + sndPair) + tup)) + (force + (force + fstPair) + tup)) + (unConstrData + (force + headList + args))) + , (unIData + (force + headList + l)) + , ((\tup -> + (\index -> + (\args -> + force + (case + (equalsInteger + 0 + index) + [ (delay + (force + (case + (equalsInteger + 1 + index) + [ (delay + (traceError + "PT1")) + , (delay + (constr 0 + [ ])) ]))) + , (delay + (constr 1 + [ ])) ])) + (force + (force + sndPair) + tup)) + (force + (force + fstPair) + tup)) + (unConstrData + (force + headList + (force + tailList + l)))) ]) + (force + tailList + args))) ])) + (force + (force + sndPair) + tup)) + (force + (force + fstPair) + tup)) + (unConstrData + (force + headList + args))) ])) ]))) + , (delay + (constr 1 [])) ])) + (force (force sndPair) tup)) + (force (force fstPair) tup)) + (unConstrData + (force headList args))) ])) ]))) + , (delay (constr 0 [(unIData (force headList args))])) ])) (force (force sndPair) tup)) (force (force fstPair) tup)) (unConstrData diff --git a/plutus-tx-plugin/test/BuiltinList/Budget/9.6/all.eval.golden b/plutus-tx-plugin/test/BuiltinList/Budget/9.6/all.eval.golden index 08e0f559563..746e03c7497 100644 --- a/plutus-tx-plugin/test/BuiltinList/Budget/9.6/all.eval.golden +++ b/plutus-tx-plugin/test/BuiltinList/Budget/9.6/all.eval.golden @@ -1,5 +1,5 @@ -CPU: 15_879_700 -Memory: 70_810 -Size: 124 +CPU: 13_059_161 +Memory: 58_399 +Size: 114 (constr 0 (constr 1) (constr 0)) \ No newline at end of file diff --git a/plutus-tx-plugin/test/BuiltinList/Budget/9.6/all.pir.golden b/plutus-tx-plugin/test/BuiltinList/Budget/9.6/all.pir.golden index ed60d11be74..f521b0298c9 100644 --- a/plutus-tx-plugin/test/BuiltinList/Budget/9.6/all.pir.golden +++ b/plutus-tx-plugin/test/BuiltinList/Budget/9.6/all.pir.golden @@ -44,7 +44,8 @@ let {all dead. dead}) in go - !ifThenElse : all a. bool -> a -> a -> a = ifThenElse + !ifThenElse : all a. bool -> a -> a -> a + = /\a -> \(b : bool) (x : a) (y : a) -> case a b [y, x] !lessThanInteger : integer -> integer -> bool = lessThanInteger ~greaterThanEqualsInteger : integer -> integer -> Bool = \(x : integer) -> diff --git a/plutus-tx-plugin/test/BuiltinList/Budget/9.6/all.uplc.golden b/plutus-tx-plugin/test/BuiltinList/Budget/9.6/all.uplc.golden index fa8fdb3c973..907c0dff240 100644 --- a/plutus-tx-plugin/test/BuiltinList/Budget/9.6/all.uplc.golden +++ b/plutus-tx-plugin/test/BuiltinList/Budget/9.6/all.uplc.golden @@ -1,33 +1,35 @@ (program 1.1.0 (\xs -> - (\greaterThanEqualsInteger -> - (\cse -> - constr 0 - [ (cse (\v -> greaterThanEqualsInteger v 8) xs) - , (cse (\v -> greaterThanEqualsInteger v 0) xs) ]) - (\p -> - force - ((\f -> - (\s -> f (\x -> f (\x -> f (\x -> f (\x -> s s x) x) x) x)) - (\s -> f (\x -> s s x))) - (\go arg -> - delay - (\xs -> - force - (force (force chooseList) - xs - (delay (constr 0 [])) - (delay - ((\xs -> - force - (case - (p (force headList xs)) - [ (delay - (force (go (delay (\x -> x))) - xs)) - , (delay (constr 1 [])) ])) - (force tailList xs)))))) - (delay (\x -> x))))) - (\x y -> - force ifThenElse (lessThanInteger x y) (constr 1 []) (constr 0 [])))) \ No newline at end of file + (\cse -> + constr 0 + [ (cse + (\v -> + case (lessThanInteger v 8) [(constr 0 []), (constr 1 [])]) + xs) + , (cse + (\v -> + case (lessThanInteger v 0) [(constr 0 []), (constr 1 [])]) + xs) ]) + (\p -> + force + ((\f -> + (\s -> f (\x -> f (\x -> f (\x -> f (\x -> s s x) x) x) x)) + (\s -> f (\x -> s s x))) + (\go arg -> + delay + (\xs -> + force + (force (force chooseList) + xs + (delay (constr 0 [])) + (delay + ((\xs -> + force + (case + (p (force headList xs)) + [ (delay + (force (go (delay (\x -> x))) xs)) + , (delay (constr 1 [])) ])) + (force tailList xs)))))) + (delay (\x -> x)))))) \ No newline at end of file diff --git a/plutus-tx-plugin/test/BuiltinList/Budget/9.6/and.eval.golden b/plutus-tx-plugin/test/BuiltinList/Budget/9.6/and.eval.golden index 4e857a872c3..c19d185a2af 100644 --- a/plutus-tx-plugin/test/BuiltinList/Budget/9.6/and.eval.golden +++ b/plutus-tx-plugin/test/BuiltinList/Budget/9.6/and.eval.golden @@ -1,5 +1,5 @@ -CPU: 2_267_812 -Memory: 9_794 -Size: 91 +CPU: 1_891_714 +Memory: 8_392 +Size: 84 (constr 1) \ No newline at end of file diff --git a/plutus-tx-plugin/test/BuiltinList/Budget/9.6/and.pir.golden b/plutus-tx-plugin/test/BuiltinList/Budget/9.6/and.pir.golden index f9e0ff8c43c..01d1fdf03c3 100644 --- a/plutus-tx-plugin/test/BuiltinList/Budget/9.6/and.pir.golden +++ b/plutus-tx-plugin/test/BuiltinList/Budget/9.6/and.pir.golden @@ -40,7 +40,8 @@ let {all dead. dead}) in go - !ifThenElse : all a. bool -> a -> a -> a = ifThenElse + !ifThenElse : all a. bool -> a -> a -> a + = /\a -> \(b : bool) (x : a) (y : a) -> case a b [y, x] ~and : list bool -> Bool = all {bool} diff --git a/plutus-tx-plugin/test/BuiltinList/Budget/9.6/and.uplc.golden b/plutus-tx-plugin/test/BuiltinList/Budget/9.6/and.uplc.golden index 46488ebefaa..8b802ec959e 100644 --- a/plutus-tx-plugin/test/BuiltinList/Budget/9.6/and.uplc.golden +++ b/plutus-tx-plugin/test/BuiltinList/Budget/9.6/and.uplc.golden @@ -15,13 +15,11 @@ (delay ((\xs -> force - (force - (force ifThenElse - (force headList xs) - (delay - (delay - (force (go (delay (\x -> x))) xs))) - (delay (delay (constr 1 [])))))) + (case + (force headList xs) + [ (delay (constr 1 [])) + , (delay + (force (go (delay (\x -> x))) xs)) ])) (force tailList xs)))))) (delay (\x -> x))) xs)) \ No newline at end of file diff --git a/plutus-tx-plugin/test/BuiltinList/Budget/9.6/any.eval.golden b/plutus-tx-plugin/test/BuiltinList/Budget/9.6/any.eval.golden index 62c554f810c..43f814232c4 100644 --- a/plutus-tx-plugin/test/BuiltinList/Budget/9.6/any.eval.golden +++ b/plutus-tx-plugin/test/BuiltinList/Budget/9.6/any.eval.golden @@ -1,5 +1,5 @@ -CPU: 25_389_722 -Memory: 112_596 -Size: 124 +CPU: 20_804_840 +Memory: 92_478 +Size: 114 (constr 0 (constr 0) (constr 1)) \ No newline at end of file diff --git a/plutus-tx-plugin/test/BuiltinList/Budget/9.6/any.pir.golden b/plutus-tx-plugin/test/BuiltinList/Budget/9.6/any.pir.golden index 6cf466ec176..24bba36ac36 100644 --- a/plutus-tx-plugin/test/BuiltinList/Budget/9.6/any.pir.golden +++ b/plutus-tx-plugin/test/BuiltinList/Budget/9.6/any.pir.golden @@ -44,7 +44,8 @@ let {all dead. dead}) in go - !ifThenElse : all a. bool -> a -> a -> a = ifThenElse + !ifThenElse : all a. bool -> a -> a -> a + = /\a -> \(b : bool) (x : a) (y : a) -> case a b [y, x] !lessThanInteger : integer -> integer -> bool = lessThanInteger ~greaterThanEqualsInteger : integer -> integer -> Bool = \(x : integer) -> diff --git a/plutus-tx-plugin/test/BuiltinList/Budget/9.6/any.uplc.golden b/plutus-tx-plugin/test/BuiltinList/Budget/9.6/any.uplc.golden index ad074859ce4..5ed90bb6936 100644 --- a/plutus-tx-plugin/test/BuiltinList/Budget/9.6/any.uplc.golden +++ b/plutus-tx-plugin/test/BuiltinList/Budget/9.6/any.uplc.golden @@ -1,33 +1,36 @@ (program 1.1.0 (\xs -> - (\greaterThanEqualsInteger -> - (\cse -> - constr 0 - [ (cse (\v -> greaterThanEqualsInteger v 8) xs) - , (cse (\v -> greaterThanEqualsInteger v 12) xs) ]) - (\p -> - force - ((\f -> - (\s -> f (\x -> f (\x -> f (\x -> f (\x -> s s x) x) x) x)) - (\s -> f (\x -> s s x))) - (\go arg -> - delay - (\xs -> - force - (force (force chooseList) - xs - (delay (constr 1 [])) - (delay - ((\xs -> - force - (case - (p (force headList xs)) - [ (delay (constr 0 [])) - , (delay - (force (go (delay (\x -> x))) - xs)) ])) - (force tailList xs)))))) - (delay (\x -> x))))) - (\x y -> - force ifThenElse (lessThanInteger x y) (constr 1 []) (constr 0 [])))) \ No newline at end of file + (\cse -> + constr 0 + [ (cse + (\v -> + case (lessThanInteger v 8) [(constr 0 []), (constr 1 [])]) + xs) + , (cse + (\v -> + case (lessThanInteger v 12) [(constr 0 []), (constr 1 [])]) + xs) ]) + (\p -> + force + ((\f -> + (\s -> f (\x -> f (\x -> f (\x -> f (\x -> s s x) x) x) x)) + (\s -> f (\x -> s s x))) + (\go arg -> + delay + (\xs -> + force + (force (force chooseList) + xs + (delay (constr 1 [])) + (delay + ((\xs -> + force + (case + (p (force headList xs)) + [ (delay (constr 0 [])) + , (delay + (force (go (delay (\x -> x))) + xs)) ])) + (force tailList xs)))))) + (delay (\x -> x)))))) \ No newline at end of file diff --git a/plutus-tx-plugin/test/BuiltinList/Budget/9.6/concatMap.eval.golden b/plutus-tx-plugin/test/BuiltinList/Budget/9.6/concatMap.eval.golden index fbc00729b2a..cf55db80963 100644 --- a/plutus-tx-plugin/test/BuiltinList/Budget/9.6/concatMap.eval.golden +++ b/plutus-tx-plugin/test/BuiltinList/Budget/9.6/concatMap.eval.golden @@ -1,5 +1,5 @@ -CPU: 64_688_464 -Memory: 290_812 -Size: 237 +CPU: 60_006_994 +Memory: 275_782 +Size: 233 (con (list integer) [1,1,2,2,3,3,4,4,5,5,6,6,7,7,8,8,9,9,10,10]) \ No newline at end of file diff --git a/plutus-tx-plugin/test/BuiltinList/Budget/9.6/concatMap.pir.golden b/plutus-tx-plugin/test/BuiltinList/Budget/9.6/concatMap.pir.golden index b8d4a82639c..be1aa8af04a 100644 --- a/plutus-tx-plugin/test/BuiltinList/Budget/9.6/concatMap.pir.golden +++ b/plutus-tx-plugin/test/BuiltinList/Budget/9.6/concatMap.pir.golden @@ -67,7 +67,8 @@ let data Bool | Bool_match where True : Bool False : Bool - !ifThenElse : all a. bool -> a -> a -> a = ifThenElse + !ifThenElse : all a. bool -> a -> a -> a + = /\a -> \(b : bool) (x : a) (y : a) -> case a b [y, x] !lessThanEqualsInteger : integer -> integer -> bool = lessThanEqualsInteger !subtractInteger : integer -> integer -> integer = subtractInteger ~replicate : all a. (\arep -> list arep) a -> integer -> a -> list a diff --git a/plutus-tx-plugin/test/BuiltinList/Budget/9.6/concatMap.uplc.golden b/plutus-tx-plugin/test/BuiltinList/Budget/9.6/concatMap.uplc.golden index 506fd482612..3f3c999cc5d 100644 --- a/plutus-tx-plugin/test/BuiltinList/Budget/9.6/concatMap.uplc.golden +++ b/plutus-tx-plugin/test/BuiltinList/Budget/9.6/concatMap.uplc.golden @@ -48,17 +48,19 @@ delay (\n -> force - (force ifThenElse + (case (lessThanEqualsInteger n 0) - (delay []) - (delay - (force mkCons - x - (force - (go (delay (\x -> x))) - (subtractInteger - n - 1))))))) + [ (delay + (force mkCons + x + (force + (go + (delay + (\x -> x))) + (subtractInteger + n + 1)))) + , (delay []) ]))) (delay (\x -> x))) 2)) (force (go (delay (\x -> x))) xs))) diff --git a/plutus-tx-plugin/test/BuiltinList/Budget/9.6/drop.eval.golden b/plutus-tx-plugin/test/BuiltinList/Budget/9.6/drop.eval.golden index d4b180e9815..2ed8eb8e6d1 100644 --- a/plutus-tx-plugin/test/BuiltinList/Budget/9.6/drop.eval.golden +++ b/plutus-tx-plugin/test/BuiltinList/Budget/9.6/drop.eval.golden @@ -1,5 +1,5 @@ -CPU: 8_410_491 -Memory: 36_202 -Size: 115 +CPU: 7_474_197 +Memory: 33_196 +Size: 111 (con (list integer) [6,7,8,9,10]) \ No newline at end of file diff --git a/plutus-tx-plugin/test/BuiltinList/Budget/9.6/drop.pir.golden b/plutus-tx-plugin/test/BuiltinList/Budget/9.6/drop.pir.golden index ad0bb4546a8..071f3841990 100644 --- a/plutus-tx-plugin/test/BuiltinList/Budget/9.6/drop.pir.golden +++ b/plutus-tx-plugin/test/BuiltinList/Budget/9.6/drop.pir.golden @@ -13,7 +13,8 @@ let (/\dead -> z) (/\dead -> f (headList {a} xs) (tailList {a} xs)) {r} - !ifThenElse : all a. bool -> a -> a -> a = ifThenElse + !ifThenElse : all a. bool -> a -> a -> a + = /\a -> \(b : bool) (x : a) (y : a) -> case a b [y, x] !lessThanEqualsInteger : integer -> integer -> bool = lessThanEqualsInteger !subtractInteger : integer -> integer -> integer = subtractInteger in diff --git a/plutus-tx-plugin/test/BuiltinList/Budget/9.6/drop.uplc.golden b/plutus-tx-plugin/test/BuiltinList/Budget/9.6/drop.uplc.golden index da557a22073..1bcf6028be5 100644 --- a/plutus-tx-plugin/test/BuiltinList/Budget/9.6/drop.uplc.golden +++ b/plutus-tx-plugin/test/BuiltinList/Budget/9.6/drop.uplc.golden @@ -9,20 +9,21 @@ (delay (\`$dMkNil` n l -> force - (force ifThenElse + (case (lessThanEqualsInteger n 0) - (delay l) - (delay - (force - (force (force chooseList) - l - (delay `$dMkNil`) - (delay - ((\ds xs -> - force (force (drop (delay (\x -> x)))) - `$dMkNil` - (subtractInteger n 1) - xs) - (force headList l) - (force tailList l)))))))))) + [ (delay + (force + (force (force chooseList) + l + (delay `$dMkNil`) + (delay + ((\ds xs -> + force + (force (drop (delay (\x -> x)))) + `$dMkNil` + (subtractInteger n 1) + xs) + (force headList l) + (force tailList l)))))) + , (delay l) ])))) (delay (\x -> x))))) \ No newline at end of file diff --git a/plutus-tx-plugin/test/BuiltinList/Budget/9.6/dropWhile.eval.golden b/plutus-tx-plugin/test/BuiltinList/Budget/9.6/dropWhile.eval.golden index 0fcbe541260..ad20e4df339 100644 --- a/plutus-tx-plugin/test/BuiltinList/Budget/9.6/dropWhile.eval.golden +++ b/plutus-tx-plugin/test/BuiltinList/Budget/9.6/dropWhile.eval.golden @@ -1,5 +1,5 @@ -CPU: 6_095_830 -Memory: 25_590 -Size: 95 +CPU: 5_155_585 +Memory: 22_085 +Size: 88 (con (list integer) [5,6,7,8,9,10]) \ No newline at end of file diff --git a/plutus-tx-plugin/test/BuiltinList/Budget/9.6/dropWhile.pir.golden b/plutus-tx-plugin/test/BuiltinList/Budget/9.6/dropWhile.pir.golden index ad7f046b99a..a9aecba2aa6 100644 --- a/plutus-tx-plugin/test/BuiltinList/Budget/9.6/dropWhile.pir.golden +++ b/plutus-tx-plugin/test/BuiltinList/Budget/9.6/dropWhile.pir.golden @@ -46,7 +46,8 @@ let xs in \(eta : list a) -> go eta - !ifThenElse : all a. bool -> a -> a -> a = ifThenElse + !ifThenElse : all a. bool -> a -> a -> a + = /\a -> \(b : bool) (x : a) (y : a) -> case a b [y, x] !lessThanInteger : integer -> integer -> bool = lessThanInteger ~lessThanInteger : integer -> integer -> Bool = \(x : integer) -> diff --git a/plutus-tx-plugin/test/BuiltinList/Budget/9.6/dropWhile.uplc.golden b/plutus-tx-plugin/test/BuiltinList/Budget/9.6/dropWhile.uplc.golden index 1b9af8ab54e..54ff0c97a8c 100644 --- a/plutus-tx-plugin/test/BuiltinList/Budget/9.6/dropWhile.uplc.golden +++ b/plutus-tx-plugin/test/BuiltinList/Budget/9.6/dropWhile.uplc.golden @@ -15,14 +15,11 @@ (delay ((\xs' -> force - (force - (force ifThenElse - (lessThanInteger (force headList xs) 5) - (delay - (delay - (force (go (delay (\x -> x))) - xs'))) - (delay (delay xs))))) + (case + (lessThanInteger (force headList xs) 5) + [ (delay xs) + , (delay + (force (go (delay (\x -> x))) xs')) ])) (force tailList xs)))))) (delay (\x -> x))) xs)) \ No newline at end of file diff --git a/plutus-tx-plugin/test/BuiltinList/Budget/9.6/elem.eval.golden b/plutus-tx-plugin/test/BuiltinList/Budget/9.6/elem.eval.golden index dd97143ae91..f208cac73da 100644 --- a/plutus-tx-plugin/test/BuiltinList/Budget/9.6/elem.eval.golden +++ b/plutus-tx-plugin/test/BuiltinList/Budget/9.6/elem.eval.golden @@ -1,5 +1,5 @@ -CPU: 22_876_496 -Memory: 96_096 -Size: 107 +CPU: 19_491_614 +Memory: 83_478 +Size: 100 (constr 0 (constr 0) (constr 1)) \ No newline at end of file diff --git a/plutus-tx-plugin/test/BuiltinList/Budget/9.6/elem.pir.golden b/plutus-tx-plugin/test/BuiltinList/Budget/9.6/elem.pir.golden index dd1b82e7769..b7b6d2ed0bb 100644 --- a/plutus-tx-plugin/test/BuiltinList/Budget/9.6/elem.pir.golden +++ b/plutus-tx-plugin/test/BuiltinList/Budget/9.6/elem.pir.golden @@ -3,7 +3,8 @@ let True : Bool False : Bool !equalsInteger : integer -> integer -> bool = equalsInteger - !ifThenElse : all a. bool -> a -> a -> a = ifThenElse + !ifThenElse : all a. bool -> a -> a -> a + = /\a -> \(b : bool) (x : a) (y : a) -> case a b [y, x] ~equalsInteger : integer -> integer -> Bool = \(x : integer) -> let diff --git a/plutus-tx-plugin/test/BuiltinList/Budget/9.6/elem.uplc.golden b/plutus-tx-plugin/test/BuiltinList/Budget/9.6/elem.uplc.golden index a7446d7ecb5..96b331eec0d 100644 --- a/plutus-tx-plugin/test/BuiltinList/Budget/9.6/elem.uplc.golden +++ b/plutus-tx-plugin/test/BuiltinList/Budget/9.6/elem.uplc.golden @@ -17,15 +17,10 @@ (delay ((\xs -> force - (force - (force ifThenElse - (equalsInteger - a - (force headList xs)) - (delay (delay (constr 0 []))) - (delay - (delay - (force (go (delay (\x -> x))) - xs)))))) + (case + (equalsInteger a (force headList xs)) + [ (delay + (force (go (delay (\x -> x))) xs)) + , (delay (constr 0 [])) ])) (force tailList xs)))))) (delay (\x -> x)))))) \ No newline at end of file diff --git a/plutus-tx-plugin/test/BuiltinList/Budget/9.6/elemBy.eval.golden b/plutus-tx-plugin/test/BuiltinList/Budget/9.6/elemBy.eval.golden index 1315ba3e6a8..120dcb14dc1 100644 --- a/plutus-tx-plugin/test/BuiltinList/Budget/9.6/elemBy.eval.golden +++ b/plutus-tx-plugin/test/BuiltinList/Budget/9.6/elemBy.eval.golden @@ -1,5 +1,5 @@ -CPU: 12_822_024 -Memory: 54_312 -Size: 95 +CPU: 10_941_534 +Memory: 47_302 +Size: 88 (constr 1) \ No newline at end of file diff --git a/plutus-tx-plugin/test/BuiltinList/Budget/9.6/elemBy.pir.golden b/plutus-tx-plugin/test/BuiltinList/Budget/9.6/elemBy.pir.golden index 2b33b96f6e6..52cbc9d2aa0 100644 --- a/plutus-tx-plugin/test/BuiltinList/Budget/9.6/elemBy.pir.golden +++ b/plutus-tx-plugin/test/BuiltinList/Budget/9.6/elemBy.pir.golden @@ -44,7 +44,8 @@ let {all dead. dead}) in go - !ifThenElse : all a. bool -> a -> a -> a = ifThenElse + !ifThenElse : all a. bool -> a -> a -> a + = /\a -> \(b : bool) (x : a) (y : a) -> case a b [y, x] !lessThanEqualsInteger : integer -> integer -> bool = lessThanEqualsInteger ~lessThanEqualsInteger : integer -> integer -> Bool = \(x : integer) -> diff --git a/plutus-tx-plugin/test/BuiltinList/Budget/9.6/elemBy.uplc.golden b/plutus-tx-plugin/test/BuiltinList/Budget/9.6/elemBy.uplc.golden index 357c71c629b..545e5d92e10 100644 --- a/plutus-tx-plugin/test/BuiltinList/Budget/9.6/elemBy.uplc.golden +++ b/plutus-tx-plugin/test/BuiltinList/Budget/9.6/elemBy.uplc.golden @@ -15,16 +15,12 @@ (delay ((\xs -> force - (force - (force ifThenElse - (lessThanEqualsInteger - (force headList xs) - 0) - (delay (delay (constr 0 []))) - (delay - (delay - (force (go (delay (\x -> x))) - xs)))))) + (case + (lessThanEqualsInteger + (force headList xs) + 0) + [ (delay (force (go (delay (\x -> x))) xs)) + , (delay (constr 0 [])) ])) (force tailList xs)))))) (delay (\x -> x))) xs)) \ No newline at end of file diff --git a/plutus-tx-plugin/test/BuiltinList/Budget/9.6/filter.eval.golden b/plutus-tx-plugin/test/BuiltinList/Budget/9.6/filter.eval.golden index fd821a0419a..ca63c9a4e76 100644 --- a/plutus-tx-plugin/test/BuiltinList/Budget/9.6/filter.eval.golden +++ b/plutus-tx-plugin/test/BuiltinList/Budget/9.6/filter.eval.golden @@ -1,5 +1,5 @@ -CPU: 16_588_094 -Memory: 66_982 -Size: 110 +CPU: 14_707_604 +Memory: 59_972 +Size: 103 (con (list integer) [2,4,6,8,10]) \ No newline at end of file diff --git a/plutus-tx-plugin/test/BuiltinList/Budget/9.6/filter.pir.golden b/plutus-tx-plugin/test/BuiltinList/Budget/9.6/filter.pir.golden index 24f771b0605..5ca955ce877 100644 --- a/plutus-tx-plugin/test/BuiltinList/Budget/9.6/filter.pir.golden +++ b/plutus-tx-plugin/test/BuiltinList/Budget/9.6/filter.pir.golden @@ -4,7 +4,8 @@ let data Bool | Bool_match where True : Bool False : Bool - !ifThenElse : all a. bool -> a -> a -> a = ifThenElse + !ifThenElse : all a. bool -> a -> a -> a + = /\a -> \(b : bool) (x : a) (y : a) -> case a b [y, x] !modInteger : integer -> integer -> integer = modInteger ~even : integer -> Bool = \(n : integer) -> diff --git a/plutus-tx-plugin/test/BuiltinList/Budget/9.6/filter.uplc.golden b/plutus-tx-plugin/test/BuiltinList/Budget/9.6/filter.uplc.golden index 3e74357867c..893a6edf6ca 100644 --- a/plutus-tx-plugin/test/BuiltinList/Budget/9.6/filter.uplc.golden +++ b/plutus-tx-plugin/test/BuiltinList/Budget/9.6/filter.uplc.golden @@ -16,11 +16,10 @@ ((\x xs -> (\xs -> force - (force - (force ifThenElse - (equalsInteger (modInteger x 2) 0) - (delay (delay (force mkCons x xs))) - (delay (delay xs))))) + (case + (equalsInteger (modInteger x 2) 0) + [ (delay xs) + , (delay (force mkCons x xs)) ])) (force (go (delay (\x -> x))) xs)) (force headList xs) (force tailList xs)))))) diff --git a/plutus-tx-plugin/test/BuiltinList/Budget/9.6/find.eval.golden b/plutus-tx-plugin/test/BuiltinList/Budget/9.6/find.eval.golden index 5e47e40ff45..4aed4976a5d 100644 --- a/plutus-tx-plugin/test/BuiltinList/Budget/9.6/find.eval.golden +++ b/plutus-tx-plugin/test/BuiltinList/Budget/9.6/find.eval.golden @@ -1,5 +1,5 @@ -CPU: 26_269_722 -Memory: 118_096 -Size: 128 +CPU: 21_684_840 +Memory: 97_978 +Size: 118 (constr 0 (constr 0 (con integer 8)) (constr 1)) \ No newline at end of file diff --git a/plutus-tx-plugin/test/BuiltinList/Budget/9.6/find.pir.golden b/plutus-tx-plugin/test/BuiltinList/Budget/9.6/find.pir.golden index 5fe6116d349..e2eff29b469 100644 --- a/plutus-tx-plugin/test/BuiltinList/Budget/9.6/find.pir.golden +++ b/plutus-tx-plugin/test/BuiltinList/Budget/9.6/find.pir.golden @@ -47,7 +47,8 @@ let {all dead. dead}) in go - !ifThenElse : all a. bool -> a -> a -> a = ifThenElse + !ifThenElse : all a. bool -> a -> a -> a + = /\a -> \(b : bool) (x : a) (y : a) -> case a b [y, x] !lessThanInteger : integer -> integer -> bool = lessThanInteger ~greaterThanEqualsInteger : integer -> integer -> Bool = \(x : integer) -> diff --git a/plutus-tx-plugin/test/BuiltinList/Budget/9.6/find.uplc.golden b/plutus-tx-plugin/test/BuiltinList/Budget/9.6/find.uplc.golden index aff11190216..ffb0c42c032 100644 --- a/plutus-tx-plugin/test/BuiltinList/Budget/9.6/find.uplc.golden +++ b/plutus-tx-plugin/test/BuiltinList/Budget/9.6/find.uplc.golden @@ -1,34 +1,37 @@ (program 1.1.0 (\xs -> - (\greaterThanEqualsInteger -> - (\cse -> - constr 0 - [ (cse (\v -> greaterThanEqualsInteger v 8) xs) - , (cse (\v -> greaterThanEqualsInteger v 12) xs) ]) - (\p -> - force - ((\f -> - (\s -> f (\x -> f (\x -> f (\x -> f (\x -> s s x) x) x) x)) - (\s -> f (\x -> s s x))) - (\go arg -> - delay - (\xs -> - force - (force (force chooseList) - xs - (delay (constr 1 [])) - (delay - ((\x xs -> - force - (case - (p x) - [ (delay (constr 0 [x])) - , (delay - (force (go (delay (\x -> x))) - xs)) ])) - (force headList xs) - (force tailList xs)))))) - (delay (\x -> x))))) - (\x y -> - force ifThenElse (lessThanInteger x y) (constr 1 []) (constr 0 [])))) \ No newline at end of file + (\cse -> + constr 0 + [ (cse + (\v -> + case (lessThanInteger v 8) [(constr 0 []), (constr 1 [])]) + xs) + , (cse + (\v -> + case (lessThanInteger v 12) [(constr 0 []), (constr 1 [])]) + xs) ]) + (\p -> + force + ((\f -> + (\s -> f (\x -> f (\x -> f (\x -> f (\x -> s s x) x) x) x)) + (\s -> f (\x -> s s x))) + (\go arg -> + delay + (\xs -> + force + (force (force chooseList) + xs + (delay (constr 1 [])) + (delay + ((\x xs -> + force + (case + (p x) + [ (delay (constr 0 [x])) + , (delay + (force (go (delay (\x -> x))) + xs)) ])) + (force headList xs) + (force tailList xs)))))) + (delay (\x -> x)))))) \ No newline at end of file diff --git a/plutus-tx-plugin/test/BuiltinList/Budget/9.6/findIndexJust.eval.golden b/plutus-tx-plugin/test/BuiltinList/Budget/9.6/findIndexJust.eval.golden index a380634298f..a9991eb280c 100644 --- a/plutus-tx-plugin/test/BuiltinList/Budget/9.6/findIndexJust.eval.golden +++ b/plutus-tx-plugin/test/BuiltinList/Budget/9.6/findIndexJust.eval.golden @@ -1,5 +1,5 @@ -CPU: 5_592_480 -Memory: 22_898 -Size: 105 +CPU: 4_840_284 +Memory: 20_094 +Size: 98 (constr 0 (con integer 3)) \ No newline at end of file diff --git a/plutus-tx-plugin/test/BuiltinList/Budget/9.6/findIndexJust.pir.golden b/plutus-tx-plugin/test/BuiltinList/Budget/9.6/findIndexJust.pir.golden index fed3d1ac82c..b02c603f6b3 100644 --- a/plutus-tx-plugin/test/BuiltinList/Budget/9.6/findIndexJust.pir.golden +++ b/plutus-tx-plugin/test/BuiltinList/Budget/9.6/findIndexJust.pir.golden @@ -4,7 +4,8 @@ let data Bool | Bool_match where True : Bool False : Bool - !ifThenElse : all a. bool -> a -> a -> a = ifThenElse + !ifThenElse : all a. bool -> a -> a -> a + = /\a -> \(b : bool) (x : a) (y : a) -> case a b [y, x] ~equalsInteger : integer -> integer -> Bool = \(x : integer) -> let diff --git a/plutus-tx-plugin/test/BuiltinList/Budget/9.6/findIndexJust.uplc.golden b/plutus-tx-plugin/test/BuiltinList/Budget/9.6/findIndexJust.uplc.golden index ce0a37f00de..50c3f52441c 100644 --- a/plutus-tx-plugin/test/BuiltinList/Budget/9.6/findIndexJust.uplc.golden +++ b/plutus-tx-plugin/test/BuiltinList/Budget/9.6/findIndexJust.uplc.golden @@ -15,15 +15,13 @@ (delay ((\xs -> force - (force - (force ifThenElse - (equalsInteger (force headList xs) 4) - (delay (delay (constr 0 [i]))) - (delay - (delay - (force (go (delay (\x -> x))) - (addInteger i 1) - xs)))))) + (case + (equalsInteger (force headList xs) 4) + [ (delay + (force (go (delay (\x -> x))) + (addInteger i 1) + xs)) + , (delay (constr 0 [i])) ])) (force tailList xs)))))) (delay (\x -> x))) 0 diff --git a/plutus-tx-plugin/test/BuiltinList/Budget/9.6/findIndexNothing.eval.golden b/plutus-tx-plugin/test/BuiltinList/Budget/9.6/findIndexNothing.eval.golden index 2046c2e9632..6b90ad00bc7 100644 --- a/plutus-tx-plugin/test/BuiltinList/Budget/9.6/findIndexNothing.eval.golden +++ b/plutus-tx-plugin/test/BuiltinList/Budget/9.6/findIndexNothing.eval.golden @@ -1,5 +1,5 @@ -CPU: 15_087_064 -Memory: 61_632 -Size: 105 +CPU: 13_206_574 +Memory: 54_622 +Size: 98 (constr 1) \ No newline at end of file diff --git a/plutus-tx-plugin/test/BuiltinList/Budget/9.6/findIndexNothing.pir.golden b/plutus-tx-plugin/test/BuiltinList/Budget/9.6/findIndexNothing.pir.golden index f1e9efba8b0..161fe796891 100644 --- a/plutus-tx-plugin/test/BuiltinList/Budget/9.6/findIndexNothing.pir.golden +++ b/plutus-tx-plugin/test/BuiltinList/Budget/9.6/findIndexNothing.pir.golden @@ -4,7 +4,8 @@ let data Bool | Bool_match where True : Bool False : Bool - !ifThenElse : all a. bool -> a -> a -> a = ifThenElse + !ifThenElse : all a. bool -> a -> a -> a + = /\a -> \(b : bool) (x : a) (y : a) -> case a b [y, x] ~equalsInteger : integer -> integer -> Bool = \(x : integer) -> let diff --git a/plutus-tx-plugin/test/BuiltinList/Budget/9.6/findIndexNothing.uplc.golden b/plutus-tx-plugin/test/BuiltinList/Budget/9.6/findIndexNothing.uplc.golden index 514fe355b04..ce3cd8e258a 100644 --- a/plutus-tx-plugin/test/BuiltinList/Budget/9.6/findIndexNothing.uplc.golden +++ b/plutus-tx-plugin/test/BuiltinList/Budget/9.6/findIndexNothing.uplc.golden @@ -15,15 +15,13 @@ (delay ((\xs -> force - (force - (force ifThenElse - (equalsInteger (force headList xs) 99) - (delay (delay (constr 0 [i]))) - (delay - (delay - (force (go (delay (\x -> x))) - (addInteger i 1) - xs)))))) + (case + (equalsInteger (force headList xs) 99) + [ (delay + (force (go (delay (\x -> x))) + (addInteger i 1) + xs)) + , (delay (constr 0 [i])) ])) (force tailList xs)))))) (delay (\x -> x))) 0 diff --git a/plutus-tx-plugin/test/BuiltinList/Budget/9.6/findIndices.eval.golden b/plutus-tx-plugin/test/BuiltinList/Budget/9.6/findIndices.eval.golden index cb88d8c947c..bd240d57fbb 100644 --- a/plutus-tx-plugin/test/BuiltinList/Budget/9.6/findIndices.eval.golden +++ b/plutus-tx-plugin/test/BuiltinList/Budget/9.6/findIndices.eval.golden @@ -1,5 +1,5 @@ -CPU: 18_768_174 -Memory: 74_302 -Size: 119 +CPU: 17_527_684 +Memory: 71_292 +Size: 118 (con (list integer) [0,2,4,6,8]) \ No newline at end of file diff --git a/plutus-tx-plugin/test/BuiltinList/Budget/9.6/findIndices.pir.golden b/plutus-tx-plugin/test/BuiltinList/Budget/9.6/findIndices.pir.golden index a18a73cf484..06285de3cb9 100644 --- a/plutus-tx-plugin/test/BuiltinList/Budget/9.6/findIndices.pir.golden +++ b/plutus-tx-plugin/test/BuiltinList/Budget/9.6/findIndices.pir.golden @@ -48,7 +48,8 @@ let in go 0 !equalsInteger : integer -> integer -> bool = equalsInteger - !ifThenElse : all a. bool -> a -> a -> a = ifThenElse + !ifThenElse : all a. bool -> a -> a -> a + = /\a -> \(b : bool) (x : a) (y : a) -> case a b [y, x] !modInteger : integer -> integer -> integer = modInteger ~even : integer -> Bool = \(n : integer) -> diff --git a/plutus-tx-plugin/test/BuiltinList/Budget/9.6/findIndices.uplc.golden b/plutus-tx-plugin/test/BuiltinList/Budget/9.6/findIndices.uplc.golden index a24ef8885db..8a61699165c 100644 --- a/plutus-tx-plugin/test/BuiltinList/Budget/9.6/findIndices.uplc.golden +++ b/plutus-tx-plugin/test/BuiltinList/Budget/9.6/findIndices.uplc.golden @@ -16,13 +16,14 @@ ((\x xs -> (\indices -> force - (force - (force ifThenElse - (equalsInteger (modInteger x 2) 0) - (delay (delay indices)) - (delay - (delay - (force mkCons i indices)))))) + (case + (force + (case + (equalsInteger (modInteger x 2) 0) + [ (delay (constr 0 [])) + , (delay (constr 1 [])) ])) + [ (delay (force mkCons i indices)) + , (delay indices) ])) (force (go (delay (\x -> x))) (addInteger i 1) xs)) diff --git a/plutus-tx-plugin/test/BuiltinList/Budget/9.6/index.eval.golden b/plutus-tx-plugin/test/BuiltinList/Budget/9.6/index.eval.golden index 53f20b85ddc..cc86a31cb2c 100644 --- a/plutus-tx-plugin/test/BuiltinList/Budget/9.6/index.eval.golden +++ b/plutus-tx-plugin/test/BuiltinList/Budget/9.6/index.eval.golden @@ -1,5 +1,5 @@ -CPU: 1_441_742 -Memory: 5_802 -Size: 72 +CPU: 1_285_693 +Memory: 5_301 +Size: 68 (con integer 6) \ No newline at end of file diff --git a/plutus-tx-plugin/test/BuiltinList/Budget/9.6/index.pir.golden b/plutus-tx-plugin/test/BuiltinList/Budget/9.6/index.pir.golden index 4d07729ee13..3ecda27747a 100644 --- a/plutus-tx-plugin/test/BuiltinList/Budget/9.6/index.pir.golden +++ b/plutus-tx-plugin/test/BuiltinList/Budget/9.6/index.pir.golden @@ -15,7 +15,8 @@ let (/\dead -> f (headList {a} xs) (tailList {a} xs)) {r} !drop : all a. integer -> list a -> list a = dropList - !ifThenElse : all a. bool -> a -> a -> a = ifThenElse + !ifThenElse : all a. bool -> a -> a -> a + = /\a -> \(b : bool) (x : a) (y : a) -> case a b [y, x] !lessThanInteger : integer -> integer -> bool = lessThanInteger data Unit | Unit_match where Unit : Unit diff --git a/plutus-tx-plugin/test/BuiltinList/Budget/9.6/index.uplc.golden b/plutus-tx-plugin/test/BuiltinList/Budget/9.6/index.uplc.golden index 866c5fb0c76..7e049b62635 100644 --- a/plutus-tx-plugin/test/BuiltinList/Budget/9.6/index.uplc.golden +++ b/plutus-tx-plugin/test/BuiltinList/Budget/9.6/index.uplc.golden @@ -3,20 +3,20 @@ (\xs -> force ((\traceError -> - force ifThenElse + case (lessThanInteger 5 0) - (delay (traceError "PT21")) - (delay - ((\l -> - force - (force (force chooseList) - l - (delay (\_ann -> traceError "PT22")) - (delay - ((\x xs ds _ann -> x) - (force headList l) - (force tailList l)))) - (constr 0 []) - (constr 0 [])) - (force dropList 5 xs)))) + [ (delay + ((\l -> + force + (force (force chooseList) + l + (delay (\_ann -> traceError "PT22")) + (delay + ((\x xs ds _ann -> x) + (force headList l) + (force tailList l)))) + (constr 0 []) + (constr 0 [])) + (force dropList 5 xs))) + , (delay (traceError "PT21")) ]) (\str -> (\x -> error) (force trace str (constr 0 [])))))) \ No newline at end of file diff --git a/plutus-tx-plugin/test/BuiltinList/Budget/9.6/indexNegative.pir.golden b/plutus-tx-plugin/test/BuiltinList/Budget/9.6/indexNegative.pir.golden index 73aa369442a..073a77d943f 100644 --- a/plutus-tx-plugin/test/BuiltinList/Budget/9.6/indexNegative.pir.golden +++ b/plutus-tx-plugin/test/BuiltinList/Budget/9.6/indexNegative.pir.golden @@ -15,7 +15,8 @@ let (/\dead -> f (headList {a} xs) (tailList {a} xs)) {r} !drop : all a. integer -> list a -> list a = dropList - !ifThenElse : all a. bool -> a -> a -> a = ifThenElse + !ifThenElse : all a. bool -> a -> a -> a + = /\a -> \(b : bool) (x : a) (y : a) -> case a b [y, x] !lessThanInteger : integer -> integer -> bool = lessThanInteger data Unit | Unit_match where Unit : Unit diff --git a/plutus-tx-plugin/test/BuiltinList/Budget/9.6/indexNegative.uplc.golden b/plutus-tx-plugin/test/BuiltinList/Budget/9.6/indexNegative.uplc.golden index 751f886b406..4a1f552146b 100644 --- a/plutus-tx-plugin/test/BuiltinList/Budget/9.6/indexNegative.uplc.golden +++ b/plutus-tx-plugin/test/BuiltinList/Budget/9.6/indexNegative.uplc.golden @@ -4,21 +4,21 @@ (\i -> force ((\traceError -> - force ifThenElse + case (lessThanInteger i 0) - (delay (traceError "PT21")) - (delay - ((\l -> - force - (force (force chooseList) - l - (delay (\_ann -> traceError "PT22")) - (delay - ((\x xs ds _ann -> x) - (force headList l) - (force tailList l)))) - (constr 0 []) - (constr 0 [])) - (force dropList i xs)))) + [ (delay + ((\l -> + force + (force (force chooseList) + l + (delay (\_ann -> traceError "PT22")) + (delay + ((\x xs ds _ann -> x) + (force headList l) + (force tailList l)))) + (constr 0 []) + (constr 0 [])) + (force dropList i xs))) + , (delay (traceError "PT21")) ]) (\str -> (\x -> error) (force trace str (constr 0 []))))) (subtractInteger 0 1))) \ No newline at end of file diff --git a/plutus-tx-plugin/test/BuiltinList/Budget/9.6/indexTooLarge.pir.golden b/plutus-tx-plugin/test/BuiltinList/Budget/9.6/indexTooLarge.pir.golden index 6800dac0f2e..224917c5f22 100644 --- a/plutus-tx-plugin/test/BuiltinList/Budget/9.6/indexTooLarge.pir.golden +++ b/plutus-tx-plugin/test/BuiltinList/Budget/9.6/indexTooLarge.pir.golden @@ -15,7 +15,8 @@ let (/\dead -> f (headList {a} xs) (tailList {a} xs)) {r} !drop : all a. integer -> list a -> list a = dropList - !ifThenElse : all a. bool -> a -> a -> a = ifThenElse + !ifThenElse : all a. bool -> a -> a -> a + = /\a -> \(b : bool) (x : a) (y : a) -> case a b [y, x] !lessThanInteger : integer -> integer -> bool = lessThanInteger data Unit | Unit_match where Unit : Unit diff --git a/plutus-tx-plugin/test/BuiltinList/Budget/9.6/indexTooLarge.uplc.golden b/plutus-tx-plugin/test/BuiltinList/Budget/9.6/indexTooLarge.uplc.golden index d6793d58743..71644652148 100644 --- a/plutus-tx-plugin/test/BuiltinList/Budget/9.6/indexTooLarge.uplc.golden +++ b/plutus-tx-plugin/test/BuiltinList/Budget/9.6/indexTooLarge.uplc.golden @@ -3,20 +3,20 @@ (\xs -> force ((\traceError -> - force ifThenElse + case (lessThanInteger 10 0) - (delay (traceError "PT21")) - (delay - ((\l -> - force - (force (force chooseList) - l - (delay (\_ann -> traceError "PT22")) - (delay - ((\x xs ds _ann -> x) - (force headList l) - (force tailList l)))) - (constr 0 []) - (constr 0 [])) - (force dropList 10 xs)))) + [ (delay + ((\l -> + force + (force (force chooseList) + l + (delay (\_ann -> traceError "PT22")) + (delay + ((\x xs ds _ann -> x) + (force headList l) + (force tailList l)))) + (constr 0 []) + (constr 0 [])) + (force dropList 10 xs))) + , (delay (traceError "PT21")) ]) (\str -> (\x -> error) (force trace str (constr 0 [])))))) \ No newline at end of file diff --git a/plutus-tx-plugin/test/BuiltinList/Budget/9.6/mapMaybe.eval.golden b/plutus-tx-plugin/test/BuiltinList/Budget/9.6/mapMaybe.eval.golden index 7988d00d8b3..e8a5b24845e 100644 --- a/plutus-tx-plugin/test/BuiltinList/Budget/9.6/mapMaybe.eval.golden +++ b/plutus-tx-plugin/test/BuiltinList/Budget/9.6/mapMaybe.eval.golden @@ -1,5 +1,5 @@ -CPU: 16_908_094 -Memory: 68_982 -Size: 122 +CPU: 15_667_604 +Memory: 65_972 +Size: 121 (con (list integer) [1,3,5,7,9]) \ No newline at end of file diff --git a/plutus-tx-plugin/test/BuiltinList/Budget/9.6/mapMaybe.pir.golden b/plutus-tx-plugin/test/BuiltinList/Budget/9.6/mapMaybe.pir.golden index 94a964d0f4e..d1c5f95014f 100644 --- a/plutus-tx-plugin/test/BuiltinList/Budget/9.6/mapMaybe.pir.golden +++ b/plutus-tx-plugin/test/BuiltinList/Budget/9.6/mapMaybe.pir.golden @@ -48,7 +48,8 @@ let True : Bool False : Bool !equalsInteger : integer -> integer -> bool = equalsInteger - !ifThenElse : all a. bool -> a -> a -> a = ifThenElse + !ifThenElse : all a. bool -> a -> a -> a + = /\a -> \(b : bool) (x : a) (y : a) -> case a b [y, x] !modInteger : integer -> integer -> integer = modInteger ~even : integer -> Bool = \(n : integer) -> diff --git a/plutus-tx-plugin/test/BuiltinList/Budget/9.6/mapMaybe.uplc.golden b/plutus-tx-plugin/test/BuiltinList/Budget/9.6/mapMaybe.uplc.golden index 9cb4012c613..ecbb5712c87 100644 --- a/plutus-tx-plugin/test/BuiltinList/Budget/9.6/mapMaybe.uplc.golden +++ b/plutus-tx-plugin/test/BuiltinList/Budget/9.6/mapMaybe.uplc.golden @@ -18,14 +18,16 @@ (case ((\x -> force - (force - (force ifThenElse - (equalsInteger - (modInteger x 2) - 0) - (delay (delay (constr 1 []))) - (delay - (delay (constr 0 [x])))))) + (case + (force + (case + (equalsInteger + (modInteger x 2) + 0) + [ (delay (constr 0 [])) + , (delay (constr 1 [])) ])) + [ (delay (constr 0 [x])) + , (delay (constr 1 [])) ])) (force headList xs)) [ (\y -> delay diff --git a/plutus-tx-plugin/test/BuiltinList/Budget/9.6/notElem.eval.golden b/plutus-tx-plugin/test/BuiltinList/Budget/9.6/notElem.eval.golden index 3d5b583b61f..7407090eaac 100644 --- a/plutus-tx-plugin/test/BuiltinList/Budget/9.6/notElem.eval.golden +++ b/plutus-tx-plugin/test/BuiltinList/Budget/9.6/notElem.eval.golden @@ -1,5 +1,5 @@ -CPU: 12_970_984 -Memory: 54_712 -Size: 101 +CPU: 11_090_494 +Memory: 47_702 +Size: 94 (constr 0) \ No newline at end of file diff --git a/plutus-tx-plugin/test/BuiltinList/Budget/9.6/notElem.pir.golden b/plutus-tx-plugin/test/BuiltinList/Budget/9.6/notElem.pir.golden index d8ac7b44488..3a6ecb2f5b3 100644 --- a/plutus-tx-plugin/test/BuiltinList/Budget/9.6/notElem.pir.golden +++ b/plutus-tx-plugin/test/BuiltinList/Budget/9.6/notElem.pir.golden @@ -1,6 +1,7 @@ let !equalsInteger : integer -> integer -> bool = equalsInteger - !ifThenElse : all a. bool -> a -> a -> a = ifThenElse + !ifThenElse : all a. bool -> a -> a -> a + = /\a -> \(b : bool) (x : a) (y : a) -> case a b [y, x] data Bool | Bool_match where True : Bool False : Bool diff --git a/plutus-tx-plugin/test/BuiltinList/Budget/9.6/notElem.uplc.golden b/plutus-tx-plugin/test/BuiltinList/Budget/9.6/notElem.uplc.golden index c899f12f0c9..36151c13ee3 100644 --- a/plutus-tx-plugin/test/BuiltinList/Budget/9.6/notElem.uplc.golden +++ b/plutus-tx-plugin/test/BuiltinList/Budget/9.6/notElem.uplc.golden @@ -17,16 +17,12 @@ (delay ((\xs -> force - (force - (force ifThenElse - (equalsInteger - 42 - (force headList xs)) - (delay (delay (constr 0 []))) - (delay - (delay - (force (go (delay (\x -> x))) - xs)))))) + (case + (equalsInteger 42 (force headList xs)) + [ (delay + (force (go (delay (\x -> x))) + xs)) + , (delay (constr 0 [])) ])) (force tailList xs)))))) (delay (\x -> x))) xs) diff --git a/plutus-tx-plugin/test/BuiltinList/Budget/9.6/nub.eval.golden b/plutus-tx-plugin/test/BuiltinList/Budget/9.6/nub.eval.golden index e472fbdf562..9384ae7a92d 100644 --- a/plutus-tx-plugin/test/BuiltinList/Budget/9.6/nub.eval.golden +++ b/plutus-tx-plugin/test/BuiltinList/Budget/9.6/nub.eval.golden @@ -1,5 +1,5 @@ -CPU: 182_519_998 -Memory: 809_124 -Size: 266 +CPU: 163_715_098 +Memory: 739_024 +Size: 259 (con (list integer) [1,2,3,4,5,6,7,8,9,10]) \ No newline at end of file diff --git a/plutus-tx-plugin/test/BuiltinList/Budget/9.6/nub.pir.golden b/plutus-tx-plugin/test/BuiltinList/Budget/9.6/nub.pir.golden index 93f8ef0d563..4f710970a4e 100644 --- a/plutus-tx-plugin/test/BuiltinList/Budget/9.6/nub.pir.golden +++ b/plutus-tx-plugin/test/BuiltinList/Budget/9.6/nub.pir.golden @@ -1,6 +1,7 @@ let !equalsInteger : integer -> integer -> bool = equalsInteger - !ifThenElse : all a. bool -> a -> a -> a = ifThenElse + !ifThenElse : all a. bool -> a -> a -> a + = /\a -> \(b : bool) (x : a) (y : a) -> case a b [y, x] data Bool | Bool_match where True : Bool False : Bool diff --git a/plutus-tx-plugin/test/BuiltinList/Budget/9.6/nub.uplc.golden b/plutus-tx-plugin/test/BuiltinList/Budget/9.6/nub.uplc.golden index a5873a4dd45..f59c591f3cd 100644 --- a/plutus-tx-plugin/test/BuiltinList/Budget/9.6/nub.uplc.golden +++ b/plutus-tx-plugin/test/BuiltinList/Budget/9.6/nub.uplc.golden @@ -7,15 +7,12 @@ ((\f -> (\s -> f (\x -> f (\x -> f (\x -> f (\x -> s s x) x) x) x)) (\s -> f (\x -> s s x))) - (\go - arg -> + (\go arg -> delay - (\l - xs -> + (\l xs -> caseList' [] - (\y - ys -> + (\y ys -> force (case (force @@ -31,30 +28,24 @@ x) x)) (\s -> f (\x -> s s x))) - (\go - arg -> + (\go arg -> delay (caseList' (constr 1 []) - (\x - xs -> + (\x xs -> force - (force - (force - ifThenElse - (equalsInteger x y) - (delay - (delay - (constr 0 - []))) - (delay - (delay - (force - (go - (delay - (\x -> - x))) - xs)))))))) + (case + (equalsInteger x y) + [ (delay + (force + (go + (delay + (\x -> + x))) + xs)) + , (delay + (constr 0 + [])) ])))) (delay (\x -> x))) xs) [ (delay diff --git a/plutus-tx-plugin/test/BuiltinList/Budget/9.6/nubBy.eval.golden b/plutus-tx-plugin/test/BuiltinList/Budget/9.6/nubBy.eval.golden index e7d27c4448f..80815013990 100644 --- a/plutus-tx-plugin/test/BuiltinList/Budget/9.6/nubBy.eval.golden +++ b/plutus-tx-plugin/test/BuiltinList/Budget/9.6/nubBy.eval.golden @@ -1,5 +1,5 @@ -CPU: 26_348_119 -Memory: 122_070 -Size: 199 +CPU: 24_655_678 +Memory: 115_761 +Size: 192 (con (list integer) [1]) \ No newline at end of file diff --git a/plutus-tx-plugin/test/BuiltinList/Budget/9.6/nubBy.pir.golden b/plutus-tx-plugin/test/BuiltinList/Budget/9.6/nubBy.pir.golden index ec56fcd5c62..4a3aac7e580 100644 --- a/plutus-tx-plugin/test/BuiltinList/Budget/9.6/nubBy.pir.golden +++ b/plutus-tx-plugin/test/BuiltinList/Budget/9.6/nubBy.pir.golden @@ -1,6 +1,7 @@ let ~`$fMkNilInteger` : (\arep -> list arep) integer = [] - !ifThenElse : all a. bool -> a -> a -> a = ifThenElse + !ifThenElse : all a. bool -> a -> a -> a + = /\a -> \(b : bool) (x : a) (y : a) -> case a b [y, x] !lessThanEqualsInteger : integer -> integer -> bool = lessThanEqualsInteger data Bool | Bool_match where True : Bool diff --git a/plutus-tx-plugin/test/BuiltinList/Budget/9.6/nubBy.uplc.golden b/plutus-tx-plugin/test/BuiltinList/Budget/9.6/nubBy.uplc.golden index 40b19b3d8f7..d506c1583a8 100644 --- a/plutus-tx-plugin/test/BuiltinList/Budget/9.6/nubBy.uplc.golden +++ b/plutus-tx-plugin/test/BuiltinList/Budget/9.6/nubBy.uplc.golden @@ -32,22 +32,18 @@ (constr 1 []) (\x xs -> force - (force - (force ifThenElse - (lessThanEqualsInteger - x - y) - (delay - (delay - (constr 0 []))) - (delay - (delay - (force - (go - (delay - (\x -> - x))) - xs)))))))) + (case + (lessThanEqualsInteger + x + y) + [ (delay + (force + (go + (delay + (\x -> x))) + xs)) + , (delay + (constr 0 [])) ])))) (delay (\x -> x))) xs) [ (delay (force (go (delay (\x -> x))) ys xs)) diff --git a/plutus-tx-plugin/test/BuiltinList/Budget/9.6/null.eval.golden b/plutus-tx-plugin/test/BuiltinList/Budget/9.6/null.eval.golden index 4642c612e16..103c73c2d65 100644 --- a/plutus-tx-plugin/test/BuiltinList/Budget/9.6/null.eval.golden +++ b/plutus-tx-plugin/test/BuiltinList/Budget/9.6/null.eval.golden @@ -1,5 +1,5 @@ -CPU: 374_582 -Memory: 1_533 -Size: 14 +CPU: 218_533 +Memory: 1_032 +Size: 10 (constr 1) \ No newline at end of file diff --git a/plutus-tx-plugin/test/BuiltinList/Budget/9.6/null.pir.golden b/plutus-tx-plugin/test/BuiltinList/Budget/9.6/null.pir.golden index 2a404f9ab03..df0e728cd9f 100644 --- a/plutus-tx-plugin/test/BuiltinList/Budget/9.6/null.pir.golden +++ b/plutus-tx-plugin/test/BuiltinList/Budget/9.6/null.pir.golden @@ -2,7 +2,8 @@ let data Bool | Bool_match where True : Bool False : Bool - !ifThenElse : all a. bool -> a -> a -> a = ifThenElse + !ifThenElse : all a. bool -> a -> a -> a + = /\a -> \(b : bool) (x : a) (y : a) -> case a b [y, x] !null : all a. list a -> bool = nullList ~null : all a. list a -> Bool = /\a -> diff --git a/plutus-tx-plugin/test/BuiltinList/Budget/9.6/null.uplc.golden b/plutus-tx-plugin/test/BuiltinList/Budget/9.6/null.uplc.golden index 05a9d295460..1254cc1026e 100644 --- a/plutus-tx-plugin/test/BuiltinList/Budget/9.6/null.uplc.golden +++ b/plutus-tx-plugin/test/BuiltinList/Budget/9.6/null.uplc.golden @@ -1,3 +1 @@ -(program - 1.1.0 - (\xs -> force ifThenElse (force nullList xs) (constr 0 []) (constr 1 []))) \ No newline at end of file +(program 1.1.0 (\xs -> case (force nullList xs) [(constr 1 []), (constr 0 [])])) \ No newline at end of file diff --git a/plutus-tx-plugin/test/BuiltinList/Budget/9.6/or.eval.golden b/plutus-tx-plugin/test/BuiltinList/Budget/9.6/or.eval.golden index e8a17a1b2bb..6be6ad0bc5e 100644 --- a/plutus-tx-plugin/test/BuiltinList/Budget/9.6/or.eval.golden +++ b/plutus-tx-plugin/test/BuiltinList/Budget/9.6/or.eval.golden @@ -1,5 +1,5 @@ -CPU: 1_189_956 -Memory: 5_297 -Size: 91 +CPU: 1_001_907 +Memory: 4_596 +Size: 84 (constr 0) \ No newline at end of file diff --git a/plutus-tx-plugin/test/BuiltinList/Budget/9.6/or.pir.golden b/plutus-tx-plugin/test/BuiltinList/Budget/9.6/or.pir.golden index fc811297042..a89d95cdb7d 100644 --- a/plutus-tx-plugin/test/BuiltinList/Budget/9.6/or.pir.golden +++ b/plutus-tx-plugin/test/BuiltinList/Budget/9.6/or.pir.golden @@ -40,7 +40,8 @@ let {all dead. dead}) in go - !ifThenElse : all a. bool -> a -> a -> a = ifThenElse + !ifThenElse : all a. bool -> a -> a -> a + = /\a -> \(b : bool) (x : a) (y : a) -> case a b [y, x] ~or : list bool -> Bool = any {bool} diff --git a/plutus-tx-plugin/test/BuiltinList/Budget/9.6/or.uplc.golden b/plutus-tx-plugin/test/BuiltinList/Budget/9.6/or.uplc.golden index 3e448871e90..be716612155 100644 --- a/plutus-tx-plugin/test/BuiltinList/Budget/9.6/or.uplc.golden +++ b/plutus-tx-plugin/test/BuiltinList/Budget/9.6/or.uplc.golden @@ -15,14 +15,10 @@ (delay ((\xs -> force - (force - (force ifThenElse - (force headList xs) - (delay (delay (constr 0 []))) - (delay - (delay - (force (go (delay (\x -> x))) - xs)))))) + (case + (force headList xs) + [ (delay (force (go (delay (\x -> x))) xs)) + , (delay (constr 0 [])) ])) (force tailList xs)))))) (delay (\x -> x))) xs)) \ No newline at end of file diff --git a/plutus-tx-plugin/test/BuiltinList/Budget/9.6/replicate.eval.golden b/plutus-tx-plugin/test/BuiltinList/Budget/9.6/replicate.eval.golden index 2e3381d19eb..39a704857ea 100644 --- a/plutus-tx-plugin/test/BuiltinList/Budget/9.6/replicate.eval.golden +++ b/plutus-tx-plugin/test/BuiltinList/Budget/9.6/replicate.eval.golden @@ -1,5 +1,5 @@ -CPU: 9_694_546 -Memory: 41_962 -Size: 81 +CPU: 7_978_007 +Memory: 36_451 +Size: 77 (con (list integer) [0,0,0,0,0,0,0,0,0,0]) \ No newline at end of file diff --git a/plutus-tx-plugin/test/BuiltinList/Budget/9.6/replicate.pir.golden b/plutus-tx-plugin/test/BuiltinList/Budget/9.6/replicate.pir.golden index cc79eda05e1..da63482ffa4 100644 --- a/plutus-tx-plugin/test/BuiltinList/Budget/9.6/replicate.pir.golden +++ b/plutus-tx-plugin/test/BuiltinList/Budget/9.6/replicate.pir.golden @@ -3,7 +3,8 @@ let data Bool | Bool_match where True : Bool False : Bool - !ifThenElse : all a. bool -> a -> a -> a = ifThenElse + !ifThenElse : all a. bool -> a -> a -> a + = /\a -> \(b : bool) (x : a) (y : a) -> case a b [y, x] !lessThanEqualsInteger : integer -> integer -> bool = lessThanEqualsInteger !mkCons : all a. a -> list a -> list a = mkCons !subtractInteger : integer -> integer -> integer = subtractInteger diff --git a/plutus-tx-plugin/test/BuiltinList/Budget/9.6/replicate.uplc.golden b/plutus-tx-plugin/test/BuiltinList/Budget/9.6/replicate.uplc.golden index 1a6bf510bd4..171603bf43c 100644 --- a/plutus-tx-plugin/test/BuiltinList/Budget/9.6/replicate.uplc.golden +++ b/plutus-tx-plugin/test/BuiltinList/Budget/9.6/replicate.uplc.golden @@ -9,13 +9,13 @@ delay (\n -> force - (force ifThenElse + (case (lessThanEqualsInteger n 0) - (delay []) - (delay - (force mkCons - 0 - (force (go (delay (\x -> x))) - (subtractInteger n 1))))))) + [ (delay + (force mkCons + 0 + (force (go (delay (\x -> x))) + (subtractInteger n 1)))) + , (delay []) ]))) (delay (\x -> x))) 10)) \ No newline at end of file diff --git a/plutus-tx-plugin/test/BuiltinList/Budget/9.6/take.eval.golden b/plutus-tx-plugin/test/BuiltinList/Budget/9.6/take.eval.golden index 6df5a6aa7ed..cb811766fb0 100644 --- a/plutus-tx-plugin/test/BuiltinList/Budget/9.6/take.eval.golden +++ b/plutus-tx-plugin/test/BuiltinList/Budget/9.6/take.eval.golden @@ -1,5 +1,5 @@ -CPU: 8_932_301 -Memory: 37_362 -Size: 117 +CPU: 7_996_007 +Memory: 34_356 +Size: 113 (con (list integer) [1,2,3,4,5]) \ No newline at end of file diff --git a/plutus-tx-plugin/test/BuiltinList/Budget/9.6/take.pir.golden b/plutus-tx-plugin/test/BuiltinList/Budget/9.6/take.pir.golden index 531b1f2d2ea..fd0dd7e5c38 100644 --- a/plutus-tx-plugin/test/BuiltinList/Budget/9.6/take.pir.golden +++ b/plutus-tx-plugin/test/BuiltinList/Budget/9.6/take.pir.golden @@ -13,7 +13,8 @@ let (/\dead -> z) (/\dead -> f (headList {a} xs) (tailList {a} xs)) {r} - !ifThenElse : all a. bool -> a -> a -> a = ifThenElse + !ifThenElse : all a. bool -> a -> a -> a + = /\a -> \(b : bool) (x : a) (y : a) -> case a b [y, x] !lessThanEqualsInteger : integer -> integer -> bool = lessThanEqualsInteger !mkCons : all a. a -> list a -> list a = mkCons !subtractInteger : integer -> integer -> integer = subtractInteger diff --git a/plutus-tx-plugin/test/BuiltinList/Budget/9.6/take.uplc.golden b/plutus-tx-plugin/test/BuiltinList/Budget/9.6/take.uplc.golden index aca01e7a065..08a9a9f4c4e 100644 --- a/plutus-tx-plugin/test/BuiltinList/Budget/9.6/take.uplc.golden +++ b/plutus-tx-plugin/test/BuiltinList/Budget/9.6/take.uplc.golden @@ -9,22 +9,22 @@ (delay (\`$dMkNil` n l -> force - (force ifThenElse + (case (lessThanEqualsInteger n 0) - (delay `$dMkNil`) - (delay - (force - (force (force chooseList) - l - (delay `$dMkNil`) - (delay - ((\xs -> - force mkCons - (force headList l) - (force - (force (take (delay (\x -> x)))) - `$dMkNil` - (subtractInteger n 1) - xs)) - (force tailList l)))))))))) + [ (delay + (force + (force (force chooseList) + l + (delay `$dMkNil`) + (delay + ((\xs -> + force mkCons + (force headList l) + (force + (force (take (delay (\x -> x)))) + `$dMkNil` + (subtractInteger n 1) + xs)) + (force tailList l)))))) + , (delay `$dMkNil`) ])))) (delay (\x -> x))))) \ No newline at end of file diff --git a/plutus-tx-plugin/test/BuiltinList/Budget/9.6/uniqueElementJust.eval.golden b/plutus-tx-plugin/test/BuiltinList/Budget/9.6/uniqueElementJust.eval.golden index 8f40cc3c8d7..8feefd96784 100644 --- a/plutus-tx-plugin/test/BuiltinList/Budget/9.6/uniqueElementJust.eval.golden +++ b/plutus-tx-plugin/test/BuiltinList/Budget/9.6/uniqueElementJust.eval.golden @@ -1,5 +1,5 @@ -CPU: 3_878_050 -Memory: 17_462 -Size: 146 +CPU: 3_565_952 +Memory: 16_460 +Size: 142 (constr 0 (con integer 1)) \ No newline at end of file diff --git a/plutus-tx-plugin/test/BuiltinList/Budget/9.6/uniqueElementJust.pir.golden b/plutus-tx-plugin/test/BuiltinList/Budget/9.6/uniqueElementJust.pir.golden index 709ba08242e..1ea7157caad 100644 --- a/plutus-tx-plugin/test/BuiltinList/Budget/9.6/uniqueElementJust.pir.golden +++ b/plutus-tx-plugin/test/BuiltinList/Budget/9.6/uniqueElementJust.pir.golden @@ -3,7 +3,8 @@ let data Bool | Bool_match where True : Bool False : Bool - !ifThenElse : all a. bool -> a -> a -> a = ifThenElse + !ifThenElse : all a. bool -> a -> a -> a + = /\a -> \(b : bool) (x : a) (y : a) -> case a b [y, x] !lessThanEqualsInteger : integer -> integer -> bool = lessThanEqualsInteger !mkCons : all a. a -> list a -> list a = mkCons !subtractInteger : integer -> integer -> integer = subtractInteger diff --git a/plutus-tx-plugin/test/BuiltinList/Budget/9.6/uniqueElementJust.uplc.golden b/plutus-tx-plugin/test/BuiltinList/Budget/9.6/uniqueElementJust.uplc.golden index 5d6504bd0ff..9398ef2e60f 100644 --- a/plutus-tx-plugin/test/BuiltinList/Budget/9.6/uniqueElementJust.uplc.golden +++ b/plutus-tx-plugin/test/BuiltinList/Budget/9.6/uniqueElementJust.uplc.golden @@ -14,20 +14,20 @@ (delay (\`$dMkNil` n l -> force - (force ifThenElse + (case (lessThanEqualsInteger n 0) - (delay `$dMkNil`) - (delay - (caseList' - `$dMkNil` - (\x xs -> - force mkCons - x - (force (force (take (delay (\x -> x)))) - `$dMkNil` - (subtractInteger n 1) - xs)) - l)))))) + [ (delay + (caseList' + `$dMkNil` + (\x xs -> + force mkCons + x + (force (force (take (delay (\x -> x)))) + `$dMkNil` + (subtractInteger n 1) + xs)) + l)) + , (delay `$dMkNil`) ])))) (delay (\x -> x)))) (\z f xs -> force diff --git a/plutus-tx-plugin/test/DataList/Budget/9.6/any.eval.golden b/plutus-tx-plugin/test/DataList/Budget/9.6/any.eval.golden index ecdb365b71e..640e2284ad7 100644 --- a/plutus-tx-plugin/test/DataList/Budget/9.6/any.eval.golden +++ b/plutus-tx-plugin/test/DataList/Budget/9.6/any.eval.golden @@ -1,5 +1,5 @@ -CPU: 9_183_220 -Memory: 36_540 -Size: 59 +CPU: 7_934_828 +Memory: 32_532 +Size: 55 (constr 0) \ No newline at end of file diff --git a/plutus-tx-plugin/test/DataList/Budget/9.6/any.pir.golden b/plutus-tx-plugin/test/DataList/Budget/9.6/any.pir.golden index 36dae80421c..243d0fe62dd 100644 --- a/plutus-tx-plugin/test/DataList/Budget/9.6/any.pir.golden +++ b/plutus-tx-plugin/test/DataList/Budget/9.6/any.pir.golden @@ -17,7 +17,7 @@ letrec !eta : list data = tailList {data} ds in Bool_match - (ifThenElse {Bool} (lessThanInteger (unIData x) 8) False True) + (case Bool (lessThanInteger (unIData x) 8) [True, False]) {all dead. Bool} (/\dead -> True) (/\dead -> go eta) diff --git a/plutus-tx-plugin/test/DataList/Budget/9.6/any.uplc.golden b/plutus-tx-plugin/test/DataList/Budget/9.6/any.uplc.golden index 7891bcd4d67..c1a736730c0 100644 --- a/plutus-tx-plugin/test/DataList/Budget/9.6/any.uplc.golden +++ b/plutus-tx-plugin/test/DataList/Budget/9.6/any.uplc.golden @@ -11,9 +11,8 @@ ((\x -> (\eta -> force - (force ifThenElse + (case (lessThanInteger (unIData x) 8) - (delay (s s eta)) - (delay (constr 0 [])))) + [(delay (constr 0 [])), (delay (s s eta))])) (force tailList ds)) (force headList ds)))))))) \ No newline at end of file diff --git a/plutus-tx-plugin/test/DataList/Budget/9.6/elem.eval.golden b/plutus-tx-plugin/test/DataList/Budget/9.6/elem.eval.golden index afb8c9d3041..62334568db1 100644 --- a/plutus-tx-plugin/test/DataList/Budget/9.6/elem.eval.golden +++ b/plutus-tx-plugin/test/DataList/Budget/9.6/elem.eval.golden @@ -1,5 +1,5 @@ -CPU: 16_675_292 -Memory: 34_684 -Size: 57 +CPU: 15_426_900 +Memory: 30_676 +Size: 53 (constr 0) \ No newline at end of file diff --git a/plutus-tx-plugin/test/DataList/Budget/9.6/elem.pir.golden b/plutus-tx-plugin/test/DataList/Budget/9.6/elem.pir.golden index 63a722bdf4d..2e3106846ef 100644 --- a/plutus-tx-plugin/test/DataList/Budget/9.6/elem.pir.golden +++ b/plutus-tx-plugin/test/DataList/Budget/9.6/elem.pir.golden @@ -17,7 +17,7 @@ letrec !t : list data = tailList {data} xs in Bool_match - (ifThenElse {Bool} (equalsData (I 8) h) True False) + (case Bool (equalsData (I 8) h) [False, True]) {all dead. Bool} (/\dead -> True) (/\dead -> go t) diff --git a/plutus-tx-plugin/test/DataList/Budget/9.6/elem.uplc.golden b/plutus-tx-plugin/test/DataList/Budget/9.6/elem.uplc.golden index ef9a2acbd8b..205ccd00eb5 100644 --- a/plutus-tx-plugin/test/DataList/Budget/9.6/elem.uplc.golden +++ b/plutus-tx-plugin/test/DataList/Budget/9.6/elem.uplc.golden @@ -11,9 +11,8 @@ ((\h -> (\t -> force - (force ifThenElse + (case (equalsData (I 8) h) - (delay (constr 0 [])) - (delay (s s t)))) + [(delay (s s t)), (delay (constr 0 []))])) (force tailList xs)) (force headList xs)))))))) \ No newline at end of file diff --git a/plutus-tx-plugin/test/DataList/Budget/9.6/filter.eval.golden b/plutus-tx-plugin/test/DataList/Budget/9.6/filter.eval.golden index a2943a9955a..024a67c18d5 100644 --- a/plutus-tx-plugin/test/DataList/Budget/9.6/filter.eval.golden +++ b/plutus-tx-plugin/test/DataList/Budget/9.6/filter.eval.golden @@ -1,5 +1,5 @@ -CPU: 12_570_977 -Memory: 50_224 -Size: 73 +CPU: 11_010_487 +Memory: 45_214 +Size: 69 (con (list data) [I 8, I 9, I 10]) \ No newline at end of file diff --git a/plutus-tx-plugin/test/DataList/Budget/9.6/filter.pir.golden b/plutus-tx-plugin/test/DataList/Budget/9.6/filter.pir.golden index 2666b6c8386..9af6bbf9cf6 100644 --- a/plutus-tx-plugin/test/DataList/Budget/9.6/filter.pir.golden +++ b/plutus-tx-plugin/test/DataList/Budget/9.6/filter.pir.golden @@ -23,7 +23,7 @@ letrec !h : integer = unIData x in Bool_match - (ifThenElse {Bool} (lessThanInteger h 8) False True) + (case Bool (lessThanInteger h 8) [True, False]) {all dead. (\a -> list data) integer} (/\dead -> let diff --git a/plutus-tx-plugin/test/DataList/Budget/9.6/filter.uplc.golden b/plutus-tx-plugin/test/DataList/Budget/9.6/filter.uplc.golden index 71f8b189f6f..bf9cb5780f5 100644 --- a/plutus-tx-plugin/test/DataList/Budget/9.6/filter.uplc.golden +++ b/plutus-tx-plugin/test/DataList/Budget/9.6/filter.uplc.golden @@ -11,11 +11,11 @@ ((\eta -> (\h -> force - (force ifThenElse + (case (lessThanInteger h 8) - (delay (s s eta)) - (delay - ((\nt -> force mkCons (iData h) nt) - (s s eta))))) + [ (delay + ((\nt -> force mkCons (iData h) nt) + (s s eta))) + , (delay (s s eta)) ])) (unIData (force headList ds))) (force tailList ds)))))))) \ No newline at end of file diff --git a/plutus-tx-plugin/test/DataList/Budget/9.6/partition.eval.golden b/plutus-tx-plugin/test/DataList/Budget/9.6/partition.eval.golden index b6238cce68f..200b3933e86 100644 --- a/plutus-tx-plugin/test/DataList/Budget/9.6/partition.eval.golden +++ b/plutus-tx-plugin/test/DataList/Budget/9.6/partition.eval.golden @@ -1,6 +1,6 @@ -CPU: 14_295_614 -Memory: 58_252 -Size: 76 +CPU: 12_735_124 +Memory: 53_242 +Size: 72 (constr 0 diff --git a/plutus-tx-plugin/test/DataList/Budget/9.6/partition.pir.golden b/plutus-tx-plugin/test/DataList/Budget/9.6/partition.pir.golden index 857d7376b40..2cbc6c8cc86 100644 --- a/plutus-tx-plugin/test/DataList/Budget/9.6/partition.pir.golden +++ b/plutus-tx-plugin/test/DataList/Budget/9.6/partition.pir.golden @@ -28,11 +28,7 @@ in {Tuple2 (list data) (list data)} (\(ipv : list data) (ipv : list data) -> Bool_match - (ifThenElse - {Bool} - (lessThanInteger (unIData h) 8) - False - True) + (case Bool (lessThanInteger (unIData h) 8) [True, False]) {all dead. Tuple2 (list data) (list data)} (/\dead -> Tuple2 {list data} {list data} (mkCons {data} h ipv) ipv) diff --git a/plutus-tx-plugin/test/DataList/Budget/9.6/partition.uplc.golden b/plutus-tx-plugin/test/DataList/Budget/9.6/partition.uplc.golden index a0d3488ccf4..b133623a287 100644 --- a/plutus-tx-plugin/test/DataList/Budget/9.6/partition.uplc.golden +++ b/plutus-tx-plugin/test/DataList/Budget/9.6/partition.uplc.golden @@ -13,12 +13,12 @@ ((\x -> s s x) (force tailList xs)) [ (\ipv ipv -> force - (force ifThenElse + (case (lessThanInteger (unIData h) 8) - (delay - (constr 0 [ipv, (force mkCons h ipv)])) - (delay - (constr 0 - [(force mkCons h ipv), ipv])))) ]) + [ (delay + (constr 0 [(force mkCons h ipv), ipv])) + , (delay + (constr 0 + [ipv, (force mkCons h ipv)])) ])) ]) (force headList xs))))) l)) \ No newline at end of file diff --git a/plutus-tx-plugin/test/IsData/9.6/dataToData.pir.golden b/plutus-tx-plugin/test/IsData/9.6/dataToData.pir.golden index b90353ac98c..fddfd7d5afe 100644 --- a/plutus-tx-plugin/test/IsData/9.6/dataToData.pir.golden +++ b/plutus-tx-plugin/test/IsData/9.6/dataToData.pir.golden @@ -42,7 +42,8 @@ let True : Bool False : Bool !equalsInteger : integer -> integer -> bool = equalsInteger - !ifThenElse : all a. bool -> a -> a -> a = ifThenElse + !ifThenElse : all a. bool -> a -> a -> a + = /\a -> \(b : bool) (x : a) (y : a) -> case a b [y, x] ~equalsInteger : integer -> integer -> Bool = \(x : integer) -> let diff --git a/plutus-tx-plugin/test/IsData/9.6/deconstructData.pir.golden b/plutus-tx-plugin/test/IsData/9.6/deconstructData.pir.golden index 6fcac63f242..5794f71421a 100644 --- a/plutus-tx-plugin/test/IsData/9.6/deconstructData.pir.golden +++ b/plutus-tx-plugin/test/IsData/9.6/deconstructData.pir.golden @@ -51,7 +51,8 @@ let data (Maybe :: * -> *) a | Maybe_match where Just : a -> Maybe a Nothing : Maybe a - !ifThenElse : all a. bool -> a -> a -> a = ifThenElse + !ifThenElse : all a. bool -> a -> a -> a + = /\a -> \(b : bool) (x : a) (y : a) -> case a b [y, x] ~`$fFromDataTuple2_$cfromBuiltinData` : all a b. (\a -> data -> Maybe a) a -> diff --git a/plutus-tx-plugin/test/IsData/9.6/equalityAsData.pir.golden b/plutus-tx-plugin/test/IsData/9.6/equalityAsData.pir.golden index a1c84036ed3..31bfc05fcf9 100644 --- a/plutus-tx-plugin/test/IsData/9.6/equalityAsData.pir.golden +++ b/plutus-tx-plugin/test/IsData/9.6/equalityAsData.pir.golden @@ -3,7 +3,8 @@ let True : Bool False : Bool !equalsData : data -> data -> bool = equalsData - !ifThenElse : all a. bool -> a -> a -> a = ifThenElse + !ifThenElse : all a. bool -> a -> a -> a + = /\a -> \(b : bool) (x : a) (y : a) -> case a b [y, x] ~equalsData : data -> data -> Bool = \(d : data) -> let diff --git a/plutus-tx-plugin/test/IsData/9.6/matchAsData.pir.golden b/plutus-tx-plugin/test/IsData/9.6/matchAsData.pir.golden index d8f2409168e..3114acabf5f 100644 --- a/plutus-tx-plugin/test/IsData/9.6/matchAsData.pir.golden +++ b/plutus-tx-plugin/test/IsData/9.6/matchAsData.pir.golden @@ -40,7 +40,8 @@ let True : Bool False : Bool !equalsInteger : integer -> integer -> bool = equalsInteger - !ifThenElse : all a. bool -> a -> a -> a = ifThenElse + !ifThenElse : all a. bool -> a -> a -> a + = /\a -> \(b : bool) (x : a) (y : a) -> case a b [y, x] ~equalsInteger : integer -> integer -> Bool = \(x : integer) -> let diff --git a/plutus-tx-plugin/test/IsData/9.6/unsafeDeconstructData.pir.golden b/plutus-tx-plugin/test/IsData/9.6/unsafeDeconstructData.pir.golden index 45ff17198c2..cc3012539fa 100644 --- a/plutus-tx-plugin/test/IsData/9.6/unsafeDeconstructData.pir.golden +++ b/plutus-tx-plugin/test/IsData/9.6/unsafeDeconstructData.pir.golden @@ -7,7 +7,8 @@ let !equalsInteger : integer -> integer -> bool = equalsInteger !fst : all a b. pair a b -> a = fstPair !head : all a. list a -> a = headList - !ifThenElse : all a. bool -> a -> a -> a = ifThenElse + !ifThenElse : all a. bool -> a -> a -> a + = /\a -> \(b : bool) (x : a) (y : a) -> case a b [y, x] ~reconstructCaseError : string = "PT1" !snd : all a b. pair a b -> b = sndPair data Unit | Unit_match where diff --git a/plutus-tx-plugin/test/Optimization/9.6/matchAsData.pir.golden b/plutus-tx-plugin/test/Optimization/9.6/matchAsData.pir.golden index 6065724d0e9..15a155cafba 100644 --- a/plutus-tx-plugin/test/Optimization/9.6/matchAsData.pir.golden +++ b/plutus-tx-plugin/test/Optimization/9.6/matchAsData.pir.golden @@ -24,7 +24,7 @@ in {integer} (\(ds : integer) (ds : list data) -> Bool_match - (ifThenElse {Bool} (equalsInteger 0 ds) True False) + (case Bool (equalsInteger 0 ds) [False, True]) {all dead. integer} (/\dead -> let @@ -49,7 +49,7 @@ in {integer} (\(ds : integer) (ds : list data) -> Bool_match - (ifThenElse {Bool} (equalsInteger 1 ds) True False) + (case Bool (equalsInteger 1 ds) [False, True]) {all dead. integer} (/\dead -> 1) (/\dead -> diff --git a/plutus-tx-plugin/test/Optimization/9.6/unsafeDeconstructData.pir.golden b/plutus-tx-plugin/test/Optimization/9.6/unsafeDeconstructData.pir.golden index e91d682b329..15823de0689 100644 --- a/plutus-tx-plugin/test/Optimization/9.6/unsafeDeconstructData.pir.golden +++ b/plutus-tx-plugin/test/Optimization/9.6/unsafeDeconstructData.pir.golden @@ -24,12 +24,12 @@ in !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 1 index) True False) + (case Bool (equalsInteger 1 index) [False, True]) {all dead. Maybe a} (/\dead -> Nothing {a}) (/\dead -> Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. Maybe a} (/\dead -> Just {a} (`$dUnsafeFromData` (headList {data} args))) (/\dead -> traceError {Maybe a} "PT1") @@ -42,7 +42,7 @@ in !args : list data = sndPair {integer} {list data} tup in Bool_match - (ifThenElse {Bool} (equalsInteger 0 index) True False) + (case Bool (equalsInteger 0 index) [False, True]) {all dead. Tuple2 integer integer} (/\dead -> Tuple2 diff --git a/plutus-tx-plugin/test/Plugin/Basic/9.6/ifOpt.pir.golden b/plutus-tx-plugin/test/Plugin/Basic/9.6/ifOpt.pir.golden index 7f4a0d97bc7..5abf9a3935a 100644 --- a/plutus-tx-plugin/test/Plugin/Basic/9.6/ifOpt.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Basic/9.6/ifOpt.pir.golden @@ -10,7 +10,8 @@ let True : Bool False : Bool !equalsInteger : integer -> integer -> bool = equalsInteger - !ifThenElse : all a. bool -> a -> a -> a = ifThenElse + !ifThenElse : all a. bool -> a -> a -> a + = /\a -> \(b : bool) (x : a) (y : a) -> case a b [y, x] ~equalsInteger : integer -> integer -> Bool = \(x : integer) -> let diff --git a/plutus-tx-plugin/test/Plugin/Basic/9.6/integerCase.pir.golden b/plutus-tx-plugin/test/Plugin/Basic/9.6/integerCase.pir.golden index 3929dc9384d..a6cc0af8256 100644 --- a/plutus-tx-plugin/test/Plugin/Basic/9.6/integerCase.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Basic/9.6/integerCase.pir.golden @@ -4,7 +4,8 @@ let True : Bool False : Bool !equalsInteger : integer -> integer -> bool = equalsInteger - !ifThenElse : all a. bool -> a -> a -> a = ifThenElse + !ifThenElse : all a. bool -> a -> a -> a + = /\a -> \(b : bool) (x : a) (y : a) -> case a b [y, x] ~equalsInteger : integer -> integer -> Bool = \(x : integer) -> let diff --git a/plutus-tx-plugin/test/Plugin/Basic/9.6/integerPatternMatch.pir.golden b/plutus-tx-plugin/test/Plugin/Basic/9.6/integerPatternMatch.pir.golden index 394dd78e396..adbfa182939 100644 --- a/plutus-tx-plugin/test/Plugin/Basic/9.6/integerPatternMatch.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Basic/9.6/integerPatternMatch.pir.golden @@ -3,7 +3,8 @@ let True : Bool False : Bool !equalsInteger : integer -> integer -> bool = equalsInteger - !ifThenElse : all a. bool -> a -> a -> a = ifThenElse + !ifThenElse : all a. bool -> a -> a -> a + = /\a -> \(b : bool) (x : a) (y : a) -> case a b [y, x] ~equalsInteger : integer -> integer -> Bool = \(x : integer) -> let diff --git a/plutus-tx-plugin/test/Plugin/Basic/9.6/letFun.pir.golden b/plutus-tx-plugin/test/Plugin/Basic/9.6/letFun.pir.golden index 69c5751d728..147fb87e24b 100644 --- a/plutus-tx-plugin/test/Plugin/Basic/9.6/letFun.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Basic/9.6/letFun.pir.golden @@ -3,7 +3,8 @@ let True : Bool False : Bool !equalsInteger : integer -> integer -> bool = equalsInteger - !ifThenElse : all a. bool -> a -> a -> a = ifThenElse + !ifThenElse : all a. bool -> a -> a -> a + = /\a -> \(b : bool) (x : a) (y : a) -> case a b [y, x] ~equalsInteger : integer -> integer -> Bool = \(x : integer) -> let diff --git a/plutus-tx-plugin/test/Plugin/Coverage/9.6/coverageCode.pir.golden b/plutus-tx-plugin/test/Plugin/Coverage/9.6/coverageCode.pir.golden index 23046806db1..07835c8d7a9 100644 --- a/plutus-tx-plugin/test/Plugin/Coverage/9.6/coverageCode.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Coverage/9.6/coverageCode.pir.golden @@ -20,7 +20,8 @@ let {all dead. dead} {Bool} !equalsInteger : integer -> integer -> bool = equalsInteger - !ifThenElse : all a. bool -> a -> a -> a = ifThenElse + !ifThenElse : all a. bool -> a -> a -> a + = /\a -> \(b : bool) (x : a) (y : a) -> case a b [y, x] ~equalsInteger : integer -> integer -> Bool = \(x : integer) -> let diff --git a/plutus-tx-plugin/test/Plugin/Debug/9.6/fib.pir.golden b/plutus-tx-plugin/test/Plugin/Debug/9.6/fib.pir.golden index 4f89764b98f..27a79fa825f 100644 --- a/plutus-tx-plugin/test/Plugin/Debug/9.6/fib.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Debug/9.6/fib.pir.golden @@ -124,7 +124,33 @@ ) ) ) - (builtin { no-src-span } ifThenElse) + (abs + { no-src-span } + a + ({ no-src-span } type) + (lam + { no-src-span } + b + (con { no-src-span } bool) + (lam + { no-src-span } + x + { no-src-span } a + (lam + { no-src-span } + y + { no-src-span } a + (case + { no-src-span } + { no-src-span } a + { no-src-span } b + { no-src-span } y + { no-src-span } x + ) + ) + ) + ) + ) ) (termbind { no-src-span } diff --git a/plutus-tx-plugin/test/Plugin/Debug/9.6/letFun.pir.golden b/plutus-tx-plugin/test/Plugin/Debug/9.6/letFun.pir.golden index 9c0ea15b4f1..e9d6929087e 100644 --- a/plutus-tx-plugin/test/Plugin/Debug/9.6/letFun.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Debug/9.6/letFun.pir.golden @@ -54,7 +54,33 @@ ) ) ) - (builtin { no-src-span } ifThenElse) + (abs + { no-src-span } + a + ({ no-src-span } type) + (lam + { no-src-span } + b + (con { no-src-span } bool) + (lam + { no-src-span } + x + { no-src-span } a + (lam + { no-src-span } + y + { no-src-span } a + (case + { no-src-span } + { no-src-span } a + { no-src-span } b + { no-src-span } y + { no-src-span } x + ) + ) + ) + ) + ) ) (termbind { no-src-span } diff --git a/plutus-tx-plugin/test/Plugin/Functions/9.6/recursive/even.pir.golden b/plutus-tx-plugin/test/Plugin/Functions/9.6/recursive/even.pir.golden index d022832851d..c7f645ef4d8 100644 --- a/plutus-tx-plugin/test/Plugin/Functions/9.6/recursive/even.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Functions/9.6/recursive/even.pir.golden @@ -3,7 +3,8 @@ let True : Bool False : Bool !equalsInteger : integer -> integer -> bool = equalsInteger - !ifThenElse : all a. bool -> a -> a -> a = ifThenElse + !ifThenElse : all a. bool -> a -> a -> a + = /\a -> \(b : bool) (x : a) (y : a) -> case a b [y, x] ~equalsInteger : integer -> integer -> Bool = \(x : integer) -> let diff --git a/plutus-tx-plugin/test/Plugin/Functions/9.6/recursive/fib.pir.golden b/plutus-tx-plugin/test/Plugin/Functions/9.6/recursive/fib.pir.golden index fa8cbee97bd..867314d5ad1 100644 --- a/plutus-tx-plugin/test/Plugin/Functions/9.6/recursive/fib.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Functions/9.6/recursive/fib.pir.golden @@ -10,7 +10,8 @@ let True : Bool False : Bool !equalsInteger : integer -> integer -> bool = equalsInteger - !ifThenElse : all a. bool -> a -> a -> a = ifThenElse + !ifThenElse : all a. bool -> a -> a -> a + = /\a -> \(b : bool) (x : a) (y : a) -> case a b [y, x] ~equalsInteger : integer -> integer -> Bool = \(x : integer) -> let diff --git a/plutus-tx-plugin/test/Plugin/Functions/9.6/unfoldings/allDirect.pir.golden b/plutus-tx-plugin/test/Plugin/Functions/9.6/unfoldings/allDirect.pir.golden index 1fd6a9a57c1..8e90b16138b 100644 --- a/plutus-tx-plugin/test/Plugin/Functions/9.6/unfoldings/allDirect.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Functions/9.6/unfoldings/allDirect.pir.golden @@ -64,7 +64,8 @@ let = /\a -> \(g : all b. (a -> b -> b) -> b -> b) -> g {List a} (\(ds : a) (ds : List a) -> Cons {a} ds ds) (Nil {a}) - !ifThenElse : all a. bool -> a -> a -> a = ifThenElse + !ifThenElse : all a. bool -> a -> a -> a + = /\a -> \(b : bool) (x : a) (y : a) -> case a b [y, x] !lessThanInteger : integer -> integer -> bool = lessThanInteger ~lessThanInteger : integer -> integer -> Bool = \(x : integer) -> diff --git a/plutus-tx-plugin/test/Plugin/Functions/9.6/unfoldings/mutualRecursionUnfoldings.pir.golden b/plutus-tx-plugin/test/Plugin/Functions/9.6/unfoldings/mutualRecursionUnfoldings.pir.golden index 7ebed3c6e26..a10b34566da 100644 --- a/plutus-tx-plugin/test/Plugin/Functions/9.6/unfoldings/mutualRecursionUnfoldings.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Functions/9.6/unfoldings/mutualRecursionUnfoldings.pir.golden @@ -3,7 +3,8 @@ let True : Bool False : Bool !equalsInteger : integer -> integer -> bool = equalsInteger - !ifThenElse : all a. bool -> a -> a -> a = ifThenElse + !ifThenElse : all a. bool -> a -> a -> a + = /\a -> \(b : bool) (x : a) (y : a) -> case a b [y, x] !subtractInteger : integer -> integer -> integer = subtractInteger in letrec diff --git a/plutus-tx-plugin/test/Plugin/Primitives/9.6/ifThenElse.pir.golden b/plutus-tx-plugin/test/Plugin/Primitives/9.6/ifThenElse.pir.golden index d606dbd777b..55f8220f5f3 100644 --- a/plutus-tx-plugin/test/Plugin/Primitives/9.6/ifThenElse.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Primitives/9.6/ifThenElse.pir.golden @@ -3,7 +3,8 @@ let True : Bool False : Bool !equalsInteger : integer -> integer -> bool = equalsInteger - !ifThenElse : all a. bool -> a -> a -> a = ifThenElse + !ifThenElse : all a. bool -> a -> a -> a + = /\a -> \(b : bool) (x : a) (y : a) -> case a b [y, x] ~equalsInteger : integer -> integer -> Bool = \(x : integer) -> let diff --git a/plutus-tx-plugin/test/Plugin/Primitives/9.6/intCompare.pir.golden b/plutus-tx-plugin/test/Plugin/Primitives/9.6/intCompare.pir.golden index 012f049af58..86fd648756a 100644 --- a/plutus-tx-plugin/test/Plugin/Primitives/9.6/intCompare.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Primitives/9.6/intCompare.pir.golden @@ -2,7 +2,8 @@ let data Bool | Bool_match where True : Bool False : Bool - !ifThenElse : all a. bool -> a -> a -> a = ifThenElse + !ifThenElse : all a. bool -> a -> a -> a + = /\a -> \(b : bool) (x : a) (y : a) -> case a b [y, x] !lessThanInteger : integer -> integer -> bool = lessThanInteger ~lessThanInteger : integer -> integer -> Bool = \(x : integer) -> diff --git a/plutus-tx-plugin/test/Plugin/Primitives/9.6/intEq.pir.golden b/plutus-tx-plugin/test/Plugin/Primitives/9.6/intEq.pir.golden index 69c5751d728..147fb87e24b 100644 --- a/plutus-tx-plugin/test/Plugin/Primitives/9.6/intEq.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Primitives/9.6/intEq.pir.golden @@ -3,7 +3,8 @@ let True : Bool False : Bool !equalsInteger : integer -> integer -> bool = equalsInteger - !ifThenElse : all a. bool -> a -> a -> a = ifThenElse + !ifThenElse : all a. bool -> a -> a -> a + = /\a -> \(b : bool) (x : a) (y : a) -> case a b [y, x] ~equalsInteger : integer -> integer -> Bool = \(x : integer) -> let diff --git a/plutus-tx-plugin/test/Plugin/Primitives/9.6/verify.pir.golden b/plutus-tx-plugin/test/Plugin/Primitives/9.6/verify.pir.golden index 6c3b806161e..83bb880dc20 100644 --- a/plutus-tx-plugin/test/Plugin/Primitives/9.6/verify.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Primitives/9.6/verify.pir.golden @@ -2,7 +2,8 @@ let data Bool | Bool_match where True : Bool False : Bool - !ifThenElse : all a. bool -> a -> a -> a = ifThenElse + !ifThenElse : all a. bool -> a -> a -> a + = /\a -> \(b : bool) (x : a) (y : a) -> case a b [y, x] !verifyEd25519Signature : bytestring -> bytestring -> bytestring -> bool = verifyEd25519Signature ~verifyEd25519Signature : bytestring -> bytestring -> bytestring -> Bool diff --git a/plutus-tx-plugin/test/Plugin/Primitives/9.6/void.pir.golden b/plutus-tx-plugin/test/Plugin/Primitives/9.6/void.pir.golden index 078a8c43c43..7fcddced1ee 100644 --- a/plutus-tx-plugin/test/Plugin/Primitives/9.6/void.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Primitives/9.6/void.pir.golden @@ -4,7 +4,8 @@ let False : Bool ~fail : unit -> Bool = \(ds : unit) -> False !equalsInteger : integer -> integer -> bool = equalsInteger - !ifThenElse : all a. bool -> a -> a -> a = ifThenElse + !ifThenElse : all a. bool -> a -> a -> a + = /\a -> \(b : bool) (x : a) (y : a) -> case a b [y, x] ~equalsInteger : integer -> integer -> Bool = \(x : integer) -> let diff --git a/plutus-tx-plugin/test/Plugin/Profiling/9.6/fib.pir.golden b/plutus-tx-plugin/test/Plugin/Profiling/9.6/fib.pir.golden index fe8508177d9..10847182abb 100644 --- a/plutus-tx-plugin/test/Plugin/Profiling/9.6/fib.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Profiling/9.6/fib.pir.golden @@ -19,7 +19,8 @@ let True : Bool False : Bool !equalsInteger : integer -> integer -> bool = equalsInteger - !ifThenElse : all a. bool -> a -> a -> a = ifThenElse + !ifThenElse : all a. bool -> a -> a -> a + = /\a -> \(b : bool) (x : a) (y : a) -> case a b [y, x] ~equalsInteger : integer -> integer -> Bool = \(x : integer) -> let diff --git a/plutus-tx-plugin/test/Plugin/Strict/9.6/issue4645.pir.golden b/plutus-tx-plugin/test/Plugin/Strict/9.6/issue4645.pir.golden index 93bceee4a57..ec8c2edfbff 100644 --- a/plutus-tx-plugin/test/Plugin/Strict/9.6/issue4645.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Strict/9.6/issue4645.pir.golden @@ -19,4 +19,4 @@ Tuple2_match let !t : integer = trace {integer} "t" zz in - ifThenElse {Bool} (equalsInteger (trace {integer} "x" 0) t) True False) \ No newline at end of file + case Bool (equalsInteger (trace {integer} "x" 0) t) [False, True]) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Strict/9.6/strictITE.pir.golden b/plutus-tx-plugin/test/Plugin/Strict/9.6/strictITE.pir.golden index 4b1fdeb4cfb..927640eceb7 100644 --- a/plutus-tx-plugin/test/Plugin/Strict/9.6/strictITE.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Strict/9.6/strictITE.pir.golden @@ -1 +1 @@ -\(x : bool) (y : integer) (z : integer) -> ifThenElse {integer} x y z \ No newline at end of file +\(x : bool) (y : integer) (z : integer) -> case integer x [z, y] \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Typeclasses/9.6/compareTest.pir.golden b/plutus-tx-plugin/test/Plugin/Typeclasses/9.6/compareTest.pir.golden index 4f0ac1fb5c6..37628282b7f 100644 --- a/plutus-tx-plugin/test/Plugin/Typeclasses/9.6/compareTest.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Typeclasses/9.6/compareTest.pir.golden @@ -1,7 +1,8 @@ let !equalsInteger : integer -> integer -> bool = equalsInteger !lessThanEqualsInteger : integer -> integer -> bool = lessThanEqualsInteger - !ifThenElse : all a. bool -> a -> a -> a = ifThenElse + !ifThenElse : all a. bool -> a -> a -> a + = /\a -> \(b : bool) (x : a) (y : a) -> case a b [y, x] data Bool | Bool_match where True : Bool False : Bool diff --git a/plutus-tx-plugin/test/Plugin/Typeclasses/9.6/multiFunction.pir.golden b/plutus-tx-plugin/test/Plugin/Typeclasses/9.6/multiFunction.pir.golden index 1aec2f14641..27bf7318336 100644 --- a/plutus-tx-plugin/test/Plugin/Typeclasses/9.6/multiFunction.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Typeclasses/9.6/multiFunction.pir.golden @@ -15,7 +15,8 @@ let v {a -> integer} (\(v : a -> integer) (v : a -> Animal -> Bool) -> v) - !ifThenElse : all a. bool -> a -> a -> a = ifThenElse + !ifThenElse : all a. bool -> a -> a -> a + = /\a -> \(b : bool) (x : a) (y : a) -> case a b [y, x] !lessThanInteger : integer -> integer -> bool = lessThanInteger ~lessThanInteger : integer -> integer -> Bool = \(x : integer) -> diff --git a/plutus-tx-plugin/test/Plugin/Typeclasses/9.6/partialApplication.pir.golden b/plutus-tx-plugin/test/Plugin/Typeclasses/9.6/partialApplication.pir.golden index 34b7ddd4f9d..9248522cef1 100644 --- a/plutus-tx-plugin/test/Plugin/Typeclasses/9.6/partialApplication.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Typeclasses/9.6/partialApplication.pir.golden @@ -7,7 +7,8 @@ let GT : Ordering LT : Ordering !equalsInteger : integer -> integer -> bool = equalsInteger - !ifThenElse : all a. bool -> a -> a -> a = ifThenElse + !ifThenElse : all a. bool -> a -> a -> a + = /\a -> \(b : bool) (x : a) (y : a) -> case a b [y, x] !lessThanEqualsInteger : integer -> integer -> bool = lessThanEqualsInteger ~`$fOrdInteger_$ccompare` : integer -> integer -> Ordering = \(eta : integer) -> diff --git a/plutus-tx-plugin/test/Strictness/9.6/let-default.eval.golden b/plutus-tx-plugin/test/Strictness/9.6/let-default.eval.golden index ff810466164..89afb5ea2bb 100644 --- a/plutus-tx-plugin/test/Strictness/9.6/let-default.eval.golden +++ b/plutus-tx-plugin/test/Strictness/9.6/let-default.eval.golden @@ -1,5 +1,5 @@ -CPU: 393_439 -Memory: 1_802 -Size: 27 +CPU: 237_390 +Memory: 1_301 +Size: 23 (con integer 1) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Strictness/9.6/let-default.pir.golden b/plutus-tx-plugin/test/Strictness/9.6/let-default.pir.golden index 35e1bc55801..760f982dd6d 100644 --- a/plutus-tx-plugin/test/Strictness/9.6/let-default.pir.golden +++ b/plutus-tx-plugin/test/Strictness/9.6/let-default.pir.golden @@ -7,7 +7,7 @@ let in \(m : integer) -> Bool_match - (ifThenElse {Bool} (lessThanInteger m 0) True False) + (case Bool (lessThanInteger m 0) [False, True]) {all dead. integer} (/\dead -> addInteger (error {integer -> integer} m) (error {integer -> integer} m)) diff --git a/plutus-tx-plugin/test/Strictness/9.6/let-default.uplc.golden b/plutus-tx-plugin/test/Strictness/9.6/let-default.uplc.golden index 12709cecb0b..dc30b6852a2 100644 --- a/plutus-tx-plugin/test/Strictness/9.6/let-default.uplc.golden +++ b/plutus-tx-plugin/test/Strictness/9.6/let-default.uplc.golden @@ -2,7 +2,6 @@ 1.1.0 (\m -> force - (force ifThenElse + (case (lessThanInteger m 0) - (delay ((\cse -> addInteger cse cse) (error m))) - (delay m)))) \ No newline at end of file + [(delay m), (delay ((\cse -> addInteger cse cse) (error m)))]))) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Strictness/9.6/let-nonstrict.eval.golden b/plutus-tx-plugin/test/Strictness/9.6/let-nonstrict.eval.golden index ff810466164..89afb5ea2bb 100644 --- a/plutus-tx-plugin/test/Strictness/9.6/let-nonstrict.eval.golden +++ b/plutus-tx-plugin/test/Strictness/9.6/let-nonstrict.eval.golden @@ -1,5 +1,5 @@ -CPU: 393_439 -Memory: 1_802 -Size: 27 +CPU: 237_390 +Memory: 1_301 +Size: 23 (con integer 1) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Strictness/9.6/let-nonstrict.pir.golden b/plutus-tx-plugin/test/Strictness/9.6/let-nonstrict.pir.golden index 35e1bc55801..760f982dd6d 100644 --- a/plutus-tx-plugin/test/Strictness/9.6/let-nonstrict.pir.golden +++ b/plutus-tx-plugin/test/Strictness/9.6/let-nonstrict.pir.golden @@ -7,7 +7,7 @@ let in \(m : integer) -> Bool_match - (ifThenElse {Bool} (lessThanInteger m 0) True False) + (case Bool (lessThanInteger m 0) [False, True]) {all dead. integer} (/\dead -> addInteger (error {integer -> integer} m) (error {integer -> integer} m)) diff --git a/plutus-tx-plugin/test/Strictness/9.6/let-nonstrict.uplc.golden b/plutus-tx-plugin/test/Strictness/9.6/let-nonstrict.uplc.golden index 12709cecb0b..dc30b6852a2 100644 --- a/plutus-tx-plugin/test/Strictness/9.6/let-nonstrict.uplc.golden +++ b/plutus-tx-plugin/test/Strictness/9.6/let-nonstrict.uplc.golden @@ -2,7 +2,6 @@ 1.1.0 (\m -> force - (force ifThenElse + (case (lessThanInteger m 0) - (delay ((\cse -> addInteger cse cse) (error m))) - (delay m)))) \ No newline at end of file + [(delay m), (delay ((\cse -> addInteger cse cse) (error m)))]))) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Strictness/9.6/let-strict.eval.golden b/plutus-tx-plugin/test/Strictness/9.6/let-strict.eval.golden index ff810466164..89afb5ea2bb 100644 --- a/plutus-tx-plugin/test/Strictness/9.6/let-strict.eval.golden +++ b/plutus-tx-plugin/test/Strictness/9.6/let-strict.eval.golden @@ -1,5 +1,5 @@ -CPU: 393_439 -Memory: 1_802 -Size: 27 +CPU: 237_390 +Memory: 1_301 +Size: 23 (con integer 1) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Strictness/9.6/let-strict.pir.golden b/plutus-tx-plugin/test/Strictness/9.6/let-strict.pir.golden index 35e1bc55801..760f982dd6d 100644 --- a/plutus-tx-plugin/test/Strictness/9.6/let-strict.pir.golden +++ b/plutus-tx-plugin/test/Strictness/9.6/let-strict.pir.golden @@ -7,7 +7,7 @@ let in \(m : integer) -> Bool_match - (ifThenElse {Bool} (lessThanInteger m 0) True False) + (case Bool (lessThanInteger m 0) [False, True]) {all dead. integer} (/\dead -> addInteger (error {integer -> integer} m) (error {integer -> integer} m)) diff --git a/plutus-tx-plugin/test/Strictness/9.6/let-strict.uplc.golden b/plutus-tx-plugin/test/Strictness/9.6/let-strict.uplc.golden index 12709cecb0b..dc30b6852a2 100644 --- a/plutus-tx-plugin/test/Strictness/9.6/let-strict.uplc.golden +++ b/plutus-tx-plugin/test/Strictness/9.6/let-strict.uplc.golden @@ -2,7 +2,6 @@ 1.1.0 (\m -> force - (force ifThenElse + (case (lessThanInteger m 0) - (delay ((\cse -> addInteger cse cse) (error m))) - (delay m)))) \ No newline at end of file + [(delay m), (delay ((\cse -> addInteger cse cse) (error m)))]))) \ No newline at end of file diff --git a/plutus-tx-plugin/test/size/Golden/Rational/Additive/minus.size.golden b/plutus-tx-plugin/test/size/Golden/Rational/Additive/minus.size.golden index 615be700b9e..c147342cbef 100644 --- a/plutus-tx-plugin/test/size/Golden/Rational/Additive/minus.size.golden +++ b/plutus-tx-plugin/test/size/Golden/Rational/Additive/minus.size.golden @@ -1 +1 @@ -85 \ No newline at end of file +81 \ No newline at end of file diff --git a/plutus-tx-plugin/test/size/Golden/Rational/Additive/plus.size.golden b/plutus-tx-plugin/test/size/Golden/Rational/Additive/plus.size.golden index 615be700b9e..c147342cbef 100644 --- a/plutus-tx-plugin/test/size/Golden/Rational/Additive/plus.size.golden +++ b/plutus-tx-plugin/test/size/Golden/Rational/Additive/plus.size.golden @@ -1 +1 @@ -85 \ No newline at end of file +81 \ No newline at end of file diff --git a/plutus-tx-plugin/test/size/Golden/Rational/Construction/ratio.size.golden b/plutus-tx-plugin/test/size/Golden/Rational/Construction/ratio.size.golden index 6fc1e6e18c4..147ea53ba1b 100644 --- a/plutus-tx-plugin/test/size/Golden/Rational/Construction/ratio.size.golden +++ b/plutus-tx-plugin/test/size/Golden/Rational/Construction/ratio.size.golden @@ -1 +1 @@ -178 \ No newline at end of file +158 \ No newline at end of file diff --git a/plutus-tx-plugin/test/size/Golden/Rational/Construction/unsafeRatio.size.golden b/plutus-tx-plugin/test/size/Golden/Rational/Construction/unsafeRatio.size.golden index c9c41087e21..0aede4a000a 100644 --- a/plutus-tx-plugin/test/size/Golden/Rational/Construction/unsafeRatio.size.golden +++ b/plutus-tx-plugin/test/size/Golden/Rational/Construction/unsafeRatio.size.golden @@ -1 +1 @@ -114 \ No newline at end of file +102 \ No newline at end of file diff --git a/plutus-tx-plugin/test/size/Golden/Rational/Eq/equal.size.golden b/plutus-tx-plugin/test/size/Golden/Rational/Eq/equal.size.golden index dce6588ca14..368f89ceef1 100644 --- a/plutus-tx-plugin/test/size/Golden/Rational/Eq/equal.size.golden +++ b/plutus-tx-plugin/test/size/Golden/Rational/Eq/equal.size.golden @@ -1 +1 @@ -36 \ No newline at end of file +28 \ No newline at end of file diff --git a/plutus-tx-plugin/test/size/Golden/Rational/Eq/not-equal.size.golden b/plutus-tx-plugin/test/size/Golden/Rational/Eq/not-equal.size.golden index f70d7bba4ae..3e932fe8f18 100644 --- a/plutus-tx-plugin/test/size/Golden/Rational/Eq/not-equal.size.golden +++ b/plutus-tx-plugin/test/size/Golden/Rational/Eq/not-equal.size.golden @@ -1 +1 @@ -42 \ No newline at end of file +34 \ No newline at end of file diff --git a/plutus-tx-plugin/test/size/Golden/Rational/Multiplicative/scale.size.golden b/plutus-tx-plugin/test/size/Golden/Rational/Multiplicative/scale.size.golden index d1cbcfa5404..b2412e34dff 100644 --- a/plutus-tx-plugin/test/size/Golden/Rational/Multiplicative/scale.size.golden +++ b/plutus-tx-plugin/test/size/Golden/Rational/Multiplicative/scale.size.golden @@ -1 +1 @@ -66 \ No newline at end of file +62 \ No newline at end of file diff --git a/plutus-tx-plugin/test/size/Golden/Rational/Multiplicative/times.size.golden b/plutus-tx-plugin/test/size/Golden/Rational/Multiplicative/times.size.golden index 780fea92d29..e77a96349c0 100644 --- a/plutus-tx-plugin/test/size/Golden/Rational/Multiplicative/times.size.golden +++ b/plutus-tx-plugin/test/size/Golden/Rational/Multiplicative/times.size.golden @@ -1 +1 @@ -77 \ No newline at end of file +73 \ No newline at end of file diff --git a/plutus-tx-plugin/test/size/Golden/Rational/Ord/compare.size.golden b/plutus-tx-plugin/test/size/Golden/Rational/Ord/compare.size.golden index c5b431b6cba..7d37386284a 100644 --- a/plutus-tx-plugin/test/size/Golden/Rational/Ord/compare.size.golden +++ b/plutus-tx-plugin/test/size/Golden/Rational/Ord/compare.size.golden @@ -1 +1 @@ -50 \ No newline at end of file +45 \ No newline at end of file diff --git a/plutus-tx-plugin/test/size/Golden/Rational/Ord/greater-than-equal.size.golden b/plutus-tx-plugin/test/size/Golden/Rational/Ord/greater-than-equal.size.golden index 8580e7b684b..978b4e8e518 100644 --- a/plutus-tx-plugin/test/size/Golden/Rational/Ord/greater-than-equal.size.golden +++ b/plutus-tx-plugin/test/size/Golden/Rational/Ord/greater-than-equal.size.golden @@ -1 +1 @@ -30 \ No newline at end of file +26 \ No newline at end of file diff --git a/plutus-tx-plugin/test/size/Golden/Rational/Ord/greater-than.size.golden b/plutus-tx-plugin/test/size/Golden/Rational/Ord/greater-than.size.golden index 8580e7b684b..978b4e8e518 100644 --- a/plutus-tx-plugin/test/size/Golden/Rational/Ord/greater-than.size.golden +++ b/plutus-tx-plugin/test/size/Golden/Rational/Ord/greater-than.size.golden @@ -1 +1 @@ -30 \ No newline at end of file +26 \ No newline at end of file diff --git a/plutus-tx-plugin/test/size/Golden/Rational/Ord/less-than-equal.size.golden b/plutus-tx-plugin/test/size/Golden/Rational/Ord/less-than-equal.size.golden index 8580e7b684b..978b4e8e518 100644 --- a/plutus-tx-plugin/test/size/Golden/Rational/Ord/less-than-equal.size.golden +++ b/plutus-tx-plugin/test/size/Golden/Rational/Ord/less-than-equal.size.golden @@ -1 +1 @@ -30 \ No newline at end of file +26 \ No newline at end of file diff --git a/plutus-tx-plugin/test/size/Golden/Rational/Ord/less-than.size.golden b/plutus-tx-plugin/test/size/Golden/Rational/Ord/less-than.size.golden index 8580e7b684b..978b4e8e518 100644 --- a/plutus-tx-plugin/test/size/Golden/Rational/Ord/less-than.size.golden +++ b/plutus-tx-plugin/test/size/Golden/Rational/Ord/less-than.size.golden @@ -1 +1 @@ -30 \ No newline at end of file +26 \ No newline at end of file diff --git a/plutus-tx-plugin/test/size/Golden/Rational/Ord/max.size.golden b/plutus-tx-plugin/test/size/Golden/Rational/Ord/max.size.golden index dce6588ca14..1758dddccea 100644 --- a/plutus-tx-plugin/test/size/Golden/Rational/Ord/max.size.golden +++ b/plutus-tx-plugin/test/size/Golden/Rational/Ord/max.size.golden @@ -1 +1 @@ -36 \ No newline at end of file +32 \ No newline at end of file diff --git a/plutus-tx-plugin/test/size/Golden/Rational/Ord/min.size.golden b/plutus-tx-plugin/test/size/Golden/Rational/Ord/min.size.golden index dce6588ca14..1758dddccea 100644 --- a/plutus-tx-plugin/test/size/Golden/Rational/Ord/min.size.golden +++ b/plutus-tx-plugin/test/size/Golden/Rational/Ord/min.size.golden @@ -1 +1 @@ -36 \ No newline at end of file +32 \ No newline at end of file diff --git a/plutus-tx-plugin/test/size/Golden/Rational/Other/abs-specialized.size.golden b/plutus-tx-plugin/test/size/Golden/Rational/Other/abs-specialized.size.golden index 978b4e8e518..8fdd954df98 100644 --- a/plutus-tx-plugin/test/size/Golden/Rational/Other/abs-specialized.size.golden +++ b/plutus-tx-plugin/test/size/Golden/Rational/Other/abs-specialized.size.golden @@ -1 +1 @@ -26 \ No newline at end of file +22 \ No newline at end of file diff --git a/plutus-tx-plugin/test/size/Golden/Rational/Other/recip.size.golden b/plutus-tx-plugin/test/size/Golden/Rational/Other/recip.size.golden index 43c451e0c6d..abc4eff6ac8 100644 --- a/plutus-tx-plugin/test/size/Golden/Rational/Other/recip.size.golden +++ b/plutus-tx-plugin/test/size/Golden/Rational/Other/recip.size.golden @@ -1 +1 @@ -54 \ No newline at end of file +46 \ No newline at end of file diff --git a/plutus-tx-plugin/test/size/Golden/Rational/Other/round.size.golden b/plutus-tx-plugin/test/size/Golden/Rational/Other/round.size.golden index 4acc65d0120..8d0003f4668 100644 --- a/plutus-tx-plugin/test/size/Golden/Rational/Other/round.size.golden +++ b/plutus-tx-plugin/test/size/Golden/Rational/Other/round.size.golden @@ -1 +1 @@ -266 \ No newline at end of file +245 \ No newline at end of file diff --git a/plutus-tx-plugin/test/size/Golden/Rational/Serialization/fromBuiltinData.size.golden b/plutus-tx-plugin/test/size/Golden/Rational/Serialization/fromBuiltinData.size.golden index 136c8cacf37..87d78b292a2 100644 --- a/plutus-tx-plugin/test/size/Golden/Rational/Serialization/fromBuiltinData.size.golden +++ b/plutus-tx-plugin/test/size/Golden/Rational/Serialization/fromBuiltinData.size.golden @@ -1 +1 @@ -342 \ No newline at end of file +322 \ No newline at end of file diff --git a/plutus-tx-plugin/test/size/Golden/Rational/Serialization/unsafeFromBuiltinData.size.golden b/plutus-tx-plugin/test/size/Golden/Rational/Serialization/unsafeFromBuiltinData.size.golden index cd004727f24..09df927592b 100644 --- a/plutus-tx-plugin/test/size/Golden/Rational/Serialization/unsafeFromBuiltinData.size.golden +++ b/plutus-tx-plugin/test/size/Golden/Rational/Serialization/unsafeFromBuiltinData.size.golden @@ -1 +1 @@ -182 \ No newline at end of file +166 \ No newline at end of file From 6bd7a01408c6e653b74affcd3dba2c91ac3114ba Mon Sep 17 00:00:00 2001 From: effectfully Date: Wed, 25 Jun 2025 00:28:12 +0100 Subject: [PATCH 24/25] Add a note and a changelog file --- .../bitwise/test/9.6/8 queens.uplc.golden | 264 +++++++++--------- .../bitwise/test/9.6/Ed25519.uplc.golden | 220 +++++++-------- ...44_effectfully_allow_casing_on_booleans.md | 3 + .../src/UntypedPlutusCore/Core/Type.hs | 15 +- 4 files changed, 258 insertions(+), 244 deletions(-) create mode 100644 plutus-core/changelog.d/20250625_002544_effectfully_allow_casing_on_booleans.md diff --git a/plutus-benchmark/bitwise/test/9.6/8 queens.uplc.golden b/plutus-benchmark/bitwise/test/9.6/8 queens.uplc.golden index 651fddd2826..144f47ee61e 100644 --- a/plutus-benchmark/bitwise/test/9.6/8 queens.uplc.golden +++ b/plutus-benchmark/bitwise/test/9.6/8 queens.uplc.golden @@ -9,26 +9,30 @@ (\go -> (\bytesNeeded -> force - (force ifThenElse + (case (lessThanInteger dim 8) - (delay (constr 0 [])) - (delay - (force - (force ifThenElse - (equalsInteger - 0 - (remainderInteger dim 8)) - (delay - ((\cse -> - go - 0 - 0 - cse - cse - cse - (replicateByte bytesNeeded 255)) - (replicateByte bytesNeeded 0))) - (delay (constr 0 []))))))) + [ (delay + (force + (case + (equalsInteger + 0 + (remainderInteger dim 8)) + [ (delay (constr 0 [])) + , (delay + ((\cse -> + go + 0 + 0 + cse + cse + cse + (replicateByte + bytesNeeded + 255)) + (replicateByte + bytesNeeded + 0))) ]))) + , (delay (constr 0 [])) ])) (quotientInteger dim 8)) ((\s -> s s) @@ -40,102 +44,102 @@ right control -> force - (force - ifThenElse + (case (equalsInteger selectIx dim) - (delay (constr 0 [])) - (delay - ((\available -> - force - (force - ifThenElse - (equalsInteger -1 available) - (delay (constr 0 [])) - (delay - (force - (force - ifThenElse - (equalsInteger row lastRow) - (delay - (constr 1 - [ (constr 0 - [ row - , available ]) - , (constr 0 []) ])) - (delay - ((\newRow -> - (\cse -> - (\newRight -> - (\newLeft -> - (\newDown -> - (\newControl -> - (\cse -> - (\cse -> - force - (case - cse - [ (delay - (cse - (addInteger - 1 - selectIx) - row - down - left - right - control)) - , (\ipv - ipv -> - delay - (constr 1 - [ (constr 0 - [ row - , available ]) - , cse ])) ])) - (cse - 0 - newRow - newDown - newLeft - newRight - newControl)) - (s - s)) - (complementByteString - (orByteString - False - newDown - (orByteString - False - newLeft - newRight)))) - (writeBits - down - cse - (constr 0 - [ ]))) - (shiftByteString - (writeBits - left - cse - (constr 0 - [ ])) - 1)) - (shiftByteString - (writeBits - right - cse - (constr 0 - [])) - -1)) + [ (delay + ((\available -> + force + (case + (equalsInteger -1 available) + [ (delay + (force + (case + (equalsInteger + row + lastRow) + [ (delay + ((\newRow -> + (\cse -> + (\newRight -> + (\newLeft -> + (\newDown -> + (\newControl -> + (\cse -> + (\cse -> + force + (case + cse + [ (delay + (cse + (addInteger + 1 + selectIx) + row + down + left + right + control)) + , (\ipv + ipv -> + delay + (constr 1 + [ (constr 0 + [ row + , available ]) + , cse ])) ])) + (cse + 0 + newRow + newDown + newLeft + newRight + newControl)) + (s + s)) + (complementByteString + (orByteString + False + newDown + (orByteString + False + newLeft + newRight)))) + (writeBits + down + cse + (constr 0 + [ ]))) + (shiftByteString + (writeBits + left + cse + (constr 0 + [ ])) + 1)) + (shiftByteString + (writeBits + right + cse + (constr 0 + [ ])) + -1)) + (constr 1 + [ available + , (constr 0 + [ ]) ])) + (addInteger + 1 + row))) + , (delay (constr 1 - [ available + [ (constr 0 + [ row + , available ]) , (constr 0 - []) ])) - (addInteger - 1 - row)))))))) - (selectByteString selectIx control))))))) + [ ]) ])) ]))) + , (delay (constr 0 [])) ])) + (selectByteString selectIx control))) + , (delay (constr 0 [])) ])))) (\bs ixes bit -> writeBits bs @@ -148,23 +152,23 @@ ((\s -> s s) (\s which bs -> force - (force ifThenElse + (case (lessThanEqualsInteger which 0) - (delay (findFirstSetBit bs)) - (delay - ((\i -> - force - (force ifThenElse - (equalsInteger -1 i) - (delay -1) - (delay - ((\cse -> - addInteger - cse - (findFirstSetBit - (shiftByteString - bs - (subtractInteger 0 cse)))) - (addInteger 1 i))))) - ((\x -> s s x) (subtractInteger which 1) bs)))))) + [ (delay + ((\i -> + force + (case + (equalsInteger -1 i) + [ (delay + ((\cse -> + addInteger + cse + (findFirstSetBit + (shiftByteString + bs + (subtractInteger 0 cse)))) + (addInteger 1 i))) + , (delay -1) ])) + ((\x -> s s x) (subtractInteger which 1) bs))) + , (delay (findFirstSetBit bs)) ]))) (I 8))) \ No newline at end of file diff --git a/plutus-benchmark/bitwise/test/9.6/Ed25519.uplc.golden b/plutus-benchmark/bitwise/test/9.6/Ed25519.uplc.golden index 1b27aea3e44..30c7cf9619f 100644 --- a/plutus-benchmark/bitwise/test/9.6/Ed25519.uplc.golden +++ b/plutus-benchmark/bitwise/test/9.6/Ed25519.uplc.golden @@ -37,24 +37,22 @@ [ (\x y -> force - (force - ifThenElse + (case (equalsInteger x x) - (delay - (force - ifThenElse - (equalsInteger - y - y) - (constr 0 - [ ]) - (constr 1 - [ ]))) - (delay - (constr 1 - [ ])))) ]) ]) + [ (delay + (constr 1 + [ ])) + , (delay + (case + (equalsInteger + y + y) + [ (constr 1 + [ ]) + , (constr 0 + [ ]) ])) ])) ]) ]) (edwards nt (scalarMult @@ -975,7 +973,7 @@ (case ds [ (\w - rest -> + cont -> w) ])) (case ds @@ -990,7 +988,7 @@ (case ds [ (\w - cont -> + rest -> w) ])) ]) (next ipv)) ]) @@ -1483,21 +1481,20 @@ (\added -> force ((\g -> - force - ifThenElse + case (lessThanInteger 18446744073709551615 added) - (delay - (g - (subtractInteger - (subtractInteger - added - 18446744073709551615) - 1))) - (delay - (g - added))) + [ (delay + (g + added)) + , (delay + (g + (subtractInteger + (subtractInteger + added + 18446744073709551615) + 1))) ]) (integerToByteString True 8))) @@ -1513,19 +1510,18 @@ (\r -> force ((\`$j` -> - force - ifThenElse + case (lessThanEqualsInteger r -1) - (delay - (`$j` - (addInteger - 1024 - r))) - (delay - (`$j` - r))) + [ (delay + (`$j` + r)) + , (delay + (`$j` + (addInteger + 1024 + r))) ]) (\k -> appendByteString eta @@ -1595,18 +1591,17 @@ , (constr 0 [ ]) ]) xLSBVal) - (force - ifThenElse + (case (readBit (integerToByteString False 32 x) 248) - (constr 0 - [ ]) - (constr 1 - [ ]))) ]) + [ (constr 1 + [ ]) + , (constr 0 + [ ]) ])) ]) (appendByteString pubKey message)))) @@ -1638,32 +1633,33 @@ p e -> force - (force - ifThenElse + (case (equalsInteger 0 e) - (delay - (constr 0 [0, 1])) - (delay - ((\nt -> - (\nt -> - force - (case - (even e) - [ (delay - nt) - , (delay - (edwards - nt - p)) ])) - (edwards - nt - nt)) - (s - s - p - (divideInteger - e - 2)))))))) + [ (delay + ((\nt -> + (\nt -> + force + (case + (even + e) + [ (delay + nt) + , (delay + (edwards + nt + p)) ])) + (edwards + nt + nt)) + (s + s + p + (divideInteger + e + 2)))) + , (delay + (constr 0 + [0, 1])) ])))) (\ds ds -> case @@ -1723,20 +1719,20 @@ ((\s -> s s) (\s state next input -> force - (force ifThenElse + (case (equalsInteger 0 (lengthOfByteString input)) - (delay state) - (delay - (case - (next input state) - [ (\ipv ipv -> - s + [ (delay + (case + (next input state) + [ (\ipv ipv -> s - ipv - next - ipv) ])))))) + s + ipv + next + ipv) ])) + , (delay state) ])))) (\bs -> (\yInt -> (\x -> @@ -1772,10 +1768,10 @@ 57896044618658097711785492504343953926634992332820282019728792003956564819949 x) , yInt ])) ]))) ])) - (force ifThenElse + (case (readBit bs 7) - (constr 0 []) - (constr 1 []))) + [ (constr 1 []) + , (constr 0 []) ])) (xRecover yInt)) (checkValid_f (writeBits @@ -1791,8 +1787,7 @@ (\xB -> force ((\`$j` -> - force - ifThenElse + case (equalsInteger 0 (modInteger @@ -1802,14 +1797,14 @@ x) xx) 57896044618658097711785492504343953926634992332820282019728792003956564819949)) - (delay - (`$j` - (constr 1 - []))) - (delay - (`$j` - (constr 0 - [])))) + [ (delay + (`$j` + (constr 0 + []))) + , (delay + (`$j` + (constr 1 + [ ]))) ]) (\cond -> force ((\`$j` -> @@ -1963,34 +1958,33 @@ ((\s -> s s) (\s b' e m -> force - (force ifThenElse + (case (equalsInteger 0 e) - (delay 1) - (delay - ((\reduced -> - (\t -> - force - (case - (even e) - [ (delay t) - , (delay - (modInteger - (multiplyInteger t b') - m)) ])) - (modInteger - (multiplyInteger reduced reduced) - m)) - (s s b' (divideInteger e 2) m))))))) + [ (delay + ((\reduced -> + (\t -> + force + (case + (even e) + [ (delay t) + , (delay + (modInteger + (multiplyInteger t b') + m)) ])) + (modInteger + (multiplyInteger reduced reduced) + m)) + (s s b' (divideInteger e 2) m))) + , (delay 1) ])))) (\bs ixes bit -> writeBits bs (goList ixes) (force (case bit [(delay True), (delay False)])))) (\n -> - force ifThenElse + case (equalsInteger 0 (modInteger n 2)) - (constr 0 []) - (constr 1 []))) + [(constr 1 []), (constr 0 [])])) ((\s -> s s) (\s ds -> case ds [[], (\d ds -> force mkCons d (s s ds))]))) (byteStringToInteger False) diff --git a/plutus-core/changelog.d/20250625_002544_effectfully_allow_casing_on_booleans.md b/plutus-core/changelog.d/20250625_002544_effectfully_allow_casing_on_booleans.md new file mode 100644 index 00000000000..fa013d9ad10 --- /dev/null +++ b/plutus-core/changelog.d/20250625_002544_effectfully_allow_casing_on_booleans.md @@ -0,0 +1,3 @@ +### Added + +- In #7029 added support for `Case`ing on booleans and integers. For example, `case True a b` now evaluates to `b`. diff --git a/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Core/Type.hs b/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Core/Type.hs index 6fdc1800efd..55e4d89d512 100644 --- a/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Core/Type.hs +++ b/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Core/Type.hs @@ -56,6 +56,19 @@ See the GHC Notes "Tagging big families" and "Double switching for big families" GHC.StgToCmm.Expr for more details. -} +{- Note [Supported case-expressions] +Originally 'Case' was introduced to only work with 'Constr', which together create the +sums-of-products approach to representing data types. + +However in https://github.com/IntersectMBO/plutus/issues/6602 we decided that the best way to +speed up processing values of built-in types is to extend 'Case' such that it supports pattern +matching on those. + +Currently, 'Case' only supports booleans and integers, but we plan to extend it to lists and data. + +See the @CaseBuiltin DefaultUni@ instance for how casing behaves for supported built-in types. +-} + {-| The type of Untyped Plutus Core terms. Mirrors the type of Typed Plutus Core terms except 1. all types are removed @@ -84,9 +97,9 @@ data Term name uni fun ann -- See Note [Term constructor ordering and numbers] | Error !ann -- TODO: worry about overflow, maybe use an Integer - -- TODO: try spine-strict list or strict list or vector -- See Note [Constr tag type] | Constr !ann !Word64 ![Term name uni fun ann] + -- See Note [Supported case-expressions]. | Case !ann !(Term name uni fun ann) !(Vector (Term name uni fun ann)) deriving stock (Functor, Generic) From 803c53b4849ae68abc38eea18c00bbbeb84d71bb Mon Sep 17 00:00:00 2001 From: effectfully Date: Wed, 25 Jun 2025 02:29:28 +0100 Subject: [PATCH 25/25] Guess who forgot to add casing on builtins to the CK machine --- .../executables/plutus/AnyProgram/Run.hs | 2 +- plutus-core/plutus-core.cabal | 1 + .../src/PlutusCore/Evaluation/Machine/Ck.hs | 35 ++++++++++++++----- .../plutus-core/test/Evaluation/Machines.hs | 3 +- .../Generators/Hedgehog/TypeEvalCheck.hs | 2 +- .../PlutusCore/Generators/NEAT/Spec.hs | 5 +-- plutus-core/testlib/PlutusCore/Test.hs | 2 +- .../Evaluation/Machine/Cek/Internal.hs | 6 ++-- .../Machine/SteppableCek/Internal.hs | 2 +- .../Evaluation/Golden/caseInteger.plc.golden | 3 +- .../testlib/Evaluation/Golden.hs | 5 +-- plutus-executables/executables/plc/Main.hs | 2 +- plutus-metatheory/plutus-metatheory.cabal | 1 + plutus-metatheory/test/NEAT/Spec.hs | 3 +- 14 files changed, 49 insertions(+), 23 deletions(-) diff --git a/plutus-core/executables/plutus/AnyProgram/Run.hs b/plutus-core/executables/plutus/AnyProgram/Run.hs index 13a8b548001..c0c48378609 100644 --- a/plutus-core/executables/plutus/AnyProgram/Run.hs +++ b/plutus-core/executables/plutus/AnyProgram/Run.hs @@ -45,7 +45,7 @@ runPlc :: (?opts :: Opts) runPlc (PLC.Program _ _ t) | Nothing <- _budget ?opts = -- CK machine currently only works with ann==() , so we void before - case PLC.runCk defaultBuiltinsRuntimeForTesting False (void t) of + case PLC.runCk defaultBuiltinsRuntimeForTesting def False (void t) of (Left errorWithCause, logs) -> do for_ logs (printE . unpack) failE $ show errorWithCause diff --git a/plutus-core/plutus-core.cabal b/plutus-core/plutus-core.cabal index ab07b53bb4b..5c574ea5f19 100644 --- a/plutus-core/plutus-core.cabal +++ b/plutus-core/plutus-core.cabal @@ -472,6 +472,7 @@ library untyped-plutus-core-testlib , base16-bytestring , bytestring , cardano-crypto-class + , data-default-class , dlist , flat ^>=0.6 , hedgehog diff --git a/plutus-core/plutus-core/src/PlutusCore/Evaluation/Machine/Ck.hs b/plutus-core/plutus-core/src/PlutusCore/Evaluation/Machine/Ck.hs index a77d2d6ea5e..4a379564501 100644 --- a/plutus-core/plutus-core/src/PlutusCore/Evaluation/Machine/Ck.hs +++ b/plutus-core/plutus-core/src/PlutusCore/Evaluation/Machine/Ck.hs @@ -46,7 +46,9 @@ import Data.DList qualified as DList import Data.List.Extras (wix) import Data.STRef import Data.Text (Text) +import Data.Vector qualified as Vector import Data.Word +import Prettyprinter (vcat) import Universe infix 4 |>, <| @@ -77,6 +79,7 @@ ckValueToTerm = \case data CkEnv uni fun s = CkEnv { ckEnvRuntime :: BuiltinsRuntime fun (CkValue uni fun) + , ckCaserBuiltin :: CaserBuiltin uni -- 'Nothing' means no logging. 'DList' is due to the fact that we need efficient append -- as we store logs as "latest go last". , ckEnvMayEmitRef :: Maybe (STRef s (DList Text)) @@ -85,8 +88,9 @@ data CkEnv uni fun s = CkEnv instance (PrettyUni uni, Pretty fun) => PrettyBy PrettyConfigPlc (CkValue uni fun) where prettyBy cfg = prettyBy cfg . ckValueToTerm -data CkUserError = - CkEvaluationFailure -- Error has been called or a builtin application has failed +data CkUserError + = CkCaseBuiltinError Text -- ^ 'Case' over a value of a built-in type failed. + | CkEvaluationFailure -- Error has been called or a builtin application has failed deriving stock (Show, Eq, Generic) deriving anyclass (NFData) @@ -100,6 +104,10 @@ type CkM uni fun s = (ST s)) instance Pretty CkUserError where + pretty (CkCaseBuiltinError err) = vcat + [ "'case' over a value of a built-in type failed with" + , pretty err + ] pretty CkEvaluationFailure = "The provided Plutus code called 'error'." instance BuiltinErrorToEvaluationError (MachineError fun) CkUserError where @@ -146,12 +154,13 @@ instance ExMemoryUsage (CkValue uni fun) where runCkM :: BuiltinsRuntime fun (CkValue uni fun) + -> CaserBuiltin uni -> Bool -> (forall s. CkM uni fun s a) -> (Either (CkEvaluationException uni fun) a, [Text]) -runCkM runtime emitting a = runST $ do +runCkM runtime caser emitting a = runST $ do mayLogsRef <- if emitting then Just <$> newSTRef DList.empty else pure Nothing - errOrRes <- runExceptT . runReaderT a $ CkEnv runtime mayLogsRef + errOrRes <- runExceptT . runReaderT a $ CkEnv runtime caser mayLogsRef logs <- case mayLogsRef of Nothing -> pure [] Just logsRef -> DList.toList <$> readSTRef logsRef @@ -233,6 +242,12 @@ FrameCase cs : stack <| e = case e of go (arg:rest) s = go rest (FrameAwaitFunValue arg : s) Nothing -> throwErrorWithCause (StructuralError $ MissingCaseBranchMachineError i) $ ckValueToTerm e + VCon val -> do + caser <- asks ckCaserBuiltin + case unCaserBuiltin caser val $ Vector.fromList cs of + Left err -> + throwErrorWithCause (OperationalError $ CkCaseBuiltinError err) $ ckValueToTerm e + Right res -> stack |> res _ -> throwErrorWithCause (StructuralError NonConstrScrutinizedMachineError) $ ckValueToTerm e -- | Transfers a 'Spine' onto the stack. The first argument will be at the top of the stack. @@ -323,29 +338,33 @@ applyEvaluate _ val _ = runCk :: BuiltinsRuntime fun (CkValue uni fun) + -> CaserBuiltin uni -> Bool -> Term TyName Name uni fun () -> (Either (CkEvaluationException uni fun) (Term TyName Name uni fun ()), [Text]) -runCk runtime emitting term = runCkM runtime emitting $ [] |> term +runCk runtime caser emitting term = runCkM runtime caser emitting $ [] |> term -- | Evaluate a term using the CK machine with logging enabled. evaluateCk :: BuiltinsRuntime fun (CkValue uni fun) + -> CaserBuiltin uni -> Term TyName Name uni fun () -> (Either (CkEvaluationException uni fun) (Term TyName Name uni fun ()), [Text]) -evaluateCk runtime = runCk runtime True +evaluateCk runtime caser = runCk runtime caser True -- | Evaluate a term using the CK machine with logging disabled. evaluateCkNoEmit :: BuiltinsRuntime fun (CkValue uni fun) + -> CaserBuiltin uni -> Term TyName Name uni fun () -> Either (CkEvaluationException uni fun) (Term TyName Name uni fun ()) -evaluateCkNoEmit runtime = fst . runCk runtime False +evaluateCkNoEmit runtime caser = fst . runCk runtime caser False -- | Unlift a value using the CK machine. readKnownCk :: ReadKnown (Term TyName Name uni fun ()) a => BuiltinsRuntime fun (CkValue uni fun) + -> CaserBuiltin uni -> Term TyName Name uni fun () -> Either (CkEvaluationException uni fun) a -readKnownCk runtime = evaluateCkNoEmit runtime >=> readKnownSelf +readKnownCk runtime caser = evaluateCkNoEmit runtime caser >=> readKnownSelf diff --git a/plutus-core/plutus-core/test/Evaluation/Machines.hs b/plutus-core/plutus-core/test/Evaluation/Machines.hs index 5b841ffa174..ee578452b10 100644 --- a/plutus-core/plutus-core/test/Evaluation/Machines.hs +++ b/plutus-core/plutus-core/test/Evaluation/Machines.hs @@ -17,6 +17,7 @@ import PlutusCore.Generators.Hedgehog.Test import PlutusCore.Pretty import PlutusCore.Test +import Data.Default.Class (def) import Test.Tasty import Test.Tasty.Hedgehog @@ -37,5 +38,5 @@ testMachine machine eval = test_machines :: TestTree test_machines = testGroup "machines" - [ testMachine "CK" $ evaluateCkNoEmit defaultBuiltinsRuntimeForTesting + [ testMachine "CK" $ evaluateCkNoEmit defaultBuiltinsRuntimeForTesting def ] diff --git a/plutus-core/testlib/PlutusCore/Generators/Hedgehog/TypeEvalCheck.hs b/plutus-core/testlib/PlutusCore/Generators/Hedgehog/TypeEvalCheck.hs index bf644ab825b..97267e285e9 100644 --- a/plutus-core/testlib/PlutusCore/Generators/Hedgehog/TypeEvalCheck.hs +++ b/plutus-core/testlib/PlutusCore/Generators/Hedgehog/TypeEvalCheck.hs @@ -120,7 +120,7 @@ unsafeTypeEvalCheck => TermOf (Term TyName Name uni fun ()) a -> TermOf (Term TyName Name uni fun ()) (EvaluationResult (Term TyName Name uni fun ())) unsafeTypeEvalCheck termOfTbv = do - let errOrRes = typeEvalCheckBy (evaluateCkNoEmit defaultBuiltinsRuntimeForTesting) termOfTbv + let errOrRes = typeEvalCheckBy (evaluateCkNoEmit defaultBuiltinsRuntimeForTesting def) termOfTbv case errOrRes of Left err -> error $ concat [ prettyPlcErrorString err diff --git a/plutus-core/testlib/PlutusCore/Generators/NEAT/Spec.hs b/plutus-core/testlib/PlutusCore/Generators/NEAT/Spec.hs index 7c36d9f2a24..a447b3c7573 100644 --- a/plutus-core/testlib/PlutusCore/Generators/NEAT/Spec.hs +++ b/plutus-core/testlib/PlutusCore/Generators/NEAT/Spec.hs @@ -43,6 +43,7 @@ import UntypedPlutusCore.Evaluation.Machine.Cek qualified as U import Control.Monad (unless) import Control.Monad.Except (ExceptT, catchError, liftEither, runExceptT, throwError, withExceptT) import Control.Search (Enumerable (..), Options (..), search') +import Data.Default.Class (def) import Data.Maybe import Data.Stream qualified as Stream import Data.Tagged @@ -144,7 +145,7 @@ prop_typePreservation tyG tmG = do -- Check if the converted term, when evaluated by CK, still has the same type: tmCK <- withExceptT CkP $ liftEither $ - evaluateCkNoEmit defaultBuiltinsRuntimeForTesting tm `catchError` handleError ty + evaluateCkNoEmit defaultBuiltinsRuntimeForTesting def tm `catchError` handleError ty withExceptT TypeError $ checkType tcConfig () tmCK (Normalized ty) -- |Property: check if both the typed CK and untyped CEK machines produce the same output @@ -162,7 +163,7 @@ prop_agree_termEval tyG tmG = do -- run typed CK on input tmCk <- withExceptT CkP $ liftEither $ - evaluateCkNoEmit defaultBuiltinsRuntimeForTesting tm `catchError` handleError ty + evaluateCkNoEmit defaultBuiltinsRuntimeForTesting def tm `catchError` handleError ty -- erase CK output let tmUCk = eraseTerm tmCk diff --git a/plutus-core/testlib/PlutusCore/Test.hs b/plutus-core/testlib/PlutusCore/Test.hs index 7f2e84d087e..68d66bb32ea 100644 --- a/plutus-core/testlib/PlutusCore/Test.hs +++ b/plutus-core/testlib/PlutusCore/Test.hs @@ -233,7 +233,7 @@ runTPlc values = do (unsafeFromRight .* TPLC.applyProgram) ps liftEither . first toException . TPLC.splitStructuralOperational $ - TPLC.evaluateCkNoEmit TPLC.defaultBuiltinsRuntimeForTesting t + TPLC.evaluateCkNoEmit TPLC.defaultBuiltinsRuntimeForTesting def t -- | An evaluation failure plus the final budget and logs. data EvaluationExceptionWithLogsAndBudget err = diff --git a/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Evaluation/Machine/Cek/Internal.hs b/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Evaluation/Machine/Cek/Internal.hs index b86f2c06aea..47b3ba3b90b 100644 --- a/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Evaluation/Machine/Cek/Internal.hs +++ b/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Evaluation/Machine/Cek/Internal.hs @@ -417,7 +417,7 @@ type GivenCekReqs uni fun ann s = ) data CekUserError - = CaseBuiltinError Text -- ^ 'Case' over a value of a built-in type failed. + = CekCaseBuiltinError Text -- ^ 'Case' over a value of a built-in type failed. | CekOutOfExError !ExRestrictingBudget -- ^ The final overspent (i.e. negative) budget. | CekEvaluationFailure -- ^ Error has been called or a builtin application has failed deriving stock (Show, Eq, Generic) @@ -521,7 +521,7 @@ instance ThrowableBuiltins uni fun => Nothing instance Pretty CekUserError where - pretty (CaseBuiltinError err) = vcat + pretty (CekCaseBuiltinError err) = vcat [ "'case' over a value of a built-in type failed with" , pretty err ] @@ -805,7 +805,7 @@ enterComputeCek = computeCek Just t -> computeCek (transferArgStack args ctx) env t Nothing -> throwErrorDischarged (StructuralError $ MissingCaseBranchMachineError i) e VCon val -> case unCaserBuiltin ?cekCaserBuiltin val cs of - Left err -> throwErrorDischarged (OperationalError $ CaseBuiltinError err) e + Left err -> throwErrorDischarged (OperationalError $ CekCaseBuiltinError err) e Right res -> computeCek ctx env res _ -> throwErrorDischarged (StructuralError NonConstrScrutinizedMachineError) e diff --git a/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Evaluation/Machine/SteppableCek/Internal.hs b/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Evaluation/Machine/SteppableCek/Internal.hs index cdb3085a1a8..d61a028a917 100644 --- a/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Evaluation/Machine/SteppableCek/Internal.hs +++ b/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Evaluation/Machine/SteppableCek/Internal.hs @@ -212,7 +212,7 @@ returnCek (FrameCases ann env cs ctx) e = case e of in computeCek ctx' env t Nothing -> throwErrorDischarged (StructuralError $ MissingCaseBranchMachineError i) e VCon val -> case unCaserBuiltin ?cekCaserBuiltin val cs of - Left err -> throwErrorDischarged (OperationalError $ CaseBuiltinError err) e + Left err -> throwErrorDischarged (OperationalError $ CekCaseBuiltinError err) e Right res -> pure $ Computing ctx env res _ -> throwErrorDischarged (StructuralError NonConstrScrutinizedMachineError) e diff --git a/plutus-core/untyped-plutus-core/test/Evaluation/Golden/caseInteger.plc.golden b/plutus-core/untyped-plutus-core/test/Evaluation/Golden/caseInteger.plc.golden index 2d18b6497e3..315273b1b83 100644 --- a/plutus-core/untyped-plutus-core/test/Evaluation/Golden/caseInteger.plc.golden +++ b/plutus-core/untyped-plutus-core/test/Evaluation/Golden/caseInteger.plc.golden @@ -1,3 +1,4 @@ (Left An error has occurred: -A non-constructor/non-builtin value was scrutinized in a case expression +'case' over a value of a built-in type failed with +'case 1' is out of bounds for the given number of branches: 0 Caused by: (con integer 1)) \ No newline at end of file diff --git a/plutus-core/untyped-plutus-core/testlib/Evaluation/Golden.hs b/plutus-core/untyped-plutus-core/testlib/Evaluation/Golden.hs index b25631d36df..8a753b1893f 100644 --- a/plutus-core/untyped-plutus-core/testlib/Evaluation/Golden.hs +++ b/plutus-core/untyped-plutus-core/testlib/Evaluation/Golden.hs @@ -30,6 +30,7 @@ import UntypedPlutusCore.Evaluation.Machine.Cek import Control.Monad.Except import Data.Bifunctor import Data.ByteString.Lazy qualified as BSL +import Data.Default.Class (Default (def)) import Data.Text (Text) import Data.Text.Encoding (encodeUtf8) import Test.Tasty @@ -411,7 +412,7 @@ goldenVsEvaluatedCK :: String -> Term TyName Name DefaultUni DefaultFun () -> Te goldenVsEvaluatedCK name = goldenVsPretty ".plc.golden" name . bimap (fmap eraseTerm) eraseTerm - . evaluateCkNoEmit defaultBuiltinsRuntimeForTesting + . evaluateCkNoEmit defaultBuiltinsRuntimeForTesting def goldenVsEvaluatedCEK :: String -> Term TyName Name DefaultUni DefaultFun () -> TestTree goldenVsEvaluatedCEK name @@ -436,7 +437,7 @@ goldenVsTypecheckedEvaluatedCK name term = -- that the term is well-typed before checking that the type of the result is the -- one stored in the golden file (we could simply check the two types for equality, -- but since we're doing golden testing in this file, why not do it here as well). - case (runTypecheck term, evaluateCkNoEmit defaultBuiltinsRuntimeForTesting term) of + case (runTypecheck term, evaluateCkNoEmit defaultBuiltinsRuntimeForTesting def term) of (Right _, Right res) -> goldenVsTypechecked name res _ -> testGroup name [] diff --git a/plutus-executables/executables/plc/Main.hs b/plutus-executables/executables/plc/Main.hs index 6229e4253dd..24ba6bf8086 100644 --- a/plutus-executables/executables/plc/Main.hs +++ b/plutus-executables/executables/plc/Main.hs @@ -202,7 +202,7 @@ runOptimisations (OptimiseOptions inp ifmt outp ofmt mode _) = do runEval :: EvalOptions -> IO () runEval (EvalOptions inp ifmt outp printMode nameFormat semvar) = do prog <- readProgram ifmt inp - let evaluate = Ck.evaluateCkNoEmit (PLC.defaultBuiltinsRuntimeForSemanticsVariant semvar) + let evaluate = Ck.evaluateCkNoEmit (PLC.defaultBuiltinsRuntimeForSemanticsVariant semvar) def term = void $ prog ^. PLC.progTerm case evaluate term of Right v -> diff --git a/plutus-metatheory/plutus-metatheory.cabal b/plutus-metatheory/plutus-metatheory.cabal index 71654a4a644..981a4bc2a9f 100644 --- a/plutus-metatheory/plutus-metatheory.cabal +++ b/plutus-metatheory/plutus-metatheory.cabal @@ -390,6 +390,7 @@ test-suite test-NEAT hs-source-dirs: test/NEAT build-depends: , base + , data-default-class , lazy-search , mtl , plutus-core ^>=1.47 diff --git a/plutus-metatheory/test/NEAT/Spec.hs b/plutus-metatheory/test/NEAT/Spec.hs index ea817745c53..234c336a5ab 100644 --- a/plutus-metatheory/test/NEAT/Spec.hs +++ b/plutus-metatheory/test/NEAT/Spec.hs @@ -4,6 +4,7 @@ module Main where import Control.Monad (unless) import Control.Monad.Except (ExceptT (..), catchError, liftEither, withExceptT) import Data.Coolean +import Data.Default.Class (def) import Data.Either import Data.List import PlutusCore @@ -104,7 +105,7 @@ prop_Term tyG tmG = do -- 2. run production CK against metatheory CK tmPlcCK <- withExceptT CkP $ liftEither $ - evaluateCkNoEmit defaultBuiltinsRuntimeForTesting tm `catchError` handleError ty + evaluateCkNoEmit defaultBuiltinsRuntimeForTesting def tm `catchError` handleError ty tmCK <- withExceptT (const $ Ctrex (CtrexTermEvaluationFail "0" tyG tmG)) $ liftEither $ runTCKAgda tmDB tmCKN <- withExceptT FVErrorP $ unDeBruijnTerm tmCK