From 2b8a3e9c23a7e60d78bd5e1fc4459af6bc79c845 Mon Sep 17 00:00:00 2001 From: kwxm Date: Tue, 28 May 2024 22:02:03 +0100 Subject: [PATCH] Fix partial reversion of #6086 caused by merge --- .../common/PlutusBenchmark/Common.hs | 71 +------------------ plutus-benchmark/plutus-benchmark.cabal | 11 ++- 2 files changed, 6 insertions(+), 76 deletions(-) diff --git a/plutus-benchmark/common/PlutusBenchmark/Common.hs b/plutus-benchmark/common/PlutusBenchmark/Common.hs index 6870a5b055d..8e2c71a01f3 100644 --- a/plutus-benchmark/common/PlutusBenchmark/Common.hs +++ b/plutus-benchmark/common/PlutusBenchmark/Common.hs @@ -35,14 +35,13 @@ import PlutusBenchmark.ProtocolParameters as PP import PlutusLedgerApi.Common qualified as LedgerApi -import PlutusTx qualified as Tx - import PlutusCore qualified as PLC import PlutusCore.Default import PlutusCore.Evaluation.Machine.ExBudget (ExBudget (..)) import PlutusCore.Evaluation.Machine.ExBudgetingDefaults qualified as PLC import PlutusCore.Evaluation.Machine.ExMemory (ExCPU (..), ExMemory (..)) +import PlutusTx.Test.Util.Compiled import UntypedPlutusCore qualified as UPLC import UntypedPlutusCore.Evaluation.Machine.Cek as Cek import UntypedPlutusCore.Evaluation.Machine.Cek qualified as UPLC @@ -52,7 +51,6 @@ import Criterion.Main import Criterion.Types (Config (..)) import Data.ByteString qualified as BS import Data.SatInt (fromSatInt) -import Data.Text (Text) import Flat qualified import GHC.IO.Encoding (setLocaleEncoding) import System.Directory @@ -78,58 +76,6 @@ getConfig limit = do timeLimit = limit } -type Term = UPLC.Term PLC.NamedDeBruijn DefaultUni DefaultFun () -type Program = UPLC.Program PLC.NamedDeBruijn DefaultUni DefaultFun () - -{- | Given a DeBruijn-named term, give every variable the name "v". If we later - call unDeBruijn, that will rename the variables to things like "v123", where - 123 is the relevant de Bruijn index.-} -toNamedDeBruijnTerm - :: UPLC.Term UPLC.DeBruijn DefaultUni DefaultFun () - -> UPLC.Term UPLC.NamedDeBruijn DefaultUni DefaultFun () -toNamedDeBruijnTerm = UPLC.termMapNames UPLC.fakeNameDeBruijn - -{- | Remove the textual names from a NamedDeBruijn term -} -toAnonDeBruijnTerm - :: Term - -> UPLC.Term UPLC.DeBruijn DefaultUni DefaultFun () -toAnonDeBruijnTerm = UPLC.termMapNames UPLC.unNameDeBruijn - -toAnonDeBruijnProg - :: UPLC.Program UPLC.NamedDeBruijn DefaultUni DefaultFun () - -> UPLC.Program UPLC.DeBruijn DefaultUni DefaultFun () -toAnonDeBruijnProg (UPLC.Program () ver body) = - UPLC.Program () ver $ toAnonDeBruijnTerm body - - -{- | Just extract the body of a program wrapped in a 'CompiledCodeIn'. We use this a lot. -} -compiledCodeToTerm - :: Tx.CompiledCodeIn DefaultUni DefaultFun a -> Term -compiledCodeToTerm (Tx.getPlcNoAnn -> UPLC.Program _ _ body) = body - -{- | Lift a Haskell value to a PLC term. The constraints get a bit out of control - if we try to do this over an arbitrary universe.-} -haskellValueToTerm - :: Tx.Lift DefaultUni a => a -> Term -haskellValueToTerm = compiledCodeToTerm . Tx.liftCodeDef - -{- | Just run a term to obtain an `EvaluationResult` (used for tests etc.) -} -unsafeRunTermCek :: Term -> EvaluationResult Term -unsafeRunTermCek = - unsafeToEvaluationResult - . (\(res, _, _) -> res) - . runCekDeBruijn PLC.defaultCekParametersForTesting Cek.restrictingEnormous Cek.noEmitter - --- | Just run a term. -runTermCek :: - Term -> - ( Either (CekEvaluationException UPLC.NamedDeBruijn DefaultUni DefaultFun) Term - , [Text] - ) -runTermCek = - (\(res, _, logs) -> (res, logs)) - . runCekDeBruijn PLC.defaultCekParametersForTesting Cek.restrictingEnormous Cek.logEmitter - -- | Evaluate a script and return the CPU and memory costs (according to the cost model) getCostsCek :: UPLC.Program UPLC.NamedDeBruijn DefaultUni DefaultFun () -> (Integer, Integer) getCostsCek (UPLC.Program _ _ prog) = @@ -138,21 +84,6 @@ getCostsCek (UPLC.Program _ _ prog) = let ExBudget (ExCPU cpu)(ExMemory mem) = budget in (fromSatInt cpu, fromSatInt mem) -{- | Evaluate a PLC term and check that the result matches a given Haskell value - (perhaps obtained by running the Haskell code that the term was compiled - from). We evaluate the lifted Haskell value as well, because lifting may - produce reducible terms. The function is polymorphic in the comparison - operator so that we can use it with both HUnit Assertions and QuickCheck - Properties. -} -cekResultMatchesHaskellValue - :: Tx.Lift DefaultUni a - => Term - -> (EvaluationResult Term -> EvaluationResult Term -> b) - -> a - -> b -cekResultMatchesHaskellValue term matches value = - (unsafeRunTermCek term) `matches` (unsafeRunTermCek $ haskellValueToTerm value) - -- | Create the evaluation context for the benchmarks. This doesn't exactly match how it's done -- on-chain, but that's okay because the evaluation context is cached by the ledger, so we're -- deliberately not including it in the benchmarks. diff --git a/plutus-benchmark/plutus-benchmark.cabal b/plutus-benchmark/plutus-benchmark.cabal index ec454bb1e99..35a906f7ddf 100644 --- a/plutus-benchmark/plutus-benchmark.cabal +++ b/plutus-benchmark/plutus-benchmark.cabal @@ -83,20 +83,19 @@ library plutus-benchmark-common other-modules: Paths_plutus_benchmark build-depends: - , base >=4.9 && <5 + , base >=4.9 && <5 , bytestring , criterion , deepseq , directory , filepath - , flat ^>=0.6 - , plutus-core ^>=1.28 - , plutus-ledger-api ^>=1.28 - , plutus-tx ^>=1.28 + , flat ^>=0.6 + , plutus-core ^>=1.28 + , plutus-ledger-api ^>=1.28 + , plutus-tx-test-util , tasty , tasty-golden , temporary - , text ---------------- nofib ----------------