From 7185604532eaeada462fde60abe7e6546892f92c Mon Sep 17 00:00:00 2001 From: Yura Lazarev Date: Wed, 27 Mar 2024 10:24:48 +0100 Subject: [PATCH 1/2] PLT-8659 UPLC term order evaluator takes into account builtin argument saturation (#5850) * UPLC term order evaluator takes into account builtin argument saturation * Use factual builtin arity when doing CSE * Changelog entry --- .../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 +- ...093efe7bc76d6322aed6ddb582ad.budget.golden | 4 +- ...0cfd0cbf7fd4a372b0dc59fa17e1.budget.golden | 4 +- ..._Yuriy.Lazaryev_term_eval_order_builtin.md | 3 + plutus-core/executables/pir/Main.hs | 16 +- plutus-core/executables/uplc/Main.hs | 27 ++-- plutus-core/plutus-core.cabal | 2 + .../plutus-core/src/PlutusCore/Arity.hs | 2 +- .../plutus-core/src/PlutusCore/Compiler.hs | 49 +++--- .../src/PlutusCore/Compiler/Opts.hs | 27 ++++ plutus-core/plutus-ir/src/PlutusIR/Purity.hs | 2 +- plutus-core/testlib/PlutusCore/Test.hs | 17 +- .../src/UntypedPlutusCore/Purity.hs | 151 +++++++++++------- .../src/UntypedPlutusCore/Simplify.hs | 64 +++----- .../src/UntypedPlutusCore/Simplify/Opts.hs | 35 ++++ .../src/UntypedPlutusCore/Transform/Cse.hs | 82 ++++------ .../src/UntypedPlutusCore/Transform/Inline.hs | 69 ++++---- .../untyped-plutus-core/test/Analysis/Spec.hs | 9 +- .../test/Transform/Simplify.hs | 4 + plutus-tx-plugin/src/PlutusTx/Plugin.hs | 1 + .../9.6/patternMatching-budget.budget.golden | 4 +- .../Budget/9.6/patternMatching.uplc.golden | 58 +++---- .../recordFields-budget-manual.budget.golden | 4 +- .../9.6/recordFields-budget.budget.golden | 4 +- .../9.6/recordFields-manual.uplc.golden | 43 +++-- .../Budget/9.6/recordFields.uplc.golden | 42 +++-- plutus-tx/src/PlutusTx/Lift.hs | 14 +- 34 files changed, 410 insertions(+), 359 deletions(-) create mode 100644 plutus-core/changelog.d/20240326_133744_Yuriy.Lazaryev_term_eval_order_builtin.md create mode 100644 plutus-core/plutus-core/src/PlutusCore/Compiler/Opts.hs create mode 100644 plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Simplify/Opts.hs 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 0c894f49b3b..474592cbc22 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: 282508764 -| mem: 856552}) \ No newline at end of file +({cpu: 281818764 +| mem: 853552}) \ 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 b87ef01cc67..e75f5e5b4eb 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: 23474602554 -| mem: 69678832}) \ No newline at end of file +({cpu: 23467702554 +| mem: 69648832}) \ 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 10e33794b97..4cf43930822 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: 85015834 -| mem: 263092}) \ No newline at end of file +({cpu: 84670834 +| mem: 261592}) \ 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 2f59ed59f36..1f5311f1f50 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: 5996604004 -| mem: 17844232}) \ No newline at end of file +({cpu: 5993154004 +| mem: 17829232}) \ 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 3e81ace971a..31fdb61bd3b 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: 188350620 -| mem: 557080}) \ No newline at end of file +({cpu: 187660620 +| mem: 554080}) \ 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 b2cd5dbfdd5..83de61dc0d8 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: 14193534300 -| mem: 39720400}) \ No newline at end of file +({cpu: 14186634300 +| mem: 39690400}) \ 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 eef5903952d..3b3f8254872 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: 61018710 -| mem: 188240}) \ No newline at end of file +({cpu: 60673710 +| mem: 186740}) \ 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 ef00d0010d3..75abae85e80 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: 3672944700 -| mem: 10355000}) \ No newline at end of file +({cpu: 3669494700 +| mem: 10340000}) \ No newline at end of file diff --git a/plutus-benchmark/marlowe/test/semantics/9.6/18cefc240debc0fcab14efdd451adfd02793093efe7bc76d6322aed6ddb582ad.budget.golden b/plutus-benchmark/marlowe/test/semantics/9.6/18cefc240debc0fcab14efdd451adfd02793093efe7bc76d6322aed6ddb582ad.budget.golden index 781ac7c0251..17394f2d300 100644 --- a/plutus-benchmark/marlowe/test/semantics/9.6/18cefc240debc0fcab14efdd451adfd02793093efe7bc76d6322aed6ddb582ad.budget.golden +++ b/plutus-benchmark/marlowe/test/semantics/9.6/18cefc240debc0fcab14efdd451adfd02793093efe7bc76d6322aed6ddb582ad.budget.golden @@ -1,2 +1,2 @@ -({cpu: 951958685 -| mem: 3466381}) \ No newline at end of file +({cpu: 951682685 +| mem: 3465181}) \ No newline at end of file diff --git a/plutus-benchmark/marlowe/test/semantics/9.6/82213dfdb6a812b40446438767c61a388d2c0cfd0cbf7fd4a372b0dc59fa17e1.budget.golden b/plutus-benchmark/marlowe/test/semantics/9.6/82213dfdb6a812b40446438767c61a388d2c0cfd0cbf7fd4a372b0dc59fa17e1.budget.golden index 67abab70d12..7c516832020 100644 --- a/plutus-benchmark/marlowe/test/semantics/9.6/82213dfdb6a812b40446438767c61a388d2c0cfd0cbf7fd4a372b0dc59fa17e1.budget.golden +++ b/plutus-benchmark/marlowe/test/semantics/9.6/82213dfdb6a812b40446438767c61a388d2c0cfd0cbf7fd4a372b0dc59fa17e1.budget.golden @@ -1,2 +1,2 @@ -({cpu: 1499682480 -| mem: 4967076}) \ No newline at end of file +({cpu: 1499268480 +| mem: 4965276}) \ No newline at end of file diff --git a/plutus-core/changelog.d/20240326_133744_Yuriy.Lazaryev_term_eval_order_builtin.md b/plutus-core/changelog.d/20240326_133744_Yuriy.Lazaryev_term_eval_order_builtin.md new file mode 100644 index 00000000000..8c36f5a76eb --- /dev/null +++ b/plutus-core/changelog.d/20240326_133744_Yuriy.Lazaryev_term_eval_order_builtin.md @@ -0,0 +1,3 @@ +### Changed + +- Partially applied builtins are estimated to be pure and work-free to better inform other optimizations, e.g. common subexpression elimination. diff --git a/plutus-core/executables/pir/Main.hs b/plutus-core/executables/pir/Main.hs index bfdf2b19dcc..9590fb1c7f9 100644 --- a/plutus-core/executables/pir/Main.hs +++ b/plutus-core/executables/pir/Main.hs @@ -1,6 +1,5 @@ -- editorconfig-checker-disable-file {-# LANGUAGE DeriveAnyClass #-} -{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TypeApplications #-} @@ -101,7 +100,7 @@ pOptimise :: Parser Bool pOptimise = flag True False ( long "dont-optimise" <> long "dont-optimize" - <> help ("Turn off optimisations") + <> help "Turn off optimisations" ) pJustTest :: Parser Bool @@ -133,7 +132,7 @@ pPirOptions = hsubparser $ "and test if it can be successfully compiled to PLC.") <> command "convert" (info (Convert <$> pPirConvertOptions) - (progDesc $ "Convert a program between textual and flat-named format.")) + (progDesc "Convert a program between textual and flat-named format.")) <> command "optimise" (optimise "Run the PIR optimisation pipeline on the input.") <> command "optimize" (optimise "Same as 'optimise'.") <> command "print" @@ -153,7 +152,7 @@ compileToPlc optimise p = do plcTcConfig <- PLC.getDefTypeCheckConfig PIR.noProvenance let ctx = getCtx plcTcConfig plcProg <- runExcept $ flip runReaderT ctx $ runQuoteT $ PIR.compileProgram p - pure $ () <$ plcProg + pure $ void plcProg where getCtx :: PLC.TypeCheckConfig PLC.DefaultUni PLC.DefaultFun -> PIR.CompilationCtx PLC.DefaultUni PLC.DefaultFun a @@ -169,7 +168,8 @@ compileToUplc optimise plcProg = let plcCompilerOpts = if optimise then PLC.defaultCompilationOpts - else PLC.defaultCompilationOpts & PLC.coSimplifyOpts . UPLC.soMaxSimplifierIterations .~ 0 + else PLC.defaultCompilationOpts + & PLC.coSimplifyOpts . UPLC.soMaxSimplifierIterations .~ 0 in flip runReader plcCompilerOpts $ runQuoteT $ PLC.compileProgram plcProg loadPirAndCompile :: CompileOptions -> IO () @@ -177,7 +177,7 @@ loadPirAndCompile (CompileOptions language optimise test inp ifmt outp ofmt mode pirProg <- readProgram (pirFormatToFormat ifmt) inp when test $ putStrLn "!!! Compiling" -- Now compile to plc, maybe optimising - case compileToPlc optimise (() <$ pirProg) of + case compileToPlc optimise (void pirProg) of Left pirError -> error $ show pirError Right plcProg -> case language of @@ -213,7 +213,7 @@ runOptimisations (PirOptimiseOptions inp ifmt outp ofmt mode) = do case doOptimisations term of Left e -> error $ show e Right t -> writeProgram outp (pirFormatToFormat ofmt) mode - (Program () PLC.latestVersion(() <$ t)) + (Program () PLC.latestVersion(void t)) ---------------- Analysis ---------------- @@ -229,7 +229,7 @@ loadPirAndAnalyse :: AnalyseOptions -> IO () loadPirAndAnalyse (AnalyseOptions inp ifmt outp) = do -- load pir and make sure that it is globally unique (required for retained size) p :: PirProg PLC.SrcSpan <- readProgram (pirFormatToFormat ifmt) inp - let PIR.Program _ _ term = PLC.runQuote . PLC.rename $ () <$ p + let PIR.Program _ _ term = PLC.runQuote . PLC.rename $ void p putStrLn "!!! Analysing for retention" let -- all the variable names (tynames coerced to names) diff --git a/plutus-core/executables/uplc/Main.hs b/plutus-core/executables/uplc/Main.hs index aac5247bdee..ffb6b6b689a 100644 --- a/plutus-core/executables/uplc/Main.hs +++ b/plutus-core/executables/uplc/Main.hs @@ -251,13 +251,15 @@ plutusOpts = hsubparser $ ---------------- Optimisation ---------------- -- | Run the UPLC optimisations -runOptimisations:: OptimiseOptions -> IO () +runOptimisations :: OptimiseOptions -> IO () runOptimisations (OptimiseOptions inp ifmt outp ofmt mode) = do - prog <- readProgram ifmt inp :: IO (UplcProg SrcSpan) - simplified <- PLC.runQuoteT $ do - renamed <- PLC.rename prog - UPLC.simplifyProgram UPLC.defaultSimplifyOpts renamed - writeProgram outp ofmt mode simplified + prog <- readProgram ifmt inp :: IO (UplcProg SrcSpan) + simplified <- PLC.runQuoteT $ do + renamed <- PLC.rename prog + let defaultBuiltinSemanticsVariant :: BuiltinSemanticsVariant PLC.DefaultFun + defaultBuiltinSemanticsVariant = def + UPLC.simplifyProgram UPLC.defaultSimplifyOpts defaultBuiltinSemanticsVariant renamed + writeProgram outp ofmt mode simplified ---------------- Script application ---------------- @@ -265,7 +267,7 @@ runOptimisations (OptimiseOptions inp ifmt outp ofmt mode) = do -- scripts must be UPLC.Program objects. runApply :: ApplyOptions -> IO () runApply (ApplyOptions inputfiles ifmt outp ofmt mode) = do - scripts <- mapM ((readProgram ifmt :: Input -> IO (UplcProg SrcSpan)) . FileInput) inputfiles + scripts <- mapM ((readProgram ifmt :: Input -> IO (UplcProg SrcSpan)) . FileInput) inputfiles let appliedScript = case void <$> scripts of [] -> errorWithoutStackTrace "No input files" @@ -282,16 +284,15 @@ runApplyToData (ApplyOptions inputfiles ifmt outp ofmt mode) = p:ds -> do prog@(UPLC.Program _ version _) :: UplcProg SrcSpan <- readProgram ifmt (FileInput p) args <- mapM (getDataObject version) ds - let prog' = () <$ prog + let prog' = void prog appliedScript = foldl1 (unsafeFromRight .* UPLC.applyProgram) (prog':args) writeProgram outp ofmt mode appliedScript where getDataObject :: UPLC.Version -> FilePath -> IO (UplcProg ()) getDataObject ver path = do bs <- BSL.readFile path case unflat bs of - Left err -> fail ("Error reading " ++ show path ++ ": " ++ show err) - Right (d :: Data) -> - pure $ UPLC.Program () ver $ mkConstant () d + Left err -> fail ("Error reading " ++ show path ++ ": " ++ show err) + Right (d :: Data) -> pure $ UPLC.Program () ver $ mkConstant () d ---------------- Benchmarking ---------------- @@ -300,7 +301,7 @@ runBenchmark (BenchmarkOptions inp ifmt semvar timeLim) = do prog <- readProgram ifmt inp let criterionConfig = defaultConfig {reportFile = Nothing, timeLimit = timeLim} cekparams = mkMachineParameters semvar PLC.defaultCekCostModel - getResult (x,_,_) = either (error . show) (\_ -> ()) x -- Extract an evaluation result + getResult (x,_,_) = either (error . show) (const ()) x -- Extract an evaluation result evaluate = getResult . Cek.runCekDeBruijn cekparams Cek.restrictingEnormous Cek.noEmitter -- readProgam throws away De Bruijn indices and returns an AST with Names; -- we have to put them back to get an AST with NamedDeBruijn names. @@ -309,7 +310,7 @@ runBenchmark (BenchmarkOptions inp ifmt semvar timeLim) = do -- Big names slow things down !anonTerm = UPLC.termMapNames (\(PLC.NamedDeBruijn _ i) -> PLC.NamedDeBruijn "" i) term -- Big annotations slow things down - !unitAnnTerm = force (() <$ anonTerm) + !unitAnnTerm = force (void anonTerm) benchmarkWith criterionConfig $! whnf evaluate unitAnnTerm ---------------- Evaluation ---------------- diff --git a/plutus-core/plutus-core.cabal b/plutus-core/plutus-core.cabal index 86ade0cf9fd..337d425bc4a 100644 --- a/plutus-core/plutus-core.cabal +++ b/plutus-core/plutus-core.cabal @@ -98,6 +98,7 @@ library PlutusCore.Check.Value PlutusCore.Compiler PlutusCore.Compiler.Erase + PlutusCore.Compiler.Opts PlutusCore.Compiler.Types PlutusCore.Core PlutusCore.Crypto.BLS12_381.Error @@ -256,6 +257,7 @@ library UntypedPlutusCore.Mark UntypedPlutusCore.Rename.Internal UntypedPlutusCore.Simplify + UntypedPlutusCore.Simplify.Opts UntypedPlutusCore.Size UntypedPlutusCore.Subst UntypedPlutusCore.Transform.CaseOfCase diff --git a/plutus-core/plutus-core/src/PlutusCore/Arity.hs b/plutus-core/plutus-core/src/PlutusCore/Arity.hs index 6a0ff949623..301249ab1c5 100644 --- a/plutus-core/plutus-core/src/PlutusCore/Arity.hs +++ b/plutus-core/plutus-core/src/PlutusCore/Arity.hs @@ -45,4 +45,4 @@ builtinArity -> Arity builtinArity _ semvar fun = case toBuiltinMeaning @uni @fun @(Term TyName Name uni fun ()) semvar fun of - BuiltinMeaning sch _ _ -> typeSchemeArity sch + BuiltinMeaning sch _ _ -> typeSchemeArity sch diff --git a/plutus-core/plutus-core/src/PlutusCore/Compiler.hs b/plutus-core/plutus-core/src/PlutusCore/Compiler.hs index 4733ab1a756..1d9404fefdd 100644 --- a/plutus-core/plutus-core/src/PlutusCore/Compiler.hs +++ b/plutus-core/plutus-core/src/PlutusCore/Compiler.hs @@ -1,45 +1,36 @@ -{-# LANGUAGE TemplateHaskell #-} -module PlutusCore.Compiler ( - compileTerm - , compileProgram - , CompilationOpts (..) - , coSimplifyOpts - , defaultCompilationOpts - ) where +module PlutusCore.Compiler + ( module Opts + , compileTerm + , compileProgram + ) where import PlutusCore.Compiler.Erase import PlutusCore.Compiler.Types import PlutusCore.Core import PlutusCore.Name.Unique import PlutusCore.Rename -import UntypedPlutusCore.Core qualified as UPLC +import UntypedPlutusCore.Core.Type qualified as UPLC import UntypedPlutusCore.Simplify qualified as UPLC -import Control.Lens -import Control.Monad.Reader - -newtype CompilationOpts name a = CompilationOpts { _coSimplifyOpts :: UPLC.SimplifyOpts name a } - deriving stock (Show) - -makeLenses ''CompilationOpts - -defaultCompilationOpts :: CompilationOpts name a -defaultCompilationOpts = CompilationOpts { _coSimplifyOpts = UPLC.defaultSimplifyOpts } +import Control.Lens (view) +import Control.Monad.Reader (MonadReader) +import PlutusCore.Compiler.Opts as Opts -- | Compile a PLC term to UPLC, and optimize it. compileTerm - :: (Compiling m uni fun name a, MonadReader (CompilationOpts name a) m) - => Term tyname name uni fun a - -> m (UPLC.Term name uni fun a) + :: (Compiling m uni fun name a, MonadReader (CompilationOpts name fun a) m) + => Term tyname name uni fun a + -> m (UPLC.Term name uni fun a) compileTerm t = do - simplOpts <- asks _coSimplifyOpts - let erased = eraseTerm t - renamed <- rename erased - UPLC.simplifyTerm simplOpts renamed + simplOpts <- view coSimplifyOpts + builtinSemanticsVariant <- view coBuiltinSemanticsVariant + let erased = eraseTerm t + renamed <- rename erased + UPLC.simplifyTerm simplOpts builtinSemanticsVariant renamed -- | Compile a PLC program to UPLC, and optimize it. compileProgram - :: (Compiling m uni fun name a, MonadReader (CompilationOpts name a) m) - => Program tyname name uni fun a - -> m (UPLC.Program name uni fun a) + :: (Compiling m uni fun name a, MonadReader (CompilationOpts name fun a) m) + => Program tyname name uni fun a + -> m (UPLC.Program name uni fun a) compileProgram (Program a v t) = UPLC.Program a v <$> compileTerm t diff --git a/plutus-core/plutus-core/src/PlutusCore/Compiler/Opts.hs b/plutus-core/plutus-core/src/PlutusCore/Compiler/Opts.hs new file mode 100644 index 00000000000..ea08279ff83 --- /dev/null +++ b/plutus-core/plutus-core/src/PlutusCore/Compiler/Opts.hs @@ -0,0 +1,27 @@ +{-# LANGUAGE TemplateHaskell #-} + +module PlutusCore.Compiler.Opts + ( CompilationOpts (..) + , coSimplifyOpts + , coBuiltinSemanticsVariant + , defaultCompilationOpts + ) where + +import Control.Lens (makeLenses) +import Data.Default.Class (Default (def)) +import PlutusCore.Builtin.Meaning (BuiltinSemanticsVariant) +import UntypedPlutusCore.Simplify.Opts (SimplifyOpts, defaultSimplifyOpts) + +data CompilationOpts name fun a = CompilationOpts + { _coSimplifyOpts :: SimplifyOpts name a + , _coBuiltinSemanticsVariant :: BuiltinSemanticsVariant fun + } + +$(makeLenses ''CompilationOpts) + +defaultCompilationOpts :: (Default (BuiltinSemanticsVariant fun)) => CompilationOpts name fun a +defaultCompilationOpts = + CompilationOpts + { _coSimplifyOpts = defaultSimplifyOpts + , _coBuiltinSemanticsVariant = def + } diff --git a/plutus-core/plutus-ir/src/PlutusIR/Purity.hs b/plutus-core/plutus-ir/src/PlutusIR/Purity.hs index 4871874be33..f189bb97ba6 100644 --- a/plutus-core/plutus-ir/src/PlutusIR/Purity.hs +++ b/plutus-core/plutus-ir/src/PlutusIR/Purity.hs @@ -248,7 +248,7 @@ termEvaluationOrder binfo vinfo = goTerm -- TODO: previous definition of work-free included this, it's slightly -- unclear if we should do since we do update partial builtin meanings -- etc. - -- If it's unsaturated, we definitely don't, and don't do any work + -- If it's unsaturated, we definitely don't do any work Just Undersaturated -> pureWorkFree -- Don't know, be conservative Nothing -> maybeImpureWork diff --git a/plutus-core/testlib/PlutusCore/Test.hs b/plutus-core/testlib/PlutusCore/Test.hs index 25dfdfffd81..2a376051637 100644 --- a/plutus-core/testlib/PlutusCore/Test.hs +++ b/plutus-core/testlib/PlutusCore/Test.hs @@ -151,12 +151,15 @@ instance ToUPlc (UPLC.Program TPLC.Name uni fun ()) uni fun where toUPlc = pure instance - ( TPLC.Typecheckable uni fun - , Hashable fun - ) - => ToUPlc (TPLC.Program TPLC.TyName UPLC.Name uni fun ()) uni fun where - toUPlc = - pure . TPLC.runQuote . flip runReaderT TPLC.defaultCompilationOpts . TPLC.compileProgram + ( TPLC.Typecheckable uni fun + , Hashable fun + ) + => ToUPlc (TPLC.Program TPLC.TyName UPLC.Name uni fun ()) uni fun where + toUPlc = + pure + . TPLC.runQuote + . flip runReaderT TPLC.defaultCompilationOpts + . TPLC.compileProgram instance ToUPlc (UPLC.Program UPLC.NamedDeBruijn uni fun ()) uni fun where toUPlc p = @@ -294,7 +297,7 @@ runUPlcProfile' values = do (res, UPLC.CountingSt _, logs) = UPLC.runCek TPLC.defaultCekParameters UPLC.counting UPLC.logWithBudgetEmitter t case res of - Left err -> throwError (SomeException $ err) + Left err -> throwError (SomeException err) Right _ -> pure logs ppCatch :: (PrettyPlc a) => ExceptT SomeException IO a -> IO (Doc ann) diff --git a/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Purity.hs b/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Purity.hs index 9f4d9ae8468..3197f5d9cb3 100644 --- a/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Purity.hs +++ b/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Purity.hs @@ -4,7 +4,9 @@ {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} {-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE ViewPatterns #-} -- Stripped-down version of PlutusIR.Purity module UntypedPlutusCore.Purity @@ -18,8 +20,12 @@ module UntypedPlutusCore.Purity ) where import Data.DList qualified as DList +import Data.Typeable (Proxy (..)) +import PlutusCore.Arity (builtinArity) +import PlutusCore.Builtin.Meaning (ToBuiltinMeaning (..)) import PlutusCore.Pretty (Pretty (pretty), PrettyBy (prettyBy)) import Prettyprinter (vsep, (<+>)) +import UntypedPlutusCore.Core (splitApplication) import UntypedPlutusCore.Core.Type (Term (..)) -- | Is this pure? Either yes, or maybe not. @@ -73,10 +79,7 @@ unEvalOrder (EvalOrder ts) = evalThis :: EvalTerm name uni fun a -> EvalOrder name uni fun a evalThis = EvalOrder . DList.singleton -instance - (PrettyBy config (Term name uni fun a)) - => PrettyBy config (EvalOrder name uni fun a) - where +instance (PrettyBy config (Term name uni fun a)) => PrettyBy config (EvalOrder name uni fun a) where prettyBy config eo = vsep $ fmap (prettyBy config) (unEvalOrder eo) {- | Given a term, return the order in which it and its sub-terms will be evaluated. @@ -89,70 +92,90 @@ This makes some assumptions about the evaluator, in particular about the order i which we evaluate sub-terms, but these match the current evaluator and we are not planning on changing it. -} -termEvaluationOrder :: forall name uni fun a. Term name uni fun a -> EvalOrder name uni fun a -termEvaluationOrder = \case - t@(Apply _ fun arg) -> - -- first the function - termEvaluationOrder fun - -- then the arg - <> termEvaluationOrder arg - -- then the whole term, which means environment manipulation, so work - <> evalThis (EvalTerm Pure MaybeWork t) - <> case fun of - -- known function body - LamAbs _ _ body -> termEvaluationOrder body - -- unknown function body - _ -> evalThis Unknown - t@(Force _ dterm) -> - -- first delayed term - termEvaluationOrder dterm - -- then the whole term, which will mean forcing, so work - <> evalThis (EvalTerm Pure MaybeWork t) - <> case dterm of - -- known delayed term - Delay _ body -> termEvaluationOrder body - -- unknown delayed term - _ -> evalThis Unknown - t@(Constr _ _ ts) -> - -- first the arguments, in left-to-right order - foldMap termEvaluationOrder ts - -- then the whole term, which means constructing the value, so work - <> evalThis (EvalTerm Pure MaybeWork t) - t@(Case _ scrut _) -> - -- first the scrutinee - termEvaluationOrder scrut - -- then the whole term, which means finding the case so work - <> evalThis (EvalTerm Pure MaybeWork t) - -- then we go to an unknown scrutinee - <> evalThis Unknown - -- Leaf terms - t@Var{} -> - evalThis (EvalTerm Pure WorkFree t) - t@Error{} -> - -- definitely effectful! but not relevant from a work perspective - evalThis (EvalTerm MaybeImpure WorkFree t) - -- program terminates - <> evalThis Unknown - t@Builtin{} -> - evalThis (EvalTerm Pure WorkFree t) - t@Delay{} -> - evalThis (EvalTerm Pure WorkFree t) - t@LamAbs{} -> - evalThis (EvalTerm Pure WorkFree t) - t@Constant{} -> - evalThis (EvalTerm Pure WorkFree t) +termEvaluationOrder + :: forall name uni fun a + . (ToBuiltinMeaning uni fun) + => BuiltinSemanticsVariant fun + -> Term name uni fun a + -> EvalOrder name uni fun a +termEvaluationOrder builtinSemanticsVariant = goTerm + where + goTerm = \case + t@(splitApplication -> (Builtin _ann fun, args)) -> + foldMap (goTerm . snd) args <> evalOrder + where + evalOrder = + if length args < length (builtinArity @uni @fun (Proxy @uni) builtinSemanticsVariant fun) + then -- If it's unsaturated, we definitely don't do any work + evalThis (EvalTerm Pure WorkFree t) + else -- If it's saturated or oversaturated, we might have an effect here + evalThis (EvalTerm MaybeImpure MaybeWork t) + t@(Apply _ fun arg) -> + -- first the function + goTerm fun + -- then the arg + <> goTerm arg + -- then the whole term, which means environment manipulation, so work + <> evalThis (EvalTerm Pure MaybeWork t) + <> case fun of + -- known function body + LamAbs _ _ body -> goTerm body + -- unknown function body + _ -> evalThis Unknown + t@(Force _ dterm) -> + -- first delayed term + goTerm dterm + -- then the whole term, which will mean forcing, so work + <> evalThis (EvalTerm Pure MaybeWork t) + <> case dterm of + -- known delayed term + Delay _ body -> goTerm body + -- unknown delayed term + _ -> evalThis Unknown + t@(Constr _ _ ts) -> + -- first the arguments, in left-to-right order + foldMap goTerm ts + -- then the whole term, which means constructing the value, so work + <> evalThis (EvalTerm Pure MaybeWork t) + t@(Case _ scrut _) -> + -- first the scrutinee + goTerm scrut + -- then the whole term, which means finding the case so work + <> evalThis (EvalTerm Pure MaybeWork t) + -- then we go to an unknown scrutinee + <> evalThis Unknown + -- Leaf terms + t@Var{} -> + evalThis (EvalTerm Pure WorkFree t) + t@Error{} -> + -- definitely effectful! but not relevant from a work perspective + evalThis (EvalTerm MaybeImpure WorkFree t) + -- program terminates + <> evalThis Unknown + t@Builtin{} -> + evalThis (EvalTerm Pure WorkFree t) + t@Delay{} -> + evalThis (EvalTerm Pure WorkFree t) + t@LamAbs{} -> + evalThis (EvalTerm Pure WorkFree t) + t@Constant{} -> + evalThis (EvalTerm Pure WorkFree t) {- | Will evaluating this term have side effects (looping or error)? This is slightly wider than the definition of a value, as it includes applications that are known to be pure, as well as things that can't be returned from the machine (as they'd be ill-scoped). -} -isPure :: Term name uni fun a -> Bool -isPure t = +isPure + :: (ToBuiltinMeaning uni fun) + => BuiltinSemanticsVariant fun + -> Term name uni fun a + -> Bool +isPure builtinSemanticsVariant term = -- to work out if the term is pure, we see if we can look through -- the whole evaluation order without hitting something that might be -- effectful - go $ unEvalOrder (termEvaluationOrder t) + go (unEvalOrder (termEvaluationOrder builtinSemanticsVariant term)) where go :: [EvalTerm name uni fun a] -> Bool go [] = True @@ -169,12 +192,16 @@ isPure t = Note: The definition of 'work-free' is a little unclear, but the idea is that evaluating this term should do very a trivial amount of work. -} -isWorkFree :: Term name uni fun a -> Bool -isWorkFree t = +isWorkFree + :: (ToBuiltinMeaning uni fun) + => BuiltinSemanticsVariant fun + -> Term name uni fun a + -> Bool +isWorkFree builtinSemanticsVariant term = -- to work out if the term is pure, we see if we can look through -- the whole evaluation order without hitting something that might be -- effectful - go $ unEvalOrder (termEvaluationOrder t) + go (unEvalOrder (termEvaluationOrder builtinSemanticsVariant term)) where go :: [EvalTerm name uni fun a] -> Bool go [] = True diff --git a/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Simplify.hs b/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Simplify.hs index da775302943..7908ca65709 100644 --- a/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Simplify.hs +++ b/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Simplify.hs @@ -1,17 +1,10 @@ {-# LANGUAGE GADTs #-} -{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeApplications #-} module UntypedPlutusCore.Simplify ( + module Opts, simplifyTerm, simplifyProgram, - SimplifyOpts (..), - soMaxSimplifierIterations, - soMaxCseIterations, - soInlineHints, - soConservativeOpts, - soInlineConstants, - defaultSimplifyOpts, InlineHints (..), ) where @@ -20,54 +13,36 @@ import PlutusCore.Default qualified as PLC import PlutusCore.Default.Builtins import PlutusCore.Name.Unique import UntypedPlutusCore.Core.Type +import UntypedPlutusCore.Simplify.Opts as Opts import UntypedPlutusCore.Transform.CaseOfCase import UntypedPlutusCore.Transform.CaseReduce import UntypedPlutusCore.Transform.Cse -import UntypedPlutusCore.Transform.FloatDelay -import UntypedPlutusCore.Transform.Inline +import UntypedPlutusCore.Transform.FloatDelay (floatDelay) +import UntypedPlutusCore.Transform.ForceDelay (forceDelay) +import UntypedPlutusCore.Transform.Inline (InlineHints (..), inline) -import Control.Lens.TH import Control.Monad import Data.List import Data.Typeable -import UntypedPlutusCore.Transform.ForceDelay (forceDelay) - -data SimplifyOpts name a = SimplifyOpts - { _soMaxSimplifierIterations :: Int - , _soMaxCseIterations :: Int - , _soConservativeOpts :: Bool - , _soInlineHints :: InlineHints name a - , _soInlineConstants :: Bool - } - deriving stock (Show) - -makeLenses ''SimplifyOpts - -defaultSimplifyOpts :: SimplifyOpts name a -defaultSimplifyOpts = - SimplifyOpts - { _soMaxSimplifierIterations = 12 - , _soMaxCseIterations = 4 - , _soConservativeOpts = False - , _soInlineHints = mempty - , _soInlineConstants = True - } simplifyProgram :: forall name uni fun m a. (Compiling m uni fun name a) => SimplifyOpts name a -> + BuiltinSemanticsVariant fun -> Program name uni fun a -> m (Program name uni fun a) -simplifyProgram opts (Program a v t) = Program a v <$> simplifyTerm opts t +simplifyProgram opts builtinSemanticsVariant (Program a v t) = + Program a v <$> simplifyTerm opts builtinSemanticsVariant t simplifyTerm :: forall name uni fun m a. (Compiling m uni fun name a) => SimplifyOpts name a -> + BuiltinSemanticsVariant fun -> Term name uni fun a -> m (Term name uni fun a) -simplifyTerm opts = +simplifyTerm opts builtinSemanticsVariant = simplifyNTimes (_soMaxSimplifierIterations opts) >=> cseNTimes cseTimes where -- Run the simplifier @n@ times @@ -82,20 +57,21 @@ simplifyTerm opts = -- generate simplification step simplifyStep :: Int -> Term name uni fun a -> m (Term name uni fun a) simplifyStep _ = - floatDelay - >=> pure . forceDelay - >=> pure . caseOfCase' - >=> pure . caseReduce - >=> inline (_soInlineConstants opts) (_soInlineHints opts) + floatDelay + >=> pure . forceDelay + >=> pure . caseOfCase' + >=> pure . caseReduce + >=> inline (_soInlineConstants opts) (_soInlineHints opts) builtinSemanticsVariant caseOfCase' :: Term name uni fun a -> Term name uni fun a caseOfCase' = case eqT @fun @DefaultFun of - Just Refl -> caseOfCase - Nothing -> id + Just Refl -> caseOfCase + Nothing -> id cseStep :: Int -> Term name uni fun a -> m (Term name uni fun a) - cseStep _ = case (eqT @name @Name, eqT @uni @PLC.DefaultUni) of - (Just Refl, Just Refl) -> cse + cseStep _ = + case (eqT @name @Name, eqT @uni @PLC.DefaultUni) of + (Just Refl, Just Refl) -> cse builtinSemanticsVariant _ -> pure cseTimes = if _soConservativeOpts opts then 0 else _soMaxCseIterations opts diff --git a/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Simplify/Opts.hs b/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Simplify/Opts.hs new file mode 100644 index 00000000000..8b232fb72cf --- /dev/null +++ b/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Simplify/Opts.hs @@ -0,0 +1,35 @@ +{-# LANGUAGE TemplateHaskell #-} + +module UntypedPlutusCore.Simplify.Opts + ( SimplifyOpts (..) + , soMaxSimplifierIterations + , soMaxCseIterations + , soInlineHints + , soConservativeOpts + , soInlineConstants + , defaultSimplifyOpts + ) where + +import Control.Lens.TH (makeLenses) +import PlutusCore.Annotation (InlineHints) + +data SimplifyOpts name a = SimplifyOpts + { _soMaxSimplifierIterations :: Int + , _soMaxCseIterations :: Int + , _soConservativeOpts :: Bool + , _soInlineHints :: InlineHints name a + , _soInlineConstants :: Bool + } + deriving stock (Show) + +$(makeLenses ''SimplifyOpts) + +defaultSimplifyOpts :: SimplifyOpts name a +defaultSimplifyOpts = + SimplifyOpts + { _soMaxSimplifierIterations = 12 + , _soMaxCseIterations = 4 + , _soConservativeOpts = False + , _soInlineHints = mempty + , _soInlineConstants = True + } diff --git a/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Transform/Cse.hs b/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Transform/Cse.hs index 8fa662fa38f..8e674f83c02 100644 --- a/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Transform/Cse.hs +++ b/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Transform/Cse.hs @@ -1,30 +1,33 @@ +{-# LANGUAGE BlockArguments #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TupleSections #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE TypeOperators #-} module UntypedPlutusCore.Transform.Cse (cse) where import PlutusCore (MonadQuote, Name, Rename, freshName, rename) +import PlutusCore.Builtin (ToBuiltinMeaning (BuiltinSemanticsVariant)) import UntypedPlutusCore.Core import UntypedPlutusCore.Purity (isWorkFree) -import UntypedPlutusCore.Size - -import Control.Lens -import Control.Monad -import Control.Monad.Trans.Class -import Control.Monad.Trans.Reader -import Control.Monad.Trans.State.Strict -import Data.Foldable -import Data.Hashable +import UntypedPlutusCore.Size (termSize) + +import Control.Arrow ((>>>)) +import Control.Lens (foldrOf, transformOf) +import Control.Monad (join, void) +import Control.Monad.Trans.Class (MonadTrans (lift)) +import Control.Monad.Trans.Reader (ReaderT (runReaderT), ask, local) +import Control.Monad.Trans.State.Strict (State, evalState, get, put) +import Data.Foldable (Foldable (foldl')) +import Data.Hashable (Hashable) import Data.HashMap.Strict (HashMap) import Data.HashMap.Strict qualified as Map -import Data.List.Extra -import Data.Ord -import Data.Traversable -import Data.Tuple.Extra +import Data.List.Extra (isSuffixOf, sortOn) +import Data.Ord (Down (..)) +import Data.Proxy (Proxy (..)) +import Data.Traversable (for) +import Data.Tuple.Extra (snd3, thd3) +import PlutusCore.Arity (builtinArity) {- Note [CSE] @@ -207,12 +210,13 @@ data CseCandidate uni fun ann = CseCandidate cse :: ( MonadQuote m , Hashable (Term Name uni fun ()) - , Hashable fun , Rename (Term Name uni fun ann) + , ToBuiltinMeaning uni fun ) => + BuiltinSemanticsVariant fun -> Term Name uni fun ann -> m (Term Name uni fun ann) -cse t0 = do +cse builtinSemanticsVariant t0 = do t <- rename t0 let annotated = annotate t commonSubexprs = @@ -224,24 +228,9 @@ cse t0 = do . filter ((> 1) . thd3) . join . Map.elems - $ countOccs (calcBuiltinArity t) annotated + $ countOccs builtinSemanticsVariant annotated mkCseTerm commonSubexprs annotated --- | The first pass. See Note [CSE]. -calcBuiltinArity :: - forall name uni fun ann. - (Hashable fun) => - Term name uni fun ann -> - HashMap fun Int -calcBuiltinArity = foldrOf termSubtermsDeep go Map.empty - where - go :: Term name uni fun ann -> HashMap fun Int -> HashMap fun Int - go = \case - t@Apply{} - | (Builtin _ fun, args) <- splitApplication t -> - Map.insertWith max fun (length args) - _ -> id - -- | The second pass. See Note [CSE]. annotate :: Term name uni fun ann -> Term name uni fun (Path, ann) annotate = flip evalState 0 . flip runReaderT [] . go @@ -279,14 +268,14 @@ annotate = flip evalState 0 . flip runReaderT [] . go -- | The third pass. See Note [CSE]. countOccs :: forall name uni fun ann. - (Hashable (Term name uni fun ()), Hashable fun) => - HashMap fun Int -> + (Hashable (Term name uni fun ()), ToBuiltinMeaning uni fun) => + BuiltinSemanticsVariant fun -> Term name uni fun (Path, ann) -> -- | Here, the value of the inner map not only contains the count, but also contains -- the annotated term, corresponding to the term that is the key of the outer map. -- The annotated terms need to be recorded since they will be used for substitution. HashMap (Term name uni fun ()) [(Path, Term name uni fun (Path, ann), Int)] -countOccs arityInfo = foldrOf termSubtermsDeep addToMap Map.empty +countOccs builtinSemanticsVariant = foldrOf termSubtermsDeep addToMap Map.empty where addToMap :: Term name uni fun (Path, ann) -> @@ -296,15 +285,14 @@ countOccs arityInfo = foldrOf termSubtermsDeep addToMap Map.empty -- We don't consider work-free terms for CSE, because doing so may or may not -- have a size benefit, but certainly doesn't have any cost benefit (the cost -- will in fact be slightly higher due to the additional application). - -- - -- `isWorkFree` currently doesn't check whether a builtin application is saturated, - -- or whether an term is the (possibly repeated) forcing of a builtin (which should - -- be workfree), so we check it separately. - | isWorkFree t0 || not (isBuiltinSaturated t0) || isForcingBuiltin t0 = id + | isWorkFree builtinSemanticsVariant t0 + || not (isBuiltinSaturated t0) + || isForcingBuiltin t0 = + id | otherwise = Map.alter ( \case - Nothing -> Just $ [(path, t0, 1)] + Nothing -> Just [(path, t0, 1)] Just paths -> Just $ combinePaths t0 path paths ) t @@ -312,11 +300,11 @@ countOccs arityInfo = foldrOf termSubtermsDeep addToMap Map.empty t = void t0 path = fst (termAnn t0) - isBuiltinSaturated = \case - t@Apply{} - | (Builtin _ fun, args) <- splitApplication t -> - length args >= Map.findWithDefault 0 fun arityInfo - _ -> True + isBuiltinSaturated = + splitApplication >>> \case + (Builtin _ fun, args) -> + length args >= length (builtinArity (Proxy @uni) builtinSemanticsVariant fun) + _term -> True isForcingBuiltin = \case Builtin{} -> True diff --git a/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Transform/Inline.hs b/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Transform/Inline.hs index da3916a6028..30b7dc4b45c 100644 --- a/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Transform/Inline.hs +++ b/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Transform/Inline.hs @@ -118,18 +118,20 @@ type InliningConstraints name uni fun = ) -- See Note [Differences from PIR inliner] 2 -data InlineInfo name a = InlineInfo - { _iiUsages :: Usages.Usages - , _iiHints :: InlineHints name a - , _iiInlineConstants :: Bool +data InlineInfo name fun a = InlineInfo + { _iiUsages :: Usages.Usages + , _iiHints :: InlineHints name a + , _iiBuiltinSemanticsVariant :: PLC.BuiltinSemanticsVariant fun + , _iiInlineConstants :: Bool } + makeLenses ''InlineInfo -- Using a concrete monad makes a very large difference to the performance of this module -- (determined from profiling) -- | The monad the inliner runs in. -type InlineM name uni fun a = ReaderT (InlineInfo name a) (StateT (S name uni fun a) Quote) +type InlineM name uni fun a = ReaderT (InlineInfo name fun a) (StateT (S name uni fun a) Quote) -- | Look up the unprocessed variable in the substitution. lookupTerm :: @@ -175,16 +177,16 @@ inline :: -- | inline constants Bool -> InlineHints name a -> + PLC.BuiltinSemanticsVariant fun -> Term name uni fun a -> m (Term name uni fun a) -inline inlineConstants hints t = - let - inlineInfo :: InlineInfo name a - inlineInfo = InlineInfo usgs hints inlineConstants - usgs :: Usages.Usages - usgs = Usages.termUsages t - in - liftQuote $ flip evalStateT mempty $ flip runReaderT inlineInfo $ processTerm t +inline inlineConstants hints builtinSemanticsVariant t = + liftQuote $ flip evalStateT mempty $ runReaderT (processTerm t) InlineInfo + { _iiUsages = Usages.termUsages t + , _iiHints = hints + , _iiBuiltinSemanticsVariant = builtinSemanticsVariant + , _iiInlineConstants = inlineConstants + } -- See Note [Differences from PIR inliner] 3 @@ -259,7 +261,7 @@ processSingleBinding body (Def vd@(UVarDecl a n) rhs0) = do VarInfo { _varBinders = binders , _varRhs = rhs - , _varRhsBody = (Done (dupable rhsBody)) + , _varRhsBody = Done (dupable rhsBody) } pure . Just $ Def vd rhs Nothing -> pure Nothing @@ -323,8 +325,10 @@ shouldUnconditionallyInline n rhs body = do pure isTermPure &&^ acceptable inlineConstants rhs -- | Check if term is pure. See Note [Inlining and purity] -checkPurity :: Term name uni fun a -> InlineM name uni fun a Bool -checkPurity t = pure $ isPure t +checkPurity :: PLC.ToBuiltinMeaning uni fun => Term name uni fun a -> InlineM name uni fun a Bool +checkPurity t = do + builtinSemanticsVariant <- view iiBuiltinSemanticsVariant + pure $ isPure builtinSemanticsVariant t nameUsedAtMostOnce :: forall name uni fun a. @@ -338,22 +342,25 @@ nameUsedAtMostOnce n = do isFirstVarBeforeEffects :: forall name uni fun ann. InliningConstraints name uni fun - => name -> Term name uni fun ann -> InlineM name uni fun ann Bool + => name + -> Term name uni fun ann + -> InlineM name uni fun ann Bool isFirstVarBeforeEffects n t = do - -- This can in the worst case traverse a lot of the term, which could lead to us - -- doing ~quadratic work as we process the program. However in practice most terms - -- have a relatively short evaluation order before we hit Unknown, so it's not too bad. - pure $ go (unEvalOrder (termEvaluationOrder t)) - where - -- Found the variable we're looking for! - go ((EvalTerm _ _ (Var _ n')):_) | n == n' = True - -- Found a pure term, ignore it and continue - go ((EvalTerm Pure _ _):rest) = go rest - -- Found a possibly impure term, our variable is definitely not first - go ((EvalTerm MaybeImpure _ _):_) = False - -- Don't know, be conservative - go (Unknown:_) = False - go [] = False + builtinSemanticsVariant <- view iiBuiltinSemanticsVariant + -- This can in the worst case traverse a lot of the term, which could lead to us + -- doing ~quadratic work as we process the program. However in practice most terms + -- have a relatively short evaluation order before we hit Unknown, so it's not too bad. + pure $ go (unEvalOrder (termEvaluationOrder builtinSemanticsVariant t)) + where + -- Found the variable we're looking for! + go ((EvalTerm _ _ (Var _ n')):_) | n == n' = True + -- Found a pure term, ignore it and continue + go ((EvalTerm Pure _ _):rest) = go rest + -- Found a possibly impure term, our variable is definitely not first + go ((EvalTerm MaybeImpure _ _):_) = False + -- Don't know, be conservative + go (Unknown:_) = False + go [] = False effectSafe :: forall name uni fun a. diff --git a/plutus-core/untyped-plutus-core/test/Analysis/Spec.hs b/plutus-core/untyped-plutus-core/test/Analysis/Spec.hs index bc63e4dc313..dd8e045dd4c 100644 --- a/plutus-core/untyped-plutus-core/test/Analysis/Spec.hs +++ b/plutus-core/untyped-plutus-core/test/Analysis/Spec.hs @@ -1,5 +1,5 @@ {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TypeApplications #-} + module Analysis.Spec where import Test.Tasty.Extras @@ -8,13 +8,15 @@ import PlutusCore qualified as PLC import PlutusCore.MkPlc import PlutusCore.Pretty (prettyPlcReadableDef) import PlutusCore.Quote +import PlutusPrelude (def) import Test.Tasty import Test.Tasty.HUnit import UntypedPlutusCore import UntypedPlutusCore.Purity goldenEvalOrder :: String -> Term Name PLC.DefaultUni PLC.DefaultFun () -> TestNested -goldenEvalOrder name tm = nestedGoldenVsDoc name "" (prettyPlcReadableDef $ termEvaluationOrder tm) +goldenEvalOrder name tm = + nestedGoldenVsDoc name "" (prettyPlcReadableDef $ termEvaluationOrder def tm) -- Should hit Unknown before trying to process the undefined. Shows -- that the computation is lazy @@ -50,5 +52,6 @@ evalOrder :: TestTree evalOrder = runTestNestedIn ["untyped-plutus-core", "test", "Analysis"] $ testNested "evalOrder" [ goldenEvalOrder "letFun" letFun , goldenEvalOrder "letImpure" letImpure - , pure $ testCase "evalOrderLazy" $ 4 @=? length (unEvalOrder $ termEvaluationOrder dangerTerm) + , pure $ testCase "evalOrderLazy" $ + 4 @=? length (unEvalOrder $ termEvaluationOrder def dangerTerm) ] diff --git a/plutus-core/untyped-plutus-core/test/Transform/Simplify.hs b/plutus-core/untyped-plutus-core/test/Transform/Simplify.hs index bfab39219da..6107bcf208d 100644 --- a/plutus-core/untyped-plutus-core/test/Transform/Simplify.hs +++ b/plutus-core/untyped-plutus-core/test/Transform/Simplify.hs @@ -5,9 +5,11 @@ module Transform.Simplify where import PlutusCore qualified as PLC +import PlutusCore.Builtin (BuiltinSemanticsVariant) import PlutusCore.MkPlc import PlutusCore.Pretty import PlutusCore.Quote +import PlutusPrelude (Default (def)) import UntypedPlutusCore import Control.Lens ((&), (.~)) @@ -417,6 +419,7 @@ goldenVsSimplified name = & soMaxSimplifierIterations .~ 1 & soMaxCseIterations .~ 0 ) + (def :: BuiltinSemanticsVariant PLC.DefaultFun) goldenVsCse :: String -> Term Name PLC.DefaultUni PLC.DefaultFun () -> TestTree goldenVsCse name = @@ -428,6 +431,7 @@ goldenVsCse name = & soMaxSimplifierIterations .~ 0 & soMaxCseIterations .~ 1 ) + (def :: BuiltinSemanticsVariant PLC.DefaultFun) test_simplify :: TestTree test_simplify = diff --git a/plutus-tx-plugin/src/PlutusTx/Plugin.hs b/plutus-tx-plugin/src/PlutusTx/Plugin.hs index 3fbf4714dd0..62eb0c4d3a6 100644 --- a/plutus-tx-plugin/src/PlutusTx/Plugin.hs +++ b/plutus-tx-plugin/src/PlutusTx/Plugin.hs @@ -50,6 +50,7 @@ import GHC.Types.TyThing qualified as GHC import GHC.Utils.Logger qualified as GHC import PlutusCore qualified as PLC +import PlutusCore.Builtin qualified as PLC import PlutusCore.Compiler qualified as PLC import PlutusCore.Pretty as PLC import PlutusCore.Quote diff --git a/plutus-tx-plugin/test/AsData/Budget/9.6/patternMatching-budget.budget.golden b/plutus-tx-plugin/test/AsData/Budget/9.6/patternMatching-budget.budget.golden index e7d4a7daa8d..69c27a04457 100644 --- a/plutus-tx-plugin/test/AsData/Budget/9.6/patternMatching-budget.budget.golden +++ b/plutus-tx-plugin/test/AsData/Budget/9.6/patternMatching-budget.budget.golden @@ -1,2 +1,2 @@ -({cpu: 9927795 -| mem: 27176}) \ No newline at end of file +({cpu: 8547795 +| mem: 21176}) \ No newline at end of file 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 041db2f5b1b..e2393ed1fc3 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 @@ -3,43 +3,33 @@ program (\d -> (\cse -> (\lessThanInteger -> - (\addInteger -> + (\cse -> (\cse -> (\cse -> (\cse -> - (\cse -> - (\cse -> - (\cse -> - (\cse -> - (\cse -> - addInteger - (addInteger - (addInteger - (addInteger (cse cse) cse) - cse) - (force - (case - (lessThanInteger - (cse cse) - (cse cse)) - [ (delay (cse cse)) - , (delay (cse cse)) ]))) - (force - (case - (lessThanInteger - (cse cse) - (cse cse)) - [ (delay (cse cse)) - , (delay (cse cse)) ]))) - (addInteger cse)) - (addInteger cse)) - (addInteger cse)) - (addInteger cse)) - (case cse [(\x y z w -> x)])) - (case cse [(\x y z w -> y)])) - (case cse [(\x y z w -> z)])) - (case cse [(\x y z w -> w)])) - (\x y -> addInteger x y)) + 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)) ]))) + (force + (case + (lessThanInteger + (addInteger cse cse) + (addInteger cse cse)) + [ (delay (addInteger cse cse)) + , (delay (addInteger cse cse)) ]))) + (case cse [(\x y z w -> z)])) + (case cse [(\x y z w -> w)])) + (case cse [(\x y z w -> x)])) + (case cse [(\x y z w -> y)])) (\x y -> force ifThenElse (lessThanInteger x y) diff --git a/plutus-tx-plugin/test/AsData/Budget/9.6/recordFields-budget-manual.budget.golden b/plutus-tx-plugin/test/AsData/Budget/9.6/recordFields-budget-manual.budget.golden index ea18cde0461..e5ba4bf6d0e 100644 --- a/plutus-tx-plugin/test/AsData/Budget/9.6/recordFields-budget-manual.budget.golden +++ b/plutus-tx-plugin/test/AsData/Budget/9.6/recordFields-budget-manual.budget.golden @@ -1,2 +1,2 @@ -({cpu: 11292601 -| mem: 27874}) \ No newline at end of file +({cpu: 10464601 +| mem: 24274}) \ No newline at end of file diff --git a/plutus-tx-plugin/test/AsData/Budget/9.6/recordFields-budget.budget.golden b/plutus-tx-plugin/test/AsData/Budget/9.6/recordFields-budget.budget.golden index 913f284b9ac..b1afa13b600 100644 --- a/plutus-tx-plugin/test/AsData/Budget/9.6/recordFields-budget.budget.golden +++ b/plutus-tx-plugin/test/AsData/Budget/9.6/recordFields-budget.budget.golden @@ -1,2 +1,2 @@ -({cpu: 17541361 -| mem: 49126}) \ No newline at end of file +({cpu: 16713361 +| mem: 45526}) \ No newline at end of file diff --git a/plutus-tx-plugin/test/AsData/Budget/9.6/recordFields-manual.uplc.golden b/plutus-tx-plugin/test/AsData/Budget/9.6/recordFields-manual.uplc.golden index 016240c6151..a6f1ba700d8 100644 --- a/plutus-tx-plugin/test/AsData/Budget/9.6/recordFields-manual.uplc.golden +++ b/plutus-tx-plugin/test/AsData/Budget/9.6/recordFields-manual.uplc.golden @@ -8,30 +8,25 @@ program (\cse -> (\cse -> (\lessThanInteger -> - (\addInteger -> - (\cse -> - (\cse -> - 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)) ]))) - (force - (case - (lessThanInteger (cse cse) (cse cse)) - [ (delay (cse cse)) - , (delay (cse cse)) ]))) - (addInteger cse)) - (addInteger cse)) - (\x y -> addInteger x y)) + 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)) ]))) + (force + (case + (lessThanInteger + (addInteger cse cse) + (addInteger cse cse)) + [ (delay (addInteger cse cse)) + , (delay (addInteger cse cse)) ]))) (\x y -> force ifThenElse (lessThanInteger x y) 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 5dd742c2958..c9f674502f1 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 @@ -7,29 +7,25 @@ program (\cse -> (\cse -> (\lessThanInteger -> - (\addInteger -> - (\cse -> - (\cse -> - 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)) ]))) - (force - (case - (lessThanInteger (cse cse) (cse cse)) - [ (delay (cse cse)) - , (delay (cse cse)) ]))) - (addInteger cse)) - (addInteger cse)) - (\x y -> addInteger x y)) + 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)) ]))) + (force + (case + (lessThanInteger + (addInteger cse cse) + (addInteger cse cse)) + [ (delay (addInteger cse cse)) + , (delay (addInteger cse cse)) ]))) (\x y -> force ifThenElse (lessThanInteger x y) diff --git a/plutus-tx/src/PlutusTx/Lift.hs b/plutus-tx/src/PlutusTx/Lift.hs index 7211744afe8..01530ca9b4d 100644 --- a/plutus-tx/src/PlutusTx/Lift.hs +++ b/plutus-tx/src/PlutusTx/Lift.hs @@ -3,7 +3,7 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE PartialTypeSignatures #-} {-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeOperators #-} + module PlutusTx.Lift ( safeLift, safeLiftProgram, @@ -17,7 +17,8 @@ module PlutusTx.Lift ( typeCode, makeTypeable, makeLift, - LiftError(..)) where + LiftError(..) +) where import PlutusTx.Code import PlutusTx.Lift.Class qualified as Lift @@ -58,7 +59,8 @@ import Prelude as Haskell -- | Get a Plutus Core term corresponding to the given value. safeLift - :: (Lift.Lift uni a + :: forall a e uni fun m + . (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 @@ -86,8 +88,8 @@ safeLift v x = do & PLC.coSimplifyOpts . UPLC.soMaxCseIterations .~ 0 plc <- flip runReaderT ccConfig $ compileProgram (Program () v pir) uplc <- flip runReaderT ucOpts $ PLC.compileProgram plc - (UPLC.Program _ _ db) <- traverseOf UPLC.progTerm UPLC.deBruijnTerm uplc - pure $ (void pir, void db) + UPLC.Program _ _ db <- traverseOf UPLC.progTerm UPLC.deBruijnTerm uplc + pure (void pir, void db) -- | Get a Plutus Core program corresponding to the given value. safeLiftProgram @@ -265,4 +267,4 @@ typeCode p prog = do _ <- typeCheckAgainst p prog compiled <- flip runReaderT PLC.defaultCompilationOpts $ PLC.compileProgram prog db <- traverseOf UPLC.progTerm UPLC.deBruijnTerm compiled - pure $ DeserializedCode (const mempty <$> db) Nothing mempty + pure $ DeserializedCode (mempty <$ db) Nothing mempty From f168bc125021356f39ee2b1b537cb69bbc39997b Mon Sep 17 00:00:00 2001 From: Nikolaos Bezirgiannis <329939+bezirg@users.noreply.github.com> Date: Wed, 27 Mar 2024 13:02:45 +0100 Subject: [PATCH 2/2] [Release] 1.24.0.0 (#5856) Co-authored-by: Nikolaos Bezirgiannis --- doc/read-the-docs-site/plutus-doc.cabal | 14 +-- plutus-benchmark/plutus-benchmark.cabal | 112 +++++++++--------- plutus-conformance/plutus-conformance.cabal | 8 +- plutus-core/plutus-core.cabal | 44 +++---- plutus-ledger-api/plutus-ledger-api.cabal | 36 +++--- plutus-metatheory/plutus-metatheory.cabal | 12 +- plutus-tx-plugin/plutus-tx-plugin.cabal | 20 ++-- plutus-tx/CHANGELOG.md | 12 ++ ..._ana.pantilie95_plt_9511_audit_assocmap.md | 8 -- plutus-tx/plutus-tx.cabal | 12 +- .../prettyprinter-configurable.cabal | 4 +- 11 files changed, 143 insertions(+), 139 deletions(-) delete mode 100644 plutus-tx/changelog.d/20240315_151519_ana.pantilie95_plt_9511_audit_assocmap.md diff --git a/doc/read-the-docs-site/plutus-doc.cabal b/doc/read-the-docs-site/plutus-doc.cabal index f27d1406ed1..ae186ce25b9 100644 --- a/doc/read-the-docs-site/plutus-doc.cabal +++ b/doc/read-the-docs-site/plutus-doc.cabal @@ -77,9 +77,9 @@ executable doc-doctests , containers , flat ^>=0.6 , lens - , plutus-core ^>=1.23 - , plutus-ledger-api ^>=1.23 - , plutus-tx ^>=1.23 + , plutus-core ^>=1.24 + , plutus-ledger-api ^>=1.24 + , plutus-tx ^>=1.24 , prettyprinter , random , serialise @@ -104,10 +104,10 @@ executable quick-start , base >=4.9 && <5 , base16-bytestring , bytestring - , plutus-core ^>=1.23 - , plutus-ledger-api ^>=1.23 - , plutus-tx ^>=1.23 - , plutus-tx-plugin ^>=1.23 + , plutus-core ^>=1.24 + , plutus-ledger-api ^>=1.24 + , plutus-tx ^>=1.24 + , plutus-tx-plugin ^>=1.24 if !(impl(ghcjs) || os(ghcjs)) build-depends: plutus-tx-plugin diff --git a/plutus-benchmark/plutus-benchmark.cabal b/plutus-benchmark/plutus-benchmark.cabal index ccdf6a4c57e..45482f90725 100644 --- a/plutus-benchmark/plutus-benchmark.cabal +++ b/plutus-benchmark/plutus-benchmark.cabal @@ -78,9 +78,9 @@ library plutus-benchmark-common , directory , filepath , flat ^>=0.6 - , plutus-core ^>=1.23 + , plutus-core ^>=1.24 , plutus-metatheory - , plutus-tx ^>=1.23 + , plutus-tx ^>=1.24 , tasty , tasty-golden , temporary @@ -111,9 +111,9 @@ library nofib-internal , base >=4.9 && <5 , deepseq , plutus-benchmark-common - , plutus-core ^>=1.23 - , plutus-tx ^>=1.23 - , plutus-tx-plugin ^>=1.23 + , plutus-core ^>=1.24 + , plutus-tx ^>=1.24 + , plutus-tx-plugin ^>=1.24 executable nofib-exe import: lang, ghc-version-support @@ -127,8 +127,8 @@ executable nofib-exe , nofib-internal , optparse-applicative , plutus-benchmark-common - , plutus-core ^>=1.23 - , plutus-tx ^>=1.23 + , plutus-core ^>=1.24 + , plutus-tx ^>=1.24 , prettyprinter , transformers @@ -166,8 +166,8 @@ test-suite plutus-benchmark-nofib-tests , base >=4.9 && <5 , nofib-internal , plutus-benchmark-common - , plutus-core:{plutus-core, plutus-core-testlib} ^>=1.23 - , plutus-tx:{plutus-tx, plutus-tx-testlib} ^>=1.23 + , plutus-core:{plutus-core, plutus-core-testlib} ^>=1.24 + , plutus-tx:{plutus-tx, plutus-tx-testlib} ^>=1.24 , tasty , tasty-hunit , tasty-quickcheck @@ -197,9 +197,9 @@ library lists-internal , base >=4.9 && <5 , mtl , plutus-benchmark-common - , plutus-core ^>=1.23 - , plutus-tx ^>=1.23 - , plutus-tx-plugin ^>=1.23 + , plutus-core ^>=1.24 + , plutus-tx ^>=1.24 + , plutus-tx-plugin ^>=1.24 executable list-sort-exe import: lang, ghc-version-support @@ -210,7 +210,7 @@ executable list-sort-exe , lists-internal , monoidal-containers , plutus-benchmark-common - , plutus-core ^>=1.23 + , plutus-core ^>=1.24 benchmark lists import: lang, ghc-version-support @@ -238,8 +238,8 @@ test-suite plutus-benchmark-lists-tests , base >=4.9 && <5 , lists-internal , plutus-benchmark-common - , plutus-core:plutus-core-testlib ^>=1.23 - , plutus-tx:plutus-tx-testlib ^>=1.23 + , plutus-core:plutus-core-testlib ^>=1.24 + , plutus-tx:plutus-tx-testlib ^>=1.24 , tasty , tasty-quickcheck @@ -261,8 +261,8 @@ benchmark validation , flat ^>=0.6 , optparse-applicative , plutus-benchmark-common - , plutus-core ^>=1.23 - , plutus-ledger-api ^>=1.23 + , plutus-core ^>=1.24 + , plutus-ledger-api ^>=1.24 ---------------- validation-decode ---------------- @@ -282,8 +282,8 @@ benchmark validation-decode , flat ^>=0.6 , optparse-applicative , plutus-benchmark-common - , plutus-core ^>=1.23 - , plutus-ledger-api ^>=1.23 + , plutus-core ^>=1.24 + , plutus-ledger-api ^>=1.24 ---------------- validation-full ---------------- @@ -303,8 +303,8 @@ benchmark validation-full , flat ^>=0.6 , optparse-applicative , plutus-benchmark-common - , plutus-core ^>=1.23 - , plutus-ledger-api ^>=1.23 + , plutus-core ^>=1.24 + , plutus-ledger-api ^>=1.24 ---------------- Cek cost model calibration ---------------- @@ -323,9 +323,9 @@ benchmark cek-calibration , criterion >=1.5.9.0 , lens , mtl - , plutus-core ^>=1.23 - , plutus-tx ^>=1.23 - , plutus-tx-plugin ^>=1.23 + , plutus-core ^>=1.24 + , plutus-tx ^>=1.24 + , plutus-tx-plugin ^>=1.24 ---------------- Signature verification throughput ---------------- @@ -344,9 +344,9 @@ executable ed25519-costs , cardano-crypto-class , hedgehog , plutus-benchmark-common - , plutus-core ^>=1.23 - , plutus-tx ^>=1.23 - , plutus-tx-plugin ^>=1.23 + , plutus-core ^>=1.24 + , plutus-tx ^>=1.24 + , plutus-tx-plugin ^>=1.24 -- Calculate the predicted costs of sequences of ed25519 signature verification -- operations and compare them with a golden file. @@ -364,9 +364,9 @@ test-suite ed25519-costs-test , cardano-crypto-class , hedgehog , plutus-benchmark-common - , plutus-core:{plutus-core, plutus-core-testlib} ^>=1.23 - , plutus-tx ^>=1.23 - , plutus-tx-plugin ^>=1.23 + , plutus-core:{plutus-core, plutus-core-testlib} ^>=1.24 + , plutus-tx ^>=1.24 + , plutus-tx-plugin ^>=1.24 ---------------- BLS12-381 experiments ---------------- @@ -391,10 +391,10 @@ library bls12-381lib-internal , flat ^>=0.6 , hedgehog , plutus-benchmark-common - , plutus-core ^>=1.23 - , plutus-ledger-api ^>=1.23 - , plutus-tx ^>=1.23 - , plutus-tx-plugin ^>=1.23 + , plutus-core ^>=1.24 + , plutus-ledger-api ^>=1.24 + , plutus-tx ^>=1.24 + , plutus-tx-plugin ^>=1.24 -- Print out predicted costs of various scripts involving BLS12-381 operations executable bls12-381-costs @@ -418,7 +418,7 @@ test-suite bls12-381-costs-test , base >=4.9 && <5 , bls12-381lib-internal , plutus-benchmark-common - , plutus-core:plutus-core-testlib ^>=1.23 + , plutus-core:plutus-core-testlib ^>=1.24 -- Run benchmarks for various scripts involving BLS12-381 operations benchmark bls12-381-benchmarks @@ -432,7 +432,7 @@ benchmark bls12-381-benchmarks , bytestring , criterion >=1.5.9.0 , plutus-benchmark-common - , plutus-tx ^>=1.23 + , plutus-tx ^>=1.24 ---------------- script contexts ---------------- @@ -446,9 +446,9 @@ library script-contexts-internal exposed-modules: PlutusBenchmark.ScriptContexts build-depends: , base >=4.9 && <5 - , plutus-ledger-api ^>=1.23 - , plutus-tx ^>=1.23 - , plutus-tx-plugin ^>=1.23 + , plutus-ledger-api ^>=1.24 + , plutus-tx ^>=1.24 + , plutus-tx-plugin ^>=1.24 test-suite plutus-benchmark-script-contexts-tests import: lang, ghc-version-support @@ -460,8 +460,8 @@ test-suite plutus-benchmark-script-contexts-tests build-depends: , base >=4.9 && <5 , plutus-benchmark-common - , plutus-core:{plutus-core, plutus-core-testlib} ^>=1.23 - , plutus-tx:plutus-tx-testlib ^>=1.23 + , plutus-core:{plutus-core, plutus-core-testlib} ^>=1.24 + , plutus-tx:plutus-tx-testlib ^>=1.24 , script-contexts-internal , tasty , tasty-hunit @@ -490,10 +490,10 @@ library marlowe-internal , mtl , newtype-generics , plutus-benchmark-common - , plutus-core:{plutus-core, plutus-core-execlib} ^>=1.23 - , plutus-ledger-api ^>=1.23 - , plutus-tx ^>=1.23 - , plutus-tx-plugin ^>=1.23 + , plutus-core:{plutus-core, plutus-core-execlib} ^>=1.24 + , plutus-ledger-api ^>=1.24 + , plutus-tx ^>=1.24 + , plutus-tx-plugin ^>=1.24 , serialise executable marlowe-validators @@ -513,8 +513,8 @@ executable marlowe-validators , cardano-binary , marlowe-internal , plutus-benchmark-common - , plutus-ledger-api ^>=1.23 - , plutus-tx ^>=1.23 + , plutus-ledger-api ^>=1.24 + , plutus-tx ^>=1.24 , serialise benchmark marlowe @@ -528,8 +528,8 @@ benchmark marlowe , criterion , marlowe-internal , plutus-benchmark-common - , plutus-ledger-api ^>=1.23 - , plutus-tx ^>=1.23 + , plutus-ledger-api ^>=1.24 + , plutus-tx ^>=1.24 test-suite plutus-benchmark-marlowe-tests import: lang, ghc-version-support @@ -541,9 +541,9 @@ test-suite plutus-benchmark-marlowe-tests build-depends: , base >=4.9 && <5 , marlowe-internal - , plutus-core:{plutus-core, plutus-core-testlib} ^>=1.23 - , plutus-ledger-api ^>=1.23 - , plutus-tx:{plutus-tx, plutus-tx-testlib} ^>=1.23 + , plutus-core:{plutus-core, plutus-core-testlib} ^>=1.24 + , plutus-ledger-api ^>=1.24 + , plutus-tx:{plutus-tx, plutus-tx-testlib} ^>=1.24 , tasty ---------------- agda evaluators ---------------- @@ -566,8 +566,8 @@ benchmark validation-agda-cek , flat ^>=0.6 , optparse-applicative , plutus-benchmark-common - , plutus-core ^>=1.23 - , plutus-ledger-api ^>=1.23 + , plutus-core ^>=1.24 + , plutus-ledger-api ^>=1.24 benchmark nofib-agda-cek import: lang, ghc-version-support @@ -592,5 +592,5 @@ benchmark marlowe-agda-cek , criterion , marlowe-internal , plutus-benchmark-common - , plutus-ledger-api ^>=1.23 - , plutus-tx ^>=1.23 + , plutus-ledger-api ^>=1.24 + , plutus-tx ^>=1.24 diff --git a/plutus-conformance/plutus-conformance.cabal b/plutus-conformance/plutus-conformance.cabal index 7c523fb6b9d..c322615ccbd 100644 --- a/plutus-conformance/plutus-conformance.cabal +++ b/plutus-conformance/plutus-conformance.cabal @@ -49,7 +49,7 @@ library , base , directory , filepath - , plutus-core:{plutus-core, plutus-core-testlib} ^>=1.23 + , plutus-core:{plutus-core, plutus-core-testlib} ^>=1.24 , tasty , tasty-expected-failure , tasty-golden @@ -72,7 +72,7 @@ test-suite haskell-conformance build-depends: , base >=4.9 && <5 , plutus-conformance - , plutus-core ^>=1.23 + , plutus-core ^>=1.24 test-suite haskell-steppable-conformance import: lang @@ -85,7 +85,7 @@ test-suite haskell-steppable-conformance , base >=4.9 && <5 , lens , plutus-conformance - , plutus-core ^>=1.23 + , plutus-core ^>=1.24 test-suite agda-conformance import: lang @@ -98,6 +98,6 @@ test-suite agda-conformance , aeson , base >=4.9 && <5 , plutus-conformance - , plutus-core ^>=1.23 + , plutus-core ^>=1.24 , plutus-metatheory , transformers diff --git a/plutus-core/plutus-core.cabal b/plutus-core/plutus-core.cabal index 337d425bc4a..40c7893b64a 100644 --- a/plutus-core/plutus-core.cabal +++ b/plutus-core/plutus-core.cabal @@ -1,6 +1,6 @@ cabal-version: 3.0 name: plutus-core -version: 1.23.0.0 +version: 1.24.0.0 license: Apache-2.0 license-files: LICENSE @@ -316,7 +316,7 @@ library , nothunks ^>=0.1.5 , parser-combinators >=0.4.0 , prettyprinter >=1.1.0.1 - , prettyprinter-configurable ^>=1.23 + , prettyprinter-configurable ^>=1.24 , primitive , profunctors , recursion-schemes @@ -376,7 +376,7 @@ test-suite plutus-core-test , hex-text , mmorph , mtl - , plutus-core:{plutus-core, plutus-core-testlib} ^>=1.23 + , plutus-core:{plutus-core, plutus-core-testlib} ^>=1.24 , prettyprinter , serialise , tasty @@ -434,7 +434,7 @@ test-suite untyped-plutus-core-test , hedgehog , lens , mtl - , plutus-core:{plutus-core, plutus-core-testlib} ^>=1.23 + , plutus-core:{plutus-core, plutus-core-testlib} ^>=1.24 , pretty-show , prettyprinter , QuickCheck @@ -455,8 +455,8 @@ executable plc , bytestring , flat ^>=0.6 , optparse-applicative - , plutus-core ^>=1.23 - , plutus-core-execlib ^>=1.23 + , plutus-core ^>=1.24 + , plutus-core-execlib ^>=1.24 , text executable uplc @@ -472,8 +472,8 @@ executable uplc , haskeline , mtl , optparse-applicative - , plutus-core ^>=1.23 - , plutus-core-execlib ^>=1.23 + , plutus-core ^>=1.24 + , plutus-core-execlib ^>=1.24 , prettyprinter , split , text @@ -568,7 +568,7 @@ library plutus-ir , mtl , multiset , parser-combinators >=0.4.0 - , plutus-core ^>=1.23 + , plutus-core ^>=1.24 , prettyprinter >=1.1.0.1 , profunctors , semigroupoids @@ -633,7 +633,7 @@ test-suite plutus-ir-test , hedgehog , lens , mtl - , plutus-core:{plutus-core, plutus-core-testlib, plutus-ir} ^>=1.23 + , plutus-core:{plutus-core, plutus-core-testlib, plutus-ir} ^>=1.24 , QuickCheck , serialise , tasty @@ -656,8 +656,8 @@ executable pir , lens , megaparsec , optparse-applicative - , plutus-core-execlib ^>=1.23 - , plutus-core:{plutus-core, plutus-ir} ^>=1.23 + , plutus-core-execlib ^>=1.24 + , plutus-core:{plutus-core, plutus-ir} ^>=1.24 , text , transformers @@ -685,7 +685,7 @@ library plutus-core-execlib , monoidal-containers , mtl , optparse-applicative - , plutus-core:{plutus-core, plutus-core-testlib, plutus-ir} ^>=1.23 + , plutus-core:{plutus-core, plutus-core-testlib, plutus-ir} ^>=1.24 , prettyprinter , text @@ -747,9 +747,9 @@ library plutus-core-testlib , mmorph , mtl , multiset - , plutus-core:{plutus-core, plutus-ir} ^>=1.23 + , plutus-core:{plutus-core, plutus-ir} ^>=1.24 , prettyprinter >=1.1.0.1 - , prettyprinter-configurable ^>=1.23 + , prettyprinter-configurable ^>=1.24 , QuickCheck , quickcheck-instances , quickcheck-transformer @@ -781,7 +781,7 @@ library plutus-ir-cert exposed-modules: PlutusIR.Certifier build-depends: , base - , plutus-core:{plutus-core, plutus-ir} ^>=1.23 + , plutus-core:{plutus-core, plutus-ir} ^>=1.24 ---------------------------------------------- -- debugger @@ -814,8 +814,8 @@ executable debugger , mono-traversable , mtl , optparse-applicative - , plutus-core ^>=1.23 - , plutus-core-execlib ^>=1.23 + , plutus-core ^>=1.24 + , plutus-core-execlib ^>=1.24 , prettyprinter , primitive , text @@ -899,7 +899,7 @@ executable cost-model-budgeting-bench , hedgehog , mtl , optparse-applicative - , plutus-core ^>=1.23 + , plutus-core ^>=1.24 , QuickCheck , quickcheck-instances , random @@ -936,7 +936,7 @@ executable generate-cost-model , extra , inline-r >=1.0.1 , optparse-applicative - , plutus-core ^>=1.23 + , plutus-core ^>=1.24 , text , vector @@ -977,7 +977,7 @@ benchmark cost-model-test , hedgehog , inline-r >=1.0.1 , mmorph - , plutus-core ^>=1.23 + , plutus-core ^>=1.24 , template-haskell , text , vector @@ -993,7 +993,7 @@ executable print-cost-model , aeson , base >=4.9 && <5 , bytestring - , plutus-core ^>=1.23 + , plutus-core ^>=1.24 ---------------------------------------------- -- satint diff --git a/plutus-ledger-api/plutus-ledger-api.cabal b/plutus-ledger-api/plutus-ledger-api.cabal index 6c41663c7da..946466b85c7 100644 --- a/plutus-ledger-api/plutus-ledger-api.cabal +++ b/plutus-ledger-api/plutus-ledger-api.cabal @@ -1,6 +1,6 @@ cabal-version: 3.0 name: plutus-ledger-api -version: 1.23.0.0 +version: 1.24.0.0 license: Apache-2.0 license-files: LICENSE @@ -102,8 +102,8 @@ library , lens , mtl , nothunks - , plutus-core ^>=1.23 - , plutus-tx ^>=1.23 + , plutus-core ^>=1.24 + , plutus-tx ^>=1.24 , prettyprinter , serialise , tagged @@ -130,9 +130,9 @@ library plutus-ledger-api-testlib , base64-bytestring , bytestring , containers - , plutus-core:{plutus-core, plutus-core-testlib} ^>=1.23 - , plutus-ledger-api ^>=1.23 - , plutus-tx ^>=1.23 + , plutus-core:{plutus-core, plutus-core-testlib} ^>=1.24 + , plutus-ledger-api ^>=1.24 + , plutus-tx ^>=1.24 , prettyprinter , PyF >=0.11.1.0 , QuickCheck @@ -166,9 +166,9 @@ test-suite plutus-ledger-api-test , lens , mtl , nothunks - , plutus-core:{plutus-core, plutus-core-testlib} ^>=1.23 - , plutus-ledger-api:{plutus-ledger-api, plutus-ledger-api-testlib} ^>=1.23 - , plutus-tx:{plutus-tx, plutus-tx-testlib} ^>=1.23 + , plutus-core:{plutus-core, plutus-core-testlib} ^>=1.24 + , plutus-ledger-api:{plutus-ledger-api, plutus-ledger-api-testlib} ^>=1.24 + , plutus-tx:{plutus-tx, plutus-tx-testlib} ^>=1.24 , prettyprinter , serialise , tasty @@ -193,10 +193,10 @@ test-suite plutus-ledger-api-plugin-test build-depends: , base >=4.9 && <5 , containers - , plutus-core:{plutus-core, plutus-core-testlib} ^>=1.23 - , plutus-ledger-api ^>=1.23 - , plutus-tx-plugin ^>=1.23 - , plutus-tx:{plutus-tx, plutus-tx-testlib} ^>=1.23 + , plutus-core:{plutus-core, plutus-core-testlib} ^>=1.24 + , plutus-ledger-api ^>=1.24 + , plutus-tx-plugin ^>=1.24 + , plutus-tx:{plutus-tx, plutus-tx-testlib} ^>=1.24 , prettyprinter , tasty @@ -214,8 +214,8 @@ executable test-onchain-evaluation , extra , filepath , mtl - , plutus-core ^>=1.23 - , plutus-ledger-api:{plutus-ledger-api, plutus-ledger-api-testlib} ^>=1.23 + , plutus-core ^>=1.24 + , plutus-ledger-api:{plutus-ledger-api, plutus-ledger-api-testlib} ^>=1.24 , serialise , tasty , tasty-hunit @@ -234,9 +234,9 @@ executable analyse-script-events , filepath , lens , mtl - , plutus-core ^>=1.23 - , plutus-ledger-api:{plutus-ledger-api, plutus-ledger-api-testlib} ^>=1.23 - , plutus-tx ^>=1.23 + , plutus-core ^>=1.24 + , plutus-ledger-api:{plutus-ledger-api, plutus-ledger-api-testlib} ^>=1.24 + , plutus-tx ^>=1.24 , primitive , serialise diff --git a/plutus-metatheory/plutus-metatheory.cabal b/plutus-metatheory/plutus-metatheory.cabal index c810d621936..ec041d15f0a 100644 --- a/plutus-metatheory/plutus-metatheory.cabal +++ b/plutus-metatheory/plutus-metatheory.cabal @@ -63,7 +63,7 @@ library , megaparsec , memory , optparse-applicative - , plutus-core:{plutus-core, plutus-core-execlib} ^>=1.23 + , plutus-core:{plutus-core, plutus-core-execlib} ^>=1.24 , process , text , transformers @@ -548,8 +548,8 @@ executable plc-agda test-suite test1 import: lang build-tool-depends: - , plutus-core:plc ^>=1.23 - , plutus-core:uplc ^>=1.23 + , plutus-core:plc ^>=1.24 + , plutus-core:uplc ^>=1.24 hs-source-dirs: test build-depends: @@ -564,8 +564,8 @@ test-suite test1 test-suite test2 import: lang build-tool-depends: - , plutus-core:plc ^>=1.23 - , plutus-core:uplc ^>=1.23 + , plutus-core:plc ^>=1.24 + , plutus-core:uplc ^>=1.24 hs-source-dirs: test type: detailed-0.9 @@ -590,7 +590,7 @@ test-suite test3 , base , lazy-search , mtl - , plutus-core:{plutus-core, plutus-core-testlib} ^>=1.23 + , plutus-core:{plutus-core, plutus-core-testlib} ^>=1.24 , plutus-metatheory , size-based , Stream diff --git a/plutus-tx-plugin/plutus-tx-plugin.cabal b/plutus-tx-plugin/plutus-tx-plugin.cabal index eca847040d8..222e19561a4 100644 --- a/plutus-tx-plugin/plutus-tx-plugin.cabal +++ b/plutus-tx-plugin/plutus-tx-plugin.cabal @@ -1,6 +1,6 @@ cabal-version: 3.0 name: plutus-tx-plugin -version: 1.23.0.0 +version: 1.24.0.0 license: Apache-2.0 license-files: LICENSE @@ -83,8 +83,8 @@ library , flat ^>=0.6 , lens , mtl - , plutus-core:{plutus-core, plutus-ir} ^>=1.23 - , plutus-tx ^>=1.23 + , plutus-core:{plutus-core, plutus-ir} ^>=1.24 + , plutus-tx ^>=1.24 , prettyprinter , PyF >=0.11.1.0 , template-haskell @@ -109,7 +109,7 @@ executable gen-plugin-opts-doc , containers , lens , optparse-applicative - , plutus-tx-plugin ^>=1.23 + , plutus-tx-plugin ^>=1.24 , prettyprinter , PyF >=0.11.1.0 , text @@ -173,9 +173,9 @@ test-suite plutus-tx-plugin-tests , hedgehog , lens , mtl - , plutus-core:{plutus-core, plutus-core-testlib} ^>=1.23 - , plutus-tx-plugin ^>=1.23 - , plutus-tx:{plutus-tx, plutus-tx-testlib} ^>=1.23 + , plutus-core:{plutus-core, plutus-core-testlib} ^>=1.24 + , plutus-tx-plugin ^>=1.24 + , plutus-tx:{plutus-tx, plutus-tx-testlib} ^>=1.24 , serialise , tasty , tasty-golden @@ -203,9 +203,9 @@ test-suite size hs-source-dirs: test/size build-depends: , base >=4.9 && <5.0 - , plutus-core:{plutus-core, plutus-core-testlib} ^>=1.23 - , plutus-tx-plugin ^>=1.23 - , plutus-tx:{plutus-tx, plutus-tx-testlib} ^>=1.23 + , plutus-core:{plutus-core, plutus-core-testlib} ^>=1.24 + , plutus-tx-plugin ^>=1.24 + , plutus-tx:{plutus-tx, plutus-tx-testlib} ^>=1.24 , tagged , tasty diff --git a/plutus-tx/CHANGELOG.md b/plutus-tx/CHANGELOG.md index 619bcd7b519..236e4e868e4 100644 --- a/plutus-tx/CHANGELOG.md +++ b/plutus-tx/CHANGELOG.md @@ -1,4 +1,16 @@ + +# 1.24.0.0 — 2024-03-26 + +## Added + +- Documented functions which unsafely construct `PlutusTx.AssocMap.Map`s, or depend on the precondition that the input `Map`s do not contain duplicate entries. + +## Changed + +- Renamed `PlutusTx.AssocMap.Map.fromList` to `PlutusTx.AssocMap.Map.unsafeFromList`. +- Renamed `PlutusTx.AssocMap.Map.fromListSafe` to `PlutusTx.AssocMap.Map.safeFromList`. + # 1.22.0.0 — 2024-02-21 diff --git a/plutus-tx/changelog.d/20240315_151519_ana.pantilie95_plt_9511_audit_assocmap.md b/plutus-tx/changelog.d/20240315_151519_ana.pantilie95_plt_9511_audit_assocmap.md deleted file mode 100644 index 37a9d4d0a9f..00000000000 --- a/plutus-tx/changelog.d/20240315_151519_ana.pantilie95_plt_9511_audit_assocmap.md +++ /dev/null @@ -1,8 +0,0 @@ -### Added - -- Documented functions which unsafely construct `PlutusTx.AssocMap.Map`s, or depend on the precondition that the input `Map`s do not contain duplicate entries. - -### Changed - -- Renamed `PlutusTx.AssocMap.Map.fromList` to `PlutusTx.AssocMap.Map.unsafeFromList`. -- Renamed `PlutusTx.AssocMap.Map.fromListSafe` to `PlutusTx.AssocMap.Map.safeFromList`. diff --git a/plutus-tx/plutus-tx.cabal b/plutus-tx/plutus-tx.cabal index 5f77a70190b..8e5ce0abca6 100644 --- a/plutus-tx/plutus-tx.cabal +++ b/plutus-tx/plutus-tx.cabal @@ -1,6 +1,6 @@ cabal-version: 3.0 name: plutus-tx -version: 1.23.0.0 +version: 1.24.0.0 license: Apache-2.0 license-files: LICENSE @@ -126,7 +126,7 @@ library , lens , memory , mtl - , plutus-core:{plutus-core, plutus-ir} ^>=1.23 + , plutus-core:{plutus-core, plutus-ir} ^>=1.24 , prettyprinter , serialise , template-haskell >=2.13.0.0 @@ -159,8 +159,8 @@ library plutus-tx-testlib , hedgehog , lens , mtl - , plutus-core:{plutus-core, plutus-core-testlib, plutus-ir} ^>=1.23 - , plutus-tx ^>=1.23 + , plutus-core:{plutus-core, plutus-core-testlib, plutus-ir} ^>=1.24 + , plutus-tx ^>=1.24 , prettyprinter , tagged , tasty @@ -207,8 +207,8 @@ test-suite plutus-tx-test , hedgehog , hedgehog-fn , lens - , plutus-core:{plutus-core, plutus-core-testlib} ^>=1.23 - , plutus-tx ^>=1.23 + , plutus-core:{plutus-core, plutus-core-testlib} ^>=1.24 + , plutus-tx ^>=1.24 , pretty-show , serialise , tasty diff --git a/prettyprinter-configurable/prettyprinter-configurable.cabal b/prettyprinter-configurable/prettyprinter-configurable.cabal index 249b856143a..49749ef2347 100644 --- a/prettyprinter-configurable/prettyprinter-configurable.cabal +++ b/prettyprinter-configurable/prettyprinter-configurable.cabal @@ -1,6 +1,6 @@ cabal-version: 2.4 name: prettyprinter-configurable -version: 1.23.0.0 +version: 1.24.0.0 -- synopsis: -- description: @@ -83,7 +83,7 @@ test-suite prettyprinter-configurable-test , base >=4.9 && <5 , megaparsec , parser-combinators - , prettyprinter-configurable ^>=1.23 + , prettyprinter-configurable ^>=1.24 , QuickCheck , quickcheck-text , tasty