From a79131eecfec1292b37eb2cce1e6299b46f360cc Mon Sep 17 00:00:00 2001 From: "dependabot[bot]" <49699333+dependabot[bot]@users.noreply.github.com> Date: Mon, 18 Mar 2024 11:31:02 +0000 Subject: [PATCH 1/8] chore(deps): bump nixbuild/nix-quick-install-action from 26 to 27 (#5843) Bumps [nixbuild/nix-quick-install-action](https://github.com/nixbuild/nix-quick-install-action) from 26 to 27. - [Release notes](https://github.com/nixbuild/nix-quick-install-action/releases) - [Changelog](https://github.com/nixbuild/nix-quick-install-action/blob/master/RELEASE) - [Commits](https://github.com/nixbuild/nix-quick-install-action/compare/v26...v27) --- updated-dependencies: - dependency-name: nixbuild/nix-quick-install-action dependency-type: direct:production update-type: version-update:semver-major ... Signed-off-by: dependabot[bot] Co-authored-by: dependabot[bot] <49699333+dependabot[bot]@users.noreply.github.com> --- .github/workflows/haddock.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/haddock.yml b/.github/workflows/haddock.yml index 5a94b652ab2..6dfea7c14bb 100644 --- a/.github/workflows/haddock.yml +++ b/.github/workflows/haddock.yml @@ -13,7 +13,7 @@ jobs: name: github-pages steps: - uses: actions/checkout@v4 - - uses: nixbuild/nix-quick-install-action@v26 + - uses: nixbuild/nix-quick-install-action@v27 with: nix_conf: | experimental-features = nix-command flakes From ac41901e6d85e56772bd9e596bd7387c5d21ef3d Mon Sep 17 00:00:00 2001 From: Yura Lazarev Date: Mon, 18 Mar 2024 16:02:28 +0100 Subject: [PATCH 2/8] CIP-0057: ContractBlueprint with derived schema definitions and safe schema refs (#5824) CIP-0057: ContractBlueprint with derived schema definitions and safe schema refs (#5824) --- .../test/Blueprint/Acme.golden.json | 63 ++++- plutus-tx-plugin/test/Blueprint/Tests.hs | 126 ++++----- plutus-tx-plugin/test/Blueprint/Tests/Lib.hs | 133 +++++++--- plutus-tx/plutus-tx.cabal | 1 + plutus-tx/src/PlutusTx/Blueprint/Argument.hs | 2 +- plutus-tx/src/PlutusTx/Blueprint/Contract.hs | 70 ++--- .../src/PlutusTx/Blueprint/Definition.hs | 246 +++++++++++++----- .../src/PlutusTx/Blueprint/Definition/Id.hs | 28 +- plutus-tx/src/PlutusTx/Blueprint/Parameter.hs | 2 +- plutus-tx/src/PlutusTx/Blueprint/Purpose.hs | 3 +- plutus-tx/src/PlutusTx/Blueprint/Schema.hs | 14 +- .../PlutusTx/Blueprint/Schema/Annotation.hs | 8 +- plutus-tx/src/PlutusTx/Blueprint/TH.hs | 56 +++- plutus-tx/src/PlutusTx/Blueprint/Validator.hs | 14 +- plutus-tx/src/PlutusTx/Blueprint/Write.hs | 6 +- plutus-tx/src/PlutusTx/Builtins/Internal.hs | 11 +- .../test/Blueprint/Definition/Fixture.hs | 11 +- plutus-tx/test/Blueprint/Definition/Spec.hs | 23 +- plutus-tx/test/Blueprint/Spec.hs | 73 ++++++ 19 files changed, 610 insertions(+), 280 deletions(-) create mode 100644 plutus-tx/test/Blueprint/Spec.hs diff --git a/plutus-tx-plugin/test/Blueprint/Acme.golden.json b/plutus-tx-plugin/test/Blueprint/Acme.golden.json index 5ceb986e363..65eab6052a5 100644 --- a/plutus-tx-plugin/test/Blueprint/Acme.golden.json +++ b/plutus-tx-plugin/test/Blueprint/Acme.golden.json @@ -15,17 +15,12 @@ }, "validators": [ { - "title": "Acme Validator", + "title": "Acme Validator #1", "description": "A validator that does something awesome", "redeemer": { "title": "Acme Redeemer", "description": "A redeemer that does something awesome", - "purpose": { - "oneOf": [ - "spend", - "mint" - ] - }, + "purpose": "spend", "schema": { "$ref": "#/definitions/String" } @@ -48,8 +43,40 @@ } } ], - "compiledCode": "58ec01010032222323232300349103505435003232325333573466e1d200000218000a999ab9a3370e90010010c00cc8c8c94ccd5cd19b874800000860026eb4d5d0800cdd71aba13574400213008491035054310035573c0046aae74004dd51aba100109802a481035054310035573c0046aae74004dd50029919192999ab9a3370e90000010c0004c0112401035054310035573c0046aae74004dd5001119319ab9c001800199999a8911199a891199a89100111111400401600900380140044252005001001400084a400a0020038004008848a400e0050012410101010101010101000498101030048810001", - "hash": "21a5bbebc42a3d916719c975f622508a2c940ced5cd867cd3d87a019" + "compiledCode": "584f01010032222801199999a8911199a891199a89100111111400401600900380140044252005001001400084a400a0020038004008848a400e0050012410101010101010101000498101030048810001", + "hash": "a0a2b4161839094c666e8ea1952510e7f337aa10786cef62706244ba" + }, + { + "title": "Acme Validator #2", + "description": "Another validator that does something awesome", + "redeemer": { + "purpose": "mint", + "schema": { + "$ref": "#/definitions/Integer" + } + }, + "datum": { + "purpose": "mint", + "schema": { + "$ref": "#/definitions/Integer" + } + }, + "parameters": [ + { + "purpose": "spend", + "schema": { + "$ref": "#/definitions/Param2a" + } + }, + { + "purpose": "mint", + "schema": { + "$ref": "#/definitions/Param2b" + } + } + ], + "compiledCode": "58290101003322222800199a89110014002004424520070028008ccd4488800e0010022122900380140041", + "hash": "67923a88b5dfccdef62abd8b3f4ff857d7582b52cde4c07b8cd34175" } ], "definitions": { @@ -104,6 +131,24 @@ "Integer": { "dataType": "integer" }, + "Param2a": { + "dataType": "constructor", + "fields": [ + { + "$ref": "#/definitions/Bool" + } + ], + "index": 0 + }, + "Param2b": { + "dataType": "constructor", + "fields": [ + { + "$ref": "#/definitions/Bool" + } + ], + "index": 0 + }, "Params": { "dataType": "constructor", "fields": [ diff --git a/plutus-tx-plugin/test/Blueprint/Tests.hs b/plutus-tx-plugin/test/Blueprint/Tests.hs index 7d4858f5135..7cb4442ca5b 100644 --- a/plutus-tx-plugin/test/Blueprint/Tests.hs +++ b/plutus-tx-plugin/test/Blueprint/Tests.hs @@ -1,58 +1,29 @@ -{-# LANGUAGE AllowAmbiguousTypes #-} -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE DerivingStrategies #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE PolyKinds #-} -{-# LANGUAGE TypeApplications #-} -{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeApplications #-} module Blueprint.Tests where -import PlutusTx.Blueprint import Prelude -import Blueprint.Tests.Lib qualified as Fixture -import Control.Monad.Reader (asks) +import Blueprint.Tests.Lib (Datum, Datum2, Param2a, Param2b, Params, Redeemer, Redeemer2, + goldenJson, serialisedScript, validatorScript1, validatorScript2) import Data.Set qualified as Set -import Data.Void (Void) +import PlutusTx.Blueprint.Contract (ContractBlueprint (..)) +import PlutusTx.Blueprint.Definition (definitionRef, deriveDefinitions) +import PlutusTx.Blueprint.PlutusVersion (PlutusVersion (PlutusV3)) +import PlutusTx.Blueprint.Preamble (Preamble (..)) import PlutusTx.Blueprint.Purpose qualified as Purpose -import PlutusTx.Builtins (BuiltinByteString, BuiltinData) -import System.FilePath (()) -import Test.Tasty (TestName) +import PlutusTx.Blueprint.TH (deriveArgumentBlueprint, deriveParameterBlueprint) +import PlutusTx.Blueprint.Validator (ValidatorBlueprint (..)) +import PlutusTx.Blueprint.Write (writeBlueprint) import Test.Tasty.Extras (TestNested, testNested) -import Test.Tasty.Golden (goldenVsFile) goldenTests :: TestNested -goldenTests = testNested "Blueprint" [goldenBlueprint "Acme" contractBlueprint] +goldenTests = testNested "Blueprint" [goldenJson "Acme" (`writeBlueprint` contractBlueprint)] -goldenBlueprint :: TestName -> ContractBlueprint types -> TestNested -goldenBlueprint name blueprint = do - goldenPath <- asks $ foldr () name - let actual = goldenPath ++ ".actual.json" - let golden = goldenPath ++ ".golden.json" - pure $ goldenVsFile name golden actual (writeBlueprint actual blueprint) - -{- | All the data types exposed (directly or indirectly) by the type signature of the validator -This type level list is used to: -1. derive the schema definitions for the contract. -2. make "safe" references to the [derived] schema definitions. --} -type ValidatorTypes = - [ Fixture.Datum - , Fixture.DatumPayload - , Fixture.Params - , Fixture.Redeemer - , Fixture.Bytes Void - , () - , Bool - , Integer - , BuiltinData - , BuiltinByteString - ] - -contractBlueprint :: ContractBlueprint ValidatorTypes +contractBlueprint :: ContractBlueprint contractBlueprint = MkContractBlueprint { contractId = Nothing @@ -64,38 +35,39 @@ contractBlueprint = , preamblePlutusVersion = PlutusV3 , preambleLicense = Just "MIT" } - , contractValidators = Set.singleton validatorBlueprint - , contractDefinitions = deriveSchemaDefinitions - } - -validatorBlueprint :: ValidatorBlueprint ValidatorTypes -validatorBlueprint = - MkValidatorBlueprint - { validatorTitle = "Acme Validator" - , validatorDescription = Just "A validator that does something awesome" - , validatorParameters = - Just - $ pure - MkParameterBlueprint - { parameterTitle = Just "Acme Parameter" - , parameterDescription = Just "A parameter that does something awesome" - , parameterPurpose = Set.singleton Purpose.Spend - , parameterSchema = definitionRef @Fixture.Params + , contractValidators = + Set.fromList + [ MkValidatorBlueprint + { validatorTitle = + "Acme Validator #1" + , validatorDescription = + Just "A validator that does something awesome" + , validatorParameters = + [$(deriveParameterBlueprint ''Params (Set.singleton Purpose.Spend))] + , validatorRedeemer = + $(deriveArgumentBlueprint ''Redeemer (Set.singleton Purpose.Spend)) + , validatorDatum = + Just $(deriveArgumentBlueprint ''Datum (Set.singleton Purpose.Spend)) + , validatorCompiledCode = + Just (serialisedScript validatorScript1) } - , validatorRedeemer = - MkArgumentBlueprint - { argumentTitle = Just "Acme Redeemer" - , argumentDescription = Just "A redeemer that does something awesome" - , argumentPurpose = Set.fromList [Purpose.Spend, Purpose.Mint] - , argumentSchema = definitionRef @Fixture.Redeemer - } - , validatorDatum = - Just - MkArgumentBlueprint - { argumentTitle = Just "Acme Datum" - , argumentDescription = Just "A datum that contains something awesome" - , argumentPurpose = Set.singleton Purpose.Spend - , argumentSchema = definitionRef @Fixture.Datum - } - , validatorCompiledCode = Just Fixture.serialisedScript + , MkValidatorBlueprint + { validatorTitle = + "Acme Validator #2" + , validatorDescription = + Just "Another validator that does something awesome" + , validatorParameters = + [ $(deriveParameterBlueprint ''Param2a (Set.singleton Purpose.Spend)) + , $(deriveParameterBlueprint ''Param2b (Set.singleton Purpose.Mint)) + ] + , validatorRedeemer = + $(deriveArgumentBlueprint ''Redeemer2 (Set.singleton Purpose.Mint)) + , validatorDatum = + Just $(deriveArgumentBlueprint ''Datum2 (Set.singleton Purpose.Mint)) + , validatorCompiledCode = + Just (serialisedScript validatorScript2) + } + ] + , contractDefinitions = + deriveDefinitions @[Params, Redeemer, Datum, Param2a, Param2b, Redeemer2, Datum2] } diff --git a/plutus-tx-plugin/test/Blueprint/Tests/Lib.hs b/plutus-tx-plugin/test/Blueprint/Tests/Lib.hs index 3afa436b50c..82cc25ad5bb 100644 --- a/plutus-tx-plugin/test/Blueprint/Tests/Lib.hs +++ b/plutus-tx-plugin/test/Blueprint/Tests/Lib.hs @@ -1,4 +1,5 @@ {-# LANGUAGE BangPatterns #-} +{-# LANGUAGE BlockArguments #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DerivingStrategies #-} @@ -14,26 +15,38 @@ module Blueprint.Tests.Lib where -import Prelude - import Codec.Serialise (serialise) import Control.Lens (over, (&)) +import Control.Monad.Reader (asks) import Data.ByteString (ByteString) import Data.ByteString.Lazy qualified as LBS import Data.Kind (Type) import Data.Void (Void) import Flat qualified -import PlutusCore.Version (plcVersion110) -import PlutusTx hiding (Typeable) +import GHC.Generics (Generic) import PlutusTx.Blueprint.Class (HasSchema (..)) import PlutusTx.Blueprint.Definition (AsDefinitionId, definitionRef) -import PlutusTx.Blueprint.Schema (Schema (SchemaBytes), emptyBytesSchema) +import PlutusTx.Blueprint.Schema (Schema (..), emptyBytesSchema) import PlutusTx.Blueprint.Schema.Annotation (SchemaComment (..), SchemaDescription (..), SchemaInfo (..), SchemaTitle (..), emptySchemaInfo) -import PlutusTx.Builtins (BuiltinByteString, BuiltinString, emptyByteString) -import PlutusTx.Prelude qualified as PlutusTx +import PlutusTx.Blueprint.TH (makeIsDataSchemaIndexed) +import PlutusTx.Builtins.Internal (BuiltinByteString, BuiltinData, BuiltinString, emptyByteString) +import PlutusTx.Code qualified as PlutusTx +import PlutusTx.IsData (FromData, ToData (..), UnsafeFromData (..)) +import PlutusTx.Lift qualified as PlutusTx +import PlutusTx.TH qualified as PlutusTx +import Prelude +import System.FilePath (()) +import Test.Tasty (TestName) +import Test.Tasty.Extras (TestNested) +import Test.Tasty.Golden (goldenVsFile) import UntypedPlutusCore qualified as UPLC +---------------------------------------------------------------------------------------------------- +-- Validator 1 for testing blueprints -------------------------------------------------------------- + +{-# ANN type Params (SchemaTitle "Acme Parameter") #-} +{-# ANN type Params (SchemaDescription "A parameter that does something awesome") #-} data Params = MkParams { myUnit :: () , myBool :: Bool @@ -41,74 +54,116 @@ data Params = MkParams , myBuiltinData :: BuiltinData , myBuiltinByteString :: BuiltinByteString } + deriving stock (Generic) deriving anyclass (AsDefinitionId) $(PlutusTx.makeLift ''Params) $(makeIsDataSchemaIndexed ''Params [('MkParams, 0)]) newtype Bytes (phantom :: Type) = MkAcmeBytes BuiltinByteString - deriving newtype (ToData, FromData, UnsafeFromData) + deriving stock (Generic) deriving anyclass (AsDefinitionId) + deriving newtype (ToData, FromData, UnsafeFromData) instance HasSchema (Bytes phantom) ts where - schema = SchemaBytes emptySchemaInfo { title = Just "SchemaBytes" } emptyBytesSchema + schema = SchemaBytes emptySchemaInfo{title = Just "SchemaBytes"} emptyBytesSchema {-# ANN MkDatumPayload (SchemaComment "MkDatumPayload") #-} + data DatumPayload = MkDatumPayload { myAwesomeDatum1 :: Integer , myAwesomeDatum2 :: Bytes Void } + deriving stock (Generic) deriving anyclass (AsDefinitionId) +{-# ANN type Datum (SchemaTitle "Acme Datum") #-} +{-# ANN type Datum (SchemaDescription "A datum that contains something awesome") #-} + {-# ANN DatumLeft (SchemaTitle "Datum") #-} {-# ANN DatumLeft (SchemaDescription "DatumLeft") #-} {-# ANN DatumLeft (SchemaComment "This constructor is parameterless") #-} + {-# ANN DatumRight (SchemaTitle "Datum") #-} {-# ANN DatumRight (SchemaDescription "DatumRight") #-} {-# ANN DatumRight (SchemaComment "This constructor has a payload") #-} + data Datum = DatumLeft | DatumRight DatumPayload + deriving stock (Generic) deriving anyclass (AsDefinitionId) +{-# ANN type Redeemer (SchemaTitle "Acme Redeemer") #-} +{-# ANN type Redeemer (SchemaDescription "A redeemer that does something awesome") #-} + type Redeemer = BuiltinString type ScriptContext = () -type Validator = Params -> Datum -> Redeemer -> ScriptContext -> Bool - $(makeIsDataSchemaIndexed ''DatumPayload [('MkDatumPayload, 0)]) $(makeIsDataSchemaIndexed ''Datum [('DatumLeft, 0), ('DatumRight, 1)]) -serialisedScript :: ByteString -serialisedScript = +{-# INLINEABLE typedValidator1 #-} +typedValidator1 :: Params -> Datum -> Redeemer -> ScriptContext -> Bool +typedValidator1 _params _datum _redeemer _context = False + +validatorScript1 :: PlutusTx.CompiledCode (Datum -> Redeemer -> ScriptContext -> Bool) +validatorScript1 = + $$(PlutusTx.compile [||typedValidator1||]) + `PlutusTx.unsafeApplyCode` PlutusTx.liftCodeDef + MkParams + { myUnit = () + , myBool = True + , myInteger = fromIntegral (maxBound @Int) + 1 + , myBuiltinData = toBuiltinData (3 :: Integer) + , myBuiltinByteString = emptyByteString + } + +---------------------------------------------------------------------------------------------------- +-- Validator 2 for testing blueprints -------------------------------------------------------------- + +newtype Param2a = MkParam2a Bool + deriving stock (Generic) + deriving anyclass (AsDefinitionId) + +$(PlutusTx.makeLift ''Param2a) +$(makeIsDataSchemaIndexed ''Param2a [('MkParam2a, 0)]) + +newtype Param2b = MkParam2b Bool + deriving stock (Generic) + deriving anyclass (AsDefinitionId) + +$(PlutusTx.makeLift ''Param2b) +$(makeIsDataSchemaIndexed ''Param2b [('MkParam2b, 0)]) + +type Datum2 = Integer + +type Redeemer2 = Integer + +{-# INLINEABLE typedValidator2 #-} +typedValidator2 :: Param2a -> Param2b -> Datum2 -> Redeemer2 -> ScriptContext -> Bool +typedValidator2 _p1 _p2 _datum _redeemer _context = True + +validatorScript2 :: PlutusTx.CompiledCode (Datum2 -> Redeemer2 -> ScriptContext -> Bool) +validatorScript2 = + $$(PlutusTx.compile [||typedValidator2||]) + `PlutusTx.unsafeApplyCode` PlutusTx.liftCodeDef (MkParam2a False) + `PlutusTx.unsafeApplyCode` PlutusTx.liftCodeDef (MkParam2b True) + +---------------------------------------------------------------------------------------------------- +-- Helper functions -------------------------------------------------------------------------------- + +serialisedScript :: PlutusTx.CompiledCode t -> ByteString +serialisedScript validatorScript = PlutusTx.getPlcNoAnn validatorScript & over UPLC.progTerm (UPLC.termMapNames UPLC.unNameDeBruijn) & UPLC.UnrestrictedProgram & Flat.flat & serialise & LBS.toStrict - where - {-# INLINEABLE typedValidator #-} - typedValidator :: Validator - typedValidator _params _datum _redeemer _context = False - - {-# INLINEABLE untypedValidator #-} - untypedValidator :: Params -> BuiltinData -> BuiltinString -> BuiltinData -> () - untypedValidator params datum redeemer ctx = - PlutusTx.check $ typedValidator params acmeDatum acmeRedeemer scriptContext - where - acmeDatum :: Datum = PlutusTx.unsafeFromBuiltinData datum - acmeRedeemer :: Redeemer = redeemer - scriptContext :: ScriptContext = PlutusTx.unsafeFromBuiltinData ctx - - validatorScript :: PlutusTx.CompiledCode (BuiltinData -> BuiltinString -> BuiltinData -> ()) - validatorScript = - $$(PlutusTx.compile [||untypedValidator||]) - `PlutusTx.unsafeApplyCode` PlutusTx.liftCode - plcVersion110 - MkParams - { myUnit = () - , myBool = True - , myInteger = fromIntegral (maxBound @Int) + 1 - , myBuiltinData = PlutusTx.toBuiltinData (3 :: Integer) - , myBuiltinByteString = emptyByteString - } + +goldenJson :: TestName -> (FilePath -> IO ()) -> TestNested +goldenJson name cb = do + goldenPath <- asks $ foldr () name + let actual = goldenPath ++ ".actual.json" + let golden = goldenPath ++ ".golden.json" + pure $ goldenVsFile name golden actual (cb actual) diff --git a/plutus-tx/plutus-tx.cabal b/plutus-tx/plutus-tx.cabal index 1aeb402c127..5f77a70190b 100644 --- a/plutus-tx/plutus-tx.cabal +++ b/plutus-tx/plutus-tx.cabal @@ -179,6 +179,7 @@ test-suite plutus-tx-test other-modules: Blueprint.Definition.Fixture Blueprint.Definition.Spec + Blueprint.Spec List.Spec Rational.Laws Rational.Laws.Additive diff --git a/plutus-tx/src/PlutusTx/Blueprint/Argument.hs b/plutus-tx/src/PlutusTx/Blueprint/Argument.hs index 9d8d8bb8e18..0f2ccf35ca2 100644 --- a/plutus-tx/src/PlutusTx/Blueprint/Argument.hs +++ b/plutus-tx/src/PlutusTx/Blueprint/Argument.hs @@ -28,7 +28,7 @@ data ArgumentBlueprint (referencedTypes :: [Type]) = MkArgumentBlueprint , argumentSchema :: Schema referencedTypes -- ^ A Plutus Data Schema. } - deriving stock (Show, Eq) + deriving stock (Show, Eq, Ord) instance ToJSON (ArgumentBlueprint referencedTypes) where toJSON MkArgumentBlueprint{..} = diff --git a/plutus-tx/src/PlutusTx/Blueprint/Contract.hs b/plutus-tx/src/PlutusTx/Blueprint/Contract.hs index 8090327541a..b6646c2f03e 100644 --- a/plutus-tx/src/PlutusTx/Blueprint/Contract.hs +++ b/plutus-tx/src/PlutusTx/Blueprint/Contract.hs @@ -1,5 +1,6 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE GADTs #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} @@ -12,52 +13,55 @@ import Data.Aeson (ToJSON (..), (.=)) import Data.Aeson qualified as Aeson import Data.Aeson.Extra (optionalField, requiredField) import Data.Aeson.Extra qualified as Aeson -import Data.Kind (Type) import Data.Map (Map) import Data.Map qualified as Map import Data.Set (Set) import Data.Text (Text) import PlutusPrelude (ensure) -import PlutusTx.Blueprint.Definition (DefinitionId) +import PlutusTx.Blueprint.Definition (DefinitionId, Definitions, definitionsToMap) import PlutusTx.Blueprint.Preamble (Preamble) -import PlutusTx.Blueprint.Schema (Schema) import PlutusTx.Blueprint.Validator (ValidatorBlueprint) {- | A blueprint of a smart contract, 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 - in a type-safe way. +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 the note ["Unrolling" types] for more details. -} -data ContractBlueprint (referencedTypes :: [Type]) = MkContractBlueprint - { 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 :: Map DefinitionId (Schema referencedTypes) - -- ^ A registry of schema definitions used across the blueprint. - } - deriving stock (Show) +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 -instance ToJSON (ContractBlueprint referencedTypes) where +instance ToJSON ContractBlueprint where toJSON MkContractBlueprint{..} = - Aeson.buildObject - $ requiredField "$schema" schemaUrl - . requiredField - "$vocabulary" - ( Aeson.object - [ "https://json-schema.org/draft/2020-12/vocab/core" .= True - , "https://json-schema.org/draft/2020-12/vocab/applicator" .= True - , "https://json-schema.org/draft/2020-12/vocab/validation" .= True - , "https://cips.cardano.org/cips/cip57" .= True - ] - ) - . requiredField "preamble" contractPreamble - . requiredField "validators" contractValidators - . optionalField "$id" contractId - . optionalField "definitions" (ensure (not . Map.null) contractDefinitions) + Aeson.buildObject $ + requiredField "$schema" schemaUrl + . requiredField + "$vocabulary" + ( Aeson.object + [ "https://json-schema.org/draft/2020-12/vocab/core" .= True + , "https://json-schema.org/draft/2020-12/vocab/applicator" .= True + , "https://json-schema.org/draft/2020-12/vocab/validation" .= True + , "https://cips.cardano.org/cips/cip57" .= True + ] + ) + . requiredField "preamble" contractPreamble + . requiredField "validators" contractValidators + . optionalField "$id" contractId + . optionalField "definitions" definitions where schemaUrl :: String schemaUrl = "https://cips.cardano.org/cips/cip57/schemas/plutus-blueprint.json" + + definitions :: Maybe (Map DefinitionId Aeson.Value) + definitions = ensure (not . Map.null) (definitionsToMap contractDefinitions toJSON) diff --git a/plutus-tx/src/PlutusTx/Blueprint/Definition.hs b/plutus-tx/src/PlutusTx/Blueprint/Definition.hs index 5e094f83de7..438c35ad30e 100644 --- a/plutus-tx/src/PlutusTx/Blueprint/Definition.hs +++ b/plutus-tx/src/PlutusTx/Blueprint/Definition.hs @@ -1,9 +1,12 @@ {-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE DataKinds #-} +{-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GADTs #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE PolyKinds #-} +{-# LANGUAGE RankNTypes #-} {-# LANGUAGE StandaloneKindSignatures #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} @@ -15,25 +18,176 @@ -- | This module provides a functionality to derive and reference schema definitions. module PlutusTx.Blueprint.Definition ( module DefinitionId, - HasSchemaDefinition, + Definitions (..), + Definition (..), + definition, definitionRef, - deriveSchemaDefinitions, + addDefinition, + definitionsToMap, + HasSchemaDefinition, + + -- ** Type-level utilities + Unroll, + UnrollAll, + Unrollable (..), + deriveDefinitions, ) where +import Prelude + import Data.Kind (Constraint, Type) import Data.Map (Map) import Data.Map qualified as Map +import Data.Text (Text) +import GHC.Generics (Generic (Rep), K1, M1, U1, type (:*:), type (:+:)) import GHC.TypeLits qualified as GHC import PlutusTx.Blueprint.Class (HasSchema, schema) -import PlutusTx.Blueprint.Definition.Id as DefinitionId +import PlutusTx.Blueprint.Definition.Id as DefinitionId (AsDefinitionId (..), DefinitionId (..)) import PlutusTx.Blueprint.Schema (Schema (..)) +import PlutusTx.Builtins.Internal (BuiltinByteString, BuiltinData, BuiltinList, BuiltinString, + BuiltinUnit) + +-- | A schema definition of a type @t@ with a list of referenced types @ts@. +data Definition t ts = MkDefinition DefinitionId (Schema ts) + deriving stock (Show) + +-- | A registry of schema definitions. +data Definitions (ts :: [Type]) where + NoDefinitions :: Definitions '[] + AddDefinition :: Definition t ts -> Definitions ts -> Definitions (t ': ts) + +deriving stock instance Show (Definitions ts) + +-- | Add a schema definition to a registry. +addDefinition :: Definitions ts -> Definition t ts -> Definitions (t ': ts) +addDefinition NoDefinitions d = AddDefinition d NoDefinitions +addDefinition (AddDefinition t s) d = AddDefinition d (AddDefinition t s) + +definitionsToMap :: Definitions ts -> (forall xs. Schema xs -> v) -> Map DefinitionId v +definitionsToMap NoDefinitions _k = Map.empty +definitionsToMap (AddDefinition (MkDefinition defId v) s) k = + Map.insert defId (k v) (definitionsToMap s k) + +-- | Construct a schema definition. +definition :: forall t ts. (AsDefinitionId t, HasSchema t ts) => Definition t ts +definition = MkDefinition (definitionId @t) (schema @t) -- | Construct a schema that is a reference to a schema definition. -definitionRef :: - forall typ types. - (AsDefinitionId typ, HasSchemaDefinition typ types) => - Schema types -definitionRef = SchemaDefinitionRef (definitionId @typ) +definitionRef :: forall t ts. (AsDefinitionId t, HasSchemaDefinition t ts) => Schema ts +definitionRef = SchemaDefinitionRef (definitionId @t) + +---------------------------------------------------------------------------------------------------- +-- Functionality to "unroll" types. -- For more context see the note ["Unrolling" types] ----------- + +{- Note ["Unrolling" types] + +ContractBlueprint needs to be parameterized by a list of types used in +a contract's type signature (including nested types) in order to: + a) produce a JSON-schema definition for every type used. + b) ensure that the schema definitions are referenced in a type-safe way. + +Given the following contract validator's type signature: + + typedValidator :: Redeemer -> Datum -> ScriptContext -> Bool + +and the following data type definitions: + + data Redeemer = MkRedeemer MyStruct + data MyStruct = MkMyStruct { field1 :: Integer, field2 :: Bool } + type Datum = () + +The ContractBlueprint type should be: + + ContractBlueprint '[Redeemer, MyStruct, Integer, Bool, ()] + +However, for contract blurprints authors specifying all the nested types manually is +cumbersome and error-prone. To make it easier to work with, we provide the Unroll type family +that can be used to traverse a type accumulating all types nested within it: + + Unroll Redeemer ~ '[Redeemer, MyStruct, Integer, Bool] + UnrollAll '[Redeemer, Datum] ~ '[Redeemer, MyStruct, Integer, Bool, ()] + +This way blueprint authors can specify the top-level types used in a contract and the UnrollAll +type family will take care of discovering all the nested types: + + Blueprint '[Redeemer, Datum] + + is equivalent to + + ContractBlueprint '[Redeemer, MyStruct, Integer, Bool, ()] + +-} + +type family UnrollAll xs :: [Type] where + UnrollAll '[] = '[] + UnrollAll (x ': xs) = Concat (Unroll x) (UnrollAll xs) + +{- | Unroll a type into a list of all nested types (including the type itself). + + If a type doesn't have a generic representation, then this type family gets "stuck". + The good news is that for the purpose of deriving schema definitions, we only need to + consider types that are either end-user defined (and therefore have a generic representation) or + built-in types that we explicitly list here as terminals in order not to get "stuck". +-} +type family Unroll (p :: Type) :: [Type] where + Unroll Int = '[Int] + Unroll Integer = '[Integer] + Unroll Text = '[Text] + Unroll BuiltinData = '[BuiltinData] + Unroll BuiltinUnit = '[BuiltinUnit] + Unroll BuiltinString = '[BuiltinString] + Unroll (BuiltinList a) = Prepend (BuiltinList a) (GUnroll (Rep a)) + Unroll BuiltinByteString = '[BuiltinByteString] + Unroll p = Prepend p (GUnroll (Break (NoGeneric p) (Rep p))) + +-- | Detect stuck type family: https://blog.csongor.co.uk/report-stuck-families/#custom-type-errors +type family Break e (rep :: Type -> Type) :: Type -> Type where + Break _ (M1 a b c) = M1 a b c + Break _ (f :*: g) = f :*: g + Break _ (f :+: g) = f :+: g + Break _ (K1 a b) = K1 a b + Break e U1 = U1 + Break e x = e + +type family NoGeneric t where + NoGeneric x = GHC.TypeError (GHC.Text "No instance for " GHC.:<>: GHC.ShowType (Generic x)) + +-- | Unroll a generic representation of a type into a list of all nested types. +type family GUnroll (t :: Type -> Type) :: [Type] where + GUnroll (M1 _ _ f) = GUnroll f + GUnroll (f :*: g) = GUnroll f ++ GUnroll g + GUnroll (f :+: g) = GUnroll f ++ GUnroll g + GUnroll (K1 _ c) = Unroll c + GUnroll U1 = '[] + +-- | Insert @x@ into @xs@ unless it's already there. +type Insert :: forall k. k -> [k] -> [k] +type family Insert x xs where + Insert x '[] = '[x] + Insert x (x : xs) = x ': xs + Insert x (y : xs) = y ': Insert x xs + +type Prepend :: forall k. k -> [k] -> [k] +type family Prepend x xs where + Prepend x '[] = '[x] + Prepend x (x : xs) = x ': xs + Prepend x (y : xs) = x ': y ': xs + +-- | Concatenates two type-level lists +type Concat :: forall k. [k] -> [k] -> [k] +type family Concat (as :: [k]) (bs :: [k]) :: [k] where + Concat '[] bs = bs + Concat as '[] = as + Concat (a : as) bs = a ': Concat as bs + +-- | Concatenates two type-level lists removing duplicates. +type (++) :: forall k. [k] -> [k] -> [k] +type family (as :: [k]) ++ (bs :: [k]) :: [k] where + '[] ++ bs = bs + as ++ '[] = as + (a : as) ++ bs = Insert a (as ++ bs) + +infixr 5 ++ {- | A constraint that checks if a schema definition is present in a list of schema definitions. @@ -49,67 +203,17 @@ type family HasSchemaDefinition n xs where GHC.:<>: GHC.Text " type was not found in the list of types having schema definitions." ) --- | Derive a map of schema definitions from a list of types. -deriveSchemaDefinitions :: - forall (types :: [Type]). - (AsDefinitionsEntries types types) => - Map DefinitionId (Schema types) -deriveSchemaDefinitions = Map.fromList (definitionEntries @types @types) - -{- | This class is only used internally to derive schema definition entries from a list of types. - -It uses 2 instances to iterate a type-level list: - * one instance terminates recursion when the list of [remaining] types to iterate is empty. - * another instance does a recursive step: - taking a head and tail, - adds a schema definition entry if the head is in the `allTypes` - and recurses on tail as `remainingTypes`. - -This way in the beginning of iteration `allTypes` == `remainingTypes` and then -`allTypes` stays the same list, while `remainingTypes` is shrinking until empty. - -Here is an analogy at the value level, where `remainingTypes` serves a similar purpose: - -@ -type Typ = String -type DefinitionId = String -type Schema = String - -asDefinitionEntries :: [Typ] -> [(DefinitionId, Schema)] -asDefinitionEntries allTypes = go allTypes allTypes - where - go :: [Typ] -> [Typ] -> [(DefinitionId, Schema)] - go allTypes remainingTypes = - case remainingTypes of - [] -> [] - (h : t) -> - let defId = lookupDefinitionId h allTypes - schema = lookupSchema h allTypes - in (defId, schema) : go allTypes t - -lookupDefinitionId :: Typ -> [Typ] -> DefinitionId -lookupDefinitionId t allTypes | t `elem` allTypes = "DefinitionId for " ++ t -lookupDefinitionId t _ = error $ "Type " ++ show t ++ " not found" - -lookupSchema :: Typ -> [Typ] -> Schema -lookupSchema t allTypes | t `elem` allTypes = "Schema for " ++ t -lookupSchema t _ = error $ "Type " ++ show t ++ " not found" -@ - +{- | This class and its two instances are used internally to derive +'Definitions' for a given list of types. -} -class AsDefinitionsEntries (allTypes :: [Type]) (remainingTypes :: [Type]) where - definitionEntries :: [(DefinitionId, Schema allTypes)] - -instance AsDefinitionsEntries allTypes '[] where - definitionEntries = [] - -instance - ( AsDefinitionId t - , HasSchema t allTypes - , AsDefinitionsEntries allTypes ts - ) => - AsDefinitionsEntries allTypes (t ': ts) - where - definitionEntries = - (definitionId @t, schema @t @allTypes) - : definitionEntries @allTypes @ts +class Unrollable ts where + unroll :: Definitions ts + +instance Unrollable '[] where + unroll = NoDefinitions + +instance (Unrollable ts, AsDefinitionId t, HasSchema t ts) => Unrollable (t : ts) where + unroll = addDefinition (unroll @ts) (definition @t) + +deriveDefinitions :: forall ts. (Unrollable (UnrollAll ts)) => Definitions (UnrollAll ts) +deriveDefinitions = unroll @(UnrollAll ts) diff --git a/plutus-tx/src/PlutusTx/Blueprint/Definition/Id.hs b/plutus-tx/src/PlutusTx/Blueprint/Definition/Id.hs index 5da436b7574..c4bd17115ee 100644 --- a/plutus-tx/src/PlutusTx/Blueprint/Definition/Id.hs +++ b/plutus-tx/src/PlutusTx/Blueprint/Definition/Id.hs @@ -1,8 +1,16 @@ -{-# LANGUAGE AllowAmbiguousTypes #-} -{-# LANGUAGE DefaultSignatures #-} -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE DerivingStrategies #-} -{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DefaultSignatures #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE UndecidableInstances #-} module PlutusTx.Blueprint.Definition.Id ( DefinitionId, @@ -18,7 +26,7 @@ import Data.Text (Text) import Data.Text qualified as Text import Data.Typeable (Proxy (..), Typeable, typeRep) import GHC.Generics (Generic) -import PlutusTx.Builtins (BuiltinByteString, BuiltinData, BuiltinString) +import PlutusTx.Builtins.Internal (BuiltinByteString, BuiltinData, BuiltinList, BuiltinString) -- | A reference to a Schema definition. newtype DefinitionId = MkDefinitionId {definitionIdToText :: Text} @@ -35,11 +43,19 @@ class AsDefinitionId a where instance AsDefinitionId () where definitionId = MkDefinitionId "Unit" + instance AsDefinitionId Bool + instance AsDefinitionId Integer + instance AsDefinitionId BuiltinData where definitionId = MkDefinitionId "Data" + instance AsDefinitionId BuiltinString where definitionId = MkDefinitionId "String" + instance AsDefinitionId BuiltinByteString where definitionId = MkDefinitionId "ByteString" + +instance (AsDefinitionId a) => AsDefinitionId (BuiltinList a) where + definitionId = MkDefinitionId $ "List_" <> definitionIdToText (definitionId @a) diff --git a/plutus-tx/src/PlutusTx/Blueprint/Parameter.hs b/plutus-tx/src/PlutusTx/Blueprint/Parameter.hs index 85963eded69..b8377e180ed 100644 --- a/plutus-tx/src/PlutusTx/Blueprint/Parameter.hs +++ b/plutus-tx/src/PlutusTx/Blueprint/Parameter.hs @@ -34,7 +34,7 @@ data ParameterBlueprint (referencedTypes :: [Type]) = MkParameterBlueprint , parameterSchema :: Schema referencedTypes -- ^ A Plutus Data Schema. } - deriving stock (Show, Eq) + deriving stock (Show, Eq, Ord) instance ToJSON (ParameterBlueprint referencedTypes) where toJSON MkParameterBlueprint{..} = diff --git a/plutus-tx/src/PlutusTx/Blueprint/Purpose.hs b/plutus-tx/src/PlutusTx/Blueprint/Purpose.hs index 74795c6e30c..d066370311a 100644 --- a/plutus-tx/src/PlutusTx/Blueprint/Purpose.hs +++ b/plutus-tx/src/PlutusTx/Blueprint/Purpose.hs @@ -9,13 +9,14 @@ import Prelude import Data.Aeson (ToJSON (..)) 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. -} data Purpose = Spend | Mint | Withdraw | Publish - deriving stock (Eq, Ord, Show) + deriving stock (Eq, Ord, Show, Lift) instance ToJSON Purpose where toJSON = Json.String . purposeToText diff --git a/plutus-tx/src/PlutusTx/Blueprint/Schema.hs b/plutus-tx/src/PlutusTx/Blueprint/Schema.hs index 571be5bfb77..5bf77fcd595 100644 --- a/plutus-tx/src/PlutusTx/Blueprint/Schema.hs +++ b/plutus-tx/src/PlutusTx/Blueprint/Schema.hs @@ -59,7 +59,7 @@ data Schema (referencedTypes :: [Type]) | SchemaAllOf (NonEmpty (Schema referencedTypes)) | SchemaNot (Schema referencedTypes) | SchemaDefinitionRef DefinitionId - deriving stock (Eq, Show, Generic, Data) + deriving stock (Eq, Ord, Show, Generic, Data) deriving anyclass instance (Typeable referencedTypes) => Plated (Schema referencedTypes) @@ -155,7 +155,7 @@ data IntegerSchema = MkIntegerSchema , exclusiveMaximum :: Maybe Integer -- ^ An instance is valid only if it is strictly less than "exclusiveMaximum". } - deriving stock (Eq, Show, Generic, Data) + deriving stock (Eq, Ord, Show, Generic, Data) emptyIntegerSchema :: IntegerSchema emptyIntegerSchema = @@ -176,7 +176,7 @@ data BytesSchema = MkBytesSchema , maxLength :: Maybe Natural -- ^ An instance is valid if its length is less than, or equal to, this value. } - deriving stock (Eq, Show, Generic, Data) + deriving stock (Eq, Ord, Show, Generic, Data) emptyBytesSchema :: BytesSchema emptyBytesSchema = MkBytesSchema{enum = [], minLength = Nothing, maxLength = Nothing} @@ -192,7 +192,7 @@ data ListSchema (referencedTypes :: [Type]) = MkListSchema -- ^ 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, Show, Generic, Data) + deriving stock (Eq, Ord, Show, Generic, Data) mkListSchema :: Schema referencedTypes -> ListSchema referencedTypes mkListSchema schema = @@ -213,7 +213,7 @@ data MapSchema (referencedTypes :: [Type]) = MkMapSchema , maxItems :: Maybe Natural -- ^ A map instance is valid if its size is less than, or equal to, this value. } - deriving stock (Eq, Show, Generic, Data) + deriving stock (Eq, Ord, Show, Generic, Data) data ConstructorSchema (referencedTypes :: [Type]) = MkConstructorSchema { index :: Natural @@ -221,7 +221,7 @@ data ConstructorSchema (referencedTypes :: [Type]) = MkConstructorSchema , fieldSchemas :: [Schema referencedTypes] -- ^ Field schemas } - deriving stock (Eq, Show, Generic, Data) + deriving stock (Eq, Ord, Show, Generic, Data) data PairSchema (referencedTypes :: [Type]) = MkPairSchema { left :: Schema referencedTypes @@ -229,4 +229,4 @@ data PairSchema (referencedTypes :: [Type]) = MkPairSchema , right :: Schema referencedTypes -- ^ Schema of the second element } - deriving stock (Eq, Show, Generic, Data) + 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 193069cfb72..29b78f4178b 100644 --- a/plutus-tx/src/PlutusTx/Blueprint/Schema/Annotation.hs +++ b/plutus-tx/src/PlutusTx/Blueprint/Schema/Annotation.hs @@ -27,7 +27,7 @@ data SchemaInfo = MkSchemaInfo , description :: Maybe String , comment :: Maybe String } - deriving stock (Eq, Show, Generic, Data, Lift) + deriving stock (Eq, Ord, Show, Generic, Data, Lift) emptySchemaInfo :: SchemaInfo emptySchemaInfo = MkSchemaInfo Nothing Nothing Nothing @@ -69,7 +69,7 @@ This annotation could be attached to a type or constructor: newtype MyFoo = MkMyFoo Int @ -} -newtype SchemaTitle = SchemaTitle String +newtype SchemaTitle = SchemaTitle {schemaTitleToString :: String} deriving newtype (Eq, Ord, Show, Typeable, ToJSON) deriving stock (Data, Lift) @@ -82,7 +82,7 @@ This annotation could be attached to a type or constructor: newtype MyFoo = MkMyFoo Int @ -} -newtype SchemaDescription = SchemaDescription String +newtype SchemaDescription = SchemaDescription {schemaDescriptionToString :: String} deriving newtype (Eq, Ord, Show, Typeable, ToJSON) deriving stock (Data, Lift) @@ -95,6 +95,6 @@ This annotation could be attached to a type or constructor: newtype MyFoo = MkMyFoo Int @ -} -newtype SchemaComment = SchemaComment String +newtype SchemaComment = SchemaComment {schemaCommentToString :: String} deriving newtype (Eq, Ord, Show, Typeable, ToJSON) deriving stock (Data, Lift) diff --git a/plutus-tx/src/PlutusTx/Blueprint/TH.hs b/plutus-tx/src/PlutusTx/Blueprint/TH.hs index ad39aff0f77..53bc9ee8adb 100644 --- a/plutus-tx/src/PlutusTx/Blueprint/TH.hs +++ b/plutus-tx/src/PlutusTx/Blueprint/TH.hs @@ -1,4 +1,5 @@ {-# LANGUAGE CPP #-} +{-# LANGUAGE EmptyCase #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE RecordWildCards #-} @@ -14,16 +15,22 @@ import Prelude import Data.Data (Data) import Data.List (nub) import Data.List.NonEmpty qualified as NE +import Data.Set (Set) +import Data.Text qualified as Text import GHC.Natural (naturalToInteger) import Language.Haskell.TH qualified as TH import Language.Haskell.TH.Datatype qualified as TH import Numeric.Natural (Natural) -import PlutusPrelude (for, (<<$>>)) +import PlutusPrelude (for, (<&>), (<<$>>)) +import PlutusTx.Blueprint.Argument (ArgumentBlueprint (..)) import PlutusTx.Blueprint.Class (HasSchema (..)) import PlutusTx.Blueprint.Definition (HasSchemaDefinition) +import PlutusTx.Blueprint.Parameter (ParameterBlueprint (..)) +import PlutusTx.Blueprint.Purpose (Purpose) import PlutusTx.Blueprint.Schema (ConstructorSchema (..), Schema (..)) import PlutusTx.Blueprint.Schema.Annotation (SchemaAnn (..), SchemaComment, SchemaDescription, - SchemaInfo (..), SchemaTitle, annotationsToSchemaInfo) + SchemaInfo (..), SchemaTitle, annotationsToSchemaInfo, + schemaDescriptionToString, schemaTitleToString) import PlutusTx.IsData.TH (makeIsDataIndexed) {- | @@ -85,9 +92,6 @@ makeHasSchemaInstance dataTypeName indices = do description <- MkSchemaAnnDescription <<$>> lookupAnn @SchemaDescription name comment <- MkSchemaAnnComment <<$>> lookupAnn @SchemaComment name pure $ title ++ description ++ comment - where - lookupAnn :: (Data a) => TH.Name -> TH.Q [a] - lookupAnn = TH.reifyAnnotations . TH.AnnLookupName -- | Make SchemaInfo from a list of schema annotations, failing in case of ambiguity. schemaInfoFromAnns :: [SchemaAnn] -> TH.Q SchemaInfo @@ -117,3 +121,45 @@ mkSchemaClause ts ctorIndexes = mkSchemaConstructor (TH.ConstructorInfo{..}, info, naturalToInteger -> ctorIndex) = do fields <- for constructorFields $ \t -> [|definitionRef @($(pure t)) @($(pure ts))|] [|SchemaConstructor info (MkConstructorSchema ctorIndex $(pure (TH.ListE fields)))|] + +deriveParameterBlueprint :: TH.Name -> Set Purpose -> TH.ExpQ +deriveParameterBlueprint tyName purpose = do + title <- Text.pack . schemaTitleToString <<$>> lookupSchemaTitle tyName + description <- Text.pack . schemaDescriptionToString <<$>> lookupSchemaDescription tyName + [| MkParameterBlueprint + { parameterTitle = title + , parameterDescription = description + , parameterPurpose = purpose + , parameterSchema = definitionRef @($(TH.conT tyName)) + } + |] + +deriveArgumentBlueprint :: TH.Name -> Set Purpose -> TH.ExpQ +deriveArgumentBlueprint tyName purpose = do + title <- Text.pack . schemaTitleToString <<$>> lookupSchemaTitle tyName + description <- Text.pack . schemaDescriptionToString <<$>> lookupSchemaDescription tyName + [| MkArgumentBlueprint + { argumentTitle = title + , argumentDescription = description + , argumentPurpose = purpose + , argumentSchema = definitionRef @($(TH.conT tyName)) + } + |] + +---------------------------------------------------------------------------------------------------- +-- TH Utilities ------------------------------------------------------------------------------------ + +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 + [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 + [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 100437b943f..bd18fbfa84b 100644 --- a/plutus-tx/src/PlutusTx/Blueprint/Validator.hs +++ b/plutus-tx/src/PlutusTx/Blueprint/Validator.hs @@ -13,7 +13,7 @@ import Data.Aeson.Extra (buildObject, optionalField, requiredField) import Data.ByteString (ByteString) import Data.ByteString.Base16 qualified as Base16 import Data.Kind (Type) -import Data.List.NonEmpty (NonEmpty) +import Data.List.NonEmpty qualified as NE import Data.Text (Text) import Data.Text.Encoding qualified as Text import PlutusCore.Crypto.Hash (blake2b_224) @@ -22,9 +22,9 @@ import PlutusTx.Blueprint.Parameter (ParameterBlueprint) {- | 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 - in a type-safe way. +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 +in a type-safe way. -} data ValidatorBlueprint (referencedTypes :: [Type]) = MkValidatorBlueprint { validatorTitle :: Text @@ -35,12 +35,12 @@ data ValidatorBlueprint (referencedTypes :: [Type]) = MkValidatorBlueprint -- ^ A description of the redeemer format expected by this validator. , validatorDatum :: Maybe (ArgumentBlueprint referencedTypes) -- ^ A description of the datum format expected by this validator. - , validatorParameters :: Maybe (NonEmpty (ParameterBlueprint referencedTypes)) + , validatorParameters :: [ParameterBlueprint referencedTypes] -- ^ A list of parameters required by the script. , validatorCompiledCode :: Maybe ByteString -- ^ A full compiled and CBOR-encoded serialized flat script. } - deriving stock (Show, Eq) + deriving stock (Show, Eq, Ord) instance ToJSON (ValidatorBlueprint referencedTypes) where toJSON MkValidatorBlueprint{..} = @@ -49,7 +49,7 @@ instance ToJSON (ValidatorBlueprint referencedTypes) where . requiredField "redeemer" validatorRedeemer . optionalField "description" validatorDescription . optionalField "datum" validatorDatum - . optionalField "parameters" validatorParameters + . optionalField "parameters" (NE.nonEmpty validatorParameters) . optionalField "compiledCode" (toHex <$> validatorCompiledCode) . optionalField "hash" (toHex . blake2b_224 <$> validatorCompiledCode) where diff --git a/plutus-tx/src/PlutusTx/Blueprint/Write.hs b/plutus-tx/src/PlutusTx/Blueprint/Write.hs index 16eb9c476a7..4ca01cdabb5 100644 --- a/plutus-tx/src/PlutusTx/Blueprint/Write.hs +++ b/plutus-tx/src/PlutusTx/Blueprint/Write.hs @@ -12,10 +12,10 @@ import Data.ByteString.Lazy qualified as LBS import PlutusTx.Blueprint.Contract (ContractBlueprint) import Prelude -writeBlueprint :: FilePath -> ContractBlueprint types -> IO () -writeBlueprint f = LBS.writeFile f . encodeBlueprint +writeBlueprint :: FilePath -> ContractBlueprint -> IO () +writeBlueprint f blueprint = LBS.writeFile f (encodeBlueprint blueprint) -encodeBlueprint :: ContractBlueprint types -> LBS.ByteString +encodeBlueprint :: ContractBlueprint -> LBS.ByteString encodeBlueprint = encodePretty' Pretty.defConfig diff --git a/plutus-tx/src/PlutusTx/Builtins/Internal.hs b/plutus-tx/src/PlutusTx/Builtins/Internal.hs index ec9344c7972..cdaa73e6eb3 100644 --- a/plutus-tx/src/PlutusTx/Builtins/Internal.hs +++ b/plutus-tx/src/PlutusTx/Builtins/Internal.hs @@ -10,6 +10,9 @@ -- they're NOINLINE! {-# 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 -- in Plutus Core. -- @@ -22,13 +25,13 @@ import Data.ByteArray qualified as BA import Data.ByteString qualified as BS import Data.ByteString.Lazy qualified as BSL import Data.Coerce (coerce) -import Data.Data +import Data.Data (Data) import Data.Foldable qualified as Foldable import Data.Hashable (Hashable (..)) import Data.Kind (Type) import Data.Text as Text (Text, empty) import Data.Text.Encoding as Text (decodeUtf8, encodeUtf8) -import GHC.Generics +import GHC.Generics (Generic) import PlutusCore.Bitwise.Convert qualified as Convert import PlutusCore.Builtin (BuiltinResult (..)) import PlutusCore.Crypto.BLS12_381.G1 qualified as BLS12_381.G1 @@ -397,7 +400,7 @@ tail (BuiltinList (_:xs)) = BuiltinList xs tail (BuiltinList []) = Haskell.error "empty list" {-# NOINLINE chooseList #-} -chooseList :: BuiltinList a -> b -> b-> b +chooseList :: BuiltinList a -> b -> b -> b chooseList (BuiltinList []) b1 _ = b1 chooseList (BuiltinList (_:_)) _ b2 = b2 @@ -470,7 +473,7 @@ mkConstr i (BuiltinList args) = BuiltinData (PLC.Constr i (fmap builtinDataToDat {-# NOINLINE mkMap #-} mkMap :: BuiltinList (BuiltinPair BuiltinData BuiltinData) -> BuiltinData -mkMap (BuiltinList es) = BuiltinData (PLC.Map $ (fmap p2p es)) +mkMap (BuiltinList es) = BuiltinData (PLC.Map (fmap p2p es)) where p2p (BuiltinPair (d, d')) = (builtinDataToData d, builtinDataToData d') diff --git a/plutus-tx/test/Blueprint/Definition/Fixture.hs b/plutus-tx/test/Blueprint/Definition/Fixture.hs index 69be134e07e..b174a5d5475 100644 --- a/plutus-tx/test/Blueprint/Definition/Fixture.hs +++ b/plutus-tx/test/Blueprint/Definition/Fixture.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE FlexibleInstances #-} @@ -12,14 +11,18 @@ module Blueprint.Definition.Fixture where import Prelude +import GHC.Generics (Generic) import PlutusTx.Blueprint.Definition (AsDefinitionId, definitionRef) import PlutusTx.Blueprint.TH (makeIsDataSchemaIndexed) newtype T1 = MkT1 Integer - deriving anyclass (AsDefinitionId) + deriving stock (Generic) + +deriving anyclass instance (AsDefinitionId T1) +$(makeIsDataSchemaIndexed ''T1 [('MkT1, 0)]) data T2 = MkT2 T1 T1 - deriving anyclass (AsDefinitionId) + deriving stock (Generic) -$(makeIsDataSchemaIndexed ''T1 [('MkT1, 0)]) +deriving anyclass instance (AsDefinitionId T2) $(makeIsDataSchemaIndexed ''T2 [('MkT2, 0)]) diff --git a/plutus-tx/test/Blueprint/Definition/Spec.hs b/plutus-tx/test/Blueprint/Definition/Spec.hs index f034fc4ad6b..1d3fbc9f3a5 100644 --- a/plutus-tx/test/Blueprint/Definition/Spec.hs +++ b/plutus-tx/test/Blueprint/Definition/Spec.hs @@ -1,8 +1,11 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GADTs #-} {-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE PartialTypeSignatures #-} {-# LANGUAGE PolyKinds #-} +{-# LANGUAGE RankNTypes #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-} @@ -13,10 +16,11 @@ import Prelude import Blueprint.Definition.Fixture qualified as Fixture import Control.Lens.Plated (universe) +import Data.Map (Map) import Data.Map qualified as Map import Data.Set (isSubsetOf) import Data.Set qualified as Set -import PlutusTx.Blueprint.Definition +import PlutusTx.Blueprint.Definition (DefinitionId, definitionsToMap, deriveDefinitions) import PlutusTx.Blueprint.Schema (Schema (..)) import Test.Tasty (TestTree, testGroup) import Test.Tasty.HUnit (Assertion, testCase, (@?), (@?=)) @@ -27,7 +31,7 @@ tests = "PlutusTx.Blueprint.Definition" [ testCase "Derived definitions are empty when no types are provided." - (deriveSchemaDefinitions @'[] @?= Map.empty) + (definitionsToMap (deriveDefinitions @'[]) (const ()) @?= mempty) , testCase "There are not less schema definitions than listed domain types." atLeastAsManyDefinitionsAsTypes @@ -41,8 +45,7 @@ atLeastAsManyDefinitionsAsTypes = (length (Map.keys definitions) >= 3) @? "Not enough schema definitions: < 3" where - definitions = - deriveSchemaDefinitions @[Fixture.T1, Fixture.T2, Integer] + definitions = definitionsToMap (deriveDefinitions @[Fixture.T1, Fixture.T2, Integer]) (const ()) allReferencedDefinitionsAreDefined :: Assertion allReferencedDefinitionsAreDefined = @@ -53,11 +56,15 @@ allReferencedDefinitionsAreDefined = Set.fromList [ ref | schemas <- universe (Map.elems definitions) - , SchemaDefinitionRef ref <- schemas + , SomeSchema (SchemaDefinitionRef ref) <- schemas ] - definedIds = - Set.fromList (Map.keys definitions) + definedIds = Set.fromList (Map.keys definitions) + + definitions :: Map DefinitionId SomeSchema definitions = -- Here T2 depends on T1 (and not vice-versa) but we intentionally provide them out of order -- to prove that any order is valid. - deriveSchemaDefinitions @[Fixture.T1, Fixture.T2, Integer] + definitionsToMap (deriveDefinitions @[Fixture.T1, Fixture.T2, Integer]) SomeSchema + +data SomeSchema where + SomeSchema :: Schema xs -> SomeSchema diff --git a/plutus-tx/test/Blueprint/Spec.hs b/plutus-tx/test/Blueprint/Spec.hs new file mode 100644 index 00000000000..5699a4ab6a6 --- /dev/null +++ b/plutus-tx/test/Blueprint/Spec.hs @@ -0,0 +1,73 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeOperators #-} + +module Blueprint.Spec where + +import Prelude + +import Data.Typeable ((:~:) (Refl)) +import GHC.Generics (Generic) +import PlutusTx.Blueprint.Class (HasSchema (..)) +import PlutusTx.Blueprint.Definition (AsDefinitionId, Definitions, Unroll, UnrollAll, + Unrollable (..)) +import PlutusTx.Blueprint.Schema (Schema (..)) +import PlutusTx.Blueprint.Schema.Annotation (emptySchemaInfo) + +testUnrollNop :: Unroll Nop :~: '[Nop] +testUnrollNop = Refl + +testUnrollBaz :: Unroll Baz :~: [Baz, Integer] +testUnrollBaz = Refl + +testUnrollZap :: Unroll Zap :~: [Zap, Nop, Integer, Bool] +testUnrollZap = Refl + +testUnrollBar :: Unroll Bar :~: [Bar, Zap, Nop, Integer, Bool, Baz] +testUnrollBar = Refl + +testUnrollFoo :: Unroll Foo :~: [Foo, Bar, Zap, Nop, Integer, Bool, Baz] +testUnrollFoo = Refl + +testUnrollAll :: UnrollAll [Nop, Baz] :~: [Nop, Baz, Integer] +testUnrollAll = Refl + +definitions :: Definitions [Foo, Bar, Zap, Nop, Integer, Bool, Baz] +definitions = unroll @(UnrollAll '[Foo]) + +---------------------------------------------------------------------------------------------------- +-- Test fixture ------------------------------------------------------------------------------------ + +newtype Foo = MkFoo Bar +deriving stock instance (Generic Foo) +deriving anyclass instance (AsDefinitionId Foo) +instance HasSchema Foo ts where + schema = SchemaBuiltInUnit emptySchemaInfo + +data Bar = MkBar Baz Zap +deriving stock instance (Generic Bar) +deriving anyclass instance (AsDefinitionId Bar) +instance HasSchema Bar ts where + schema = SchemaBuiltInUnit emptySchemaInfo + +data Baz = MkBaz Integer Integer +deriving stock instance (Generic Baz) +deriving anyclass instance (AsDefinitionId Baz) +instance HasSchema Baz ts where + schema = SchemaBuiltInUnit emptySchemaInfo + +data Zap = MkZap Bool Integer Nop +deriving stock instance (Generic Zap) +deriving anyclass instance (AsDefinitionId Zap) +instance HasSchema Zap ts where + schema = SchemaBuiltInUnit emptySchemaInfo + +data Nop = MkNop +deriving stock instance (Generic Nop) +deriving anyclass instance (AsDefinitionId Nop) +instance HasSchema Nop ts where + schema = SchemaBuiltInUnit emptySchemaInfo From 5879f8e9fc68a444b6ab8645759916060090a593 Mon Sep 17 00:00:00 2001 From: Ana Pantilie <45069775+ana-pantilie@users.noreply.github.com> Date: Tue, 19 Mar 2024 19:49:46 +0200 Subject: [PATCH 3/8] Document unsafe operations of `AssocMap` (#5838) --- .../Marlowe/Core/V1/Semantics.hs | 6 +- .../src/PlutusLedgerApi/V1/Value.hs | 19 ++++- plutus-ledger-api/src/PlutusLedgerApi/V2.hs | 4 +- plutus-ledger-api/src/PlutusLedgerApi/V3.hs | 2 +- plutus-ledger-api/test-plugin/Spec/Budget.hs | 3 +- plutus-ledger-api/test-plugin/Spec/Value.hs | 2 +- .../testlib/PlutusLedgerApi/Test/V1/Value.hs | 2 +- ..._ana.pantilie95_plt_9511_audit_assocmap.md | 8 ++ plutus-tx/src/PlutusTx/AssocMap.hs | 76 ++++++++++++++----- 9 files changed, 91 insertions(+), 31 deletions(-) create mode 100644 plutus-tx/changelog.d/20240315_151519_ana.pantilie95_plt_9511_audit_assocmap.md diff --git a/plutus-benchmark/marlowe/src/PlutusBenchmark/Marlowe/Core/V1/Semantics.hs b/plutus-benchmark/marlowe/src/PlutusBenchmark/Marlowe/Core/V1/Semantics.hs index 221603c2b35..918462e4a5d 100644 --- a/plutus-benchmark/marlowe/src/PlutusBenchmark/Marlowe/Core/V1/Semantics.hs +++ b/plutus-benchmark/marlowe/src/PlutusBenchmark/Marlowe/Core/V1/Semantics.hs @@ -328,12 +328,12 @@ refundOne accounts = case Map.toList accounts of -- Isabelle semantics in that it returns the least-recently -- added account-token combination rather than the first -- lexicographically ordered one. Also, the sequence - -- `Map.fromList . tail . Map.toList` preserves the + -- `Map.unsafeFromList . tail . Map.toList` preserves the -- invariants of order and non-duplication. ((accId, token), balance) : rest -> if balance > 0 - then Just ((accId, token, balance), Map.fromList rest) - else refundOne (Map.fromList rest) + then Just ((accId, token, balance), Map.unsafeFromList rest) + else refundOne (Map.unsafeFromList rest) -- | Obtains the amount of money available an account. diff --git a/plutus-ledger-api/src/PlutusLedgerApi/V1/Value.hs b/plutus-ledger-api/src/PlutusLedgerApi/V1/Value.hs index 014004a78ad..99eace37ae5 100644 --- a/plutus-ledger-api/src/PlutusLedgerApi/V1/Value.hs +++ b/plutus-ledger-api/src/PlutusLedgerApi/V1/Value.hs @@ -262,6 +262,7 @@ instance MeetSemiLattice Value where {-# INLINABLE valueOf #-} -- | Get the quantity of the given currency in the 'Value'. +-- Assumes that the underlying map doesn't contain duplicate keys. valueOf :: Value -> CurrencySymbol -> TokenName -> Integer valueOf (Value mp) cur tn = case Map.lookup cur mp of @@ -271,6 +272,8 @@ valueOf (Value mp) cur tn = Just v -> v {-# INLINABLE currencySymbolValueOf #-} +-- | Get the total value of the currency symbol in the 'Value' map. +-- Assumes that the underlying map doesn't contain duplicate keys. currencySymbolValueOf :: Value -> CurrencySymbol -> Integer currencySymbolValueOf (Value mp) cur = case Map.lookup cur mp of Nothing -> 0 @@ -290,8 +293,8 @@ singleton :: CurrencySymbol -> TokenName -> Integer -> Value singleton c tn i = Value (Map.singleton c (Map.singleton tn i)) {-# INLINABLE lovelaceValue #-} -lovelaceValue :: Lovelace -> Value -- | A 'Value' containing the given quantity of Lovelace. +lovelaceValue :: Lovelace -> Value lovelaceValue = singleton adaSymbol adaToken . getLovelace {-# INLINABLE lovelaceValueOf #-} @@ -310,7 +313,7 @@ assetClassValueOf :: Value -> AssetClass -> Integer assetClassValueOf v (AssetClass (c, t)) = valueOf v c t {-# INLINABLE unionVal #-} --- | Combine two 'Value' maps +-- | Combine two 'Value' maps, assumes the well-definedness of the two maps. unionVal :: Value -> Value -> Map.Map CurrencySymbol (Map.Map TokenName (These Integer Integer)) unionVal (Value l) (Value r) = let @@ -322,6 +325,8 @@ unionVal (Value l) (Value r) = in unThese <$> combined {-# INLINABLE unionWith #-} +-- | Combine two 'Value' maps with the argument function. +-- Assumes the well-definedness of the two maps. unionWith :: (Integer -> Integer -> Integer) -> Value -> Value -> Value unionWith f ls rs = let @@ -336,6 +341,7 @@ unionWith f ls rs = -- | Convert a 'Value' to a simple list, keeping only the non-zero amounts. -- Note that the result isn't sorted, meaning @v1 == v2@ doesn't generally imply -- @flattenValue v1 == flattenValue v2@. +-- Also assumes that there are no duplicate keys in the 'Value' 'Map'. flattenValue :: Value -> [(CurrencySymbol, TokenName, Integer)] flattenValue v = goOuter [] (Map.toList $ getValue v) where @@ -355,6 +361,8 @@ isZero :: Value -> Bool isZero (Value xs) = Map.all (Map.all (\i -> 0 == i)) xs {-# INLINABLE checkPred #-} +-- | Checks whether a predicate holds for all the values in a 'Value' +-- union. Assumes the well-definedness of the two underlying 'Map's. checkPred :: (These Integer Integer -> Bool) -> Value -> Value -> Bool checkPred f l r = let @@ -417,8 +425,11 @@ split (Value mp) = (negate (Value neg), Value pos) where (l, r) = Map.mapThese (\i -> if i <= 0 then This i else That i) mp' {-# INLINABLE unordEqWith #-} -{- | Check equality of two lists given a function checking whether a 'Value' is zero and a function -checking equality of values. +{- | Check equality of two lists of distinct key-value pairs, each value being uniquely +identified by a key, given a function checking whether a 'Value' is zero and a function +checking equality of values. Note that the caller must ensure that the two lists are +well-defined in this sense. This is not checked or enforced in `unordEqWith`, and therefore +it might yield undefined results for ill-defined input. This function recurses on both the lists in parallel and checks whether the key-value pairs are equal pointwise. If there is a mismatch, then it tries to find the left key-value pair in the right diff --git a/plutus-ledger-api/src/PlutusLedgerApi/V2.hs b/plutus-ledger-api/src/PlutusLedgerApi/V2.hs index 6cd8f5d998c..ab17125c809 100644 --- a/plutus-ledger-api/src/PlutusLedgerApi/V2.hs +++ b/plutus-ledger-api/src/PlutusLedgerApi/V2.hs @@ -100,7 +100,7 @@ module PlutusLedgerApi.V2 ( -- *** Association maps Map, - fromList, + unsafeFromList, -- *** Newtypes and hash types ScriptHash (..), @@ -138,7 +138,7 @@ import PlutusLedgerApi.V2.ParamName import PlutusLedgerApi.V2.Tx (OutputDatum (..)) import PlutusCore.Data qualified as PLC -import PlutusTx.AssocMap (Map, fromList) +import PlutusTx.AssocMap (Map, unsafeFromList) import Control.Monad.Except (MonadError) diff --git a/plutus-ledger-api/src/PlutusLedgerApi/V3.hs b/plutus-ledger-api/src/PlutusLedgerApi/V3.hs index 936834c23c3..d6249a9e8d9 100644 --- a/plutus-ledger-api/src/PlutusLedgerApi/V3.hs +++ b/plutus-ledger-api/src/PlutusLedgerApi/V3.hs @@ -118,7 +118,7 @@ module PlutusLedgerApi.V3 ( -- *** Association maps V2.Map, - V2.fromList, + V2.unsafeFromList, -- *** Newtypes and hash types V2.ScriptHash (..), diff --git a/plutus-ledger-api/test-plugin/Spec/Budget.hs b/plutus-ledger-api/test-plugin/Spec/Budget.hs index ec22c9b461c..f2393bf912f 100644 --- a/plutus-ledger-api/test-plugin/Spec/Budget.hs +++ b/plutus-ledger-api/test-plugin/Spec/Budget.hs @@ -50,7 +50,8 @@ compiledCurrencySymbolValueOf :: CompiledCode (Value -> CurrencySymbol -> Intege compiledCurrencySymbolValueOf = $$(compile [||currencySymbolValueOf||]) mkValue :: [(Integer, [(Integer, Integer)])] -> Value -mkValue = Value . Map.fromList . fmap (bimap toSymbol (Map.fromList . fmap (first toToken))) +mkValue = + Value . Map.unsafeFromList . fmap (bimap toSymbol (Map.unsafeFromList . fmap (first toToken))) toSymbol :: Integer -> CurrencySymbol toSymbol = currencySymbol . fromString . show diff --git a/plutus-ledger-api/test-plugin/Spec/Value.hs b/plutus-ledger-api/test-plugin/Spec/Value.hs index b2b920793a9..87ad1c6ec24 100644 --- a/plutus-ledger-api/test-plugin/Spec/Value.hs +++ b/plutus-ledger-api/test-plugin/Spec/Value.hs @@ -147,7 +147,7 @@ currencyLongListOptions = ListTx.concatMap (maybe longCurrencyChunk pure) currencyListWithHooks listsToValue :: [(CurrencySymbol, [(TokenName, Integer)])] -> Value -listsToValue = Value . AssocMap.fromList . ListTx.map (fmap AssocMap.fromList) +listsToValue = Value . AssocMap.unsafeFromList . ListTx.map (fmap AssocMap.unsafeFromList) valueToLists :: Value -> [(CurrencySymbol, [(TokenName, Integer)])] valueToLists = ListTx.map (fmap AssocMap.toList) . AssocMap.toList . getValue diff --git a/plutus-ledger-api/testlib/PlutusLedgerApi/Test/V1/Value.hs b/plutus-ledger-api/testlib/PlutusLedgerApi/Test/V1/Value.hs index 3386e38947b..90afa8a1ee4 100644 --- a/plutus-ledger-api/testlib/PlutusLedgerApi/Test/V1/Value.hs +++ b/plutus-ledger-api/testlib/PlutusLedgerApi/Test/V1/Value.hs @@ -18,7 +18,7 @@ import Test.QuickCheck -- | Convert a list representation of a 'Value' to the 'Value'. listsToValue :: [(CurrencySymbol, [(TokenName, Integer)])] -> Value -listsToValue = Value . AssocMap.fromList . ListTx.map (fmap AssocMap.fromList) +listsToValue = Value . AssocMap.unsafeFromList . ListTx.map (fmap AssocMap.unsafeFromList) -- | Convert a 'Value' to its list representation. valueToLists :: Value -> [(CurrencySymbol, [(TokenName, Integer)])] 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 new file mode 100644 index 00000000000..37a9d4d0a9f --- /dev/null +++ b/plutus-tx/changelog.d/20240315_151519_ana.pantilie95_plt_9511_audit_assocmap.md @@ -0,0 +1,8 @@ +### 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/src/PlutusTx/AssocMap.hs b/plutus-tx/src/PlutusTx/AssocMap.hs index 2053038e206..12cfce5684c 100644 --- a/plutus-tx/src/PlutusTx/AssocMap.hs +++ b/plutus-tx/src/PlutusTx/AssocMap.hs @@ -18,8 +18,8 @@ module PlutusTx.AssocMap ( singleton, empty, null, - fromList, - fromListSafe, + unsafeFromList, + safeFromList, toList, keys, elems, @@ -53,15 +53,27 @@ import GHC.Generics (Generic) import Language.Haskell.TH.Syntax as TH (Lift) import Prettyprinter (Pretty (..)) -{- HLINT ignore "Use newtype instead of data" -} - -- 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! newtype Map k v = Map {unMap :: [(k, v)]} deriving stock (Generic, Haskell.Eq, Haskell.Show, Data, TH.Lift) deriving newtype (Eq, Ord, NFData) --- Hand-written instances to use the underlying 'Map' type in 'Data', and +-- | 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) @@ -74,6 +86,11 @@ instance (ToData k, ToData v) => ToData (Map k v) where go [] = BI.mkNilPairData BI.unitval 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 d = P.matchData' @@ -104,6 +121,12 @@ instance (FromData k, FromData v) => FromData (Map k v) where ) () +-- | 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. @@ -151,23 +174,27 @@ 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 -{-# INLINEABLE fromList #-} -fromList :: [(k, v)] -> Map k v -fromList = Map +{-# INLINEABLE unsafeFromList #-} +-- | 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 fromListSafe #-} +{-# INLINEABLE safeFromList #-} -- | 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. -fromListSafe :: Eq k => [(k, v)] -> Map k v -fromListSafe = foldr (uncurry insert) empty +safeFromList :: Eq k => [(k, v)] -> Map k v +safeFromList = foldr (uncurry insert) empty {-# INLINEABLE toList #-} toList :: Map k v -> [(k, v)] toList (Map l) = l {-# INLINEABLE lookup #-} - --- | Find an entry in a 'Map'. +-- | 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 @@ -191,6 +218,9 @@ insert k v (Map xs) = Map (go xs) go ((k', v') : rest) = if k == k' then (k, v) : rest else (k', v') : go rest {-# INLINEABLE delete #-} +-- | 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 @@ -200,11 +230,17 @@ delete key (Map ls) = Map (go ls) | otherwise = (k, v) : go rest {-# INLINEABLE keys #-} --- | The keys of a 'Map'. +-- | 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 --- | Combine two 'Map's. +-- | 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 @@ -216,6 +252,7 @@ union (Map ls) (Map rs) = ls' :: [(k, These v r)] ls' = P.fmap (\(c, i) -> (c, f i (lookup c (Map rs)))) ls + -- Keeps only those keys which don't appear in the left map. rs' :: [(k, r)] rs' = P.filter (\(c, _) -> not (any (\(c', _) -> c' == c) ls)) rs @@ -225,8 +262,12 @@ union (Map ls) (Map rs) = Map (ls' ++ rs'') {-# INLINEABLE unionWith #-} - -- | 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 @@ -244,7 +285,6 @@ unionWith merge (Map ls) (Map rs) = Map (ls' ++ rs') {-# INLINEABLE mapThese #-} - -- | 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) @@ -280,7 +320,7 @@ filter f (Map m) = Map $ P.filter (f . snd) m {-# INLINEABLE elems #-} --- | Return all elements of the map in the ascending order of their keys. +-- | Return all elements of the map. elems :: Map k v -> [v] elems (Map xs) = P.fmap (\(_ :: k, v) -> v) xs From 973e03bbccbe3b860e2c8bf70c2f49418811a6ce Mon Sep 17 00:00:00 2001 From: Joseph Fajen <104791413+joseph-fajen@users.noreply.github.com> Date: Tue, 19 Mar 2024 12:31:03 -0700 Subject: [PATCH 4/8] Added info about PlutusV3 to the Read-the-docs page about Plutus language changes (#5844) * added info for PlutusV3 * incorporating minor review comments --- .../reference/cardano/language-changes.rst | 50 +++++++++++++++++-- 1 file changed, 46 insertions(+), 4 deletions(-) diff --git a/doc/read-the-docs-site/reference/cardano/language-changes.rst b/doc/read-the-docs-site/reference/cardano/language-changes.rst index e6b09155df1..047cf77917c 100644 --- a/doc/read-the-docs-site/reference/cardano/language-changes.rst +++ b/doc/read-the-docs-site/reference/cardano/language-changes.rst @@ -8,12 +8,12 @@ Language versions See the documentation on :ref:`language versions ` for an explanation of what they are. -Plutus V1 +PlutusV1 ~~~~~~~~~~ ``PlutusV1`` was the initial version of Plutus, introduced in the Alonzo hard fork. -Plutus V2 +PlutusV2 ~~~~~~~~~~ ``PlutusV2`` was introduced in the Vasil hard fork. @@ -29,7 +29,7 @@ The ``ScriptContext`` was extended to include the following information: Examples ------------ -- `Plutus V2 functionalities `_ +- `PlutusV2 functionalities `_ - `How to use reference inputs `_ - `How to use inline datums `_ - `How to reference scripts `_ @@ -53,6 +53,48 @@ Vasil All of the built-in types and functions from ``PlutusV1`` were added to ``PlutusV2``. -The following built-in function was added to ``PlutusV2`` only (i.e., it is not available in ``PlutusV1``). +The following built-in function was added to ``PlutusV2`` only (ie, it is not available in ``PlutusV1``). - ``serializeData`` (proposed in `CIP-42 `_) + +PlutusV3 +~~~~~~~~~ + +Plutus and cryptography teams at IOG, in collaboration with `MLabs `_, continue to develop Plutus capabilities. Starting with the release of `Cardano node v.8.8.0-pre `_, ``PlutusV3`` is available on `SanchoNet `_, introducing the Cardano community to governance features from `CIP-1694 `_ in a controlled testnet environment. + +``PlutusV3`` is the new ledger language that enhances Plutus Core's cryptographic capabilities, offering the following benefits for the smart contract developer community: + +- Providing an updated script context that will let users see `CIP-1694 `_ governance-related entities and voting features +- Interoperability between blockchains +- Advanced Plutus primitives +- Well-known and optimal cryptographic algorithms +- Support for porting of smart contracts from Ethereum +- Creating sidechain bridges +- Improving performance by adding a sums of products (SOPs) feature to support the direct encoding of differrent data types. + +Sums of products +~~~~~~~~~~~~~~~~ + +``PlutusV3`` introduces sums of products - a way of encoding data types that leads to smaller and cheaper scripts compared with `Scott encoding `_, a common way of encoding data types in Plutus Core. + +The sums of products approach aims to boost script efficiency and improve code generation for Plutus Core compilers. The changes involve new term constructors for packing fields into constructor values and efficient tag inspection for case branches, potentially running programs 30% faster. For an in-depth discussion, see `CIP-85 `_. + +New cryptographic primitives +~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +``PlutusV3`` provides new built-in primitives that expand the language's capabilities. + +- **BLS12-381**: A curve pairing that includes 17 primitives that support cryptographic curves. This is a benefit to sidechain specification implementation and `Mithril `_ integration. +- **Blake2b-224**: A cryptographic hash function for on-chain computation of public-key hashes for the validation of transaction signatures. Supports community projects and contributes to Cardano's versatility. +- **Keccak-256**: A cryptographic hash function that produces a 256-bit (32-byte) hash value, commonly used for secure data verification. Supports Ethereum signature verification within scripts and cross-chain solutions. + +Bitwise primitives +~~~~~~~~~~~~~~~~~~~ + +PlutusV3 initially brings several new bitwise primitives (with more to come at later stages). The introduction of `CIP-58 `_ bitwise primitives will enable the following features: + +- Very low-level bit manipulations within Plutus, supporting the ability to execute high-performance data manipulation operations. +- Supporting the implementation of secure and robust cryptographic algorithms within Plutus. +- Facilitating standard, high-performance implementations for conversions between integers and bytestrings. + +``PlutusV3`` adds two bitwise primitives: ``integerToByteString`` and ``byteStringToInteger``. The remaining primitives will be added to ``PlutusV3`` gradually and will not require a new ledger language. From 6c12f150edce991b5cfffeb5bdd1ca53ad45df49 Mon Sep 17 00:00:00 2001 From: Ana Pantilie <45069775+ana-pantilie@users.noreply.github.com> Date: Wed, 20 Mar 2024 13:07:40 +0200 Subject: [PATCH 5/8] Generalised force-delay optimisation (#5799) Signed-off-by: Ana Pantilie --- .../test/9.6/bls12-381-costs.golden | 2 +- ...0001020101020201010000020102.budget.golden | 4 +- ...0101010100000001000001010000.budget.golden | 4 +- ...0104030002040304020400000102.budget.golden | 4 +- ...92faf62e0b991d7310a2f91666b8.budget.golden | 4 +- ...0001010000010001000001000101.budget.golden | 4 +- ...0201010102000102010201010000.budget.golden | 4 +- ...0807010208060100070207080202.budget.golden | 4 +- ...0300030304040400010301040303.budget.golden | 4 +- ...0104050a0b0f0506070f0a070008.budget.golden | 4 +- ...66dd7544678743890b0e8e1add63.budget.golden | 4 +- ...0207000101060706050502040301.budget.golden | 4 +- ...0e0a0d06030f1006030701020607.budget.golden | 4 +- ...95115748c026f9ec129384c262c4.budget.golden | 4 +- ...031d8de696d90ec789e70d6bc1d8.budget.golden | 4 +- ...1c1f1d201c040f10091b020a0e1a.budget.golden | 4 +- ...e55e4096f5ce2e804735a7fbaf91.budget.golden | 4 +- ...c9b87e5d7bea570087ec506935d5.budget.golden | 4 +- ...093efe7bc76d6322aed6ddb582ad.budget.golden | 4 +- ...0c2c133a1a3c3f3c232a26153a04.budget.golden | 4 +- ...fc38298d567d15ee9f2eea69d89e.budget.golden | 4 +- ...0823471c67737f0b076870331260.budget.golden | 4 +- ...2ebcf66ec4ad77e51c11501381c7.budget.golden | 4 +- ...0d1d1c150e110a110e1006160a0d.budget.golden | 4 +- ...0f1140211c3e3f171e26312b0220.budget.golden | 4 +- ...2b19ba72dc4951941fb4c20d2263.budget.golden | 4 +- ...8b4ddcf426852b441f9a9d02c882.budget.golden | 4 +- ...636986014de2d2aaa460ddde0bc3.budget.golden | 4 +- ...f22719a996871ad412cbe4de78b5.budget.golden | 4 +- ...450b9ce8a0f42a6e313b752e6f2c.budget.golden | 4 +- ...63d209a453048a66c6eee624a695.budget.golden | 4 +- ...66785e8b5183c8139db2aa7312d1.budget.golden | 4 +- ...21d13fec0375606325eee9a34a6a.budget.golden | 4 +- ...88446e2d10625119a9d17fa3ec3d.budget.golden | 4 +- ...e396c299a0ce101ee6bf4b2020db.budget.golden | 4 +- ...21a467dedb278328215167eca455.budget.golden | 4 +- ...a81ca3841f47f37633e8aacbb5de.budget.golden | 4 +- ...7fabffc9de499a0de7cabb335479.budget.golden | 4 +- ...78958cab3b9d9353978b08c36d8a.budget.golden | 4 +- ...6319a7b5ce4202cb54dfef8e37e7.budget.golden | 4 +- ...32125976f29b1c3e21d9f537845c.budget.golden | 4 +- ...b32bd8aecb48a228b50e02b055c8.budget.golden | 4 +- ...af0d28e1eb68faeecc45f4655f57.budget.golden | 4 +- ...fff00a555ce8c55e36ddc003007a.budget.golden | 4 +- ...e5ae1892d07ee71161bfb55a7cb7.budget.golden | 4 +- ...3b335a85a2825502ab1e0687197e.budget.golden | 4 +- ...f38f7539b7ba7167d577c0c8b8ce.budget.golden | 4 +- ...ad1d2bc2bd497ec0ecb68f989d2b.budget.golden | 4 +- ...fc0b8409ba1e98f95fa5b6caf999.budget.golden | 4 +- ...878a0e0a7d6f7fe1d4a619e06112.budget.golden | 4 +- ...39062b5728182e073e5760561a66.budget.golden | 4 +- ...9df7ac1a8ce86d3e43dfb5e4f6bc.budget.golden | 4 +- ...c6712c28c54f5a25792049294acc.budget.golden | 4 +- ...1dc6f4e7e412eeb5a3ced42fb642.budget.golden | 4 +- ...4dd7a4e368d1c8dd9c1f7a4309a5.budget.golden | 4 +- ...575294ea39061b81a194ebb9eaae.budget.golden | 4 +- ...3805fac9d5fb4ff2d3066e53fc7e.budget.golden | 4 +- ...afcb38fbfa1dbc31ac2053628a38.budget.golden | 4 +- ...d4342612accf40913f9ae9419fac.budget.golden | 4 +- ...fccd3dce2a23910bddd35c503b71.budget.golden | 4 +- ...009738401d264bf9b3eb7c6f49c1.budget.golden | 4 +- ...e1e953867cc4900cc25e5b9dec47.budget.golden | 4 +- ...a420954018d8301ec4f9783be0d7.budget.golden | 4 +- ...e71ea3abfc52ffbe3ecb93436ea2.budget.golden | 4 +- ...40a1abd79718e681228f4057403a.budget.golden | 4 +- ...e40a5defc6f3b9be68b70b4a3db6.budget.golden | 4 +- ...22a9dcbe277c143ed3aede9d265f.budget.golden | 4 +- ...e61afdb3ac18128e1688c07071ba.budget.golden | 4 +- ...0cfd0cbf7fd4a372b0dc59fa17e1.budget.golden | 4 +- ...a1ce6db4e501df1086773c6c0201.budget.golden | 4 +- ...517055197aff6b60a87ff718d66c.budget.golden | 4 +- ...8e75beb636692478ec39f74ee221.budget.golden | 4 +- ...605fe1490aa3f4f64a3fa8881b25.budget.golden | 4 +- ...54897d6d1d0e21bc380147687bd5.budget.golden | 4 +- ...42aee239a2d9bc5314d127cce592.budget.golden | 4 +- ...d9997bdf2d8b2998c6bfeef3b122.budget.golden | 4 +- ...eccf3df3a605bd6bc6a456cde871.budget.golden | 4 +- ...e81fea90e41afebd669e51bb60c8.budget.golden | 4 +- ...de89510b29cccce81971e38e0835.budget.golden | 4 +- ...884e504d2c410ad63ba46d8ca35c.budget.golden | 4 +- ...8bb1d1e29eacecd022eeb168b315.budget.golden | 4 +- ...3a51a0c0c7890f2214df9ac19274.budget.golden | 4 +- ...ba143ce0579f1602fd780cabf153.budget.golden | 4 +- ...e276b5dabc66ff669d5650d0be1c.budget.golden | 4 +- ...6eec7a26fa31b80ae69d44805efc.budget.golden | 4 +- ...d3eccec8cac9c70a4857b88a5eb8.budget.golden | 4 +- ...2f3330fe5b77b3222f570395d9f5.budget.golden | 4 +- ...0ba5822197ade7dd540489ec5e95.budget.golden | 4 +- ...11195d161b5bb0a2b58f89b2c65a.budget.golden | 4 +- ...9e06036460eea3705c88ea867e33.budget.golden | 4 +- ...054c6f7f34355fcfeefebef479f3.budget.golden | 4 +- ...13fdc347c704ddaa27042757d990.budget.golden | 4 +- ...c7c8323256c31c90c520ee6a1080.budget.golden | 4 +- ...78dd8cd5ddb981375a028b3a40a5.budget.golden | 4 +- ...413f979f2492cf3339319d8cc079.budget.golden | 4 +- ...6dfd7af4231bdd41b9ec268bc7e1.budget.golden | 4 +- ...7131740212762ae4483ec749fe1d.budget.golden | 4 +- ...42123cf8660aac2b5bac21ec28f0.budget.golden | 4 +- ...e54333bdd408cbe7c47c55e73ae4.budget.golden | 4 +- ...da59aa929cffe0f1ff5355db8d79.budget.golden | 4 +- ...aa02274161b23d57709c0f8b8de6.budget.golden | 4 +- .../test/semantics/9.6/semantics.size.golden | 2 +- .../src/UntypedPlutusCore/Simplify.hs | 4 +- .../UntypedPlutusCore/Transform/ForceDelay.hs | 207 +++++++++++++++++- .../test/Transform/Simplify.hs | 106 +++++++++ .../Transform/forceDelayComplex.uplc.golden | 1 + .../forceDelayMultiApply.uplc.golden | 1 + .../forceDelayMultiForce.uplc.golden | 1 + .../Transform/forceDelaySimple.uplc.golden | 1 + .../test/Transform/inlinePure4.uplc.golden | 3 +- .../Transform/interveningLambda.uplc.golden | 2 +- .../Budget/9.6/patternMatching.uplc.golden | 4 +- 112 files changed, 521 insertions(+), 213 deletions(-) create mode 100644 plutus-core/untyped-plutus-core/test/Transform/forceDelayComplex.uplc.golden create mode 100644 plutus-core/untyped-plutus-core/test/Transform/forceDelayMultiApply.uplc.golden create mode 100644 plutus-core/untyped-plutus-core/test/Transform/forceDelayMultiForce.uplc.golden create mode 100644 plutus-core/untyped-plutus-core/test/Transform/forceDelaySimple.uplc.golden 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 3df829ebb1d..6d19f9351d6 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 @@ -103,7 +103,7 @@ VRF example n Script size CPU usage Memory usage ---------------------------------------------------------------------- - - 715 (4.4%) 1303368563 (13.0%) 49449 (0.4%) + - 712 (4.3%) 1303299563 (13.0%) 49149 (0.4%) G1 Verify diff --git a/plutus-benchmark/marlowe/test/semantics/9.6/0000020002010200020101020201000100010001020101020201010000020102.budget.golden b/plutus-benchmark/marlowe/test/semantics/9.6/0000020002010200020101020201000100010001020101020201010000020102.budget.golden index 8e3059046b5..2e1af9375bd 100644 --- a/plutus-benchmark/marlowe/test/semantics/9.6/0000020002010200020101020201000100010001020101020201010000020102.budget.golden +++ b/plutus-benchmark/marlowe/test/semantics/9.6/0000020002010200020101020201000100010001020101020201010000020102.budget.golden @@ -1,2 +1,2 @@ -({cpu: 401412988 -| mem: 1451263}) \ No newline at end of file +({cpu: 400791988 +| mem: 1448563}) \ No newline at end of file diff --git a/plutus-benchmark/marlowe/test/semantics/9.6/0001000101000000010101000001000001010101010100000001000001010000.budget.golden b/plutus-benchmark/marlowe/test/semantics/9.6/0001000101000000010101000001000001010101010100000001000001010000.budget.golden index e5d37a32e73..ca7dac7a94c 100644 --- a/plutus-benchmark/marlowe/test/semantics/9.6/0001000101000000010101000001000001010101010100000001000001010000.budget.golden +++ b/plutus-benchmark/marlowe/test/semantics/9.6/0001000101000000010101000001000001010101010100000001000001010000.budget.golden @@ -1,2 +1,2 @@ -({cpu: 519999134 -| mem: 1821564}) \ No newline at end of file +({cpu: 519677134 +| mem: 1820164}) \ No newline at end of file diff --git a/plutus-benchmark/marlowe/test/semantics/9.6/0003040402030103010203030303000200000104030002040304020400000102.budget.golden b/plutus-benchmark/marlowe/test/semantics/9.6/0003040402030103010203030303000200000104030002040304020400000102.budget.golden index 19cca68d57a..2ff20cb639a 100644 --- a/plutus-benchmark/marlowe/test/semantics/9.6/0003040402030103010203030303000200000104030002040304020400000102.budget.golden +++ b/plutus-benchmark/marlowe/test/semantics/9.6/0003040402030103010203030303000200000104030002040304020400000102.budget.golden @@ -1,2 +1,2 @@ -({cpu: 1368245687 -| mem: 5135402}) \ No newline at end of file +({cpu: 1367463687 +| mem: 5132002}) \ No newline at end of file diff --git a/plutus-benchmark/marlowe/test/semantics/9.6/004025fd712d6c325ffa12c16d157064192992faf62e0b991d7310a2f91666b8.budget.golden b/plutus-benchmark/marlowe/test/semantics/9.6/004025fd712d6c325ffa12c16d157064192992faf62e0b991d7310a2f91666b8.budget.golden index 5af2037bd8b..f02ac31f6e7 100644 --- a/plutus-benchmark/marlowe/test/semantics/9.6/004025fd712d6c325ffa12c16d157064192992faf62e0b991d7310a2f91666b8.budget.golden +++ b/plutus-benchmark/marlowe/test/semantics/9.6/004025fd712d6c325ffa12c16d157064192992faf62e0b991d7310a2f91666b8.budget.golden @@ -1,2 +1,2 @@ -({cpu: 971935150 -| mem: 3459445}) \ No newline at end of file +({cpu: 970348150 +| mem: 3452545}) \ No newline at end of file diff --git a/plutus-benchmark/marlowe/test/semantics/9.6/0101010001010101010101000100010100000001010000010001000001000101.budget.golden b/plutus-benchmark/marlowe/test/semantics/9.6/0101010001010101010101000100010100000001010000010001000001000101.budget.golden index d1c69187c23..5be221a5b6f 100644 --- a/plutus-benchmark/marlowe/test/semantics/9.6/0101010001010101010101000100010100000001010000010001000001000101.budget.golden +++ b/plutus-benchmark/marlowe/test/semantics/9.6/0101010001010101010101000100010100000001010000010001000001000101.budget.golden @@ -1,2 +1,2 @@ -({cpu: 842825112 -| mem: 2477998}) \ No newline at end of file +({cpu: 842043112 +| mem: 2474598}) \ No newline at end of file diff --git a/plutus-benchmark/marlowe/test/semantics/9.6/0101020201010201010200010102000201000201010102000102010201010000.budget.golden b/plutus-benchmark/marlowe/test/semantics/9.6/0101020201010201010200010102000201000201010102000102010201010000.budget.golden index 8ff0927a94e..6fa427ca3dd 100644 --- a/plutus-benchmark/marlowe/test/semantics/9.6/0101020201010201010200010102000201000201010102000102010201010000.budget.golden +++ b/plutus-benchmark/marlowe/test/semantics/9.6/0101020201010201010200010102000201000201010102000102010201010000.budget.golden @@ -1,2 +1,2 @@ -({cpu: 376467639 -| mem: 1373721}) \ No newline at end of file +({cpu: 376191639 +| mem: 1372521}) \ No newline at end of file diff --git a/plutus-benchmark/marlowe/test/semantics/9.6/0101080808040600020306010000000302050807010208060100070207080202.budget.golden b/plutus-benchmark/marlowe/test/semantics/9.6/0101080808040600020306010000000302050807010208060100070207080202.budget.golden index 0db948ead95..69b78e6a857 100644 --- a/plutus-benchmark/marlowe/test/semantics/9.6/0101080808040600020306010000000302050807010208060100070207080202.budget.golden +++ b/plutus-benchmark/marlowe/test/semantics/9.6/0101080808040600020306010000000302050807010208060100070207080202.budget.golden @@ -1,2 +1,2 @@ -({cpu: 997974739 -| mem: 3653124}) \ No newline at end of file +({cpu: 997652739 +| mem: 3651724}) \ No newline at end of file diff --git a/plutus-benchmark/marlowe/test/semantics/9.6/0104010200020000040103020102020004040300030304040400010301040303.budget.golden b/plutus-benchmark/marlowe/test/semantics/9.6/0104010200020000040103020102020004040300030304040400010301040303.budget.golden index 3b0e007b117..c49bf576667 100644 --- a/plutus-benchmark/marlowe/test/semantics/9.6/0104010200020000040103020102020004040300030304040400010301040303.budget.golden +++ b/plutus-benchmark/marlowe/test/semantics/9.6/0104010200020000040103020102020004040300030304040400010301040303.budget.golden @@ -1,2 +1,2 @@ -({cpu: 985076123 -| mem: 3606481}) \ No newline at end of file +({cpu: 984570123 +| mem: 3604281}) \ No newline at end of file diff --git a/plutus-benchmark/marlowe/test/semantics/9.6/04000f0b04051006000e060f09080d0b090d0104050a0b0f0506070f0a070008.budget.golden b/plutus-benchmark/marlowe/test/semantics/9.6/04000f0b04051006000e060f09080d0b090d0104050a0b0f0506070f0a070008.budget.golden index 26ecf14562c..366827e900c 100644 --- a/plutus-benchmark/marlowe/test/semantics/9.6/04000f0b04051006000e060f09080d0b090d0104050a0b0f0506070f0a070008.budget.golden +++ b/plutus-benchmark/marlowe/test/semantics/9.6/04000f0b04051006000e060f09080d0b090d0104050a0b0f0506070f0a070008.budget.golden @@ -1,2 +1,2 @@ -({cpu: 913587161 -| mem: 3290999}) \ No newline at end of file +({cpu: 912690161 +| mem: 3287099}) \ No newline at end of file diff --git a/plutus-benchmark/marlowe/test/semantics/9.6/0543a00ba1f63076c1db6bf94c6ff13ae7d266dd7544678743890b0e8e1add63.budget.golden b/plutus-benchmark/marlowe/test/semantics/9.6/0543a00ba1f63076c1db6bf94c6ff13ae7d266dd7544678743890b0e8e1add63.budget.golden index 1ecb25adf07..82c6984ef30 100644 --- a/plutus-benchmark/marlowe/test/semantics/9.6/0543a00ba1f63076c1db6bf94c6ff13ae7d266dd7544678743890b0e8e1add63.budget.golden +++ b/plutus-benchmark/marlowe/test/semantics/9.6/0543a00ba1f63076c1db6bf94c6ff13ae7d266dd7544678743890b0e8e1add63.budget.golden @@ -1,2 +1,2 @@ -({cpu: 1335886976 -| mem: 4623885}) \ No newline at end of file +({cpu: 1333655976 +| mem: 4614185}) \ No newline at end of file diff --git a/plutus-benchmark/marlowe/test/semantics/9.6/0705030002040601010206030604080208020207000101060706050502040301.budget.golden b/plutus-benchmark/marlowe/test/semantics/9.6/0705030002040601010206030604080208020207000101060706050502040301.budget.golden index 62f52b8b17c..e7bd35a1fd1 100644 --- a/plutus-benchmark/marlowe/test/semantics/9.6/0705030002040601010206030604080208020207000101060706050502040301.budget.golden +++ b/plutus-benchmark/marlowe/test/semantics/9.6/0705030002040601010206030604080208020207000101060706050502040301.budget.golden @@ -1,2 +1,2 @@ -({cpu: 1410834502 -| mem: 4711774}) \ No newline at end of file +({cpu: 1407637502 +| mem: 4697874}) \ No newline at end of file diff --git a/plutus-benchmark/marlowe/test/semantics/9.6/07070c070510030509010e050d00040907050e0a0d06030f1006030701020607.budget.golden b/plutus-benchmark/marlowe/test/semantics/9.6/07070c070510030509010e050d00040907050e0a0d06030f1006030701020607.budget.golden index 0e579ab25dc..99969ae1216 100644 --- a/plutus-benchmark/marlowe/test/semantics/9.6/07070c070510030509010e050d00040907050e0a0d06030f1006030701020607.budget.golden +++ b/plutus-benchmark/marlowe/test/semantics/9.6/07070c070510030509010e050d00040907050e0a0d06030f1006030701020607.budget.golden @@ -1,2 +1,2 @@ -({cpu: 1328135567 -| mem: 4842543}) \ No newline at end of file +({cpu: 1326939567 +| mem: 4837343}) \ No newline at end of file diff --git a/plutus-benchmark/marlowe/test/semantics/9.6/0bcfd9487614104ec48de2ea0b2c0979866a95115748c026f9ec129384c262c4.budget.golden b/plutus-benchmark/marlowe/test/semantics/9.6/0bcfd9487614104ec48de2ea0b2c0979866a95115748c026f9ec129384c262c4.budget.golden index 18d9f8e61a2..f21dc7cf6df 100644 --- a/plutus-benchmark/marlowe/test/semantics/9.6/0bcfd9487614104ec48de2ea0b2c0979866a95115748c026f9ec129384c262c4.budget.golden +++ b/plutus-benchmark/marlowe/test/semantics/9.6/0bcfd9487614104ec48de2ea0b2c0979866a95115748c026f9ec129384c262c4.budget.golden @@ -1,2 +1,2 @@ -({cpu: 1461455571 -| mem: 5309691}) \ No newline at end of file +({cpu: 1460719571 +| mem: 5306491}) \ No newline at end of file diff --git a/plutus-benchmark/marlowe/test/semantics/9.6/0be82588e4e4bf2ef428d2f44b7687bbb703031d8de696d90ec789e70d6bc1d8.budget.golden b/plutus-benchmark/marlowe/test/semantics/9.6/0be82588e4e4bf2ef428d2f44b7687bbb703031d8de696d90ec789e70d6bc1d8.budget.golden index 07de4203f9d..ddae8176c87 100644 --- a/plutus-benchmark/marlowe/test/semantics/9.6/0be82588e4e4bf2ef428d2f44b7687bbb703031d8de696d90ec789e70d6bc1d8.budget.golden +++ b/plutus-benchmark/marlowe/test/semantics/9.6/0be82588e4e4bf2ef428d2f44b7687bbb703031d8de696d90ec789e70d6bc1d8.budget.golden @@ -1,2 +1,2 @@ -({cpu: 1773166290 -| mem: 6446866}) \ No newline at end of file +({cpu: 1771924290 +| mem: 6441466}) \ No newline at end of file diff --git a/plutus-benchmark/marlowe/test/semantics/9.6/0f1d0110001b121d051e15140c0c05141d151c1f1d201c040f10091b020a0e1a.budget.golden b/plutus-benchmark/marlowe/test/semantics/9.6/0f1d0110001b121d051e15140c0c05141d151c1f1d201c040f10091b020a0e1a.budget.golden index 3e899a4d3d2..d7fa38cace1 100644 --- a/plutus-benchmark/marlowe/test/semantics/9.6/0f1d0110001b121d051e15140c0c05141d151c1f1d201c040f10091b020a0e1a.budget.golden +++ b/plutus-benchmark/marlowe/test/semantics/9.6/0f1d0110001b121d051e15140c0c05141d151c1f1d201c040f10091b020a0e1a.budget.golden @@ -1,2 +1,2 @@ -({cpu: 610770250 -| mem: 2243067}) \ No newline at end of file +({cpu: 610494250 +| mem: 2241867}) \ No newline at end of file diff --git a/plutus-benchmark/marlowe/test/semantics/9.6/119fbea4164e2bf21d2b53aa6c2c4e79414fe55e4096f5ce2e804735a7fbaf91.budget.golden b/plutus-benchmark/marlowe/test/semantics/9.6/119fbea4164e2bf21d2b53aa6c2c4e79414fe55e4096f5ce2e804735a7fbaf91.budget.golden index 6c2d224f676..c4b1860c85d 100644 --- a/plutus-benchmark/marlowe/test/semantics/9.6/119fbea4164e2bf21d2b53aa6c2c4e79414fe55e4096f5ce2e804735a7fbaf91.budget.golden +++ b/plutus-benchmark/marlowe/test/semantics/9.6/119fbea4164e2bf21d2b53aa6c2c4e79414fe55e4096f5ce2e804735a7fbaf91.budget.golden @@ -1,2 +1,2 @@ -({cpu: 937067950 -| mem: 3383163}) \ No newline at end of file +({cpu: 935480950 +| mem: 3376263}) \ No newline at end of file diff --git a/plutus-benchmark/marlowe/test/semantics/9.6/12910f24d994d451ff379b12c9d1ecdb9239c9b87e5d7bea570087ec506935d5.budget.golden b/plutus-benchmark/marlowe/test/semantics/9.6/12910f24d994d451ff379b12c9d1ecdb9239c9b87e5d7bea570087ec506935d5.budget.golden index e8ca9c56bbe..6d2334892e5 100644 --- a/plutus-benchmark/marlowe/test/semantics/9.6/12910f24d994d451ff379b12c9d1ecdb9239c9b87e5d7bea570087ec506935d5.budget.golden +++ b/plutus-benchmark/marlowe/test/semantics/9.6/12910f24d994d451ff379b12c9d1ecdb9239c9b87e5d7bea570087ec506935d5.budget.golden @@ -1,2 +1,2 @@ -({cpu: 633141368 -| mem: 2327151}) \ No newline at end of file +({cpu: 632865368 +| mem: 2325951}) \ 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 302e646a37d..781ac7c0251 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: 953154685 -| mem: 3471581}) \ No newline at end of file +({cpu: 951958685 +| mem: 3466381}) \ No newline at end of file diff --git a/plutus-benchmark/marlowe/test/semantics/9.6/1a2f2540121f09321216090b2b1f211e3f020c2c133a1a3c3f3c232a26153a04.budget.golden b/plutus-benchmark/marlowe/test/semantics/9.6/1a2f2540121f09321216090b2b1f211e3f020c2c133a1a3c3f3c232a26153a04.budget.golden index f6615208266..6ebe321a341 100644 --- a/plutus-benchmark/marlowe/test/semantics/9.6/1a2f2540121f09321216090b2b1f211e3f020c2c133a1a3c3f3c232a26153a04.budget.golden +++ b/plutus-benchmark/marlowe/test/semantics/9.6/1a2f2540121f09321216090b2b1f211e3f020c2c133a1a3c3f3c232a26153a04.budget.golden @@ -1,2 +1,2 @@ -({cpu: 379087524 -| mem: 1379223}) \ No newline at end of file +({cpu: 378811524 +| mem: 1378023}) \ No newline at end of file diff --git a/plutus-benchmark/marlowe/test/semantics/9.6/1a573aed5c46d637919ccb5548dfc22a55c9fc38298d567d15ee9f2eea69d89e.budget.golden b/plutus-benchmark/marlowe/test/semantics/9.6/1a573aed5c46d637919ccb5548dfc22a55c9fc38298d567d15ee9f2eea69d89e.budget.golden index e85c70398eb..f0a3ac801f4 100644 --- a/plutus-benchmark/marlowe/test/semantics/9.6/1a573aed5c46d637919ccb5548dfc22a55c9fc38298d567d15ee9f2eea69d89e.budget.golden +++ b/plutus-benchmark/marlowe/test/semantics/9.6/1a573aed5c46d637919ccb5548dfc22a55c9fc38298d567d15ee9f2eea69d89e.budget.golden @@ -1,2 +1,2 @@ -({cpu: 1164191012 -| mem: 4258822}) \ No newline at end of file +({cpu: 1163639012 +| mem: 4256422}) \ No newline at end of file diff --git a/plutus-benchmark/marlowe/test/semantics/9.6/1d56060c3b271226064c672a282663643b1b0823471c67737f0b076870331260.budget.golden b/plutus-benchmark/marlowe/test/semantics/9.6/1d56060c3b271226064c672a282663643b1b0823471c67737f0b076870331260.budget.golden index 1bf88005f7d..032dcab60e4 100644 --- a/plutus-benchmark/marlowe/test/semantics/9.6/1d56060c3b271226064c672a282663643b1b0823471c67737f0b076870331260.budget.golden +++ b/plutus-benchmark/marlowe/test/semantics/9.6/1d56060c3b271226064c672a282663643b1b0823471c67737f0b076870331260.budget.golden @@ -1,2 +1,2 @@ -({cpu: 928815971 -| mem: 3288845}) \ No newline at end of file +({cpu: 927918971 +| mem: 3284945}) \ No newline at end of file diff --git a/plutus-benchmark/marlowe/test/semantics/9.6/1d6e3c137149a440f35e0efc685b16bfb8052ebcf66ec4ad77e51c11501381c7.budget.golden b/plutus-benchmark/marlowe/test/semantics/9.6/1d6e3c137149a440f35e0efc685b16bfb8052ebcf66ec4ad77e51c11501381c7.budget.golden index 01a29189c49..ae736314e2c 100644 --- a/plutus-benchmark/marlowe/test/semantics/9.6/1d6e3c137149a440f35e0efc685b16bfb8052ebcf66ec4ad77e51c11501381c7.budget.golden +++ b/plutus-benchmark/marlowe/test/semantics/9.6/1d6e3c137149a440f35e0efc685b16bfb8052ebcf66ec4ad77e51c11501381c7.budget.golden @@ -1,2 +1,2 @@ -({cpu: 379112696 -| mem: 1379223}) \ No newline at end of file +({cpu: 378836696 +| mem: 1378023}) \ No newline at end of file diff --git a/plutus-benchmark/marlowe/test/semantics/9.6/1f0f02191604101e1f201016171604060d010d1d1c150e110a110e1006160a0d.budget.golden b/plutus-benchmark/marlowe/test/semantics/9.6/1f0f02191604101e1f201016171604060d010d1d1c150e110a110e1006160a0d.budget.golden index 18e639f5ae1..afd5862b0c2 100644 --- a/plutus-benchmark/marlowe/test/semantics/9.6/1f0f02191604101e1f201016171604060d010d1d1c150e110a110e1006160a0d.budget.golden +++ b/plutus-benchmark/marlowe/test/semantics/9.6/1f0f02191604101e1f201016171604060d010d1d1c150e110a110e1006160a0d.budget.golden @@ -1,2 +1,2 @@ -({cpu: 685471166 -| mem: 1321274}) \ No newline at end of file +({cpu: 685149166 +| mem: 1319874}) \ No newline at end of file diff --git a/plutus-benchmark/marlowe/test/semantics/9.6/202d273721330b31193405101e0637202e2a0f1140211c3e3f171e26312b0220.budget.golden b/plutus-benchmark/marlowe/test/semantics/9.6/202d273721330b31193405101e0637202e2a0f1140211c3e3f171e26312b0220.budget.golden index b4052b938bc..d1be652ae3d 100644 --- a/plutus-benchmark/marlowe/test/semantics/9.6/202d273721330b31193405101e0637202e2a0f1140211c3e3f171e26312b0220.budget.golden +++ b/plutus-benchmark/marlowe/test/semantics/9.6/202d273721330b31193405101e0637202e2a0f1140211c3e3f171e26312b0220.budget.golden @@ -1,2 +1,2 @@ -({cpu: 2100690471 -| mem: 1702798}) \ No newline at end of file +({cpu: 2099908471 +| mem: 1699398}) \ No newline at end of file diff --git a/plutus-benchmark/marlowe/test/semantics/9.6/21953bf8798b28df60cb459db24843fb46782b19ba72dc4951941fb4c20d2263.budget.golden b/plutus-benchmark/marlowe/test/semantics/9.6/21953bf8798b28df60cb459db24843fb46782b19ba72dc4951941fb4c20d2263.budget.golden index 58cc9f3e5fa..f8d17270f82 100644 --- a/plutus-benchmark/marlowe/test/semantics/9.6/21953bf8798b28df60cb459db24843fb46782b19ba72dc4951941fb4c20d2263.budget.golden +++ b/plutus-benchmark/marlowe/test/semantics/9.6/21953bf8798b28df60cb459db24843fb46782b19ba72dc4951941fb4c20d2263.budget.golden @@ -1,2 +1,2 @@ -({cpu: 451667264 -| mem: 1665240}) \ No newline at end of file +({cpu: 451345264 +| mem: 1663840}) \ No newline at end of file diff --git a/plutus-benchmark/marlowe/test/semantics/9.6/238b21364ab5bdae3ddb514d7001c8feba128b4ddcf426852b441f9a9d02c882.budget.golden b/plutus-benchmark/marlowe/test/semantics/9.6/238b21364ab5bdae3ddb514d7001c8feba128b4ddcf426852b441f9a9d02c882.budget.golden index 8ff0927a94e..6fa427ca3dd 100644 --- a/plutus-benchmark/marlowe/test/semantics/9.6/238b21364ab5bdae3ddb514d7001c8feba128b4ddcf426852b441f9a9d02c882.budget.golden +++ b/plutus-benchmark/marlowe/test/semantics/9.6/238b21364ab5bdae3ddb514d7001c8feba128b4ddcf426852b441f9a9d02c882.budget.golden @@ -1,2 +1,2 @@ -({cpu: 376467639 -| mem: 1373721}) \ No newline at end of file +({cpu: 376191639 +| mem: 1372521}) \ No newline at end of file diff --git a/plutus-benchmark/marlowe/test/semantics/9.6/26e24ee631a6d927ea4fb4fac530cfd82ff7636986014de2d2aaa460ddde0bc3.budget.golden b/plutus-benchmark/marlowe/test/semantics/9.6/26e24ee631a6d927ea4fb4fac530cfd82ff7636986014de2d2aaa460ddde0bc3.budget.golden index 4f2fb7a394c..6989248cef5 100644 --- a/plutus-benchmark/marlowe/test/semantics/9.6/26e24ee631a6d927ea4fb4fac530cfd82ff7636986014de2d2aaa460ddde0bc3.budget.golden +++ b/plutus-benchmark/marlowe/test/semantics/9.6/26e24ee631a6d927ea4fb4fac530cfd82ff7636986014de2d2aaa460ddde0bc3.budget.golden @@ -1,2 +1,2 @@ -({cpu: 708075079 -| mem: 2631700}) \ No newline at end of file +({cpu: 707178079 +| mem: 2627800}) \ No newline at end of file diff --git a/plutus-benchmark/marlowe/test/semantics/9.6/2797d7ac77c1b6aff8e42cf9a47fa86b1e60f22719a996871ad412cbe4de78b5.budget.golden b/plutus-benchmark/marlowe/test/semantics/9.6/2797d7ac77c1b6aff8e42cf9a47fa86b1e60f22719a996871ad412cbe4de78b5.budget.golden index 97fa3c1f2c7..debcd810ca3 100644 --- a/plutus-benchmark/marlowe/test/semantics/9.6/2797d7ac77c1b6aff8e42cf9a47fa86b1e60f22719a996871ad412cbe4de78b5.budget.golden +++ b/plutus-benchmark/marlowe/test/semantics/9.6/2797d7ac77c1b6aff8e42cf9a47fa86b1e60f22719a996871ad412cbe4de78b5.budget.golden @@ -1,2 +1,2 @@ -({cpu: 1125881447 -| mem: 1708118}) \ No newline at end of file +({cpu: 1125329447 +| mem: 1705718}) \ No newline at end of file diff --git a/plutus-benchmark/marlowe/test/semantics/9.6/28fdce478e179db0e38fb5f3f4105e940ece450b9ce8a0f42a6e313b752e6f2c.budget.golden b/plutus-benchmark/marlowe/test/semantics/9.6/28fdce478e179db0e38fb5f3f4105e940ece450b9ce8a0f42a6e313b752e6f2c.budget.golden index 6f72edd6424..f7d123d71fd 100644 --- a/plutus-benchmark/marlowe/test/semantics/9.6/28fdce478e179db0e38fb5f3f4105e940ece450b9ce8a0f42a6e313b752e6f2c.budget.golden +++ b/plutus-benchmark/marlowe/test/semantics/9.6/28fdce478e179db0e38fb5f3f4105e940ece450b9ce8a0f42a6e313b752e6f2c.budget.golden @@ -1,2 +1,2 @@ -({cpu: 994209090 -| mem: 3234804}) \ No newline at end of file +({cpu: 993427090 +| mem: 3231404}) \ No newline at end of file diff --git a/plutus-benchmark/marlowe/test/semantics/9.6/2cb21612178a2d9336b59d06cbf80488577463d209a453048a66c6eee624a695.budget.golden b/plutus-benchmark/marlowe/test/semantics/9.6/2cb21612178a2d9336b59d06cbf80488577463d209a453048a66c6eee624a695.budget.golden index 7d269263d45..6da02f3efac 100644 --- a/plutus-benchmark/marlowe/test/semantics/9.6/2cb21612178a2d9336b59d06cbf80488577463d209a453048a66c6eee624a695.budget.golden +++ b/plutus-benchmark/marlowe/test/semantics/9.6/2cb21612178a2d9336b59d06cbf80488577463d209a453048a66c6eee624a695.budget.golden @@ -1,2 +1,2 @@ -({cpu: 996809863 -| mem: 3647447}) \ No newline at end of file +({cpu: 996303863 +| mem: 3645247}) \ No newline at end of file diff --git a/plutus-benchmark/marlowe/test/semantics/9.6/2f58c9d884813042bce9cf7c66048767dff166785e8b5183c8139db2aa7312d1.budget.golden b/plutus-benchmark/marlowe/test/semantics/9.6/2f58c9d884813042bce9cf7c66048767dff166785e8b5183c8139db2aa7312d1.budget.golden index ab0fe881750..fe700a89402 100644 --- a/plutus-benchmark/marlowe/test/semantics/9.6/2f58c9d884813042bce9cf7c66048767dff166785e8b5183c8139db2aa7312d1.budget.golden +++ b/plutus-benchmark/marlowe/test/semantics/9.6/2f58c9d884813042bce9cf7c66048767dff166785e8b5183c8139db2aa7312d1.budget.golden @@ -1,2 +1,2 @@ -({cpu: 950335999 -| mem: 3439634}) \ No newline at end of file +({cpu: 950013999 +| mem: 3438234}) \ No newline at end of file diff --git a/plutus-benchmark/marlowe/test/semantics/9.6/30aa34dfbe89e0c43f569929a96c0d2b74c321d13fec0375606325eee9a34a6a.budget.golden b/plutus-benchmark/marlowe/test/semantics/9.6/30aa34dfbe89e0c43f569929a96c0d2b74c321d13fec0375606325eee9a34a6a.budget.golden index 80c0b4eb6df..e981a50a7c9 100644 --- a/plutus-benchmark/marlowe/test/semantics/9.6/30aa34dfbe89e0c43f569929a96c0d2b74c321d13fec0375606325eee9a34a6a.budget.golden +++ b/plutus-benchmark/marlowe/test/semantics/9.6/30aa34dfbe89e0c43f569929a96c0d2b74c321d13fec0375606325eee9a34a6a.budget.golden @@ -1,2 +1,2 @@ -({cpu: 1505628983 -| mem: 5592160}) \ No newline at end of file +({cpu: 1504616983 +| mem: 5587760}) \ No newline at end of file diff --git a/plutus-benchmark/marlowe/test/semantics/9.6/322acde099bc34a929182d5b894214fc87ec88446e2d10625119a9d17fa3ec3d.budget.golden b/plutus-benchmark/marlowe/test/semantics/9.6/322acde099bc34a929182d5b894214fc87ec88446e2d10625119a9d17fa3ec3d.budget.golden index f6615208266..6ebe321a341 100644 --- a/plutus-benchmark/marlowe/test/semantics/9.6/322acde099bc34a929182d5b894214fc87ec88446e2d10625119a9d17fa3ec3d.budget.golden +++ b/plutus-benchmark/marlowe/test/semantics/9.6/322acde099bc34a929182d5b894214fc87ec88446e2d10625119a9d17fa3ec3d.budget.golden @@ -1,2 +1,2 @@ -({cpu: 379087524 -| mem: 1379223}) \ No newline at end of file +({cpu: 378811524 +| mem: 1378023}) \ No newline at end of file diff --git a/plutus-benchmark/marlowe/test/semantics/9.6/331e4a1bb30f28d7073c54f9a13c10ae19e2e396c299a0ce101ee6bf4b2020db.budget.golden b/plutus-benchmark/marlowe/test/semantics/9.6/331e4a1bb30f28d7073c54f9a13c10ae19e2e396c299a0ce101ee6bf4b2020db.budget.golden index 7bcd67939f2..41f58d8a108 100644 --- a/plutus-benchmark/marlowe/test/semantics/9.6/331e4a1bb30f28d7073c54f9a13c10ae19e2e396c299a0ce101ee6bf4b2020db.budget.golden +++ b/plutus-benchmark/marlowe/test/semantics/9.6/331e4a1bb30f28d7073c54f9a13c10ae19e2e396c299a0ce101ee6bf4b2020db.budget.golden @@ -1,2 +1,2 @@ -({cpu: 592553756 -| mem: 2180551}) \ No newline at end of file +({cpu: 592277756 +| mem: 2179351}) \ No newline at end of file diff --git a/plutus-benchmark/marlowe/test/semantics/9.6/33c3efd79d9234a78262b52bc6bbf8124cb321a467dedb278328215167eca455.budget.golden b/plutus-benchmark/marlowe/test/semantics/9.6/33c3efd79d9234a78262b52bc6bbf8124cb321a467dedb278328215167eca455.budget.golden index 40ec3377285..bc4febdc87e 100644 --- a/plutus-benchmark/marlowe/test/semantics/9.6/33c3efd79d9234a78262b52bc6bbf8124cb321a467dedb278328215167eca455.budget.golden +++ b/plutus-benchmark/marlowe/test/semantics/9.6/33c3efd79d9234a78262b52bc6bbf8124cb321a467dedb278328215167eca455.budget.golden @@ -1,2 +1,2 @@ -({cpu: 802122623 -| mem: 2987472}) \ No newline at end of file +({cpu: 801800623 +| mem: 2986072}) \ No newline at end of file diff --git a/plutus-benchmark/marlowe/test/semantics/9.6/383683bfcecdab0f4df507f59631c702bd11a81ca3841f47f37633e8aacbb5de.budget.golden b/plutus-benchmark/marlowe/test/semantics/9.6/383683bfcecdab0f4df507f59631c702bd11a81ca3841f47f37633e8aacbb5de.budget.golden index 54c8371bf71..387f41287cd 100644 --- a/plutus-benchmark/marlowe/test/semantics/9.6/383683bfcecdab0f4df507f59631c702bd11a81ca3841f47f37633e8aacbb5de.budget.golden +++ b/plutus-benchmark/marlowe/test/semantics/9.6/383683bfcecdab0f4df507f59631c702bd11a81ca3841f47f37633e8aacbb5de.budget.golden @@ -1,2 +1,2 @@ -({cpu: 952220059 -| mem: 3466382}) \ No newline at end of file +({cpu: 951668059 +| mem: 3463982}) \ No newline at end of file diff --git a/plutus-benchmark/marlowe/test/semantics/9.6/3bb75b2e53eb13f718eacd3263ab4535f9137fabffc9de499a0de7cabb335479.budget.golden b/plutus-benchmark/marlowe/test/semantics/9.6/3bb75b2e53eb13f718eacd3263ab4535f9137fabffc9de499a0de7cabb335479.budget.golden index 8ff0927a94e..6fa427ca3dd 100644 --- a/plutus-benchmark/marlowe/test/semantics/9.6/3bb75b2e53eb13f718eacd3263ab4535f9137fabffc9de499a0de7cabb335479.budget.golden +++ b/plutus-benchmark/marlowe/test/semantics/9.6/3bb75b2e53eb13f718eacd3263ab4535f9137fabffc9de499a0de7cabb335479.budget.golden @@ -1,2 +1,2 @@ -({cpu: 376467639 -| mem: 1373721}) \ No newline at end of file +({cpu: 376191639 +| mem: 1372521}) \ No newline at end of file diff --git a/plutus-benchmark/marlowe/test/semantics/9.6/3db496e6cd39a8b888a89d0de07dace4397878958cab3b9d9353978b08c36d8a.budget.golden b/plutus-benchmark/marlowe/test/semantics/9.6/3db496e6cd39a8b888a89d0de07dace4397878958cab3b9d9353978b08c36d8a.budget.golden index 8c29079b236..98e5a3ee4cd 100644 --- a/plutus-benchmark/marlowe/test/semantics/9.6/3db496e6cd39a8b888a89d0de07dace4397878958cab3b9d9353978b08c36d8a.budget.golden +++ b/plutus-benchmark/marlowe/test/semantics/9.6/3db496e6cd39a8b888a89d0de07dace4397878958cab3b9d9353978b08c36d8a.budget.golden @@ -1,2 +1,2 @@ -({cpu: 1012201727 -| mem: 3611242}) \ No newline at end of file +({cpu: 1010959727 +| mem: 3605842}) \ No newline at end of file diff --git a/plutus-benchmark/marlowe/test/semantics/9.6/44a9e339fa25948b48637fe7e10dcfc6d1256319a7b5ce4202cb54dfef8e37e7.budget.golden b/plutus-benchmark/marlowe/test/semantics/9.6/44a9e339fa25948b48637fe7e10dcfc6d1256319a7b5ce4202cb54dfef8e37e7.budget.golden index 8ff0927a94e..6fa427ca3dd 100644 --- a/plutus-benchmark/marlowe/test/semantics/9.6/44a9e339fa25948b48637fe7e10dcfc6d1256319a7b5ce4202cb54dfef8e37e7.budget.golden +++ b/plutus-benchmark/marlowe/test/semantics/9.6/44a9e339fa25948b48637fe7e10dcfc6d1256319a7b5ce4202cb54dfef8e37e7.budget.golden @@ -1,2 +1,2 @@ -({cpu: 376467639 -| mem: 1373721}) \ No newline at end of file +({cpu: 376191639 +| mem: 1372521}) \ No newline at end of file diff --git a/plutus-benchmark/marlowe/test/semantics/9.6/4c3efd13b6c69112a8a888372d56c86e60c232125976f29b1c3e21d9f537845c.budget.golden b/plutus-benchmark/marlowe/test/semantics/9.6/4c3efd13b6c69112a8a888372d56c86e60c232125976f29b1c3e21d9f537845c.budget.golden index bce6ff3d13c..96f928b40fe 100644 --- a/plutus-benchmark/marlowe/test/semantics/9.6/4c3efd13b6c69112a8a888372d56c86e60c232125976f29b1c3e21d9f537845c.budget.golden +++ b/plutus-benchmark/marlowe/test/semantics/9.6/4c3efd13b6c69112a8a888372d56c86e60c232125976f29b1c3e21d9f537845c.budget.golden @@ -1,2 +1,2 @@ -({cpu: 1343889312 -| mem: 4938677}) \ No newline at end of file +({cpu: 1343153312 +| mem: 4935477}) \ No newline at end of file diff --git a/plutus-benchmark/marlowe/test/semantics/9.6/4d7adf91bfc93cebe95a7e054ec17cfbb912b32bd8aecb48a228b50e02b055c8.budget.golden b/plutus-benchmark/marlowe/test/semantics/9.6/4d7adf91bfc93cebe95a7e054ec17cfbb912b32bd8aecb48a228b50e02b055c8.budget.golden index 15260bf3ad6..9da09c43d15 100644 --- a/plutus-benchmark/marlowe/test/semantics/9.6/4d7adf91bfc93cebe95a7e054ec17cfbb912b32bd8aecb48a228b50e02b055c8.budget.golden +++ b/plutus-benchmark/marlowe/test/semantics/9.6/4d7adf91bfc93cebe95a7e054ec17cfbb912b32bd8aecb48a228b50e02b055c8.budget.golden @@ -1,2 +1,2 @@ -({cpu: 887177643 -| mem: 3259985}) \ No newline at end of file +({cpu: 886901643 +| mem: 3258785}) \ No newline at end of file diff --git a/plutus-benchmark/marlowe/test/semantics/9.6/4f9e8d361b85e62db2350dd3ae77463540e7af0d28e1eb68faeecc45f4655f57.budget.golden b/plutus-benchmark/marlowe/test/semantics/9.6/4f9e8d361b85e62db2350dd3ae77463540e7af0d28e1eb68faeecc45f4655f57.budget.golden index 45c0a753c76..3dc69541ec2 100644 --- a/plutus-benchmark/marlowe/test/semantics/9.6/4f9e8d361b85e62db2350dd3ae77463540e7af0d28e1eb68faeecc45f4655f57.budget.golden +++ b/plutus-benchmark/marlowe/test/semantics/9.6/4f9e8d361b85e62db2350dd3ae77463540e7af0d28e1eb68faeecc45f4655f57.budget.golden @@ -1,2 +1,2 @@ -({cpu: 476727343 -| mem: 1695344}) \ No newline at end of file +({cpu: 476405343 +| mem: 1693944}) \ No newline at end of file diff --git a/plutus-benchmark/marlowe/test/semantics/9.6/52df7c8dfaa5f801cd837faa65f2fd333665fff00a555ce8c55e36ddc003007a.budget.golden b/plutus-benchmark/marlowe/test/semantics/9.6/52df7c8dfaa5f801cd837faa65f2fd333665fff00a555ce8c55e36ddc003007a.budget.golden index def991727e8..ad7c09ff75e 100644 --- a/plutus-benchmark/marlowe/test/semantics/9.6/52df7c8dfaa5f801cd837faa65f2fd333665fff00a555ce8c55e36ddc003007a.budget.golden +++ b/plutus-benchmark/marlowe/test/semantics/9.6/52df7c8dfaa5f801cd837faa65f2fd333665fff00a555ce8c55e36ddc003007a.budget.golden @@ -1,2 +1,2 @@ -({cpu: 456544520 -| mem: 1638385}) \ No newline at end of file +({cpu: 456268520 +| mem: 1637185}) \ No newline at end of file diff --git a/plutus-benchmark/marlowe/test/semantics/9.6/53ed4db7ab33d6f907eec91a861d1188269be5ae1892d07ee71161bfb55a7cb7.budget.golden b/plutus-benchmark/marlowe/test/semantics/9.6/53ed4db7ab33d6f907eec91a861d1188269be5ae1892d07ee71161bfb55a7cb7.budget.golden index be1c4878106..443b83628d0 100644 --- a/plutus-benchmark/marlowe/test/semantics/9.6/53ed4db7ab33d6f907eec91a861d1188269be5ae1892d07ee71161bfb55a7cb7.budget.golden +++ b/plutus-benchmark/marlowe/test/semantics/9.6/53ed4db7ab33d6f907eec91a861d1188269be5ae1892d07ee71161bfb55a7cb7.budget.golden @@ -1,2 +1,2 @@ -({cpu: 467683100 -| mem: 1672713}) \ No newline at end of file +({cpu: 467407100 +| mem: 1671513}) \ No newline at end of file diff --git a/plutus-benchmark/marlowe/test/semantics/9.6/55dfe42688ad683b638df1fa7700219f00f53b335a85a2825502ab1e0687197e.budget.golden b/plutus-benchmark/marlowe/test/semantics/9.6/55dfe42688ad683b638df1fa7700219f00f53b335a85a2825502ab1e0687197e.budget.golden index 8ff0927a94e..6fa427ca3dd 100644 --- a/plutus-benchmark/marlowe/test/semantics/9.6/55dfe42688ad683b638df1fa7700219f00f53b335a85a2825502ab1e0687197e.budget.golden +++ b/plutus-benchmark/marlowe/test/semantics/9.6/55dfe42688ad683b638df1fa7700219f00f53b335a85a2825502ab1e0687197e.budget.golden @@ -1,2 +1,2 @@ -({cpu: 376467639 -| mem: 1373721}) \ No newline at end of file +({cpu: 376191639 +| mem: 1372521}) \ No newline at end of file diff --git a/plutus-benchmark/marlowe/test/semantics/9.6/56333d4e413dbf1a665463bf68067f63c118f38f7539b7ba7167d577c0c8b8ce.budget.golden b/plutus-benchmark/marlowe/test/semantics/9.6/56333d4e413dbf1a665463bf68067f63c118f38f7539b7ba7167d577c0c8b8ce.budget.golden index 066c81dccb0..e71ed4b75d4 100644 --- a/plutus-benchmark/marlowe/test/semantics/9.6/56333d4e413dbf1a665463bf68067f63c118f38f7539b7ba7167d577c0c8b8ce.budget.golden +++ b/plutus-benchmark/marlowe/test/semantics/9.6/56333d4e413dbf1a665463bf68067f63c118f38f7539b7ba7167d577c0c8b8ce.budget.golden @@ -1,2 +1,2 @@ -({cpu: 1013881942 -| mem: 3783744}) \ No newline at end of file +({cpu: 1013329942 +| mem: 3781344}) \ No newline at end of file diff --git a/plutus-benchmark/marlowe/test/semantics/9.6/57728d8b19b0e06412786f3dfed9e1894cd0ad1d2bc2bd497ec0ecb68f989d2b.budget.golden b/plutus-benchmark/marlowe/test/semantics/9.6/57728d8b19b0e06412786f3dfed9e1894cd0ad1d2bc2bd497ec0ecb68f989d2b.budget.golden index 8ff0927a94e..6fa427ca3dd 100644 --- a/plutus-benchmark/marlowe/test/semantics/9.6/57728d8b19b0e06412786f3dfed9e1894cd0ad1d2bc2bd497ec0ecb68f989d2b.budget.golden +++ b/plutus-benchmark/marlowe/test/semantics/9.6/57728d8b19b0e06412786f3dfed9e1894cd0ad1d2bc2bd497ec0ecb68f989d2b.budget.golden @@ -1,2 +1,2 @@ -({cpu: 376467639 -| mem: 1373721}) \ No newline at end of file +({cpu: 376191639 +| mem: 1372521}) \ No newline at end of file diff --git a/plutus-benchmark/marlowe/test/semantics/9.6/5abae75af26f45658beccbe48f7c88e74efdfc0b8409ba1e98f95fa5b6caf999.budget.golden b/plutus-benchmark/marlowe/test/semantics/9.6/5abae75af26f45658beccbe48f7c88e74efdfc0b8409ba1e98f95fa5b6caf999.budget.golden index cb316d66165..485d8d1149f 100644 --- a/plutus-benchmark/marlowe/test/semantics/9.6/5abae75af26f45658beccbe48f7c88e74efdfc0b8409ba1e98f95fa5b6caf999.budget.golden +++ b/plutus-benchmark/marlowe/test/semantics/9.6/5abae75af26f45658beccbe48f7c88e74efdfc0b8409ba1e98f95fa5b6caf999.budget.golden @@ -1,2 +1,2 @@ -({cpu: 627380441 -| mem: 2303351}) \ No newline at end of file +({cpu: 627104441 +| mem: 2302151}) \ No newline at end of file diff --git a/plutus-benchmark/marlowe/test/semantics/9.6/5d0a88250f13c49c20e146819357a808911c878a0e0a7d6f7fe1d4a619e06112.budget.golden b/plutus-benchmark/marlowe/test/semantics/9.6/5d0a88250f13c49c20e146819357a808911c878a0e0a7d6f7fe1d4a619e06112.budget.golden index 6e1d97195eb..bb0464e4566 100644 --- a/plutus-benchmark/marlowe/test/semantics/9.6/5d0a88250f13c49c20e146819357a808911c878a0e0a7d6f7fe1d4a619e06112.budget.golden +++ b/plutus-benchmark/marlowe/test/semantics/9.6/5d0a88250f13c49c20e146819357a808911c878a0e0a7d6f7fe1d4a619e06112.budget.golden @@ -1,2 +1,2 @@ -({cpu: 1344553687 -| mem: 4781561}) \ No newline at end of file +({cpu: 1343587687 +| mem: 4777361}) \ No newline at end of file diff --git a/plutus-benchmark/marlowe/test/semantics/9.6/5e274e0f593511543d41570a4b03646c1d7539062b5728182e073e5760561a66.budget.golden b/plutus-benchmark/marlowe/test/semantics/9.6/5e274e0f593511543d41570a4b03646c1d7539062b5728182e073e5760561a66.budget.golden index 78543e1889a..59be89d8a97 100644 --- a/plutus-benchmark/marlowe/test/semantics/9.6/5e274e0f593511543d41570a4b03646c1d7539062b5728182e073e5760561a66.budget.golden +++ b/plutus-benchmark/marlowe/test/semantics/9.6/5e274e0f593511543d41570a4b03646c1d7539062b5728182e073e5760561a66.budget.golden @@ -1,2 +1,2 @@ -({cpu: 1316523580 -| mem: 4755987}) \ No newline at end of file +({cpu: 1315212580 +| mem: 4750287}) \ No newline at end of file diff --git a/plutus-benchmark/marlowe/test/semantics/9.6/5e2c68ac9f62580d626636679679b97109109df7ac1a8ce86d3e43dfb5e4f6bc.budget.golden b/plutus-benchmark/marlowe/test/semantics/9.6/5e2c68ac9f62580d626636679679b97109109df7ac1a8ce86d3e43dfb5e4f6bc.budget.golden index 9a72fd70bbd..757f580cf2b 100644 --- a/plutus-benchmark/marlowe/test/semantics/9.6/5e2c68ac9f62580d626636679679b97109109df7ac1a8ce86d3e43dfb5e4f6bc.budget.golden +++ b/plutus-benchmark/marlowe/test/semantics/9.6/5e2c68ac9f62580d626636679679b97109109df7ac1a8ce86d3e43dfb5e4f6bc.budget.golden @@ -1,2 +1,2 @@ -({cpu: 664046927 -| mem: 2409989}) \ No newline at end of file +({cpu: 663540927 +| mem: 2407789}) \ No newline at end of file diff --git a/plutus-benchmark/marlowe/test/semantics/9.6/5f130d19918807b60eab4c03119d67878fb6c6712c28c54f5a25792049294acc.budget.golden b/plutus-benchmark/marlowe/test/semantics/9.6/5f130d19918807b60eab4c03119d67878fb6c6712c28c54f5a25792049294acc.budget.golden index f6615208266..6ebe321a341 100644 --- a/plutus-benchmark/marlowe/test/semantics/9.6/5f130d19918807b60eab4c03119d67878fb6c6712c28c54f5a25792049294acc.budget.golden +++ b/plutus-benchmark/marlowe/test/semantics/9.6/5f130d19918807b60eab4c03119d67878fb6c6712c28c54f5a25792049294acc.budget.golden @@ -1,2 +1,2 @@ -({cpu: 379087524 -| mem: 1379223}) \ No newline at end of file +({cpu: 378811524 +| mem: 1378023}) \ No newline at end of file diff --git a/plutus-benchmark/marlowe/test/semantics/9.6/5f306b4b24ff2b39dab6cdc9ac6ca9bb442c1dc6f4e7e412eeb5a3ced42fb642.budget.golden b/plutus-benchmark/marlowe/test/semantics/9.6/5f306b4b24ff2b39dab6cdc9ac6ca9bb442c1dc6f4e7e412eeb5a3ced42fb642.budget.golden index c8c1b31bfb4..59bb3f5c952 100644 --- a/plutus-benchmark/marlowe/test/semantics/9.6/5f306b4b24ff2b39dab6cdc9ac6ca9bb442c1dc6f4e7e412eeb5a3ced42fb642.budget.golden +++ b/plutus-benchmark/marlowe/test/semantics/9.6/5f306b4b24ff2b39dab6cdc9ac6ca9bb442c1dc6f4e7e412eeb5a3ced42fb642.budget.golden @@ -1,2 +1,2 @@ -({cpu: 962152396 -| mem: 3537162}) \ No newline at end of file +({cpu: 961600396 +| mem: 3534762}) \ No newline at end of file diff --git a/plutus-benchmark/marlowe/test/semantics/9.6/5f3d46c57a56cef6764f96c9de9677ac6e494dd7a4e368d1c8dd9c1f7a4309a5.budget.golden b/plutus-benchmark/marlowe/test/semantics/9.6/5f3d46c57a56cef6764f96c9de9677ac6e494dd7a4e368d1c8dd9c1f7a4309a5.budget.golden index a635d0b2ed0..6ae601955dd 100644 --- a/plutus-benchmark/marlowe/test/semantics/9.6/5f3d46c57a56cef6764f96c9de9677ac6e494dd7a4e368d1c8dd9c1f7a4309a5.budget.golden +++ b/plutus-benchmark/marlowe/test/semantics/9.6/5f3d46c57a56cef6764f96c9de9677ac6e494dd7a4e368d1c8dd9c1f7a4309a5.budget.golden @@ -1,2 +1,2 @@ -({cpu: 629715025 -| mem: 2311543}) \ No newline at end of file +({cpu: 629439025 +| mem: 2310343}) \ No newline at end of file diff --git a/plutus-benchmark/marlowe/test/semantics/9.6/64c3d5b43f005855ffc4d0950a02fd159aa1575294ea39061b81a194ebb9eaae.budget.golden b/plutus-benchmark/marlowe/test/semantics/9.6/64c3d5b43f005855ffc4d0950a02fd159aa1575294ea39061b81a194ebb9eaae.budget.golden index 02690ffafb7..014142c8372 100644 --- a/plutus-benchmark/marlowe/test/semantics/9.6/64c3d5b43f005855ffc4d0950a02fd159aa1575294ea39061b81a194ebb9eaae.budget.golden +++ b/plutus-benchmark/marlowe/test/semantics/9.6/64c3d5b43f005855ffc4d0950a02fd159aa1575294ea39061b81a194ebb9eaae.budget.golden @@ -1,2 +1,2 @@ -({cpu: 856256635 -| mem: 3168982}) \ No newline at end of file +({cpu: 855934635 +| mem: 3167582}) \ No newline at end of file diff --git a/plutus-benchmark/marlowe/test/semantics/9.6/65bc4b69b46d18fdff0fadbf00dd5ec2b3e03805fac9d5fb4ff2d3066e53fc7e.budget.golden b/plutus-benchmark/marlowe/test/semantics/9.6/65bc4b69b46d18fdff0fadbf00dd5ec2b3e03805fac9d5fb4ff2d3066e53fc7e.budget.golden index d40dd1ef3b2..548aa5d2475 100644 --- a/plutus-benchmark/marlowe/test/semantics/9.6/65bc4b69b46d18fdff0fadbf00dd5ec2b3e03805fac9d5fb4ff2d3066e53fc7e.budget.golden +++ b/plutus-benchmark/marlowe/test/semantics/9.6/65bc4b69b46d18fdff0fadbf00dd5ec2b3e03805fac9d5fb4ff2d3066e53fc7e.budget.golden @@ -1,2 +1,2 @@ -({cpu: 1338828659 -| mem: 1873256}) \ No newline at end of file +({cpu: 1338046659 +| mem: 1869856}) \ No newline at end of file diff --git a/plutus-benchmark/marlowe/test/semantics/9.6/66af9e473d75e3f464971f6879cc0f2ef84bafcb38fbfa1dbc31ac2053628a38.budget.golden b/plutus-benchmark/marlowe/test/semantics/9.6/66af9e473d75e3f464971f6879cc0f2ef84bafcb38fbfa1dbc31ac2053628a38.budget.golden index 2ab2d719b9b..507edbbcb6b 100644 --- a/plutus-benchmark/marlowe/test/semantics/9.6/66af9e473d75e3f464971f6879cc0f2ef84bafcb38fbfa1dbc31ac2053628a38.budget.golden +++ b/plutus-benchmark/marlowe/test/semantics/9.6/66af9e473d75e3f464971f6879cc0f2ef84bafcb38fbfa1dbc31ac2053628a38.budget.golden @@ -1,2 +1,2 @@ -({cpu: 1674583097 -| mem: 5551264}) \ No newline at end of file +({cpu: 1671386097 +| mem: 5537364}) \ No newline at end of file diff --git a/plutus-benchmark/marlowe/test/semantics/9.6/675d63836cad11b547d1b4cddd498f04c919d4342612accf40913f9ae9419fac.budget.golden b/plutus-benchmark/marlowe/test/semantics/9.6/675d63836cad11b547d1b4cddd498f04c919d4342612accf40913f9ae9419fac.budget.golden index c5fa72b998f..01dc393cbe5 100644 --- a/plutus-benchmark/marlowe/test/semantics/9.6/675d63836cad11b547d1b4cddd498f04c919d4342612accf40913f9ae9419fac.budget.golden +++ b/plutus-benchmark/marlowe/test/semantics/9.6/675d63836cad11b547d1b4cddd498f04c919d4342612accf40913f9ae9419fac.budget.golden @@ -1,2 +1,2 @@ -({cpu: 1361469327 -| mem: 4983039}) \ No newline at end of file +({cpu: 1360503327 +| mem: 4978839}) \ No newline at end of file diff --git a/plutus-benchmark/marlowe/test/semantics/9.6/67ba5a9a0245ee3aff4f34852b9889b8c810fccd3dce2a23910bddd35c503b71.budget.golden b/plutus-benchmark/marlowe/test/semantics/9.6/67ba5a9a0245ee3aff4f34852b9889b8c810fccd3dce2a23910bddd35c503b71.budget.golden index b4052b938bc..d1be652ae3d 100644 --- a/plutus-benchmark/marlowe/test/semantics/9.6/67ba5a9a0245ee3aff4f34852b9889b8c810fccd3dce2a23910bddd35c503b71.budget.golden +++ b/plutus-benchmark/marlowe/test/semantics/9.6/67ba5a9a0245ee3aff4f34852b9889b8c810fccd3dce2a23910bddd35c503b71.budget.golden @@ -1,2 +1,2 @@ -({cpu: 2100690471 -| mem: 1702798}) \ No newline at end of file +({cpu: 2099908471 +| mem: 1699398}) \ No newline at end of file diff --git a/plutus-benchmark/marlowe/test/semantics/9.6/6d88f7294dd2b5ce02c3dc609bc7715bd508009738401d264bf9b3eb7c6f49c1.budget.golden b/plutus-benchmark/marlowe/test/semantics/9.6/6d88f7294dd2b5ce02c3dc609bc7715bd508009738401d264bf9b3eb7c6f49c1.budget.golden index b78d1c035a5..6ed98bb9896 100644 --- a/plutus-benchmark/marlowe/test/semantics/9.6/6d88f7294dd2b5ce02c3dc609bc7715bd508009738401d264bf9b3eb7c6f49c1.budget.golden +++ b/plutus-benchmark/marlowe/test/semantics/9.6/6d88f7294dd2b5ce02c3dc609bc7715bd508009738401d264bf9b3eb7c6f49c1.budget.golden @@ -1,2 +1,2 @@ -({cpu: 629975340 -| mem: 2308853}) \ No newline at end of file +({cpu: 629699340 +| mem: 2307653}) \ No newline at end of file diff --git a/plutus-benchmark/marlowe/test/semantics/9.6/70f65b21b77ddb451f3df9d9fb403ced3d10e1e953867cc4900cc25e5b9dec47.budget.golden b/plutus-benchmark/marlowe/test/semantics/9.6/70f65b21b77ddb451f3df9d9fb403ced3d10e1e953867cc4900cc25e5b9dec47.budget.golden index fe48465935d..a441cccdf66 100644 --- a/plutus-benchmark/marlowe/test/semantics/9.6/70f65b21b77ddb451f3df9d9fb403ced3d10e1e953867cc4900cc25e5b9dec47.budget.golden +++ b/plutus-benchmark/marlowe/test/semantics/9.6/70f65b21b77ddb451f3df9d9fb403ced3d10e1e953867cc4900cc25e5b9dec47.budget.golden @@ -1,2 +1,2 @@ -({cpu: 956592059 -| mem: 3439563}) \ No newline at end of file +({cpu: 955005059 +| mem: 3432663}) \ No newline at end of file diff --git a/plutus-benchmark/marlowe/test/semantics/9.6/71965c9ccae31f1ffc1d85aa20a356d4ed97a420954018d8301ec4f9783be0d7.budget.golden b/plutus-benchmark/marlowe/test/semantics/9.6/71965c9ccae31f1ffc1d85aa20a356d4ed97a420954018d8301ec4f9783be0d7.budget.golden index da2ac3b4796..338c29f4874 100644 --- a/plutus-benchmark/marlowe/test/semantics/9.6/71965c9ccae31f1ffc1d85aa20a356d4ed97a420954018d8301ec4f9783be0d7.budget.golden +++ b/plutus-benchmark/marlowe/test/semantics/9.6/71965c9ccae31f1ffc1d85aa20a356d4ed97a420954018d8301ec4f9783be0d7.budget.golden @@ -1,2 +1,2 @@ -({cpu: 613415307 -| mem: 2248569}) \ No newline at end of file +({cpu: 613139307 +| mem: 2247369}) \ No newline at end of file diff --git a/plutus-benchmark/marlowe/test/semantics/9.6/74c67f2f182b9a0a66c62b95d6fac5ace3f7e71ea3abfc52ffbe3ecb93436ea2.budget.golden b/plutus-benchmark/marlowe/test/semantics/9.6/74c67f2f182b9a0a66c62b95d6fac5ace3f7e71ea3abfc52ffbe3ecb93436ea2.budget.golden index cfd8f15b09c..991f31e60d9 100644 --- a/plutus-benchmark/marlowe/test/semantics/9.6/74c67f2f182b9a0a66c62b95d6fac5ace3f7e71ea3abfc52ffbe3ecb93436ea2.budget.golden +++ b/plutus-benchmark/marlowe/test/semantics/9.6/74c67f2f182b9a0a66c62b95d6fac5ace3f7e71ea3abfc52ffbe3ecb93436ea2.budget.golden @@ -1,2 +1,2 @@ -({cpu: 1025685585 -| mem: 3787002}) \ No newline at end of file +({cpu: 1025133585 +| mem: 3784602}) \ No newline at end of file diff --git a/plutus-benchmark/marlowe/test/semantics/9.6/7529b206a78becb793da74b78c04d9d33a2540a1abd79718e681228f4057403a.budget.golden b/plutus-benchmark/marlowe/test/semantics/9.6/7529b206a78becb793da74b78c04d9d33a2540a1abd79718e681228f4057403a.budget.golden index 73ec4d8a91a..08e5ed2597f 100644 --- a/plutus-benchmark/marlowe/test/semantics/9.6/7529b206a78becb793da74b78c04d9d33a2540a1abd79718e681228f4057403a.budget.golden +++ b/plutus-benchmark/marlowe/test/semantics/9.6/7529b206a78becb793da74b78c04d9d33a2540a1abd79718e681228f4057403a.budget.golden @@ -1,2 +1,2 @@ -({cpu: 1047350211 -| mem: 3906496}) \ No newline at end of file +({cpu: 1046798211 +| mem: 3904096}) \ No newline at end of file diff --git a/plutus-benchmark/marlowe/test/semantics/9.6/75a8bb183688bce447e00f435a144c835435e40a5defc6f3b9be68b70b4a3db6.budget.golden b/plutus-benchmark/marlowe/test/semantics/9.6/75a8bb183688bce447e00f435a144c835435e40a5defc6f3b9be68b70b4a3db6.budget.golden index 7724629e26d..5381215e558 100644 --- a/plutus-benchmark/marlowe/test/semantics/9.6/75a8bb183688bce447e00f435a144c835435e40a5defc6f3b9be68b70b4a3db6.budget.golden +++ b/plutus-benchmark/marlowe/test/semantics/9.6/75a8bb183688bce447e00f435a144c835435e40a5defc6f3b9be68b70b4a3db6.budget.golden @@ -1,2 +1,2 @@ -({cpu: 884122318 -| mem: 3246709}) \ No newline at end of file +({cpu: 883846318 +| mem: 3245509}) \ No newline at end of file diff --git a/plutus-benchmark/marlowe/test/semantics/9.6/7a758e17486d1a30462c32a5d5309bd1e98322a9dcbe277c143ed3aede9d265f.budget.golden b/plutus-benchmark/marlowe/test/semantics/9.6/7a758e17486d1a30462c32a5d5309bd1e98322a9dcbe277c143ed3aede9d265f.budget.golden index 2733e950c59..ea7158cff8b 100644 --- a/plutus-benchmark/marlowe/test/semantics/9.6/7a758e17486d1a30462c32a5d5309bd1e98322a9dcbe277c143ed3aede9d265f.budget.golden +++ b/plutus-benchmark/marlowe/test/semantics/9.6/7a758e17486d1a30462c32a5d5309bd1e98322a9dcbe277c143ed3aede9d265f.budget.golden @@ -1,2 +1,2 @@ -({cpu: 633761077 -| mem: 2225432}) \ No newline at end of file +({cpu: 631645077 +| mem: 2216232}) \ No newline at end of file diff --git a/plutus-benchmark/marlowe/test/semantics/9.6/7cbc5644b745f4ea635aca42cce5e4a4b9d2e61afdb3ac18128e1688c07071ba.budget.golden b/plutus-benchmark/marlowe/test/semantics/9.6/7cbc5644b745f4ea635aca42cce5e4a4b9d2e61afdb3ac18128e1688c07071ba.budget.golden index 267f3a67b74..38d1d3f1fe1 100644 --- a/plutus-benchmark/marlowe/test/semantics/9.6/7cbc5644b745f4ea635aca42cce5e4a4b9d2e61afdb3ac18128e1688c07071ba.budget.golden +++ b/plutus-benchmark/marlowe/test/semantics/9.6/7cbc5644b745f4ea635aca42cce5e4a4b9d2e61afdb3ac18128e1688c07071ba.budget.golden @@ -1,2 +1,2 @@ -({cpu: 604413829 -| mem: 2221930}) \ No newline at end of file +({cpu: 604091829 +| mem: 2220530}) \ 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 c3fc339c5f8..67abab70d12 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: 1502764480 -| mem: 4980476}) \ No newline at end of file +({cpu: 1499682480 +| mem: 4967076}) \ No newline at end of file diff --git a/plutus-benchmark/marlowe/test/semantics/9.6/8c7fdc3da6822b5112074380003524f50fb3a1ce6db4e501df1086773c6c0201.budget.golden b/plutus-benchmark/marlowe/test/semantics/9.6/8c7fdc3da6822b5112074380003524f50fb3a1ce6db4e501df1086773c6c0201.budget.golden index 088b713e99f..4411da6d970 100644 --- a/plutus-benchmark/marlowe/test/semantics/9.6/8c7fdc3da6822b5112074380003524f50fb3a1ce6db4e501df1086773c6c0201.budget.golden +++ b/plutus-benchmark/marlowe/test/semantics/9.6/8c7fdc3da6822b5112074380003524f50fb3a1ce6db4e501df1086773c6c0201.budget.golden @@ -1,2 +1,2 @@ -({cpu: 1487319776 -| mem: 5474580}) \ No newline at end of file +({cpu: 1486307776 +| mem: 5470180}) \ No newline at end of file diff --git a/plutus-benchmark/marlowe/test/semantics/9.6/8d9ae67656a2911ab15a8e5301c960c69aa2517055197aff6b60a87ff718d66c.budget.golden b/plutus-benchmark/marlowe/test/semantics/9.6/8d9ae67656a2911ab15a8e5301c960c69aa2517055197aff6b60a87ff718d66c.budget.golden index 58cc9f3e5fa..f8d17270f82 100644 --- a/plutus-benchmark/marlowe/test/semantics/9.6/8d9ae67656a2911ab15a8e5301c960c69aa2517055197aff6b60a87ff718d66c.budget.golden +++ b/plutus-benchmark/marlowe/test/semantics/9.6/8d9ae67656a2911ab15a8e5301c960c69aa2517055197aff6b60a87ff718d66c.budget.golden @@ -1,2 +1,2 @@ -({cpu: 451667264 -| mem: 1665240}) \ No newline at end of file +({cpu: 451345264 +| mem: 1663840}) \ No newline at end of file diff --git a/plutus-benchmark/marlowe/test/semantics/9.6/96e1a2fa3ceb9a402f2a5841a0b645f87b4e8e75beb636692478ec39f74ee221.budget.golden b/plutus-benchmark/marlowe/test/semantics/9.6/96e1a2fa3ceb9a402f2a5841a0b645f87b4e8e75beb636692478ec39f74ee221.budget.golden index f6615208266..6ebe321a341 100644 --- a/plutus-benchmark/marlowe/test/semantics/9.6/96e1a2fa3ceb9a402f2a5841a0b645f87b4e8e75beb636692478ec39f74ee221.budget.golden +++ b/plutus-benchmark/marlowe/test/semantics/9.6/96e1a2fa3ceb9a402f2a5841a0b645f87b4e8e75beb636692478ec39f74ee221.budget.golden @@ -1,2 +1,2 @@ -({cpu: 379087524 -| mem: 1379223}) \ No newline at end of file +({cpu: 378811524 +| mem: 1378023}) \ No newline at end of file diff --git a/plutus-benchmark/marlowe/test/semantics/9.6/9fabc4fc3440cdb776b28c9bb1dd49c9a5b1605fe1490aa3f4f64a3fa8881b25.budget.golden b/plutus-benchmark/marlowe/test/semantics/9.6/9fabc4fc3440cdb776b28c9bb1dd49c9a5b1605fe1490aa3f4f64a3fa8881b25.budget.golden index 6cbb5741eba..4ec3883da69 100644 --- a/plutus-benchmark/marlowe/test/semantics/9.6/9fabc4fc3440cdb776b28c9bb1dd49c9a5b1605fe1490aa3f4f64a3fa8881b25.budget.golden +++ b/plutus-benchmark/marlowe/test/semantics/9.6/9fabc4fc3440cdb776b28c9bb1dd49c9a5b1605fe1490aa3f4f64a3fa8881b25.budget.golden @@ -1,2 +1,2 @@ -({cpu: 1345983255 -| mem: 4650991}) \ No newline at end of file +({cpu: 1343752255 +| mem: 4641291}) \ No newline at end of file diff --git a/plutus-benchmark/marlowe/test/semantics/9.6/a85173a832db3ea944fafc406dfe3fa3235254897d6d1d0e21bc380147687bd5.budget.golden b/plutus-benchmark/marlowe/test/semantics/9.6/a85173a832db3ea944fafc406dfe3fa3235254897d6d1d0e21bc380147687bd5.budget.golden index be1c4878106..443b83628d0 100644 --- a/plutus-benchmark/marlowe/test/semantics/9.6/a85173a832db3ea944fafc406dfe3fa3235254897d6d1d0e21bc380147687bd5.budget.golden +++ b/plutus-benchmark/marlowe/test/semantics/9.6/a85173a832db3ea944fafc406dfe3fa3235254897d6d1d0e21bc380147687bd5.budget.golden @@ -1,2 +1,2 @@ -({cpu: 467683100 -| mem: 1672713}) \ No newline at end of file +({cpu: 467407100 +| mem: 1671513}) \ No newline at end of file diff --git a/plutus-benchmark/marlowe/test/semantics/9.6/a9a853b6d083551f4ed2995551af287880ef42aee239a2d9bc5314d127cce592.budget.golden b/plutus-benchmark/marlowe/test/semantics/9.6/a9a853b6d083551f4ed2995551af287880ef42aee239a2d9bc5314d127cce592.budget.golden index 2733e950c59..ea7158cff8b 100644 --- a/plutus-benchmark/marlowe/test/semantics/9.6/a9a853b6d083551f4ed2995551af287880ef42aee239a2d9bc5314d127cce592.budget.golden +++ b/plutus-benchmark/marlowe/test/semantics/9.6/a9a853b6d083551f4ed2995551af287880ef42aee239a2d9bc5314d127cce592.budget.golden @@ -1,2 +1,2 @@ -({cpu: 633761077 -| mem: 2225432}) \ No newline at end of file +({cpu: 631645077 +| mem: 2216232}) \ No newline at end of file diff --git a/plutus-benchmark/marlowe/test/semantics/9.6/acb9c83c2b78dabef8674319ad69ba54912cd9997bdf2d8b2998c6bfeef3b122.budget.golden b/plutus-benchmark/marlowe/test/semantics/9.6/acb9c83c2b78dabef8674319ad69ba54912cd9997bdf2d8b2998c6bfeef3b122.budget.golden index fa3e01cf63b..b265ac1e694 100644 --- a/plutus-benchmark/marlowe/test/semantics/9.6/acb9c83c2b78dabef8674319ad69ba54912cd9997bdf2d8b2998c6bfeef3b122.budget.golden +++ b/plutus-benchmark/marlowe/test/semantics/9.6/acb9c83c2b78dabef8674319ad69ba54912cd9997bdf2d8b2998c6bfeef3b122.budget.golden @@ -1,2 +1,2 @@ -({cpu: 826011909 -| mem: 3062154}) \ No newline at end of file +({cpu: 825689909 +| mem: 3060754}) \ No newline at end of file diff --git a/plutus-benchmark/marlowe/test/semantics/9.6/acce04815e8fd51be93322888250060da173eccf3df3a605bd6bc6a456cde871.budget.golden b/plutus-benchmark/marlowe/test/semantics/9.6/acce04815e8fd51be93322888250060da173eccf3df3a605bd6bc6a456cde871.budget.golden index 9d69b2c4eda..3a79c625145 100644 --- a/plutus-benchmark/marlowe/test/semantics/9.6/acce04815e8fd51be93322888250060da173eccf3df3a605bd6bc6a456cde871.budget.golden +++ b/plutus-benchmark/marlowe/test/semantics/9.6/acce04815e8fd51be93322888250060da173eccf3df3a605bd6bc6a456cde871.budget.golden @@ -1,2 +1,2 @@ -({cpu: 402272964 -| mem: 1394769}) \ No newline at end of file +({cpu: 401996964 +| mem: 1393569}) \ No newline at end of file diff --git a/plutus-benchmark/marlowe/test/semantics/9.6/ad6db94ed69b7161c7604568f44358e1cc11e81fea90e41afebd669e51bb60c8.budget.golden b/plutus-benchmark/marlowe/test/semantics/9.6/ad6db94ed69b7161c7604568f44358e1cc11e81fea90e41afebd669e51bb60c8.budget.golden index 0c039a12dc4..2dacc1ac29a 100644 --- a/plutus-benchmark/marlowe/test/semantics/9.6/ad6db94ed69b7161c7604568f44358e1cc11e81fea90e41afebd669e51bb60c8.budget.golden +++ b/plutus-benchmark/marlowe/test/semantics/9.6/ad6db94ed69b7161c7604568f44358e1cc11e81fea90e41afebd669e51bb60c8.budget.golden @@ -1,2 +1,2 @@ -({cpu: 744985708 -| mem: 2750952}) \ No newline at end of file +({cpu: 744663708 +| mem: 2749552}) \ No newline at end of file diff --git a/plutus-benchmark/marlowe/test/semantics/9.6/b21a4df3b0266ad3481a26d3e3d848aad2fcde89510b29cccce81971e38e0835.budget.golden b/plutus-benchmark/marlowe/test/semantics/9.6/b21a4df3b0266ad3481a26d3e3d848aad2fcde89510b29cccce81971e38e0835.budget.golden index 99b7fdf4c64..90875ba4612 100644 --- a/plutus-benchmark/marlowe/test/semantics/9.6/b21a4df3b0266ad3481a26d3e3d848aad2fcde89510b29cccce81971e38e0835.budget.golden +++ b/plutus-benchmark/marlowe/test/semantics/9.6/b21a4df3b0266ad3481a26d3e3d848aad2fcde89510b29cccce81971e38e0835.budget.golden @@ -1,2 +1,2 @@ -({cpu: 1750286502 -| mem: 6348208}) \ No newline at end of file +({cpu: 1749044502 +| mem: 6342808}) \ No newline at end of file diff --git a/plutus-benchmark/marlowe/test/semantics/9.6/b50170cea48ee84b80558c02b15c6df52faf884e504d2c410ad63ba46d8ca35c.budget.golden b/plutus-benchmark/marlowe/test/semantics/9.6/b50170cea48ee84b80558c02b15c6df52faf884e504d2c410ad63ba46d8ca35c.budget.golden index a04028ff356..e3728a039a5 100644 --- a/plutus-benchmark/marlowe/test/semantics/9.6/b50170cea48ee84b80558c02b15c6df52faf884e504d2c410ad63ba46d8ca35c.budget.golden +++ b/plutus-benchmark/marlowe/test/semantics/9.6/b50170cea48ee84b80558c02b15c6df52faf884e504d2c410ad63ba46d8ca35c.budget.golden @@ -1,2 +1,2 @@ -({cpu: 988541276 -| mem: 3674924}) \ No newline at end of file +({cpu: 987989276 +| mem: 3672524}) \ No newline at end of file diff --git a/plutus-benchmark/marlowe/test/semantics/9.6/bb5345bfbbc460af84e784b900ec270df1948bb1d1e29eacecd022eeb168b315.budget.golden b/plutus-benchmark/marlowe/test/semantics/9.6/bb5345bfbbc460af84e784b900ec270df1948bb1d1e29eacecd022eeb168b315.budget.golden index ae2cad09bcb..6cd3ed1f72c 100644 --- a/plutus-benchmark/marlowe/test/semantics/9.6/bb5345bfbbc460af84e784b900ec270df1948bb1d1e29eacecd022eeb168b315.budget.golden +++ b/plutus-benchmark/marlowe/test/semantics/9.6/bb5345bfbbc460af84e784b900ec270df1948bb1d1e29eacecd022eeb168b315.budget.golden @@ -1,2 +1,2 @@ -({cpu: 1247344755 -| mem: 4593474}) \ No newline at end of file +({cpu: 1245987755 +| mem: 4587574}) \ No newline at end of file diff --git a/plutus-benchmark/marlowe/test/semantics/9.6/c4bb185380df6e9b66fc1ee0564f09a8d1253a51a0c0c7890f2214df9ac19274.budget.golden b/plutus-benchmark/marlowe/test/semantics/9.6/c4bb185380df6e9b66fc1ee0564f09a8d1253a51a0c0c7890f2214df9ac19274.budget.golden index 582ff5271ef..e1a26628378 100644 --- a/plutus-benchmark/marlowe/test/semantics/9.6/c4bb185380df6e9b66fc1ee0564f09a8d1253a51a0c0c7890f2214df9ac19274.budget.golden +++ b/plutus-benchmark/marlowe/test/semantics/9.6/c4bb185380df6e9b66fc1ee0564f09a8d1253a51a0c0c7890f2214df9ac19274.budget.golden @@ -1,2 +1,2 @@ -({cpu: 949342234 -| mem: 3509651}) \ No newline at end of file +({cpu: 949066234 +| mem: 3508451}) \ No newline at end of file diff --git a/plutus-benchmark/marlowe/test/semantics/9.6/c9efcb705ee057791f7c18a1de79c49f6e40ba143ce0579f1602fd780cabf153.budget.golden b/plutus-benchmark/marlowe/test/semantics/9.6/c9efcb705ee057791f7c18a1de79c49f6e40ba143ce0579f1602fd780cabf153.budget.golden index b196e676b5c..55a884e56c4 100644 --- a/plutus-benchmark/marlowe/test/semantics/9.6/c9efcb705ee057791f7c18a1de79c49f6e40ba143ce0579f1602fd780cabf153.budget.golden +++ b/plutus-benchmark/marlowe/test/semantics/9.6/c9efcb705ee057791f7c18a1de79c49f6e40ba143ce0579f1602fd780cabf153.budget.golden @@ -1,2 +1,2 @@ -({cpu: 1055091579 -| mem: 3909420}) \ No newline at end of file +({cpu: 1054539579 +| mem: 3907020}) \ No newline at end of file diff --git a/plutus-benchmark/marlowe/test/semantics/9.6/ccab11ce1a8774135d0e3c9e635631b68af9e276b5dabc66ff669d5650d0be1c.budget.golden b/plutus-benchmark/marlowe/test/semantics/9.6/ccab11ce1a8774135d0e3c9e635631b68af9e276b5dabc66ff669d5650d0be1c.budget.golden index 0a119697ed2..78e1e45c3be 100644 --- a/plutus-benchmark/marlowe/test/semantics/9.6/ccab11ce1a8774135d0e3c9e635631b68af9e276b5dabc66ff669d5650d0be1c.budget.golden +++ b/plutus-benchmark/marlowe/test/semantics/9.6/ccab11ce1a8774135d0e3c9e635631b68af9e276b5dabc66ff669d5650d0be1c.budget.golden @@ -1,2 +1,2 @@ -({cpu: 674530676 -| mem: 1286268}) \ No newline at end of file +({cpu: 674208676 +| mem: 1284868}) \ No newline at end of file diff --git a/plutus-benchmark/marlowe/test/semantics/9.6/cdb9d5c233b288a5a9dcfbd8d5c1831a0bb46eec7a26fa31b80ae69d44805efc.budget.golden b/plutus-benchmark/marlowe/test/semantics/9.6/cdb9d5c233b288a5a9dcfbd8d5c1831a0bb46eec7a26fa31b80ae69d44805efc.budget.golden index 2fa03ac7a2a..3763e42a1d9 100644 --- a/plutus-benchmark/marlowe/test/semantics/9.6/cdb9d5c233b288a5a9dcfbd8d5c1831a0bb46eec7a26fa31b80ae69d44805efc.budget.golden +++ b/plutus-benchmark/marlowe/test/semantics/9.6/cdb9d5c233b288a5a9dcfbd8d5c1831a0bb46eec7a26fa31b80ae69d44805efc.budget.golden @@ -1,2 +1,2 @@ -({cpu: 1167079384 -| mem: 4323890}) \ No newline at end of file +({cpu: 1166527384 +| mem: 4321490}) \ No newline at end of file diff --git a/plutus-benchmark/marlowe/test/semantics/9.6/ced1ea04649e093a501e43f8568ac3e6b37cd3eccec8cac9c70a4857b88a5eb8.budget.golden b/plutus-benchmark/marlowe/test/semantics/9.6/ced1ea04649e093a501e43f8568ac3e6b37cd3eccec8cac9c70a4857b88a5eb8.budget.golden index 7cb5287cfc2..ee27b739b7c 100644 --- a/plutus-benchmark/marlowe/test/semantics/9.6/ced1ea04649e093a501e43f8568ac3e6b37cd3eccec8cac9c70a4857b88a5eb8.budget.golden +++ b/plutus-benchmark/marlowe/test/semantics/9.6/ced1ea04649e093a501e43f8568ac3e6b37cd3eccec8cac9c70a4857b88a5eb8.budget.golden @@ -1,2 +1,2 @@ -({cpu: 1091981752 -| mem: 4033462}) \ No newline at end of file +({cpu: 1091429752 +| mem: 4031062}) \ No newline at end of file diff --git a/plutus-benchmark/marlowe/test/semantics/9.6/cf542b7df466b228ca2197c2aaa89238a8122f3330fe5b77b3222f570395d9f5.budget.golden b/plutus-benchmark/marlowe/test/semantics/9.6/cf542b7df466b228ca2197c2aaa89238a8122f3330fe5b77b3222f570395d9f5.budget.golden index 28fed07f414..1548c086d7f 100644 --- a/plutus-benchmark/marlowe/test/semantics/9.6/cf542b7df466b228ca2197c2aaa89238a8122f3330fe5b77b3222f570395d9f5.budget.golden +++ b/plutus-benchmark/marlowe/test/semantics/9.6/cf542b7df466b228ca2197c2aaa89238a8122f3330fe5b77b3222f570395d9f5.budget.golden @@ -1,2 +1,2 @@ -({cpu: 635073628 -| mem: 2329479}) \ No newline at end of file +({cpu: 634797628 +| mem: 2328279}) \ No newline at end of file diff --git a/plutus-benchmark/marlowe/test/semantics/9.6/d1ab832dfab25688f8845bec9387e46ee3f00ba5822197ade7dd540489ec5e95.budget.golden b/plutus-benchmark/marlowe/test/semantics/9.6/d1ab832dfab25688f8845bec9387e46ee3f00ba5822197ade7dd540489ec5e95.budget.golden index cabb65b1021..df944579952 100644 --- a/plutus-benchmark/marlowe/test/semantics/9.6/d1ab832dfab25688f8845bec9387e46ee3f00ba5822197ade7dd540489ec5e95.budget.golden +++ b/plutus-benchmark/marlowe/test/semantics/9.6/d1ab832dfab25688f8845bec9387e46ee3f00ba5822197ade7dd540489ec5e95.budget.golden @@ -1,2 +1,2 @@ -({cpu: 8429867518 -| mem: 1141754}) \ No newline at end of file +({cpu: 8429545518 +| mem: 1140354}) \ No newline at end of file diff --git a/plutus-benchmark/marlowe/test/semantics/9.6/d1c03759810747b7cab38c4296593b38567e11195d161b5bb0a2b58f89b2c65a.budget.golden b/plutus-benchmark/marlowe/test/semantics/9.6/d1c03759810747b7cab38c4296593b38567e11195d161b5bb0a2b58f89b2c65a.budget.golden index a1a9c87c3c8..1a52dccea3a 100644 --- a/plutus-benchmark/marlowe/test/semantics/9.6/d1c03759810747b7cab38c4296593b38567e11195d161b5bb0a2b58f89b2c65a.budget.golden +++ b/plutus-benchmark/marlowe/test/semantics/9.6/d1c03759810747b7cab38c4296593b38567e11195d161b5bb0a2b58f89b2c65a.budget.golden @@ -1,2 +1,2 @@ -({cpu: 1345826048 -| mem: 4961453}) \ No newline at end of file +({cpu: 1345090048 +| mem: 4958253}) \ No newline at end of file diff --git a/plutus-benchmark/marlowe/test/semantics/9.6/d64607eb8a1448595081547ea8780886fcbd9e06036460eea3705c88ea867e33.budget.golden b/plutus-benchmark/marlowe/test/semantics/9.6/d64607eb8a1448595081547ea8780886fcbd9e06036460eea3705c88ea867e33.budget.golden index 8ff0927a94e..6fa427ca3dd 100644 --- a/plutus-benchmark/marlowe/test/semantics/9.6/d64607eb8a1448595081547ea8780886fcbd9e06036460eea3705c88ea867e33.budget.golden +++ b/plutus-benchmark/marlowe/test/semantics/9.6/d64607eb8a1448595081547ea8780886fcbd9e06036460eea3705c88ea867e33.budget.golden @@ -1,2 +1,2 @@ -({cpu: 376467639 -| mem: 1373721}) \ No newline at end of file +({cpu: 376191639 +| mem: 1372521}) \ No newline at end of file diff --git a/plutus-benchmark/marlowe/test/semantics/9.6/dc241ac6ad1e04fb056d555d6a4f2d08a45d054c6f7f34355fcfeefebef479f3.budget.golden b/plutus-benchmark/marlowe/test/semantics/9.6/dc241ac6ad1e04fb056d555d6a4f2d08a45d054c6f7f34355fcfeefebef479f3.budget.golden index c606664421d..6f6cda870cb 100644 --- a/plutus-benchmark/marlowe/test/semantics/9.6/dc241ac6ad1e04fb056d555d6a4f2d08a45d054c6f7f34355fcfeefebef479f3.budget.golden +++ b/plutus-benchmark/marlowe/test/semantics/9.6/dc241ac6ad1e04fb056d555d6a4f2d08a45d054c6f7f34355fcfeefebef479f3.budget.golden @@ -1,2 +1,2 @@ -({cpu: 595173641 -| mem: 2186053}) \ No newline at end of file +({cpu: 594897641 +| mem: 2184853}) \ No newline at end of file diff --git a/plutus-benchmark/marlowe/test/semantics/9.6/dd11ae574eaeab0e9925319768989313a93913fdc347c704ddaa27042757d990.budget.golden b/plutus-benchmark/marlowe/test/semantics/9.6/dd11ae574eaeab0e9925319768989313a93913fdc347c704ddaa27042757d990.budget.golden index e2828ab4bbe..9df1b645600 100644 --- a/plutus-benchmark/marlowe/test/semantics/9.6/dd11ae574eaeab0e9925319768989313a93913fdc347c704ddaa27042757d990.budget.golden +++ b/plutus-benchmark/marlowe/test/semantics/9.6/dd11ae574eaeab0e9925319768989313a93913fdc347c704ddaa27042757d990.budget.golden @@ -1,2 +1,2 @@ -({cpu: 985775519 -| mem: 3672418}) \ No newline at end of file +({cpu: 985223519 +| mem: 3670018}) \ No newline at end of file diff --git a/plutus-benchmark/marlowe/test/semantics/9.6/e26c1cddba16e05fd10c34cbdb16ea6acdbac7c8323256c31c90c520ee6a1080.budget.golden b/plutus-benchmark/marlowe/test/semantics/9.6/e26c1cddba16e05fd10c34cbdb16ea6acdbac7c8323256c31c90c520ee6a1080.budget.golden index f97d28abecc..75817801f30 100644 --- a/plutus-benchmark/marlowe/test/semantics/9.6/e26c1cddba16e05fd10c34cbdb16ea6acdbac7c8323256c31c90c520ee6a1080.budget.golden +++ b/plutus-benchmark/marlowe/test/semantics/9.6/e26c1cddba16e05fd10c34cbdb16ea6acdbac7c8323256c31c90c520ee6a1080.budget.golden @@ -1,2 +1,2 @@ -({cpu: 446896182 -| mem: 1610786}) \ No newline at end of file +({cpu: 446574182 +| mem: 1609386}) \ No newline at end of file diff --git a/plutus-benchmark/marlowe/test/semantics/9.6/e34b48f80d49360e88c612f4016f7d68cb5678dd8cd5ddb981375a028b3a40a5.budget.golden b/plutus-benchmark/marlowe/test/semantics/9.6/e34b48f80d49360e88c612f4016f7d68cb5678dd8cd5ddb981375a028b3a40a5.budget.golden index 6328d8c5405..3c13fbe662c 100644 --- a/plutus-benchmark/marlowe/test/semantics/9.6/e34b48f80d49360e88c612f4016f7d68cb5678dd8cd5ddb981375a028b3a40a5.budget.golden +++ b/plutus-benchmark/marlowe/test/semantics/9.6/e34b48f80d49360e88c612f4016f7d68cb5678dd8cd5ddb981375a028b3a40a5.budget.golden @@ -1,2 +1,2 @@ -({cpu: 502755254 -| mem: 1846166}) \ No newline at end of file +({cpu: 502433254 +| mem: 1844766}) \ No newline at end of file diff --git a/plutus-benchmark/marlowe/test/semantics/9.6/e3afd22d01ff12f381cf915fd32358634e6c413f979f2492cf3339319d8cc079.budget.golden b/plutus-benchmark/marlowe/test/semantics/9.6/e3afd22d01ff12f381cf915fd32358634e6c413f979f2492cf3339319d8cc079.budget.golden index f6615208266..6ebe321a341 100644 --- a/plutus-benchmark/marlowe/test/semantics/9.6/e3afd22d01ff12f381cf915fd32358634e6c413f979f2492cf3339319d8cc079.budget.golden +++ b/plutus-benchmark/marlowe/test/semantics/9.6/e3afd22d01ff12f381cf915fd32358634e6c413f979f2492cf3339319d8cc079.budget.golden @@ -1,2 +1,2 @@ -({cpu: 379087524 -| mem: 1379223}) \ No newline at end of file +({cpu: 378811524 +| mem: 1378023}) \ No newline at end of file diff --git a/plutus-benchmark/marlowe/test/semantics/9.6/e9234d2671760874f3f660aae5d3416d18ce6dfd7af4231bdd41b9ec268bc7e1.budget.golden b/plutus-benchmark/marlowe/test/semantics/9.6/e9234d2671760874f3f660aae5d3416d18ce6dfd7af4231bdd41b9ec268bc7e1.budget.golden index 4a47a07c33f..d27d943c3c2 100644 --- a/plutus-benchmark/marlowe/test/semantics/9.6/e9234d2671760874f3f660aae5d3416d18ce6dfd7af4231bdd41b9ec268bc7e1.budget.golden +++ b/plutus-benchmark/marlowe/test/semantics/9.6/e9234d2671760874f3f660aae5d3416d18ce6dfd7af4231bdd41b9ec268bc7e1.budget.golden @@ -1,2 +1,2 @@ -({cpu: 880296781 -| mem: 2586674}) \ No newline at end of file +({cpu: 879514781 +| mem: 2583274}) \ No newline at end of file diff --git a/plutus-benchmark/marlowe/test/semantics/9.6/eb4a605ed3a64961e9e66ad9631c2813dadf7131740212762ae4483ec749fe1d.budget.golden b/plutus-benchmark/marlowe/test/semantics/9.6/eb4a605ed3a64961e9e66ad9631c2813dadf7131740212762ae4483ec749fe1d.budget.golden index 8ff0927a94e..6fa427ca3dd 100644 --- a/plutus-benchmark/marlowe/test/semantics/9.6/eb4a605ed3a64961e9e66ad9631c2813dadf7131740212762ae4483ec749fe1d.budget.golden +++ b/plutus-benchmark/marlowe/test/semantics/9.6/eb4a605ed3a64961e9e66ad9631c2813dadf7131740212762ae4483ec749fe1d.budget.golden @@ -1,2 +1,2 @@ -({cpu: 376467639 -| mem: 1373721}) \ No newline at end of file +({cpu: 376191639 +| mem: 1372521}) \ No newline at end of file diff --git a/plutus-benchmark/marlowe/test/semantics/9.6/ecb5e8308b57724e0f8533921693f111eba942123cf8660aac2b5bac21ec28f0.budget.golden b/plutus-benchmark/marlowe/test/semantics/9.6/ecb5e8308b57724e0f8533921693f111eba942123cf8660aac2b5bac21ec28f0.budget.golden index 30c92c3445f..03543289961 100644 --- a/plutus-benchmark/marlowe/test/semantics/9.6/ecb5e8308b57724e0f8533921693f111eba942123cf8660aac2b5bac21ec28f0.budget.golden +++ b/plutus-benchmark/marlowe/test/semantics/9.6/ecb5e8308b57724e0f8533921693f111eba942123cf8660aac2b5bac21ec28f0.budget.golden @@ -1,2 +1,2 @@ -({cpu: 815732842 -| mem: 2954050}) \ No newline at end of file +({cpu: 814835842 +| mem: 2950150}) \ No newline at end of file diff --git a/plutus-benchmark/marlowe/test/semantics/9.6/f2a8fd2014922f0d8e01541205d47e9bb2d4e54333bdd408cbe7c47c55e73ae4.budget.golden b/plutus-benchmark/marlowe/test/semantics/9.6/f2a8fd2014922f0d8e01541205d47e9bb2d4e54333bdd408cbe7c47c55e73ae4.budget.golden index 07d10c115f6..1cd8656cee0 100644 --- a/plutus-benchmark/marlowe/test/semantics/9.6/f2a8fd2014922f0d8e01541205d47e9bb2d4e54333bdd408cbe7c47c55e73ae4.budget.golden +++ b/plutus-benchmark/marlowe/test/semantics/9.6/f2a8fd2014922f0d8e01541205d47e9bb2d4e54333bdd408cbe7c47c55e73ae4.budget.golden @@ -1,2 +1,2 @@ -({cpu: 859985308 -| mem: 2864294}) \ No newline at end of file +({cpu: 859203308 +| mem: 2860894}) \ No newline at end of file diff --git a/plutus-benchmark/marlowe/test/semantics/9.6/f339f59bdf92495ed2b14e2e4d3705972b4dda59aa929cffe0f1ff5355db8d79.budget.golden b/plutus-benchmark/marlowe/test/semantics/9.6/f339f59bdf92495ed2b14e2e4d3705972b4dda59aa929cffe0f1ff5355db8d79.budget.golden index 6a353ff94c5..dfc3a3fb563 100644 --- a/plutus-benchmark/marlowe/test/semantics/9.6/f339f59bdf92495ed2b14e2e4d3705972b4dda59aa929cffe0f1ff5355db8d79.budget.golden +++ b/plutus-benchmark/marlowe/test/semantics/9.6/f339f59bdf92495ed2b14e2e4d3705972b4dda59aa929cffe0f1ff5355db8d79.budget.golden @@ -1,2 +1,2 @@ -({cpu: 1957141779 -| mem: 1226312}) \ No newline at end of file +({cpu: 1956819779 +| mem: 1224912}) \ No newline at end of file diff --git a/plutus-benchmark/marlowe/test/semantics/9.6/ffdd68a33afd86f8844c9f5e45b2bda5b035aa02274161b23d57709c0f8b8de6.budget.golden b/plutus-benchmark/marlowe/test/semantics/9.6/ffdd68a33afd86f8844c9f5e45b2bda5b035aa02274161b23d57709c0f8b8de6.budget.golden index 2ff63cd5c27..e21d91b7f47 100644 --- a/plutus-benchmark/marlowe/test/semantics/9.6/ffdd68a33afd86f8844c9f5e45b2bda5b035aa02274161b23d57709c0f8b8de6.budget.golden +++ b/plutus-benchmark/marlowe/test/semantics/9.6/ffdd68a33afd86f8844c9f5e45b2bda5b035aa02274161b23d57709c0f8b8de6.budget.golden @@ -1,2 +1,2 @@ -({cpu: 1209538395 -| mem: 4436938}) \ No newline at end of file +({cpu: 1208756395 +| mem: 4433538}) \ No newline at end of file diff --git a/plutus-benchmark/marlowe/test/semantics/9.6/semantics.size.golden b/plutus-benchmark/marlowe/test/semantics/9.6/semantics.size.golden index f1d550d5114..42f7973e4a8 100644 --- a/plutus-benchmark/marlowe/test/semantics/9.6/semantics.size.golden +++ b/plutus-benchmark/marlowe/test/semantics/9.6/semantics.size.golden @@ -1 +1 @@ -11731 \ No newline at end of file +11724 \ No newline at end of file diff --git a/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Simplify.hs b/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Simplify.hs index 9a6ae2eab6b..da775302943 100644 --- a/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Simplify.hs +++ b/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Simplify.hs @@ -24,13 +24,13 @@ import UntypedPlutusCore.Transform.CaseOfCase import UntypedPlutusCore.Transform.CaseReduce import UntypedPlutusCore.Transform.Cse import UntypedPlutusCore.Transform.FloatDelay -import UntypedPlutusCore.Transform.ForceDelay import UntypedPlutusCore.Transform.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 @@ -83,7 +83,7 @@ simplifyTerm opts = simplifyStep :: Int -> Term name uni fun a -> m (Term name uni fun a) simplifyStep _ = floatDelay - >=> pure . forceDelayCancel + >=> pure . forceDelay >=> pure . caseOfCase' >=> pure . caseReduce >=> inline (_soInlineConstants opts) (_soInlineHints opts) diff --git a/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Transform/ForceDelay.hs b/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Transform/ForceDelay.hs index 8d29fc7aeec..4c5ac9d17e2 100644 --- a/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Transform/ForceDelay.hs +++ b/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Transform/ForceDelay.hs @@ -1,16 +1,215 @@ +{- | The 'ForceDelay' optimisation pushes 'Force' inside its direct 'Apply' subterms, + removing any 'Delay' at the top of the body of the underlying lambda abstraction. + For example, @force [(\x -> delay b) a]@ is transformed into @[(\x -> b) a]@. + We also consider the case where the 'Force' is applied directly to the 'Delay' as + the base case, i.e. the case when the applications of lambdas is empty. + In such simple cases, the transformation is obviously correct, the question remains + if this approach can be generalised (note: see remark at the bottom). + + Since UPLC programs are created from erasing the types of TPLC programs (see + "PlutusCore.Compiler.Erase") we will consider TPLC terms of the following structure, + in pseudo-code (@/\@ is (multi-)type abstraction and @\@ is (multi-)term abstraction): + + > /\T1 -> \X1 -> /\T2 -> \X2 -> /\T3 -> \X3 -> ... -> /\Tn -> \Xn -> body + + where @T1 ... Tn@ are lists of type variables (e.g. @T1@ could be @[t, q, p]@) + and @X1 ... Xn@ are lists of term variables. Of course, each @/\@ and @\@ here would + desugar to a sequence of type/term abstractions. Also @[ M P Q ]@ is iterated + term application, which, as usual, is left-associative. + + In order to reason about the proposed optimisation we need to consider such terms in + the context of them being applied to some sequence of terms. + + One important observation is that this transformation requires that the underlying + (term)-lambda abstraction will be exactly reduced by the applications. + For UPLC, this can happen only when the number of lambda abstracted variables is equal + to the number of terms to which it will be applied. + For example, @force (\\x -> delay b) => (\\x -> b)@ is invalid, since the former is @error@. + The other case, we can see that applying the optimisation modifies the end result: + > force [(\x -> delay b) a1 a2] => [(\x -> b) a1 a2] => b[x1:=a1] a2 + > + > vs. + > + > force [(\x -> delay b) a1 a2] => force [(delay b[x1:=a1]) a2] => error + + To generalise, we consider the family of terms above applied to a family of types and + terms: + > [ (/\T1 -> \X1 -> ... -> /\Tn -> \Xn -> body) + > T1 X1 ... Tn Xn + > ] + + For brevity, the types and the terms to which the lambda applies are named the same as the + bound variables, but of course this isn't necessary. + Also note that in general @|Ti| == |Xi|@ doesn't necessarily hold for any @i in [1, n]@. + + Translated to UPLC, the original term is: + > delay^|T1| (\X1 -> delay^|T2| (\X2 -> delay^|T3| (\X3 -> ... -> delay^|Tn| (\Xn -> body)))) + where @delay^|A|@ means "apply delay |A| (the length of A) times". + + With the applications: + > [force^|Tn| (... [force^|T3| ([force^|T2| ([force^|T1| (original) X1]) X2]) X3] ...) Xn] + + After inlining @original@ we get: + > [force^|Tn| + > (... + > ([force^|T3| + > ([force^|T2| + > ([force^|T1| + > (delay^|T1| + > (\X1 -> + > delay^|T2| (\X2 -> + > delay^|T3| (\X3 -> + > ... -> + > delay^|Tn| (\Xn -> body))))) + > X1]) X2]) X3]) ...) Xn] + + In the end, after applying the base case optimisation: + > [force^|Tn| + > (... + > ([force^|T3| + > ([force^|T2| + > ([(\X1 -> + > delay^|T2| (\X2 -> + > delay^|T3| (\X3 -> + > ... -> + > delay^|Tn| (\Xn -> body)))) + > X1]) X2]) X3]) ...) Xn] + + Notice that the next two reduction steps (applying @X1@ and reducing @force (delay ...)@) + produce an equivalent term to applying the transformation and then the reduction rule + for application. + This is easy to check, so we continue by showing what the "optimised term" looks like: + > [force^|Tn| + > (... + > [force^|T3| + > ([(\X1 -> \X2 -> + > delay^|T3| (\X3 -> + > ... -> + > delay^|Tn| (\Xn -> body))) + > X1 X2]) X3] ...) Xn] + + The term can be optimised further by "erasing" the @force^|T3|@ and @delay^|T3|@ pair, + and so on until @Tn@. + + For examples of terms we can optimise, see the test cases in the + "Transform.Simplify.forceDelay*" module of the test suite. + + Remark: + + It has been observed that the transformation: + > force([(\x -> body) 5]) + > ==> + > [(\x -> force(body))] + where @body@ isn't necessarily of the form @delay(...)@ is also valid. + The question arises, can we generalise the algorithm above given this observation? + + Let's consider a version of this algorithm which only "pushes forces" down under the + applications of lambdas, and the following term: + > force (force ([(\x1 -> delay [(\x2 -> delay [(\x3 -> body) 5]) 7]) 9])) + > ==> (push inner force) + > force ([(\x1 -> force (delay [(\x2 -> delay [(\x3 -> body) 5]) 7]) 9]) + > ==> (push outer force) + > [(\x1 -> force (force (delay [(\x2 -> delay [(\x3 -> body) 5]) 7])) 9] + + The algorithm gets stuck because after this step the term doesn't contain a direct + application of a @force@ over a series of lambdas and applications. + To proceed, we need to introduce a separate pass which removes forces immediately + followed by delays. For our example above this results in: + > [(\x1 -> force ([(\x2 -> delay [(\x3 -> body) 5]) 7])) 9] + + As can be seen, to proceed with simplifying the term we need to run the "push" pass + again. + + For an arbitrary term to be fully reduced by such an algorithm, we would need to also do + an arbitrary number of traversals in this optimisation procedure. This increases the complexity + of the simplifier from both a computational perspective and a human-readability perspective. + + We can easily avoid this situation by removing the force-delay pairs in the same pass. + This means that we can fully reduce the term in a single traversal of the term, as described + in the original algorithm. +-} {-# LANGUAGE LambdaCase #-} module UntypedPlutusCore.Transform.ForceDelay - ( forceDelayCancel + ( forceDelay ) where import UntypedPlutusCore.Core import Control.Lens (transformOf) +import Control.Monad (guard) +import Data.Foldable (foldl') +import Data.Maybe (fromMaybe) -forceDelayCancel :: Term name uni fun a -> Term name uni fun a -forceDelayCancel = transformOf termSubterms processTerm +{- | Traverses the term, for each node applying the optimisation + detailed above. For implementation details see 'optimisationProcedure'. +-} +forceDelay :: Term name uni fun a -> Term name uni fun a +forceDelay = transformOf termSubterms processTerm +{- | Checks whether the term is of the right form, and "pushes" + the 'Force' down into the underlying lambda abstractions. +-} processTerm :: Term name uni fun a -> Term name uni fun a processTerm = \case Force _ (Delay _ t) -> t - t -> t + original@(Force _ subTerm) -> + fromMaybe original (optimisationProcedure subTerm) + t -> t + +{- | Converts the subterm of a 'Force' into specialised types for representing + multiple applications on top of multiple abstractions. Checks whether the lambda + will eventually get "exactly reduced" and applies the optimisation. + Returns 'Nothing' if the optimisation cannot be applied. +-} +optimisationProcedure :: Term name uni fun a -> Maybe (Term name uni fun a) +optimisationProcedure term = do + asMultiApply <- toMultiApply term + innerMultiAbs <- toMultiAbs . appHead $ asMultiApply + guard $ length (appSpineRev asMultiApply) == length (absVars innerMultiAbs) + case absRhs innerMultiAbs of + Delay _ subTerm -> + let optimisedInnerMultiAbs = innerMultiAbs { absRhs = subTerm} + optimisedMultiApply = + asMultiApply { appHead = fromMultiAbs optimisedInnerMultiAbs } + in pure . fromMultiApply $ optimisedMultiApply + _ -> Nothing + +data MultiApply name uni fun a = MultiApply + { appHead :: Term name uni fun a + , appSpineRev :: [(a, Term name uni fun a)] + } + +toMultiApply :: Term name uni fun a -> Maybe (MultiApply name uni fun a) +toMultiApply term = + case term of + Apply _ _ _ -> run [] term + _ -> Nothing + where + run acc (Apply a t1 t2) = + run ((a, t2) : acc) t1 + run acc t = + pure $ MultiApply t acc + +fromMultiApply :: MultiApply name uni fun a -> Term name uni fun a +fromMultiApply (MultiApply term ts) = + foldl' (\acc (ann, arg) -> Apply ann acc arg) term ts + +data MultiAbs name uni fun a = MultiAbs + { absVars :: [(a, name)] + , absRhs :: Term name uni fun a + } + +toMultiAbs :: Term name uni fun a -> Maybe (MultiAbs name uni fun a) +toMultiAbs term = + case term of + LamAbs _ _ _ -> run [] term + _ -> Nothing + where + run acc (LamAbs a name t) = + run ((a, name) : acc) t + run acc t = + pure $ MultiAbs acc t + +fromMultiAbs :: MultiAbs name uni fun a -> Term name uni fun a +fromMultiAbs (MultiAbs vars term) = + foldl' (\acc (ann, name) -> LamAbs ann name acc) term vars diff --git a/plutus-core/untyped-plutus-core/test/Transform/Simplify.hs b/plutus-core/untyped-plutus-core/test/Transform/Simplify.hs index d373c976954..74dd244b76d 100644 --- a/plutus-core/untyped-plutus-core/test/Transform/Simplify.hs +++ b/plutus-core/untyped-plutus-core/test/Transform/Simplify.hs @@ -12,6 +12,7 @@ import UntypedPlutusCore import Control.Lens ((&), (.~)) import Data.ByteString.Lazy qualified as BSL +import Data.Text (Text) import Data.Text.Encoding (encodeUtf8) import Test.Tasty import Test.Tasty.Golden @@ -226,6 +227,107 @@ multiApp = runQuote $ do app = mkIterAppNoAnn lam [mkConstant @Integer () 1, mkConstant @Integer () 2, mkConstant @Integer () 3] pure app +-- | The UPLC term in this test should come from the following TPLC term after erasing its types: +-- > (/\(p :: *) -> \(x : p) -> /\(q :: *) -> \(y : q) -> /\(r :: *) -> \(z : r) -> z) Int 1 Int 2 Int 3 +-- This case is simple in the sense that each type abstraction is followed by a single term abstraction. +forceDelaySimple :: Term Name PLC.DefaultUni PLC.DefaultFun () +forceDelaySimple = runQuote $ do + x <- freshName "x" + y <- freshName "y" + z <- freshName "z" + let one = mkConstant @Integer () 1 + two = mkConstant @Integer () 2 + three = mkConstant @Integer () 3 + t = Delay () (LamAbs () x (Delay () (LamAbs () y (Delay () (LamAbs () z (Var () z)))))) + app = Apply () (Force () (Apply () (Force () (Apply () (Force () t) one)) two)) three + pure app + +-- | A test for the case when there are multiple applications between the 'Force' at the top +-- and the 'Delay' at the top of the term inside the abstractions/applications. +forceDelayMultiApply :: Term Name PLC.DefaultUni PLC.DefaultFun () +forceDelayMultiApply = runQuote $ do + x1 <- freshName "x1" + x2 <- freshName "x2" + x3 <- freshName "x3" + f <- freshName "f" + funcVar <- freshName "funcVar" + let one = mkConstant @Integer () 1 + two = mkConstant @Integer () 2 + three = mkConstant @Integer () 3 + term = + Force () $ + mkIterAppNoAnn + ( LamAbs () x1 $ LamAbs () x2 $ LamAbs () x3 $ LamAbs () f $ + Delay () $ mkIterAppNoAnn (Var () f) [Var () x1, Var () x2, Var () x3] + ) + [one, two, three, Var () funcVar] + pure term + +-- | A test for the case when there are multiple type abstractions over a single term +-- abstraction/application. +forceDelayMultiForce :: Term Name PLC.DefaultUni PLC.DefaultFun () +forceDelayMultiForce = runQuote $ do + x <- freshName "x" + let one = mkConstant @Integer () 1 + term = + Force () $ Force () $ Force () $ + Apply () + ( LamAbs () x $ + Delay () $ Delay () $ Delay () $ + Var () x + ) + one + pure term + +-- | The UPLC term in this test should come from the following TPLC term after erasing its types: +-- +-- > (/\(p1 :: *) (p2 :: *) -> \(x : p2) -> +-- > /\(q1 :: *) (q2 :: *) (q3 :: *) -> \(y1 : q1) (y2 : q2) (y3 : String) -> +-- > /\(r :: *) -> \(z1 : r) -> \(z2 : r) -> +-- > /\(t :: *) -> \(f : p1 -> q1 -> q2 -> String -> r -> r -> String) -> +-- > f x y1 y2 y3 z1 z2 +-- > ) Int Int 1 Int String Int 2 "foo" "bar" Int 3 3 ByteString (funcVar : Int -> Int -> String -> String -> Int -> String) +-- +-- Note this term has multiple interleaved type and term instantiations/applications. +forceDelayComplex :: Term Name PLC.DefaultUni PLC.DefaultFun () +forceDelayComplex = runQuote $ do + x <- freshName "x" + y1 <- freshName "y1" + y2 <- freshName "y2" + y3 <- freshName "y3" + z1 <- freshName "z1" + z2 <- freshName "z2" + f <- freshName "f" + funcVar <- freshName "funcVar" + let one = mkConstant @Integer () 1 + two = mkConstant @Integer () 2 + three = mkConstant @Integer () 3 + foo = mkConstant @Text () "foo" + bar = mkConstant @Text () "bar" + term = + Delay () $ Delay () $ LamAbs () x $ + Delay () $ Delay () $ Delay () $ LamAbs () y1 $ LamAbs () y2 $ LamAbs () y3 $ + Delay () $ LamAbs () z1 $ LamAbs () z2 $ + Delay () $ LamAbs () f $ + mkIterAppNoAnn (Var () f) [Var () x, Var () y1, Var () y2, Var () y3, Var () z1, Var () z2] + app = + Apply () + ( Force () $ + mkIterAppNoAnn + ( Force () $ + mkIterAppNoAnn + ( Force () $ Force () $ Force () $ + Apply () + (Force () $ Force () term) + one + ) + [two, foo, bar] + ) + [three, three] + ) + (Var () funcVar) + pure app + -- | This is the first example in Note [CSE]. cse1 :: Term Name PLC.DefaultUni PLC.DefaultFun () cse1 = runQuote $ do @@ -340,6 +442,10 @@ test_simplify = , goldenVsSimplified "inlineImpure3" inlineImpure3 , goldenVsSimplified "inlineImpure4" inlineImpure4 , goldenVsSimplified "multiApp" multiApp + , goldenVsSimplified "forceDelaySimple" forceDelaySimple + , goldenVsSimplified "forceDelayMultiApply" forceDelayMultiApply + , goldenVsSimplified "forceDelayMultiForce" forceDelayMultiForce + , goldenVsSimplified "forceDelayComplex" forceDelayComplex , goldenVsCse "cse1" cse1 , goldenVsCse "cse2" cse2 , goldenVsCse "cse3" cse3 diff --git a/plutus-core/untyped-plutus-core/test/Transform/forceDelayComplex.uplc.golden b/plutus-core/untyped-plutus-core/test/Transform/forceDelayComplex.uplc.golden new file mode 100644 index 00000000000..50a3d500b30 --- /dev/null +++ b/plutus-core/untyped-plutus-core/test/Transform/forceDelayComplex.uplc.golden @@ -0,0 +1 @@ +(funcVar_7 1 2 "foo" "bar" 3 3) \ No newline at end of file diff --git a/plutus-core/untyped-plutus-core/test/Transform/forceDelayMultiApply.uplc.golden b/plutus-core/untyped-plutus-core/test/Transform/forceDelayMultiApply.uplc.golden new file mode 100644 index 00000000000..57132a23441 --- /dev/null +++ b/plutus-core/untyped-plutus-core/test/Transform/forceDelayMultiApply.uplc.golden @@ -0,0 +1 @@ +(funcVar_4 1 2 3) \ No newline at end of file diff --git a/plutus-core/untyped-plutus-core/test/Transform/forceDelayMultiForce.uplc.golden b/plutus-core/untyped-plutus-core/test/Transform/forceDelayMultiForce.uplc.golden new file mode 100644 index 00000000000..56a6051ca2b --- /dev/null +++ b/plutus-core/untyped-plutus-core/test/Transform/forceDelayMultiForce.uplc.golden @@ -0,0 +1 @@ +1 \ No newline at end of file diff --git a/plutus-core/untyped-plutus-core/test/Transform/forceDelaySimple.uplc.golden b/plutus-core/untyped-plutus-core/test/Transform/forceDelaySimple.uplc.golden new file mode 100644 index 00000000000..e440e5c8425 --- /dev/null +++ b/plutus-core/untyped-plutus-core/test/Transform/forceDelaySimple.uplc.golden @@ -0,0 +1 @@ +3 \ No newline at end of file diff --git a/plutus-core/untyped-plutus-core/test/Transform/inlinePure4.uplc.golden b/plutus-core/untyped-plutus-core/test/Transform/inlinePure4.uplc.golden index 1a6a5b3a753..5e1a936a2a0 100644 --- a/plutus-core/untyped-plutus-core/test/Transform/inlinePure4.uplc.golden +++ b/plutus-core/untyped-plutus-core/test/Transform/inlinePure4.uplc.golden @@ -1,2 +1 @@ -((\a_4 b_5 -> a_4) - (force ((\x_6 -> delay (\y_7 -> x_6 x_6)) (delay (error 1))))) \ No newline at end of file +(\b_5 -> (\x_8 y_9 -> x_8 x_8) (delay (error 1))) \ No newline at end of file diff --git a/plutus-core/untyped-plutus-core/test/Transform/interveningLambda.uplc.golden b/plutus-core/untyped-plutus-core/test/Transform/interveningLambda.uplc.golden index 4e44a1d1e9c..b9abc06d8e7 100644 --- a/plutus-core/untyped-plutus-core/test/Transform/interveningLambda.uplc.golden +++ b/plutus-core/untyped-plutus-core/test/Transform/interveningLambda.uplc.golden @@ -1 +1 @@ -(force (delay (1 1))) \ No newline at end of file +(1 1) \ 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 ff58b4029f7..041db2f5b1b 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 @@ -35,10 +35,10 @@ program (addInteger cse)) (addInteger cse)) (addInteger cse)) - (case cse [(\x y z w -> w)])) + (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 -> x)])) + (case cse [(\x y z w -> w)])) (\x y -> addInteger x y)) (\x y -> force ifThenElse From 53e45aff7592013c0de4c4929007a17ed7424248 Mon Sep 17 00:00:00 2001 From: Yura Lazarev Date: Wed, 20 Mar 2024 13:04:02 +0100 Subject: [PATCH 6/8] Chore: formatting, explicit imports. (#5847) I'll follow up on the "ad-hoc" aspect next dev meeting, until then let me merge this one and refrain from creating more ad-hoc formatting PRs. --- .../plutus-ir/src/PlutusIR/Contexts.hs | 2 +- plutus-core/plutus-ir/src/PlutusIR/Purity.hs | 426 +++++++++--------- .../src/UntypedPlutusCore/Purity.hs | 244 +++++----- 3 files changed, 334 insertions(+), 338 deletions(-) diff --git a/plutus-core/plutus-ir/src/PlutusIR/Contexts.hs b/plutus-core/plutus-ir/src/PlutusIR/Contexts.hs index 1715d66d3e7..9b3ac6c3f91 100644 --- a/plutus-core/plutus-ir/src/PlutusIR/Contexts.hs +++ b/plutus-core/plutus-ir/src/PlutusIR/Contexts.hs @@ -114,7 +114,7 @@ saturates (TypeAppContext _ _ ctx) (TypeParam:arities) = saturates ctx arities -- Param/arg mismatch saturates (TermAppContext{}) (TypeParam:_) = Nothing saturates (TypeAppContext{}) (TermParam:_) = Nothing --- Arguments lef - undersaturated +-- Arguments left - undersaturated saturates (TermAppContext{}) [] = Just Oversaturated saturates (TypeAppContext{}) [] = Just Oversaturated diff --git a/plutus-core/plutus-ir/src/PlutusIR/Purity.hs b/plutus-core/plutus-ir/src/PlutusIR/Purity.hs index d4ae9db449f..4871874be33 100644 --- a/plutus-core/plutus-ir/src/PlutusIR/Purity.hs +++ b/plutus-core/plutus-ir/src/PlutusIR/Purity.hs @@ -9,28 +9,30 @@ {-# LANGUAGE ViewPatterns #-} module PlutusIR.Purity - ( isPure - , isSaturated - , isWorkFree - , EvalOrder - , unEvalOrder - , EvalTerm (..) - , Purity (..) - , termEvaluationOrder - ) where + ( isPure + , isSaturated + , isWorkFree + , EvalOrder + , unEvalOrder + , EvalTerm (..) + , Purity (..) + , termEvaluationOrder + ) where -import PlutusCore.Builtin -import PlutusCore.Pretty -import PlutusIR -import PlutusIR.Contexts - -import Control.Lens hiding (Strict) +import Control.Lens ((^.)) import Data.DList qualified as DList import Data.List.NonEmpty qualified as NE +import PlutusCore.Builtin (BuiltinMeaning (..), ToBuiltinMeaning (..), TypeScheme (..)) import PlutusCore.Name.Unique qualified as PLC -import PlutusIR.Analysis.Builtins -import PlutusIR.Analysis.VarInfo -import Prettyprinter +import PlutusCore.Pretty (Pretty (pretty), PrettyBy (prettyBy)) +import PlutusIR (Binding (TermBind), Name, Recursivity (NonRec, Rec), + Strictness (NonStrict, Strict), Term (..), TyName) +import PlutusIR.Analysis.Builtins (BuiltinsInfo, biSemanticsVariant, builtinArityInfo) +import PlutusIR.Analysis.VarInfo (VarInfo (DatatypeConstructor), VarsInfo, lookupVarInfo, + varInfoStrictness) +import PlutusIR.Contexts (AppContext (..), Saturation (Oversaturated, Saturated, Undersaturated), + fillAppContext, saturates, splitApplication) +import Prettyprinter (vsep, (<+>)) saturatesScheme :: AppContext tyname name uni fun a -> TypeScheme val args res -> Maybe Bool -- We've passed enough arguments that the builtin will reduce. @@ -47,18 +49,17 @@ saturatesScheme AppContextEnd TypeSchemeAll{} = Just False saturatesScheme TypeAppContext{} TypeSchemeArrow{} = Nothing saturatesScheme TermAppContext{} TypeSchemeAll{} = Nothing --- | Is the given application saturated? --- Returns 'Nothing' if we can't tell. +-- | Is the given application saturated? Returns 'Nothing' if we can't tell. isSaturated - :: forall tyname name uni fun a - . ToBuiltinMeaning uni fun - => BuiltinsInfo uni fun - -> fun - -> AppContext tyname name uni fun a - -> Maybe Bool + :: forall tyname name uni fun a + . (ToBuiltinMeaning uni fun) + => BuiltinsInfo uni fun + -> fun + -> AppContext tyname name uni fun a + -> Maybe Bool isSaturated binfo fun args = let semvar = binfo ^. biSemanticsVariant - in case toBuiltinMeaning @uni @fun @(Term TyName Name uni fun ()) semvar fun of + in case toBuiltinMeaning @uni @fun @(Term TyName Name uni fun ()) semvar fun of BuiltinMeaning sch _ _ -> saturatesScheme args sch -- | Is this pure? Either yes, or maybe not. @@ -75,41 +76,47 @@ instance Pretty WorkFreedom where pretty MaybeWork = "maybe work?" pretty WorkFree = "work-free" --- | Either the "next" term to be evaluated, along with its 'Purity' and 'WorkFreedom', --- or we don't know what comes next. -data EvalTerm tyname name uni fun a = - Unknown +{- | Either the "next" term to be evaluated, along with its 'Purity' and 'WorkFreedom', +or we don't know what comes next. +-} +data EvalTerm tyname name uni fun a + = Unknown | EvalTerm Purity WorkFreedom (Term tyname name uni fun a) -instance PrettyBy config (Term tyname name uni fun a) - => PrettyBy config (EvalTerm tyname name uni fun a) where +instance + (PrettyBy config (Term tyname name uni fun a)) + => PrettyBy config (EvalTerm tyname name uni fun a) + where prettyBy _ Unknown = "" prettyBy config (EvalTerm eff work t) = pretty eff <+> pretty work <> ":" <+> prettyBy config t --- We use a DList here for efficient and lazy concatenation --- | The order in which terms get evaluated, along with their purities. +{- | The order in which terms get evaluated, along with their purities. +We use a DList here for efficient and lazy concatenation +-} newtype EvalOrder tyname name uni fun a = EvalOrder (DList.DList (EvalTerm tyname name uni fun a)) deriving newtype (Semigroup, Monoid) --- | Get the evaluation order as a list of 'EvalTerm's. Either terminates in a single --- 'Unknown', which means that we got to a point where evaluation continues but we don't --- know where; or terminates normally, in which case we actually got to the end of the --- evaluation order for the term. +{- | Get the evaluation order as a list of 'EvalTerm's. Either terminates in a single +'Unknown', which means that we got to a point where evaluation continues but we don't +know where; or terminates normally, in which case we actually got to the end of the +evaluation order for the term. +-} unEvalOrder :: EvalOrder tyname name uni fun a -> [EvalTerm tyname name uni fun a] unEvalOrder (EvalOrder ts) = -- This is where we avoid traversing the whole program beyond the first Unknown, -- since DList is lazy and we convert to a lazy list and then filter it. - takeWhileInclusive (\case { Unknown -> False; _ -> True }) - $ DList.toList ts - where - takeWhileInclusive :: (a -> Bool) -> [a] -> [a] - takeWhileInclusive p = foldr (\x ys -> if p x then x:ys else [x]) [] + takeWhileInclusive (\case Unknown -> False; _ -> True) (DList.toList ts) + where + takeWhileInclusive :: (a -> Bool) -> [a] -> [a] + takeWhileInclusive p = foldr (\x ys -> if p x then x : ys else [x]) [] evalThis :: EvalTerm tyname name uni fun a -> EvalOrder tyname name uni fun a evalThis tm = EvalOrder (DList.singleton tm) -instance PrettyBy config (Term tyname name uni fun a) - => PrettyBy config (EvalOrder tyname name uni fun a) where +instance + (PrettyBy config (Term tyname name uni fun a)) + => PrettyBy config (EvalOrder tyname 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. @@ -124,199 +131,196 @@ planning on changing it. -} termEvaluationOrder :: forall tyname name uni fun a - . (ToBuiltinMeaning uni fun, PLC.HasUnique name PLC.TermUnique) + . (ToBuiltinMeaning uni fun, PLC.HasUnique name PLC.TermUnique) => BuiltinsInfo uni fun -> VarsInfo tyname name uni a -> Term tyname name uni fun a -> EvalOrder tyname name uni fun a termEvaluationOrder binfo vinfo = goTerm - where - goTerm :: Term tyname name uni fun a -> EvalOrder tyname name uni fun a - goTerm = \case - t@(Let _ NonRec bs b) -> - -- first the bindings, in order - goBindings (NE.toList bs) - -- then the body - <> goTerm b - -- then the whole term, which will lead to applications (so work) - <> evalThis (EvalTerm Pure MaybeWork t) - (Let _ Rec _ _) -> - -- Hard to know what gets evaluated first in a recursive let-binding, - -- just give up - evalThis Unknown + where + goTerm :: Term tyname name uni fun a -> EvalOrder tyname name uni fun a + goTerm = \case + t@(Let _ NonRec bs b) -> + -- first the bindings, in order + goBindings (NE.toList bs) + -- then the body + <> goTerm b + -- then the whole term, which will lead to applications (so work) + <> evalThis (EvalTerm Pure MaybeWork t) + Let _ Rec _ _ -> + -- Hard to know what gets evaluated first in a recursive let-binding, + -- just give up + evalThis Unknown + -- If we can view as a builtin application, then handle that specially + (splitApplication -> (Builtin a fun, args)) -> goBuiltinApp a fun args + -- If we can view as a constructor application, then handle that specially. + -- Constructor applications are always pure: if under-applied they don't + -- reduce; if fully-applied they are pure; if over-applied it's going to be + -- a type error since they never return a function. So we can ignore the arity + -- in this case! + t@(splitApplication -> (h@(Var _ n), args)) + | Just (DatatypeConstructor{}) <- lookupVarInfo n vinfo -> + evalThis (EvalTerm Pure MaybeWork h) + <> appContextEvalOrder args + <> evalThis (EvalTerm Pure MaybeWork t) + -- No Unknown: we go to a known pure place, but we can't show it, + -- so we just skip it here. This has the effect of making constructor + -- applications pure - -- If we can view as a builtin application, then handle that specially - (splitApplication -> (Builtin a fun, args)) -> goBuiltinApp a fun args - -- If we can view as a constructor application, then handle that specially. - -- Constructor applications are always pure: if under-applied they don't - -- reduce; if fully-applied they are pure; if over-applied it's going to be - -- a type error since they never return a function. So we can ignore the arity - -- in this case! - t@(splitApplication -> (h@(Var _ n), args)) - | Just (DatatypeConstructor{}) <- lookupVarInfo n vinfo -> - evalThis (EvalTerm Pure MaybeWork h) - <> - goAppCtx args - <> - evalThis (EvalTerm Pure MaybeWork t) - -- No Unknown: we go to a known pure place, but we can't show it, - -- so we just skip it here. This has the effect of making constructor - -- applications pure + -- We could handle functions and type abstractions with *known* bodies + -- here. But there's not much point: beta reduction will immediately + -- turn those into let-bindings, which we do see through already. + 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) + -- then we go to the unknown function body + <> evalThis Unknown + t@(TyInst _ ta _) -> + -- first the type abstraction + goTerm ta + -- then the whole term, which will mean forcing, so work + <> evalThis (EvalTerm Pure MaybeWork t) + -- then we go to the unknown body of the type abstraction + <> evalThis Unknown + t@(IWrap _ _ _ b) -> + -- first the body + goTerm b + <> evalThis (EvalTerm Pure WorkFree t) + t@(Unwrap _ b) -> + -- first the body + goTerm b + -- then the whole term, but this is erased so it is work-free + <> evalThis (EvalTerm Pure WorkFree t) + 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 _ name) -> + -- See Note [Purity, strictness, and variables] + let purity = case varInfoStrictness <$> lookupVarInfo name vinfo of + Just Strict -> Pure + Just NonStrict -> MaybeImpure + _ -> MaybeImpure + in -- looking up the variable is work + evalThis (EvalTerm purity MaybeWork 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@TyAbs{} -> + evalThis (EvalTerm Pure WorkFree t) + t@LamAbs{} -> + evalThis (EvalTerm Pure WorkFree t) + t@Constant{} -> + evalThis (EvalTerm Pure WorkFree t) - -- We could handle functions and type abstractions with *known* bodies - -- here. But there's not much point: beta reduction will immediately - -- turn those into let-bindings, which we do see through already. - 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) - -- then we go to the unknown function body - <> evalThis Unknown - t@(TyInst _ ta _) -> - -- first the type abstraction - goTerm ta - -- then the whole term, which will mean forcing, so work - <> evalThis (EvalTerm Pure MaybeWork t) - -- then we go to the unknown body of the type abstraction - <> evalThis Unknown + goBindings :: [Binding tyname name uni fun a] -> EvalOrder tyname name uni fun a + goBindings [] = mempty + goBindings (b : bs) = case b of + -- Only strict term bindings get evaluated at this point + TermBind _ Strict _ rhs -> goTerm rhs + _ -> goBindings bs - t@(IWrap _ _ _ b) -> - -- first the body - goTerm b - <> evalThis (EvalTerm Pure WorkFree t) - t@(Unwrap _ b) -> - -- first the body - goTerm b - -- then the whole term, but this is erased so it is work-free - <> evalThis (EvalTerm Pure WorkFree t) - 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 + goBuiltinApp :: a -> fun -> AppContext tyname name uni fun a -> EvalOrder tyname name uni fun a + goBuiltinApp a fun appContext = appContextEvalOrder appContext <> evalOrder + where + evalOrder :: EvalOrder tyname name uni fun a + evalOrder = case saturates appContext (builtinArityInfo binfo fun) of + -- If it's saturated or oversaturated, we might have an effect here + Just Saturated -> maybeImpureWork + Just Oversaturated -> maybeImpureWork + -- 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 + Just Undersaturated -> pureWorkFree + -- Don't know, be conservative + Nothing -> maybeImpureWork - -- Leaf terms - t@(Var _ name) -> - -- See Note [Purity, strictness, and variables] - let purity = case varInfoStrictness <$> lookupVarInfo name vinfo of - Just Strict -> Pure - Just NonStrict -> MaybeImpure - _ -> MaybeImpure - -- looking up the variable is work - in evalThis (EvalTerm purity MaybeWork 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@TyAbs{} -> - evalThis (EvalTerm Pure WorkFree t) - t@LamAbs{} -> - evalThis (EvalTerm Pure WorkFree t) - t@Constant{} -> - evalThis (EvalTerm Pure WorkFree t) + maybeImpureWork :: EvalOrder tyname name uni fun a + maybeImpureWork = evalThis (EvalTerm MaybeImpure MaybeWork reconstructed) - goBindings :: - [Binding tyname name uni fun a] -> - EvalOrder tyname name uni fun a - goBindings [] = mempty - goBindings (b:bs) = case b of - -- Only strict term bindings get evaluated at this point - TermBind _ Strict _ rhs -> goTerm rhs - _ -> goBindings bs + pureWorkFree :: EvalOrder tyname name uni fun a + pureWorkFree = evalThis (EvalTerm Pure WorkFree reconstructed) - goBuiltinApp - :: a - -> fun - -> AppContext tyname name uni fun a - -> EvalOrder tyname name uni fun a - goBuiltinApp a hd args = - let - saturated = saturates args (builtinArityInfo binfo hd) - reconstructed = fillAppContext (Builtin a hd) args - evalEffect = case saturated of - -- If it's saturated or oversaturated, we might have an effect here - Just Saturated -> evalThis (EvalTerm MaybeImpure MaybeWork reconstructed) - Just Oversaturated -> evalThis (EvalTerm MaybeImpure MaybeWork reconstructed) - -- 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 - Just Undersaturated -> evalThis (EvalTerm Pure WorkFree reconstructed) - -- Don't know, be conservative - Nothing -> evalThis (EvalTerm MaybeImpure MaybeWork reconstructed) - in goAppCtx args <> evalEffect + reconstructed :: Term tyname name uni fun a + reconstructed = fillAppContext (Builtin a fun) appContext - goAppCtx :: AppContext tyname name uni fun a -> EvalOrder tyname name uni fun a - goAppCtx = \case - AppContextEnd -> mempty - TermAppContext t _ rest -> goTerm t <> goAppCtx rest - TypeAppContext _ _ rest -> goAppCtx rest + appContextEvalOrder :: AppContext tyname name uni fun a -> EvalOrder tyname name uni fun a + appContextEvalOrder = \case + AppContextEnd -> mempty + TermAppContext t _ rest -> goTerm t <> appContextEvalOrder rest + TypeAppContext _ _ rest -> appContextEvalOrder rest --- | 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 :: - (ToBuiltinMeaning uni fun, PLC.HasUnique name PLC.TermUnique) => - BuiltinsInfo uni fun -> - VarsInfo tyname name uni a -> - Term tyname name uni fun a -> - Bool +{- | 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 + :: (ToBuiltinMeaning uni fun, PLC.HasUnique name PLC.TermUnique) + => BuiltinsInfo uni fun + -> VarsInfo tyname name uni a + -> Term tyname name uni fun a + -> Bool isPure binfo vinfo t = -- 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 binfo vinfo t) - where - go :: [EvalTerm tyname name uni fun a] -> Bool - go [] = True - go (et:rest) = case et of - -- Might be an effect here! - EvalTerm MaybeImpure _ _ -> False - -- This term is fine, what about the rest? - EvalTerm Pure _ _ -> go rest - -- We don't know what will happen, so be conservative - Unknown -> False + where + go :: [EvalTerm tyname name uni fun a] -> Bool + go [] = True + go (et : rest) = case et of + -- Might be an effect here! + EvalTerm MaybeImpure _ _ -> False + -- This term is fine, what about the rest? + EvalTerm Pure _ _ -> go rest + -- We don't know what will happen, so be conservative + Unknown -> False -{-| Is the given term 'work-free'? +{- | Is the given term 'work-free'? 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 :: - (ToBuiltinMeaning uni fun, PLC.HasUnique name PLC.TermUnique) => - BuiltinsInfo uni fun -> - VarsInfo tyname name uni a -> - Term tyname name uni fun a -> - Bool +isWorkFree + :: (ToBuiltinMeaning uni fun, PLC.HasUnique name PLC.TermUnique) + => BuiltinsInfo uni fun + -> VarsInfo tyname name uni a + -> Term tyname name uni fun a + -> Bool isWorkFree binfo vinfo t = -- 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 binfo vinfo t) - where - go :: [EvalTerm tyname name uni fun a] -> Bool - go [] = True - go (et:rest) = case et of - -- Might be an effect here! - EvalTerm _ MaybeWork _ -> False - -- This term is fine, what about the rest? - EvalTerm _ WorkFree _ -> go rest - -- We don't know what will happen, so be conservative - Unknown -> False + where + go :: [EvalTerm tyname name uni fun a] -> Bool + go [] = True + go (et : rest) = case et of + -- Might be an effect here! + EvalTerm _ MaybeWork _ -> False + -- This term is fine, what about the rest? + EvalTerm _ WorkFree _ -> go rest + -- We don't know what will happen, so be conservative + Unknown -> False {- Note [Purity, strictness, and variables] Variables in PLC won't have effects: they can have something else substituted for them, diff --git a/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Purity.hs b/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Purity.hs index e492003d5cc..9f4d9ae8468 100644 --- a/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Purity.hs +++ b/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Purity.hs @@ -5,22 +5,22 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE UndecidableInstances #-} + -- Stripped-down version of PlutusIR.Purity module UntypedPlutusCore.Purity - ( isPure - , isWorkFree - , EvalOrder - , unEvalOrder - , EvalTerm (..) - , Purity (..) - , termEvaluationOrder - ) where - -import PlutusCore.Pretty -import UntypedPlutusCore.Core.Type + ( isPure + , isWorkFree + , EvalOrder + , unEvalOrder + , EvalTerm (..) + , Purity (..) + , termEvaluationOrder + ) where import Data.DList qualified as DList -import Prettyprinter +import PlutusCore.Pretty (Pretty (pretty), PrettyBy (prettyBy)) +import Prettyprinter (vsep, (<+>)) +import UntypedPlutusCore.Core.Type (Term (..)) -- | Is this pure? Either yes, or maybe not. data Purity = MaybeImpure | Pure @@ -36,41 +36,47 @@ instance Pretty WorkFreedom where pretty MaybeWork = "maybe work?" pretty WorkFree = "work-free" --- | Either the "next" term to be evaluated, along with its 'Purity' and 'WorkFreedom', --- or we don't know what comes next. -data EvalTerm name uni fun a = - Unknown +{- | Either the "next" term to be evaluated, along with its 'Purity' and 'WorkFreedom', +or we don't know what comes next. +-} +data EvalTerm name uni fun a + = Unknown | EvalTerm Purity WorkFreedom (Term name uni fun a) -instance PrettyBy config (Term name uni fun a) - => PrettyBy config (EvalTerm name uni fun a) where +instance + (PrettyBy config (Term name uni fun a)) + => PrettyBy config (EvalTerm name uni fun a) + where prettyBy _ Unknown = "" prettyBy config (EvalTerm eff work t) = pretty eff <+> pretty work <> ":" <+> prettyBy config t -- We use a DList here for efficient and lazy concatenation + -- | The order in which terms get evaluated, along with their purities. newtype EvalOrder name uni fun a = EvalOrder (DList.DList (EvalTerm name uni fun a)) deriving newtype (Semigroup, Monoid) --- | Get the evaluation order as a list of 'EvalTerm's. Either terminates in a single --- 'Unknown', which means that we got to a point where evaluation continues but we don't --- know where; or terminates normally, in which case we actually got to the end of the --- evaluation order for the term. +{- | Get the evaluation order as a list of 'EvalTerm's. Either terminates in a single +'Unknown', which means that we got to a point where evaluation continues but we don't +know where; or terminates normally, in which case we actually got to the end of the +evaluation order for the term. +-} unEvalOrder :: EvalOrder name uni fun a -> [EvalTerm name uni fun a] unEvalOrder (EvalOrder ts) = -- This is where we avoid traversing the whole program beyond the first Unknown, -- since DList is lazy and we convert to a lazy list and then filter it. - takeWhileInclusive (\case { Unknown -> False; _ -> True }) - $ DList.toList ts - where - takeWhileInclusive :: (a -> Bool) -> [a] -> [a] - takeWhileInclusive p = foldr (\x ys -> if p x then x:ys else [x]) [] + takeWhileInclusive (\case Unknown -> False; _ -> True) (DList.toList ts) + where + takeWhileInclusive :: (a -> Bool) -> [a] -> [a] + takeWhileInclusive p = foldr (\x ys -> if p x then x : ys else [x]) [] evalThis :: EvalTerm name uni fun a -> EvalOrder name uni fun a -evalThis tm = EvalOrder (DList.singleton tm) +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. @@ -83,113 +89,99 @@ 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 = goTerm - where - goTerm :: Term name uni fun a -> EvalOrder name uni fun a - goTerm = \case - 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) - <> dest - where - dest = 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) - <> dest - where - dest = 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 +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) + +{- | 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 = -- 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) - where - go :: [EvalTerm name uni fun a] -> Bool - go [] = True - go (et:rest) = case et of - -- Might be an effect here! - EvalTerm MaybeImpure _ _ -> False - -- This term is fine, what about the rest? - EvalTerm Pure _ _ -> go rest - -- We don't know what will happen, so be conservative - Unknown -> False - -{-| Is the given term 'work-free'? + where + go :: [EvalTerm name uni fun a] -> Bool + go [] = True + go (et : rest) = case et of + -- Might be an effect here! + EvalTerm MaybeImpure _ _ -> False + -- This term is fine, what about the rest? + EvalTerm Pure _ _ -> go rest + -- We don't know what will happen, so be conservative + Unknown -> False + +{- | Is the given term 'work-free'? 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 :: Term name uni fun a -> Bool isWorkFree t = -- 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) - where - go :: [EvalTerm name uni fun a] -> Bool - go [] = True - go (et:rest) = case et of - -- Might be an effect here! - EvalTerm _ MaybeWork _ -> False - -- This term is fine, what about the rest? - EvalTerm _ WorkFree _ -> go rest - -- We don't know what will happen, so be conservative - Unknown -> False + where + go :: [EvalTerm name uni fun a] -> Bool + go [] = True + go (et : rest) = case et of + -- Might be an effect here! + EvalTerm _ MaybeWork _ -> False + -- This term is fine, what about the rest? + EvalTerm _ WorkFree _ -> go rest + -- We don't know what will happen, so be conservative + Unknown -> False From 902cfa3ac5f4a97fc9ef45b405f74d659c671ed2 Mon Sep 17 00:00:00 2001 From: Michael Peyton Jones Date: Thu, 21 Mar 2024 12:22:53 +0000 Subject: [PATCH 7/8] Add documentation for AsData (#5729) * Add documentation for AsData * fix * Remove rogue dump option * WIP * comments --- doc/read-the-docs-site/howtos/asdata.rst | 128 ++++++++++++++++++ doc/read-the-docs-site/howtos/index.rst | 1 + .../tutorials/AuctionValidator.hs | 24 ++++ 3 files changed, 153 insertions(+) create mode 100644 doc/read-the-docs-site/howtos/asdata.rst diff --git a/doc/read-the-docs-site/howtos/asdata.rst b/doc/read-the-docs-site/howtos/asdata.rst new file mode 100644 index 00000000000..4372aaf6869 --- /dev/null +++ b/doc/read-the-docs-site/howtos/asdata.rst @@ -0,0 +1,128 @@ +.. highlight:: haskell +.. _asdata: + +How to use ``AsData`` to optimize scripts +========================================= + +The Plutus libraries contain a ``PlutusTx.asData`` module that contains Template Haskell (TH) code for encoding algebraic data types (ADTs) as ``Data`` objects in Plutus Core, as opposed to sums-of-products terms. +In general, ``asData`` pushes the burden of a computation nearer to where a value is used, in a crude sense making the evaluation less strict and more lazy. +This is intended for expert Plutus developers. + +Purpose +------- + +Values stored in datums or redeemers need to be encoded into ``Data`` objects. +When writing and optimizing a Plutus script, one of the challenges is finding the right approach to handling ``Data`` objects and how expensive that method will be. +To make an informed decision, you may need to benchmark and profile your smart contract code to measure its actual resource consumption. +The primary purpose of ``asData`` is to give you more options for how you want to handle ``Data``. + +Choice of two approoaches +------------------------- + +When handling ``Data`` objects, you have a choice of two pathways. +It is up to you to determine which pathway to use depending on your particular use case. +There are trade offs in performance and where errors occur. + +Approach one: proactively do all of the parsing +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +The first approach is to parse the object immediately (using ``fromBuiltinData``) into a native Plutus Core datatype, which will also identify any problems with the structuring of the object. +However, this performs all the work up front. + +This is the normal style that has been promoted in the past. + +Approach two: only do the parsing if and when necessary +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +In the second approach, the script doesn't do any parsing work immediately, and instead does it later, when it needs to. +It might be that this saves you a lot of work, because you may never need to parse the entire object. +Instead, the script will just carry the item around as a ``Data`` object. + +Using this method, every time the script uses the object, it will look at it to find out if it has the right shape. +If it does have the right shape, it will deconstruct the ``Data`` object and do its processing; if not, it will throw an error. +This work may be repeated depending on how your script is written. +In some cases, you might do less work, in some cases you might do more work, depending on your specific use case. + +The Plutus Tx library provides some helper functions to make this second style easier to do, in the form of the ``asData`` function. + +Using ``asData`` +------------------ + +The ``asData`` function takes the definition of a data type and replaces it with an equivalent definition whose representation uses ``Data`` directly. + +For example, if we wanted to use it on the types from the :ref:`auction example`, we would put the datatype declarations inside a Template Haskell quote and call ``asData`` on it. + +.. literalinclude:: ../tutorials/AuctionValidator.hs + :start-after: BLOCK9 + :end-before: BLOCK10 + +This is normal Template Haskell that just generates new Haskell source, so you can see the code that it generates with `{-# OPTIONS_GHC -ddump-splices #-}`, but it will look something like this: + +.. code-block:: + + PlutusTx.asData + [d| data Bid' + = Bid' {bBidder' :: PubKeyHash, bAmount' :: Lovelace} + deriving newtype (Eq, Ord, ToBuitinData, FromBuiltinData, UnsafeFromBuiltinData) + data AuctionRedeemer' = NewBid' Bid | Payout' + deriving newtype (Eq, Ord, ToBuitinData, FromBuiltinData, UnsafeFromBuiltinData) |] + + ======> + + newtype Bid' = Bid'2 BuiltinData + deriving newtype (Eq, Ord, PlutusTx.ToData, FromData, UnsafeFromData) + + {-# COMPLETE Bid' #-} + pattern Bid' :: PubKeyHash -> Lovelace -> Bid' + pattern Bid' ... + + newtype AuctionRedeemer' = AuctionRedeemer'2 BuiltinData + deriving newtype (Eq, Ord, PlutusTx.ToData, FromData, UnsafeFromData) + + {-# COMPLETE NewBid', Payout' #-} + pattern NewBid' :: Bid -> AuctionRedeemer' + pattern NewBid' ... + pattern Payout' :: AuctionRedeemer' + pattern Payout' ... + +That is: + +- It creates a newtype wrapper around ``BuiltinData`` +- It creates pattern synonyms corresponding to each of the constructors you wrote + +This lets you write code "as if" you were using the original declaration that you wrote, while in fact the pattern synonyms are handling conversion to/from ``Data`` for you. +But any values of this type actually are represented with ``Data``. +That means that when we newtype-derive the instances for converting to and from ``Data`` we get the instances for ``BuiltinData`` - which are free! + +Nested fields +~~~~~~~~~~~~~ + +The most important caveat to using ``asData`` is that ``Data`` objects encoding datatypes must also encode the *fields* of the datatype as ``Data``. +However, ``asData`` tries to make the generated code a drop-in replacement for the original code, which means that when using the pattern synonyms they try to give you the fields as they were originally defined, which means *not* encoded as ``Data``. + +For example, in the ``Bid`` case above the ``bAmount`` field is originally defined to have type ``Lovelace`` which is a newtype around a Plutus Core builtin integer. +However, since we are using ``asData``, we need to encode the field into ``Data`` in order to store it. +That means that when you construct a ``Bid`` object you must take the ``Integer`` that you start with and convert it to ``Data``, and when you pattern match on a ``Bid`` object you do the reverse conversion. + +These conversions are potentially expensive! +If the ``bAmount`` field was a complex data structure, then every time we constructed or deconstructed a ``Bid`` object we would need to convert that datastructure to or from ``Data``. +Whether or not this is a problem depends on the precise situation, but in general: + +- If the field is a builtin integer or bytestring or a wrapper around those, it is probably cheap +- If the field is a datatype which is itself defined with ``asData`` then it is free (since it's already ``Data``!) +- If the field is a complex or large datatype then it is potentially expensive + +Therefore ``asData`` tends to work best when you use it for a type and also for all the types of its fields. + +Choosing an approach +-------------------- + +There are a number of tradeoffs to consider: + +1. Plutus Tx's datatypes are faster to work with and easier to optimize than ``Data``, so if the resulting object is going to be processed in its entirety (or have parts of it repeatedly processed) then it can be better to parse it up-front. +2. If it is important to check that the entire structure is well-formed, then it is better to parse it up-front, since the conversion will check the entire structure for well-formedness immediately, rather than checking only the parts that are used when they are used. +3. If you do not want to use ``asData`` for the types of the fields, then it may be better to not use it at all in order to avoid conversion penalties at the use sites. + +Which approach is better is an empirical question and may vary in different cases. +A single script may wish to use different approaches in different places. +For example, your datum might contain a large state object which is usually only inspected in part (a good candidate for ``asData``), whereas your redeemer might be a small object which is inspected frequently to determine what to do (a good candidate for a native Plutus Tx datatype). diff --git a/doc/read-the-docs-site/howtos/index.rst b/doc/read-the-docs-site/howtos/index.rst index 0f75e873ce2..16978e01925 100644 --- a/doc/read-the-docs-site/howtos/index.rst +++ b/doc/read-the-docs-site/howtos/index.rst @@ -7,5 +7,6 @@ How-to guides :maxdepth: 3 :titlesonly: + asdata exporting-a-script profiling-scripts diff --git a/doc/read-the-docs-site/tutorials/AuctionValidator.hs b/doc/read-the-docs-site/tutorials/AuctionValidator.hs index 60e94db0b00..31bd69e57c0 100644 --- a/doc/read-the-docs-site/tutorials/AuctionValidator.hs +++ b/doc/read-the-docs-site/tutorials/AuctionValidator.hs @@ -1,7 +1,9 @@ {-# LANGUAGE DataKinds #-} +{-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE ImportQualifiedPost #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE Strict #-} {-# LANGUAGE TemplateHaskell #-} @@ -28,6 +30,7 @@ import PlutusLedgerApi.V2 (Datum (..), OutputDatum (..), ScriptContext (..), TxI TxOut (..), from, to) import PlutusLedgerApi.V2.Contexts (getContinuingOutputs) import PlutusTx +import PlutusTx.AsData qualified as PlutusTx import PlutusTx.Prelude qualified as PlutusTx import PlutusTx.Show qualified as PlutusTx @@ -206,3 +209,24 @@ auctionValidatorScript params = $$(PlutusTx.compile [||auctionUntypedValidator||]) `PlutusTx.unsafeApplyCode` PlutusTx.liftCode plcVersion100 params -- BLOCK9 +PlutusTx.asData [d| + data Bid' = Bid' + { bBidder' :: PubKeyHash, + -- ^ Bidder's wallet address. + bAmount' :: Lovelace + -- ^ Bid amount in Lovelace. + } + -- We can derive instances with the newtype strategy, and they + -- will be based on the instances for 'Data' + deriving newtype (Eq, Ord, PlutusTx.ToData, FromData, UnsafeFromData) + + -- don't do this for the datum, since it's just a newtype so + -- simply delegates to the underlying type + + -- | Redeemer is the input that changes the state of a smart contract. + -- In this case it is either a new bid, or a request to close the auction + -- and pay out the seller and the highest bidder. + data AuctionRedeemer' = NewBid' Bid | Payout' + deriving newtype (Eq, Ord, PlutusTx.ToData, FromData, UnsafeFromData) + |] +-- BLOCK10 From 381172295c0b0a8f17450b8377ee5905f03d294b Mon Sep 17 00:00:00 2001 From: Ana Pantilie <45069775+ana-pantilie@users.noreply.github.com> Date: Mon, 25 Mar 2024 09:16:04 +0200 Subject: [PATCH 8/8] Add simple force-delay tests + clean-up (#5849) Signed-off-by: Ana Pantilie --- .../plutus-core/src/PlutusCore/Name/Unique.hs | 9 ++--- .../src/PlutusCore/Name/UniqueMap.hs | 36 ++++++++----------- .../src/PlutusCore/Name/UniqueSet.hs | 3 +- .../src/PlutusIR/Transform/Inline/Utils.hs | 2 +- .../src/PlutusIR/Transform/LetFloatOut.hs | 2 +- .../UntypedPlutusCore/Transform/ForceDelay.hs | 9 +++-- .../test/Transform/Simplify.hs | 14 ++++++++ .../Transform/forceDelayNoApps.uplc.golden | 1 + .../forceDelayNoAppsLayered.uplc.golden | 1 + 9 files changed, 43 insertions(+), 34 deletions(-) create mode 100644 plutus-core/untyped-plutus-core/test/Transform/forceDelayNoApps.uplc.golden create mode 100644 plutus-core/untyped-plutus-core/test/Transform/forceDelayNoAppsLayered.uplc.golden diff --git a/plutus-core/plutus-core/src/PlutusCore/Name/Unique.hs b/plutus-core/plutus-core/src/PlutusCore/Name/Unique.hs index 383073ae2c9..fc2bcc5809d 100644 --- a/plutus-core/plutus-core/src/PlutusCore/Name/Unique.hs +++ b/plutus-core/plutus-core/src/PlutusCore/Name/Unique.hs @@ -6,17 +6,14 @@ {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeApplications #-} -{- | Defines the 'Name' type used for identifiers in Plutus Core together with a technique - to minimise the cost of 'Name' comparisons. - - A 'Name' is a piece of text used to identify a variable inside the Plutus Core languages. +{- | A 'Name' is a datatype used to identify a variable inside the Plutus Core languages. Name comparisons are a fundamental part of the domain logic, and comparing 'Text' directly is inefficient. As a solution to this problem, we provide the 'Unique' type which is an integer associated to the 'Name', unique to each instantiation of the type. We can, therefore, compare the integers instead, which is obviously much more cost-effective. - We distinguish between the names of term variables and type variables by defining wrappers - over 'Name': 'TermName' and 'TyName'. Since the code we usually write is polymorphic in the + We distinguish between the names of term variables and type variables by defining the + 'TyName' wrapper over 'Name'. Since the code we usually write is polymorphic in the name type, we want to be able to define a class of names which have an associated 'Unique'. This class is 'HasUnique', see the definition below. -} diff --git a/plutus-core/plutus-core/src/PlutusCore/Name/UniqueMap.hs b/plutus-core/plutus-core/src/PlutusCore/Name/UniqueMap.hs index d1d72256fc6..9dcfc43a918 100644 --- a/plutus-core/plutus-core/src/PlutusCore/Name/UniqueMap.hs +++ b/plutus-core/plutus-core/src/PlutusCore/Name/UniqueMap.hs @@ -6,20 +6,18 @@ module PlutusCore.Name.UniqueMap ( UniqueMap (..), -insertByUnique, -insertByName, -singletonByName, -insertNamed, -insertByNameIndex, -fromFoldable, -fromUniques, -fromNames, -lookupUnique, -lookupName, -restrictKeys, -foldr, -lookupNameIndex, -isEmpty, + insertByUnique, + insertByName, + singletonByName, + insertNamed, + insertByNameIndex, + fromFoldable, + fromUniques, + fromNames, + lookupUnique, + lookupName, + restrictKeys, + lookupNameIndex, ) where import Control.Lens (view) @@ -38,7 +36,8 @@ import Prelude hiding (foldr) newtype UniqueMap unique a = UniqueMap { unUniqueMap :: IM.IntMap a } - deriving newtype (Show, Eq, Semigroup, Monoid, Functor) + deriving stock (Show, Eq) + deriving newtype (Semigroup, Monoid, Functor, Foldable) -- | Insert a value @a@ by a @unique@. insertByUnique :: @@ -106,9 +105,6 @@ restrictKeys :: UniqueMap unique v -> UniqueSet unique -> UniqueMap unique v restrictKeys (UniqueMap m) (UniqueSet s) = UniqueMap $ IM.restrictKeys m s -foldr :: (a -> b -> b) -> b -> UniqueMap unique a -> b -foldr f unit (UniqueMap m) = IM.foldr f unit m - {- | Look up a value by the index of the unique of a name. Unlike 'lookupUnique' and 'lookupName', this function does not provide any static guarantees, so you can for example look up a type-level name in a map from term-level uniques. @@ -119,7 +115,3 @@ lookupNameIndex :: UniqueMap unique2 a -> Maybe a lookupNameIndex = lookupUnique . coerce . view unique - -{-# INLINE isEmpty #-} -isEmpty :: UniqueMap unique a -> Bool -isEmpty (UniqueMap m) = IM.null m diff --git a/plutus-core/plutus-core/src/PlutusCore/Name/UniqueSet.hs b/plutus-core/plutus-core/src/PlutusCore/Name/UniqueSet.hs index febcef347b5..5a32787e0ea 100644 --- a/plutus-core/plutus-core/src/PlutusCore/Name/UniqueSet.hs +++ b/plutus-core/plutus-core/src/PlutusCore/Name/UniqueSet.hs @@ -34,7 +34,8 @@ import PlutusCore.Name.Unique (HasUnique (..), Unique (Unique)) newtype UniqueSet unique = UniqueSet { unUniqueSet :: IS.IntSet } - deriving newtype (Show, Eq, Semigroup, Monoid) + deriving stock (Show, Eq) + deriving newtype (Semigroup, Monoid) -- | Insert a @unique@. insertByUnique :: diff --git a/plutus-core/plutus-ir/src/PlutusIR/Transform/Inline/Utils.hs b/plutus-core/plutus-ir/src/PlutusIR/Transform/Inline/Utils.hs index 4cbe93aa376..45720564ff2 100644 --- a/plutus-core/plutus-ir/src/PlutusIR/Transform/Inline/Utils.hs +++ b/plutus-core/plutus-ir/src/PlutusIR/Transform/Inline/Utils.hs @@ -158,7 +158,7 @@ lookupType tn s = UMap.lookupName tn $ s ^. typeSubst . unTypeSubst -- | Check if the type substitution is empty. isTypeSubstEmpty :: InlinerState tyname name uni fun ann -> Bool -isTypeSubstEmpty (InlinerState _ (TypeSubst tyEnv) _) = UMap.isEmpty tyEnv +isTypeSubstEmpty (InlinerState _ (TypeSubst tyEnv) _) = null tyEnv -- | Insert the unprocessed type variable into the type substitution. extendType diff --git a/plutus-core/plutus-ir/src/PlutusIR/Transform/LetFloatOut.hs b/plutus-core/plutus-ir/src/PlutusIR/Transform/LetFloatOut.hs index 4b10d047356..74f42fff6bc 100644 --- a/plutus-core/plutus-ir/src/PlutusIR/Transform/LetFloatOut.hs +++ b/plutus-core/plutus-ir/src/PlutusIR/Transform/LetFloatOut.hs @@ -434,7 +434,7 @@ floatTerm binfo t = -- HELPERS maxPos :: PLC.UniqueMap k Pos -> Pos -maxPos = UMap.foldr max topPos +maxPos = foldr max topPos withDepth :: (r ~ MarkCtx tyname name uni fun a2, MonadReader r m) => (Depth -> Depth) -> m a -> m a diff --git a/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Transform/ForceDelay.hs b/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Transform/ForceDelay.hs index 4c5ac9d17e2..a59a7b6cec2 100644 --- a/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Transform/ForceDelay.hs +++ b/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Transform/ForceDelay.hs @@ -1,4 +1,6 @@ -{- | The 'ForceDelay' optimisation pushes 'Force' inside its direct 'Apply' subterms, +{- Note [Cancelling interleaved Force-Delay pairs] + + The 'ForceDelay' optimisation pushes 'Force' inside its direct 'Apply' subterms, removing any 'Delay' at the top of the body of the underlying lambda abstraction. For example, @force [(\x -> delay b) a]@ is transformed into @[(\x -> b) a]@. We also consider the case where the 'Force' is applied directly to the 'Delay' as @@ -138,7 +140,6 @@ import UntypedPlutusCore.Core import Control.Lens (transformOf) import Control.Monad (guard) import Data.Foldable (foldl') -import Data.Maybe (fromMaybe) {- | Traverses the term, for each node applying the optimisation detailed above. For implementation details see 'optimisationProcedure'. @@ -153,7 +154,9 @@ processTerm :: Term name uni fun a -> Term name uni fun a processTerm = \case Force _ (Delay _ t) -> t original@(Force _ subTerm) -> - fromMaybe original (optimisationProcedure subTerm) + case optimisationProcedure subTerm of + Just result -> result + Nothing -> original t -> t {- | Converts the subterm of a 'Force' into specialised types for representing diff --git a/plutus-core/untyped-plutus-core/test/Transform/Simplify.hs b/plutus-core/untyped-plutus-core/test/Transform/Simplify.hs index 74dd244b76d..bfab39219da 100644 --- a/plutus-core/untyped-plutus-core/test/Transform/Simplify.hs +++ b/plutus-core/untyped-plutus-core/test/Transform/Simplify.hs @@ -227,6 +227,18 @@ multiApp = runQuote $ do app = mkIterAppNoAnn lam [mkConstant @Integer () 1, mkConstant @Integer () 2, mkConstant @Integer () 3] pure app +forceDelayNoApps :: Term Name PLC.DefaultUni PLC.DefaultFun () +forceDelayNoApps = runQuote $ do + let one = mkConstant @Integer () 1 + term = Force () $ Delay () $ Force () $ Delay () $ Force () $ Delay () one + pure term + +forceDelayNoAppsLayered :: Term Name PLC.DefaultUni PLC.DefaultFun () +forceDelayNoAppsLayered = runQuote $ do + let one = mkConstant @Integer () 1 + term = Force () $ Force () $ Force () $ Delay () $ Delay () $ Delay () one + pure term + -- | The UPLC term in this test should come from the following TPLC term after erasing its types: -- > (/\(p :: *) -> \(x : p) -> /\(q :: *) -> \(y : q) -> /\(r :: *) -> \(z : r) -> z) Int 1 Int 2 Int 3 -- This case is simple in the sense that each type abstraction is followed by a single term abstraction. @@ -442,6 +454,8 @@ test_simplify = , goldenVsSimplified "inlineImpure3" inlineImpure3 , goldenVsSimplified "inlineImpure4" inlineImpure4 , goldenVsSimplified "multiApp" multiApp + , goldenVsSimplified "forceDelayNoApps" forceDelayNoApps + , goldenVsSimplified "forceDelayNoAppsLayered" forceDelayNoAppsLayered , goldenVsSimplified "forceDelaySimple" forceDelaySimple , goldenVsSimplified "forceDelayMultiApply" forceDelayMultiApply , goldenVsSimplified "forceDelayMultiForce" forceDelayMultiForce diff --git a/plutus-core/untyped-plutus-core/test/Transform/forceDelayNoApps.uplc.golden b/plutus-core/untyped-plutus-core/test/Transform/forceDelayNoApps.uplc.golden new file mode 100644 index 00000000000..56a6051ca2b --- /dev/null +++ b/plutus-core/untyped-plutus-core/test/Transform/forceDelayNoApps.uplc.golden @@ -0,0 +1 @@ +1 \ No newline at end of file diff --git a/plutus-core/untyped-plutus-core/test/Transform/forceDelayNoAppsLayered.uplc.golden b/plutus-core/untyped-plutus-core/test/Transform/forceDelayNoAppsLayered.uplc.golden new file mode 100644 index 00000000000..56a6051ca2b --- /dev/null +++ b/plutus-core/untyped-plutus-core/test/Transform/forceDelayNoAppsLayered.uplc.golden @@ -0,0 +1 @@ +1 \ No newline at end of file