From 43e2545935f82f3d69ec80aa33c1df7cb07f4cd3 Mon Sep 17 00:00:00 2001 From: Ramsay Taylor Date: Tue, 24 Sep 2024 15:42:02 +0100 Subject: [PATCH 01/13] This seems 'too easy' but to certify things I don't think it needs to be more complex? --- .../src/VerifiedCompilation/UCSE.lagda.md | 63 +++++++++++++++++++ 1 file changed, 63 insertions(+) create mode 100644 plutus-metatheory/src/VerifiedCompilation/UCSE.lagda.md diff --git a/plutus-metatheory/src/VerifiedCompilation/UCSE.lagda.md b/plutus-metatheory/src/VerifiedCompilation/UCSE.lagda.md new file mode 100644 index 00000000000..1f7f0f3183d --- /dev/null +++ b/plutus-metatheory/src/VerifiedCompilation/UCSE.lagda.md @@ -0,0 +1,63 @@ +--- +title: VerifiedCompilation.UCSE +layout: page +--- + +# Common Subexpression Elimination Translation Phase +``` +module VerifiedCompilation.UCSE where + +``` +## Imports + +``` +open import VerifiedCompilation.Equality using (DecEq; _≟_; decPointwise) +open import VerifiedCompilation.UntypedViews using (Pred; isCase?; isApp?; isLambda?; isForce?; isBuiltin?; isConstr?; isDelay?; isTerm?; allTerms?; iscase; isapp; islambda; isforce; isbuiltin; isconstr; isterm; allterms; isdelay) +open import VerifiedCompilation.UntypedTranslation using (Translation; translation?; Relation) +open import Relation.Nullary.Product using (_×-dec_) +open import Data.Product using (_,_) +import Relation.Binary as Binary using (Decidable) +open import Relation.Nullary using (Dec; yes; no; ¬_) +open import Untyped using (_⊢; case; builtin; _·_; force; `; ƛ; delay; con; constr; error) +import Relation.Binary.PropositionalEquality as Eq +open Eq using (_≡_; refl) +open import Data.Empty using (⊥) +open import Agda.Builtin.Maybe using (Maybe; just; nothing) +open import Untyped.RenamingSubstitution using (_[_]) +``` +## Translation Relation + +This module is required to certify that an application of CSE doesn't break the +semantics; we are explicitly not evaluating whether the particular choice of +sub-expression was a "good" choice. + +As such, this Translation Relation primarily checks that substituting the expression +back in would yield the original expression. + +``` +data UCSE : Relation where + cse : {X : Set} {x : Maybe X ⊢} {x' e : X ⊢} + → Translation UCSE (x [ e ]) x' + → UCSE ((ƛ x) · e) x' + +UntypedCSE : {X : Set} {{_ : DecEq X}} → (ast : X ⊢) → (ast' : X ⊢) → Set₁ +UntypedCSE = Translation UCSE + +``` + +## Decision Procedure + +``` + +isUntypedCSE? : {X : Set} {{_ : DecEq X}} → Binary.Decidable (Translation UCSE {X}) + +{-# TERMINATING #-} +isUCSE? : {X : Set} {{_ : DecEq X}} → Binary.Decidable (UCSE {X}) +isUCSE? ast ast' with (isApp? (isLambda? isTerm?) isTerm?) ast +... | no ¬match = no λ { (cse x) → ¬match (isapp (islambda (isterm _)) (isterm _)) } +... | yes (isapp (islambda (isterm x)) (isterm e)) with isUntypedCSE? (x [ e ]) ast' +... | no ¬p = no λ { (cse x) → ¬p x } +... | yes p = yes (cse p) + +isUntypedCSE? = translation? isUCSE? +``` From 9ad6f51cf46b009022f000554f064729a4cebf85 Mon Sep 17 00:00:00 2001 From: Ramsay Taylor Date: Wed, 25 Sep 2024 10:08:14 +0100 Subject: [PATCH 02/13] Er, I think this was the wrong way round --- .../src/VerifiedCompilation/UCSE.lagda.md | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/plutus-metatheory/src/VerifiedCompilation/UCSE.lagda.md b/plutus-metatheory/src/VerifiedCompilation/UCSE.lagda.md index 1f7f0f3183d..49dcbd240a0 100644 --- a/plutus-metatheory/src/VerifiedCompilation/UCSE.lagda.md +++ b/plutus-metatheory/src/VerifiedCompilation/UCSE.lagda.md @@ -36,9 +36,9 @@ back in would yield the original expression. ``` data UCSE : Relation where - cse : {X : Set} {x : Maybe X ⊢} {x' e : X ⊢} - → Translation UCSE (x [ e ]) x' - → UCSE ((ƛ x) · e) x' + cse : {X : Set} {x' : Maybe X ⊢} {x e : X ⊢} + → Translation UCSE x (x' [ e ]) + → UCSE x ((ƛ x') · e) UntypedCSE : {X : Set} {{_ : DecEq X}} → (ast : X ⊢) → (ast' : X ⊢) → Set₁ UntypedCSE = Translation UCSE @@ -53,9 +53,9 @@ isUntypedCSE? : {X : Set} {{_ : DecEq X}} → Binary.Decidable (Translation UCSE {-# TERMINATING #-} isUCSE? : {X : Set} {{_ : DecEq X}} → Binary.Decidable (UCSE {X}) -isUCSE? ast ast' with (isApp? (isLambda? isTerm?) isTerm?) ast +isUCSE? ast ast' with (isApp? (isLambda? isTerm?) isTerm?) ast' ... | no ¬match = no λ { (cse x) → ¬match (isapp (islambda (isterm _)) (isterm _)) } -... | yes (isapp (islambda (isterm x)) (isterm e)) with isUntypedCSE? (x [ e ]) ast' +... | yes (isapp (islambda (isterm x')) (isterm e)) with isUntypedCSE? ast (x' [ e ]) ... | no ¬p = no λ { (cse x) → ¬p x } ... | yes p = yes (cse p) From 695d979a95805e6478382c5dd3a281a5ad388aea Mon Sep 17 00:00:00 2001 From: zeme-wana <15709674+zeme-wana@users.noreply.github.com> Date: Tue, 24 Sep 2024 09:52:30 +0200 Subject: [PATCH 03/13] Add version select to haddock index page (#6499) --- scripts/combined-haddock.sh | 52 ++++++++++++++++++++++++++++++++++--- 1 file changed, 49 insertions(+), 3 deletions(-) diff --git a/scripts/combined-haddock.sh b/scripts/combined-haddock.sh index f73d9114663..03d1d09a108 100755 --- a/scripts/combined-haddock.sh +++ b/scripts/combined-haddock.sh @@ -226,8 +226,54 @@ time linkchecker "${OUTPUT_DIR}/index.html" \ --no-warnings \ --output failures \ --file-output text - - if [[ "$?" != "0" ]]; then echo "Found broken or unreachable 'href=' links in the files above (also see ./linkchecker-out.txt)" -fi \ No newline at end of file +fi + + +# Add a ' + for version in $(list-valid-plutus-versions); do + if [[ "$version" == "$PLUTUS_VERSION" ]]; then + html+='" + done + html+="

" + echo "$html" +} + +inject-text-at-char "$OUTPUT_DIR/index.html" 1465 "$(build-version-select-html)" + + + + From 5fa0207b93a7706e58b2d5c57be883996361bb55 Mon Sep 17 00:00:00 2001 From: Ziyang Liu Date: Wed, 25 Sep 2024 04:09:08 -0700 Subject: [PATCH 04/13] Remove plutus-ghc-stub (#6514) --- .gitattributes | 1 - cabal.project | 6 - plutus-tx-plugin/plutus-tx-plugin.cabal | 18 +- stubs/plutus-ghc-stub/LICENSE | 31 - stubs/plutus-ghc-stub/NOTICE | 13 - stubs/plutus-ghc-stub/README.md | 6 - stubs/plutus-ghc-stub/plutus-ghc-stub.cabal | 52 -- stubs/plutus-ghc-stub/src/Class.hs | 1 - stubs/plutus-ghc-stub/src/CoreSyn.hs | 3 - stubs/plutus-ghc-stub/src/FV.hs | 1 - stubs/plutus-ghc-stub/src/FamInstEnv.hs | 3 - stubs/plutus-ghc-stub/src/Finder.hs | 1 - stubs/plutus-ghc-stub/src/GhcPlugins.hs | 7 - stubs/plutus-ghc-stub/src/Kind.hs | 2 - stubs/plutus-ghc-stub/src/LoadIface.hs | 2 - stubs/plutus-ghc-stub/src/MkId.hs | 1 - stubs/plutus-ghc-stub/src/OccName.hs | 5 - stubs/plutus-ghc-stub/src/Panic.hs | 2 - stubs/plutus-ghc-stub/src/Plugins.hs | 176 ----- stubs/plutus-ghc-stub/src/PrelNames.hs | 9 - stubs/plutus-ghc-stub/src/PrimOp.hs | 1 - stubs/plutus-ghc-stub/src/StubTypes.hs | 695 -------------------- stubs/plutus-ghc-stub/src/TcRnMonad.hs | 1 - stubs/plutus-ghc-stub/src/TcRnTypes.hs | 3 - stubs/plutus-ghc-stub/src/TysPrim.hs | 1 - 25 files changed, 1 insertion(+), 1040 deletions(-) delete mode 100644 stubs/plutus-ghc-stub/LICENSE delete mode 100644 stubs/plutus-ghc-stub/NOTICE delete mode 100644 stubs/plutus-ghc-stub/README.md delete mode 100644 stubs/plutus-ghc-stub/plutus-ghc-stub.cabal delete mode 100644 stubs/plutus-ghc-stub/src/Class.hs delete mode 100644 stubs/plutus-ghc-stub/src/CoreSyn.hs delete mode 100644 stubs/plutus-ghc-stub/src/FV.hs delete mode 100644 stubs/plutus-ghc-stub/src/FamInstEnv.hs delete mode 100644 stubs/plutus-ghc-stub/src/Finder.hs delete mode 100644 stubs/plutus-ghc-stub/src/GhcPlugins.hs delete mode 100644 stubs/plutus-ghc-stub/src/Kind.hs delete mode 100644 stubs/plutus-ghc-stub/src/LoadIface.hs delete mode 100644 stubs/plutus-ghc-stub/src/MkId.hs delete mode 100644 stubs/plutus-ghc-stub/src/OccName.hs delete mode 100644 stubs/plutus-ghc-stub/src/Panic.hs delete mode 100644 stubs/plutus-ghc-stub/src/Plugins.hs delete mode 100644 stubs/plutus-ghc-stub/src/PrelNames.hs delete mode 100644 stubs/plutus-ghc-stub/src/PrimOp.hs delete mode 100644 stubs/plutus-ghc-stub/src/StubTypes.hs delete mode 100644 stubs/plutus-ghc-stub/src/TcRnMonad.hs delete mode 100644 stubs/plutus-ghc-stub/src/TcRnTypes.hs delete mode 100644 stubs/plutus-ghc-stub/src/TysPrim.hs diff --git a/.gitattributes b/.gitattributes index b8805c53a00..0d3e8fe199a 100644 --- a/.gitattributes +++ b/.gitattributes @@ -1,6 +1,5 @@ # linguist gets confused by PIR files, and thinks they make up a lot of our source! *.pir linguist-detectable=false -stubs/plutus-ghc-stub/** linguist-vendored=true # Large HTML files inside 'notes' are dominating our repoistory language # estimate. notes/**/*.html linguist-documentation diff --git a/cabal.project b/cabal.project index 73b3d99a15a..037d1f22fd7 100644 --- a/cabal.project +++ b/cabal.project @@ -29,7 +29,6 @@ packages: cardano-constitution plutus-tx-plugin plutus-tx-test-util prettyprinter-configurable - stubs/plutus-ghc-stub doc/docusaurus/docusaurus-examples.cabal -- We never, ever, want this. @@ -60,11 +59,6 @@ if impl(ghc < 9.0) || os(windows) allow-older: plutus-cert:base if os(windows) - -- When cross compiling we don't have a `ghc` package, so use - -- the `plutus-ghc-stub` package instead. - package plutus-tx-plugin - flags: +use-ghc-stub - -- Exclude tests that use `doctest`. They will not work for -- cross compilation and `cabal` will not be able to make a plan. package prettyprinter-configurable diff --git a/plutus-tx-plugin/plutus-tx-plugin.cabal b/plutus-tx-plugin/plutus-tx-plugin.cabal index 610011015d6..f43de8bb770 100644 --- a/plutus-tx-plugin/plutus-tx-plugin.cabal +++ b/plutus-tx-plugin/plutus-tx-plugin.cabal @@ -50,11 +50,6 @@ common os-support if (impl(ghcjs) || os(windows)) buildable: False -flag use-ghc-stub - description: Use the `plutus-ghc-stub` package instead of `ghc`. - default: False - manual: True - library import: lang, ghc-version-support, os-support hs-source-dirs: src @@ -85,6 +80,7 @@ library , either , extra , flat ^>=0.6 + , ghc , lens , mtl , plutus-core:{plutus-core, plutus-ir} ^>=1.34 @@ -94,14 +90,6 @@ library , text , uniplate - if flag(use-ghc-stub) - build-depends: plutus-ghc-stub - ghc-options: - -Wno-unused-packages -Wno-unused-imports -Wno-overlapping-patterns - - else - build-depends: ghc - executable gen-plugin-opts-doc import: lang, ghc-version-support, os-support main-is: GeneratePluginOptionsDoc.hs @@ -121,10 +109,6 @@ executable gen-plugin-opts-doc test-suite plutus-tx-plugin-tests import: lang, ghc-version-support, os-support - - if flag(use-ghc-stub) - buildable: False - type: exitcode-stdio-1.0 hs-source-dirs: test main-is: Spec.hs diff --git a/stubs/plutus-ghc-stub/LICENSE b/stubs/plutus-ghc-stub/LICENSE deleted file mode 100644 index b5059b71f60..00000000000 --- a/stubs/plutus-ghc-stub/LICENSE +++ /dev/null @@ -1,31 +0,0 @@ -The Glasgow Haskell Compiler License - -Copyright 2002, The University Court of the University of Glasgow. -All rights reserved. - -Redistribution and use in source and binary forms, with or without -modification, are permitted provided that the following conditions are met: - -- Redistributions of source code must retain the above copyright notice, -this list of conditions and the following disclaimer. - -- Redistributions in binary form must reproduce the above copyright notice, -this list of conditions and the following disclaimer in the documentation -and/or other materials provided with the distribution. - -- Neither name of the University nor the names of its contributors may be -used to endorse or promote products derived from this software without -specific prior written permission. - -THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF -GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, -INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND -FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE -UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE -FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL -DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR -SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER -CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT -LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY -OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH -DAMAGE. diff --git a/stubs/plutus-ghc-stub/NOTICE b/stubs/plutus-ghc-stub/NOTICE deleted file mode 100644 index 7bfbc260968..00000000000 --- a/stubs/plutus-ghc-stub/NOTICE +++ /dev/null @@ -1,13 +0,0 @@ -Copyright 2023 Input Output Global, Inc. - - Licensed under the Apache License, Version 2.0 (the "License"); - you may not use this file except in compliance with the License. - You may obtain a copy of the License at - - http://www.apache.org/licenses/LICENSE-2.0 - - Unless required by applicable law or agreed to in writing, software - distributed under the License is distributed on an "AS IS" BASIS, - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - See the License for the specific language governing permissions and - limitations under the License. diff --git a/stubs/plutus-ghc-stub/README.md b/stubs/plutus-ghc-stub/README.md deleted file mode 100644 index 819110e8fcb..00000000000 --- a/stubs/plutus-ghc-stub/README.md +++ /dev/null @@ -1,6 +0,0 @@ -# plutus-ghc-stub: Stand in for GHC when cross compiling - -This library contains stubs for the GHC package functions -used by `plutus-tx-plugin`. This allows the plugin -to be built when cross compiling for windows or -compiling with ghcjs. diff --git a/stubs/plutus-ghc-stub/plutus-ghc-stub.cabal b/stubs/plutus-ghc-stub/plutus-ghc-stub.cabal deleted file mode 100644 index 9ca2e02a206..00000000000 --- a/stubs/plutus-ghc-stub/plutus-ghc-stub.cabal +++ /dev/null @@ -1,52 +0,0 @@ -name: plutus-ghc-stub -version: 8.6.5 -license: BSD3 -license-file: LICENSE -author: The GHC Team -maintainer: glasgow-haskell-users@haskell.org -homepage: http://www.haskell.org/ghc/ -synopsis: The GHC API -description: - Stub functionality for the Plutus plugin, for cross compilers that - don't have a GHC library installed, like GHCJS - This should contain all the types and functions that the Plutus - compiler uses. - For technical reasons (Cabal), we need to be able to compile the plutus-tx - compiler for the host platform, even if we are going to load the plugin - from the build platform libraries. - -category: Development -build-type: Simple -cabal-version: >=1.10 - -library - default-language: Haskell2010 - default-extensions: ImportQualifiedPost - exposed: False - build-depends: - base - , bytestring - , ghc-boot - , template-haskell - - hs-source-dirs: src - exposed-modules: - Class - CoreSyn - FamInstEnv - Finder - FV - GhcPlugins - Kind - LoadIface - MkId - OccName - Panic - Plugins - PrelNames - PrimOp - TcRnMonad - TcRnTypes - TysPrim - - other-modules: StubTypes diff --git a/stubs/plutus-ghc-stub/src/Class.hs b/stubs/plutus-ghc-stub/src/Class.hs deleted file mode 100644 index 3e0a0fb0675..00000000000 --- a/stubs/plutus-ghc-stub/src/Class.hs +++ /dev/null @@ -1 +0,0 @@ -module Class where diff --git a/stubs/plutus-ghc-stub/src/CoreSyn.hs b/stubs/plutus-ghc-stub/src/CoreSyn.hs deleted file mode 100644 index f8b63c02b01..00000000000 --- a/stubs/plutus-ghc-stub/src/CoreSyn.hs +++ /dev/null @@ -1,3 +0,0 @@ -module CoreSyn where - -import StubTypes diff --git a/stubs/plutus-ghc-stub/src/FV.hs b/stubs/plutus-ghc-stub/src/FV.hs deleted file mode 100644 index f41643a35c6..00000000000 --- a/stubs/plutus-ghc-stub/src/FV.hs +++ /dev/null @@ -1 +0,0 @@ -module FV where diff --git a/stubs/plutus-ghc-stub/src/FamInstEnv.hs b/stubs/plutus-ghc-stub/src/FamInstEnv.hs deleted file mode 100644 index 21c8608631b..00000000000 --- a/stubs/plutus-ghc-stub/src/FamInstEnv.hs +++ /dev/null @@ -1,3 +0,0 @@ -module FamInstEnv where - -import StubTypes diff --git a/stubs/plutus-ghc-stub/src/Finder.hs b/stubs/plutus-ghc-stub/src/Finder.hs deleted file mode 100644 index 391f6274ded..00000000000 --- a/stubs/plutus-ghc-stub/src/Finder.hs +++ /dev/null @@ -1 +0,0 @@ -module Finder where diff --git a/stubs/plutus-ghc-stub/src/GhcPlugins.hs b/stubs/plutus-ghc-stub/src/GhcPlugins.hs deleted file mode 100644 index 57d4e884f7a..00000000000 --- a/stubs/plutus-ghc-stub/src/GhcPlugins.hs +++ /dev/null @@ -1,7 +0,0 @@ -module GhcPlugins( - module Plugins, - module StubTypes, - ) where - -import Plugins -import StubTypes diff --git a/stubs/plutus-ghc-stub/src/Kind.hs b/stubs/plutus-ghc-stub/src/Kind.hs deleted file mode 100644 index bffed39903d..00000000000 --- a/stubs/plutus-ghc-stub/src/Kind.hs +++ /dev/null @@ -1,2 +0,0 @@ -module Kind where - diff --git a/stubs/plutus-ghc-stub/src/LoadIface.hs b/stubs/plutus-ghc-stub/src/LoadIface.hs deleted file mode 100644 index 93d6bfd097e..00000000000 --- a/stubs/plutus-ghc-stub/src/LoadIface.hs +++ /dev/null @@ -1,2 +0,0 @@ -module LoadIface where - diff --git a/stubs/plutus-ghc-stub/src/MkId.hs b/stubs/plutus-ghc-stub/src/MkId.hs deleted file mode 100644 index acabf3c9dcc..00000000000 --- a/stubs/plutus-ghc-stub/src/MkId.hs +++ /dev/null @@ -1 +0,0 @@ -module MkId where diff --git a/stubs/plutus-ghc-stub/src/OccName.hs b/stubs/plutus-ghc-stub/src/OccName.hs deleted file mode 100644 index 1d5a146b049..00000000000 --- a/stubs/plutus-ghc-stub/src/OccName.hs +++ /dev/null @@ -1,5 +0,0 @@ -module OccName (module StubTypes) where - -import StubTypes --- data NameSpace = NameSpace - diff --git a/stubs/plutus-ghc-stub/src/Panic.hs b/stubs/plutus-ghc-stub/src/Panic.hs deleted file mode 100644 index a6909602a00..00000000000 --- a/stubs/plutus-ghc-stub/src/Panic.hs +++ /dev/null @@ -1,2 +0,0 @@ -module Panic where - diff --git a/stubs/plutus-ghc-stub/src/Plugins.hs b/stubs/plutus-ghc-stub/src/Plugins.hs deleted file mode 100644 index abf47a9a91d..00000000000 --- a/stubs/plutus-ghc-stub/src/Plugins.hs +++ /dev/null @@ -1,176 +0,0 @@ -{-# LANGUAGE Rank2Types #-} -module Plugins ( - FrontendPlugin(..), defaultFrontendPlugin, FrontendPluginAction - , Plugin(..), CommandLineOption, LoadedPlugin(..), lpModuleName - , defaultPlugin, keepRenamedSource, withPlugins, withPlugins_ - , PluginRecompile(..) - , purePlugin, impurePlugin, flagRecompile - ) where - - -import Control.Monad -import Data.List -import Data.Semigroup qualified -import StubTypes -import TcRnTypes qualified - -plugins :: DynFlags -> [LoadedPlugin] -plugins _ = [] - -type CommandLineOption = String - --- | 'Plugin' is the compiler plugin data type. Try to avoid --- constructing one of these directly, and just modify some fields of --- 'defaultPlugin' instead: this is to try and preserve source-code --- compatibility when we add fields to this. --- --- Nonetheless, this API is preliminary and highly likely to change in --- the future. -data Plugin = Plugin { - installCoreToDos :: CorePlugin - -- ^ Modify the Core pipeline that will be used for compilation. - -- This is called as the Core pipeline is built for every module - -- being compiled, and plugins get the opportunity to modify the - -- pipeline in a nondeterministic order. - , tcPlugin :: TcPlugin - -- ^ An optional typechecker plugin, which may modify the - -- behaviour of the constraint solver. - , pluginRecompile :: [CommandLineOption] -> IO PluginRecompile - -- ^ Specify how the plugin should affect recompilation. - , parsedResultAction :: [CommandLineOption] -> ModSummary -> HsParsedModule - -> Hsc HsParsedModule - -- ^ Modify the module when it is parsed. This is called by - -- HscMain when the parsing is successful. - , renamedResultAction :: [CommandLineOption] -> TcGblEnv - -> HsGroup GhcRn -> TcM (TcGblEnv, HsGroup GhcRn) - -- ^ Modify each group after it is renamed. This is called after each - -- `HsGroup` has been renamed. - , typeCheckResultAction :: [CommandLineOption] -> ModSummary -> TcGblEnv - -> TcM TcGblEnv - -- ^ Modify the module when it is type checked. This is called add the - -- very end of typechecking. - , spliceRunAction :: [CommandLineOption] -> LHsExpr GhcTc - -> TcM (LHsExpr GhcTc) - -- ^ Modify the TH splice or quasiqoute before it is run. - , interfaceLoadAction :: forall lcl . [CommandLineOption] -> ModIface - -> IfM lcl ModIface - -- ^ Modify an interface that have been loaded. This is called by - -- LoadIface when an interface is successfully loaded. Not applied to - -- the loading of the plugin interface. Tools that rely on information from - -- modules other than the currently compiled one should implement this - -- function. - } - --- Note [Source plugins] --- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ --- The `Plugin` datatype have been extended by fields that allow access to the --- different inner representations that are generated during the compilation --- process. These fields are `parsedResultAction`, `renamedResultAction`, --- `typeCheckResultAction`, `spliceRunAction` and `interfaceLoadAction`. --- --- The main purpose of these plugins is to help tool developers. They allow --- development tools to extract the information about the source code of a big --- Haskell project during the normal build procedure. In this case the plugin --- acts as the tools access point to the compiler that can be controlled by --- compiler flags. This is important because the manipulation of compiler flags --- is supported by most build environment. --- --- For the full discussion, check the full proposal at: --- https://ghc.haskell.org/trac/ghc/wiki/ExtendedPluginsProposal - - --- | A plugin with its arguments. The result of loading the plugin. -data LoadedPlugin = LoadedPlugin { - lpPlugin :: Plugin - -- ^ the actual callable plugin - , lpModule :: ModIface - -- ^ the module containing the plugin - , lpArguments :: [CommandLineOption] - -- ^ command line arguments for the plugin - } - -lpModuleName :: LoadedPlugin -> ModuleName -lpModuleName = moduleName . mi_module . lpModule - - -data PluginRecompile = ForceRecompile | NoForceRecompile | MaybeRecompile Fingerprint - -instance Outputable PluginRecompile where - ppr ForceRecompile = text "ForceRecompile" - ppr NoForceRecompile = text "NoForceRecompile" - ppr (MaybeRecompile fp) = text "MaybeRecompile" <+> ppr fp - -instance Semigroup PluginRecompile where - ForceRecompile <> _ = ForceRecompile - NoForceRecompile <> r = r - MaybeRecompile fp <> NoForceRecompile = MaybeRecompile fp - MaybeRecompile fp <> MaybeRecompile fp' = MaybeRecompile (fingerprintFingerprints [fp, fp']) - MaybeRecompile _fp <> ForceRecompile = ForceRecompile - -instance Monoid PluginRecompile where - mempty = NoForceRecompile - mappend = (Data.Semigroup.<>) - -type CorePlugin = [CommandLineOption] -> [CoreToDo] -> CoreM [CoreToDo] -type TcPlugin = [CommandLineOption] -> Maybe TcRnTypes.TcPlugin - -purePlugin, impurePlugin, flagRecompile :: [CommandLineOption] -> IO PluginRecompile -purePlugin _args = return NoForceRecompile - -impurePlugin _args = return ForceRecompile - -flagRecompile = - return . MaybeRecompile . fingerprintFingerprints . map fingerprintString . sort - --- | Default plugin: does nothing at all! For compatibility reasons --- you should base all your plugin definitions on this default value. -defaultPlugin :: Plugin -defaultPlugin = Plugin { - installCoreToDos = const return - , tcPlugin = const Nothing - , pluginRecompile = impurePlugin - , renamedResultAction = \_ env grp -> return (env, grp) - , parsedResultAction = \_ _ -> return - , typeCheckResultAction = \_ _ -> return - , spliceRunAction = \_ -> return - , interfaceLoadAction = \_ -> return - } - - --- | A renamer plugin which mades the renamed source available in --- a typechecker plugin. -keepRenamedSource :: [CommandLineOption] -> TcGblEnv - -> HsGroup GhcRn -> TcM (TcGblEnv, HsGroup GhcRn) -keepRenamedSource _ gbl_env group = TcM_ StubM_ -{- - return (gbl_env { tcg_rn_decls = update (tcg_rn_decls gbl_env) - , tcg_rn_exports = update_exports (tcg_rn_exports gbl_env) }, group) - where - update_exports Nothing = Just [] - update_exports m = m - - update Nothing = Just emptyRnGroup - update m = m --} - -type PluginOperation m a = Plugin -> [CommandLineOption] -> a -> m a -type ConstPluginOperation m a = Plugin -> [CommandLineOption] -> a -> m () - --- | Perform an operation by using all of the plugins in turn. -withPlugins :: Monad m => DynFlags -> PluginOperation m a -> a -> m a -withPlugins df transformation input - = foldM (\arg (LoadedPlugin p _ opts) -> transformation p opts arg) - input (plugins df) - --- | Perform a constant operation by using all of the plugins in turn. -withPlugins_ :: Monad m => DynFlags -> ConstPluginOperation m a -> a -> m () -withPlugins_ df transformation input - = mapM_ (\(LoadedPlugin p _ opts) -> transformation p opts input) - (plugins df) - -type FrontendPluginAction = [String] -> [(String, Maybe Phase)] -> Ghc () -data FrontendPlugin = FrontendPlugin { - frontend :: FrontendPluginAction - } -defaultFrontendPlugin :: FrontendPlugin -defaultFrontendPlugin = FrontendPlugin { frontend = \_ _ -> return () } diff --git a/stubs/plutus-ghc-stub/src/PrelNames.hs b/stubs/plutus-ghc-stub/src/PrelNames.hs deleted file mode 100644 index dd16f213eec..00000000000 --- a/stubs/plutus-ghc-stub/src/PrelNames.hs +++ /dev/null @@ -1,9 +0,0 @@ -module PrelNames where - -import StubTypes - -eqIntegerPrimName, eqName :: Name -isStringClassName :: Name -eqIntegerPrimName = error "eqInteger#" -eqName = error "eqName" -isStringClassName = error "isStringClassName" diff --git a/stubs/plutus-ghc-stub/src/PrimOp.hs b/stubs/plutus-ghc-stub/src/PrimOp.hs deleted file mode 100644 index 1ea424e9aae..00000000000 --- a/stubs/plutus-ghc-stub/src/PrimOp.hs +++ /dev/null @@ -1 +0,0 @@ -module PrimOp where diff --git a/stubs/plutus-ghc-stub/src/StubTypes.hs b/stubs/plutus-ghc-stub/src/StubTypes.hs deleted file mode 100644 index bea030f6aab..00000000000 --- a/stubs/plutus-ghc-stub/src/StubTypes.hs +++ /dev/null @@ -1,695 +0,0 @@ --- editorconfig-checker-disable-file -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE DeriveAnyClass #-} -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE DeriveFunctor #-} -{-# LANGUAGE KindSignatures #-} -module StubTypes where - -import Control.Exception qualified as Exception -import Control.Monad -import Control.Monad.IO.Class (MonadIO (..)) -import Data.ByteString -import Data.Data (Data) -import Data.Functor.Identity -import Data.String (IsString (..)) -import Language.Haskell.TH qualified as TH - -data DynFlags = DynFlags_ -type FamInstEnvs = (FamInstEnv, FamInstEnv) -data Name = Name_ deriving (Eq, Ord, Outputable, Data) -data OccName = OccName_ deriving (Eq, Ord) -data Module = Module_ deriving (Eq, Ord) -data UnitId = UnitId_ -data TyThing = TyThing_ -data ModSummary = ModSummary_ -data TcGblEnv = TcGblEnv_ -data LHsExpr a = LHsExpr_ -data GhcTc = GhcTc_ -data GhcRn = GhcRn_ -data GhcException - = CmdLineError String - | ProgramError String - | PprProgramError String SDoc - deriving (Show, Exception.Exception) -data ModuleName = ModuleName_ deriving (Eq, Ord, Data, Outputable) -data SDoc = SDoc_ deriving Show -data HsParsedModule = HsParsedModule_ -data HsGroup a = HsGroup_ -data Phase = Phase_ -data Coercion = Coercion_ deriving Data -data Type = Type_ deriving (Data, Outputable) -type Kind = Type -type TyVar = Var -data TyCoBinder = TyCoBinder_ deriving (Data, Outputable) -data SrcSpan = SrcSpan_ deriving (Eq, Ord, Data, Outputable) -data RealSrcSpan = RealSrcSpan_ deriving (Data, Outputable) -data Tickish a = - SourceNote { sourceSpan :: RealSrcSpan -- ^ Source covered - , sourceName :: String -- ^ Name for source location - } - deriving Data -data Var = Var_ deriving (Eq, Data, Outputable) -type Id = Var -data Fingerprint = Fingerprint_ deriving Outputable -data PrintUnqualified = PrintUnqualified_ -data TyCon = TyCon_ deriving (Eq, Outputable) -data IdDetails = ClassOpId Class - | DataConWorkId DataCon - | PrimOpId PrimOp - deriving Outputable -data IdUnfolding = IdUnfolding_ deriving Outputable -data Unfolding = Unfolding_ deriving Outputable -data FunctionOrData = IsFunction | IsData - deriving (Eq, Ord, Data, Outputable) -data FV = FV_ -data Class = Class_ -data NameSpace = NameSpace_ -data HscEnv = HscEnv { hsc_dflags :: DynFlags } -data RdrName = RdrName_ -data Messages = Messages_ - -data Literal - = ------------------ - -- First the primitive guys - LitChar Char -- ^ @Char#@ - at least 31 bits. Create with 'mkMachChar' - - | LitNumber !LitNumType !Integer Type - -- ^ Any numeric literal that can be - -- internally represented with an Integer - | LitString ByteString -- ^ A string-literal: stored and emitted - -- UTF-8 encoded, we'll arrange to decode it - -- at runtime. Also emitted with a @'\0'@ - -- terminator. Create with 'mkMachString' - - | LitNullAddr -- ^ The @NULL@ pointer, the only pointer value - -- that can be represented as a Literal. Create - -- with 'nullAddrLit' - - | LitRubbish -- ^ A nonsense value, used when an unlifted - -- binding is absent and has type - -- @forall (a :: 'TYPE' 'UnliftedRep'). a@. - -- May be lowered by code-gen to any possible - -- value. Also see GHC:Note [Rubbish literals] - - | LitFloat Rational -- ^ @Float#@. Create with 'mkMachFloat' - | LitDouble Rational -- ^ @Double#@. Create with 'mkMachDouble' - - | LitLabel FastString - (Maybe Int) - FunctionOrData - -- ^ A label literal. Parameters: - -- - -- 1) The name of the symbol mentioned in the declaration - -- - -- 2) The size (in bytes) of the arguments - -- the label expects. Only applicable with - -- @stdcall@ labels. @Just x@ => @\@ will - -- be appended to label name when emitting assembly. - deriving Data - --- | Numeric literal type -data LitNumType - = LitNumInteger -- ^ @Integer@ (see GHC:Note [Integer literals]) - | LitNumNatural -- ^ @Natural@ (see GHC:Note [Natural literals]) - | LitNumInt -- ^ @Int#@ - according to target machine - | LitNumInt64 -- ^ @Int64#@ - exactly 64 bits - | LitNumWord -- ^ @Word#@ - according to target machine - | LitNumWord64 -- ^ @Word64#@ - exactly 64 bits - deriving (Data,Enum,Eq,Ord) - -type FastString = String - -data AlgTyConRhs = - AbstractTyCon - | DataTyCon { data_cons :: [DataCon] } - | TupleTyCon { data_con :: DataCon } - | SumTyCon { data_cons :: [DataCon] } - | NewTyCon { data_con :: DataCon } -data DataCon = DataCon_ deriving (Eq, Data, Outputable) -data Role = Representational -data CoAxiom (a :: BranchFlag) = CoAxiom_ -data BranchFlag = BFBranched | BFUnbranched -type Unbranched = 'BFUnbranched - -data PrimOp = IntAddOp - | IntSubOp - | IntMulOp - | IntQuotOp - | IntRemOp - | IntGtOp - | IntGeOp - | IntLtOp - | IntLeOp - | IntEqOp - deriving (Eq, Ord, Enum, Outputable) - -data Expr b - = Var Id - | Lit Literal - | App (Expr b) (Arg b) - | Lam b (Expr b) - | Let (Bind b) (Expr b) - | Case (Expr b) b Type [Alt b] -- See #case_invariants# - | Cast (Expr b) Coercion - | Tick (Tickish Id) (Expr b) - | Type Type - | Coercion Coercion - deriving (Data, Outputable) - -data Bind b - = NonRec b (Expr b) - | Rec [(b, (Expr b))] - deriving Data - -data AltCon - = DataAlt DataCon -- ^ A plain data constructor: @case e of { Foo x -> ... }@. - -- Invariant: the 'DataCon' is always from a @data@ type, and never from a @newtype@ - - | LitAlt Literal -- ^ A literal: @case e of { 1 -> ... }@ - -- Invariant: always an *unlifted* literal - -- See GHC:Note [Literal alternatives] - - | DEFAULT -- ^ Trivial alternative: @case e of { _ -> ... }@ - deriving (Data, Outputable) - -type CoreExpr = Expr CoreBndr -type CoreBndr = Var -type CoreAlt = Alt CoreBndr -type CoreBind = Bind CoreBndr -type CoreProgram = [CoreBind] -type Arg b = Expr b -type Alt b = (AltCon, [b], Expr b) - -data ImpDeclSpec - = ImpDeclSpec { - is_mod :: ModuleName, -- ^ Module imported, e.g. @import Muggle@ - -- Note the @Muggle@ may well not be - -- the defining module for this thing! - - -- TODO: either should be Module, or there - -- should be a Maybe UnitId here too. - is_as :: ModuleName, -- ^ Import alias, e.g. from @as M@ (or @Muggle@ if there is no @as@ clause) - is_qual :: Bool, -- ^ Was this import qualified? - is_dloc :: SrcSpan -- ^ The location of the entire import declaration - } deriving (Eq, Ord, Data) - -data ImpItemSpec - = ImpAll - | ImpSome { - is_explicit :: Bool, - is_iloc :: SrcSpan - } - deriving (Eq, Ord, Data) - -data ImportSpec = ImpSpec { is_decl :: ImpDeclSpec, - is_item :: ImpItemSpec } - deriving( Eq, Ord, Data ) - -data ModIface = ModIface { mi_exports :: [IfaceExport] } -data ModGuts = ModGuts { mg_fam_inst_env :: FamInstEnv, - mg_module :: Module } - -data FamInstEnv = FamInstEnv_ - -data SimplMode -- See comments in SimplMonad - = SimplMode - { sm_names :: [String] -- Name(s) of the phase - , sm_phase :: CompilerPhase - , sm_dflags :: DynFlags -- Just for convenient non-monadic - -- access; we don't override these - , sm_rules :: Bool -- Whether RULES are enabled - , sm_inline :: Bool -- Whether inlining is enabled - , sm_case_case :: Bool -- Whether case-of-case is enabled - , sm_eta_expand :: Bool -- Whether eta-expansion is enabled - } deriving Outputable - -data CompilerPhase - = Phase PhaseNum - | InitialPhase -- The first phase -- number = infinity! - -type PhaseNum = Int - -data CoreToDo -- These are diff core-to-core passes, - -- which may be invoked in any order, - -- as many times as you like. - - = CoreDoSimplify -- The core-to-core simplifier. - Int -- Max iterations - SimplMode - | CoreDoPluginPass String CorePluginPass - | CoreDoFloatInwards - | CoreDoFloatOutwards FloatOutSwitches - | CoreLiberateCase - | CoreDoPrintCore - | CoreDoStaticArgs - | CoreDoCallArity - | CoreDoExitify - | CoreDoStrictness - | CoreDoWorkerWrapper - | CoreDoSpecialising - | CoreDoSpecConstr - | CoreCSE - | CoreDoRuleCheck CompilerPhase String -- Check for non-application of rules - -- matching this string - | CoreDoNothing -- Useful when building up - | CoreDoPasses [CoreToDo] -- lists of these things - - | CoreDesugar -- Right after desugaring, no simple optimisation yet! - | CoreDesugarOpt -- CoreDesugarXXX: Not strictly a core-to-core pass, but produces - -- Core output, and hence useful to pass to endPass - - | CoreTidy - | CorePrep - | CoreOccurAnal - -data GlobalRdrElt - = GRE { gre_name :: Name - , gre_par :: Parent - , gre_lcl :: Bool -- ^ True <=> the thing was defined locally - , gre_imp :: [ImportSpec] -- ^ In scope through these imports - } deriving (Data, Eq) - -data Parent = Parent_ deriving (Eq, Data) - -data FloatOutSwitches = FloatOutSwitches_ - -type CorePluginPass = ModGuts -> CoreM ModGuts - -type IfaceExport = AvailInfo -data AvailInfo = AvailInfo_ -data GlobalRdrEnv = GlobalRdrEnv_ - -data UniqSet a = UniqSet_ -instance Semigroup (UniqSet a) where _ <> _ = UniqSet_ -instance Monoid (UniqSet a) where mempty = UniqSet_ - -data StubM a = StubM_ -instance Functor StubM where fmap _ _ = StubM_ -instance Applicative StubM where pure _ = StubM_ -instance Monad StubM - -newtype Hsc a = Hsc_ (StubM a) deriving (Functor, Applicative, Monad) -newtype CoreM a = CoreM_ (StubM a) deriving (Functor, Applicative, Monad) -instance MonadIO CoreM where - liftIO = undefined --- type CoreM a = IO a -newtype TcM a = TcM_ (StubM a) deriving (Functor, Applicative, Monad) -type TcRn a = TcM a -newtype IfM ab a = IfM_ (StubM a) deriving (Functor, Applicative, Monad) -newtype Ghc a = Ghc_ (StubM a) deriving (Functor, Applicative, Monad) - -data ModLocation = ModLocation_ -data ModuleOrigin = ModuleOrigin_ -data UnusablePackageReason = UnusablePackageReason_ -data ModuleSuggestion = ModuleSuggestion_ - -data FindResult - = Found ModLocation Module - -- ^ The module was found - | NoPackage UnitId - -- ^ The requested package was not found - | FoundMultiple [(Module, ModuleOrigin)] - -- ^ _Error_: both in multiple packages - - -- | Not found - | NotFound - { fr_paths :: [FilePath] -- Places where I looked - - , fr_pkg :: Maybe UnitId -- Just p => module is in this package's - -- manifest, but couldn't find - -- the .hi file - - , fr_mods_hidden :: [UnitId] -- Module is in these packages, - -- but the *module* is hidden - - , fr_pkgs_hidden :: [UnitId] -- Module is in these packages, - -- but the *package* is hidden - - -- Modules are in these packages, but it is unusable - , fr_unusables :: [(UnitId, UnusablePackageReason)] - - , fr_suggestions :: [ModuleSuggestion] -- Possible mis-spelled modules - } - -class Outputable a where - ppr :: a -> SDoc - pprPrec :: Rational -> a -> SDoc - ppr = pprPrec 0 - pprPrec _ _ = SDoc_ - -occName :: Name -> OccName -occName _ = OccName_ - -occNameString :: OccName -> String -occNameString _ = "OccName" - -moduleName :: Module -> ModuleName -moduleName _ = ModuleName_ - -nameModule_maybe :: Name -> Maybe Module -nameModule_maybe _ = Just Module_ - -moduleUnitId :: Module -> UnitId -moduleUnitId _ = UnitId_ - -stableModuleNameCmp :: ModuleName -> ModuleName -> Ordering -stableModuleNameCmp _ _ = EQ - -stableUnitIdCmp :: UnitId -> UnitId -> Ordering -stableUnitIdCmp _ _ = EQ - -fingerprintString :: String -> Fingerprint -fingerprintString _ = Fingerprint_ - -fingerprintFingerprints :: [Fingerprint] -> Fingerprint -fingerprintFingerprints _ = Fingerprint_ - -(<+>) :: SDoc -> SDoc -> SDoc -(<+>) _ _ = SDoc_ - -text :: String -> SDoc -text _ = SDoc_ - -instance IsString SDoc where fromString = text - -mi_module :: ModIface -> Module -mi_module _ = Module_ - -showSDocForUser :: DynFlags -> PrintUnqualified -> SDoc -> String -showSDocForUser _ _ _ = "" - -alwaysQualify :: PrintUnqualified -alwaysQualify = PrintUnqualified_ - -tyConsOfType :: Type -> UniqSet TyCon -tyConsOfType _ = UniqSet_ - -mkCoercionTy :: Coercion -> Type -mkCoercionTy _ = Type_ - -varType :: Var -> Type -varType _ = Type_ - -isLiftedTypeKind :: Kind -> Bool -isLiftedTypeKind _ = True - -classifiesTypeWithValues :: Kind -> Bool -classifiesTypeWithValues _ = True - -isRuntimeRepTy :: Type -> Bool -isRuntimeRepTy _ = True - -isRuntimeRepKindedTy :: Type -> Bool -isRuntimeRepKindedTy _ = True - -splitFunTy_maybe :: Type -> Maybe (Type, Type) -splitFunTy_maybe _ = Nothing - -unitTy :: Type -unitTy = Type_ - -unitDataConId, voidPrimId, voidArgId, rUNTIME_ERROR_ID :: Id -unitDataConId = Var_ -voidPrimId = Var_ -voidArgId = Var_ -rUNTIME_ERROR_ID = Var_ - -getOccString :: a -> String -getOccString _ = "" - -getName :: a -> Name -getName _ = Name_ - -tyVarKind :: a -> Kind -tyVarKind _ = Type_ - -tyConKind :: a -> Kind -tyConKind _ = Type_ - -tyThingId :: a -> Id -tyThingId _ = Var_ - -tyThingTyCon :: a -> TyCon -tyThingTyCon _ = TyCon_ - -boolTy, stringTy, charTy :: Type -boolTy = Type_ -stringTy = Type_ -charTy = Type_ - -getOccName :: a -> OccName -getOccName _ = OccName_ - -trueDataCon, falseDataCon, unitDataCon, charDataCon :: DataCon -trueDataCon = DataCon_ -falseDataCon = DataCon_ -unitDataCon = DataCon_ -charDataCon = DataCon_ - -boolTyCon, listTyCon, intTyCon, intPrimTyCon, addrPrimTyCon, voidPrimTyCon, unitTyCon :: TyCon -boolTyCon = TyCon_ -listTyCon = TyCon_ -intTyCon = TyCon_ -intPrimTyCon = TyCon_ -addrPrimTyCon = TyCon_ -voidPrimTyCon = TyCon_ -unitTyCon = TyCon_ - -nonDetEltsUniqSet :: UniqSet a -> [a] -nonDetEltsUniqSet _ = [] - -normaliseType :: a -> b -> c -> (Coercion, Type) -normaliseType _ _ _ = (Coercion_, Type_) - -getTyVar_maybe :: a -> Maybe TyVar -getTyVar_maybe _ = Nothing - -splitTyConApp_maybe :: Type -> Maybe (TyCon, [Type]) -splitTyConApp_maybe _ = Nothing - -splitAppTy_maybe :: Type -> Maybe (Type, Type) -splitAppTy_maybe _ = Nothing - -splitForAllTy_maybe :: Type -> Maybe (TyVar, Type) -splitForAllTy_maybe _ = Nothing - -splitCastTy_maybe :: Type -> Maybe (Type, Coercion) -splitCastTy_maybe _ = Nothing - -splitPiTy_maybe :: Type -> Maybe (TyCoBinder, Type) -splitPiTy_maybe _ = Nothing - -unwrapNewTyCon_maybe :: TyCon -> Maybe ([TyVar], Type, CoAxiom Unbranched) -unwrapNewTyCon_maybe _ = Nothing - -tyConTyVars :: TyCon -> [TyVar] -tyConTyVars _ = [] - -unionManyUniqSets :: [UniqSet a] -> UniqSet a -unionManyUniqSets _ = UniqSet_ - -dataConTyCon :: DataCon -> TyCon -dataConTyCon _ = TyCon_ - -dataConOrigArgTys :: DataCon -> [Type] -dataConOrigArgTys _ = [] - -dataConInstOrigArgTys :: DataCon -> [Type] -> [Type] -dataConInstOrigArgTys _ _ = [] - -dataConOrigResTy :: DataCon -> Type -dataConOrigResTy _ = Type_ - -isAlgTyCon, isTupleTyCon, isFamilyTyCon :: TyCon -> Bool -isAlgTyCon _ = True -isTupleTyCon _ = False -isFamilyTyCon _ = False - -isStrLitTy :: Type -> Maybe FastString -isStrLitTy _ = Nothing - -infixl 5 $+$ -($+$) :: a -> b -> b -_ $+$ x = x - -algTyConRhs :: TyCon -> AlgTyConRhs -algTyConRhs _ = AbstractTyCon - -mkCharExpr :: Char -> CoreExpr -mkCharExpr c = Lit (LitChar c) - -isDefaultAlt :: a -> Bool -isDefaultAlt _ = False - -mkListExpr :: Type -> [CoreExpr] -> CoreExpr -mkListExpr _ _ = Lit LitNullAddr - -findAlt :: AltCon -> [(AltCon, a, b)] -> Maybe (AltCon, a, b) -findAlt _ _ = Nothing - -errorIds :: [Id] -errorIds = [] - -fvVarList :: FV -> [Var] -fvVarList _ = [] - -isTyVar :: a -> Bool -isTyVar _ = False - -unpackCStringName, unpackCStringFoldrName, buildName :: Name -unpackCStringName = Name_ -unpackCStringFoldrName = Name_ -buildName = Name_ - -idDetails :: Id -> IdDetails -idDetails _ = PrimOpId IntEqOp - -realIdUnfolding :: Id -> Unfolding -realIdUnfolding _ = Unfolding_ - -mkDictSelRhs :: Class -> Int -> CoreExpr -mkDictSelRhs _ _ = Lit LitNullAddr - -classAllSelIds :: Class -> [Id] -classAllSelIds _ = [] - -expr_fvs :: CoreExpr -> FV -expr_fvs _ = FV_ - -maybeUnfoldingTemplate :: Unfolding -> Maybe CoreExpr -maybeUnfoldingTemplate _ = Nothing - -mkImpossibleExpr :: Type -> CoreExpr -mkImpossibleExpr _ = Lit LitNullAddr - -getDynFlags :: Monad m => m DynFlags -getDynFlags = return DynFlags_ - -mkFastString :: String -> FastString -mkFastString _ = "" - -moduleNameString :: ModuleName -> String -moduleNameString _ = "" - -findExposedPackageModule :: HscEnv -> ModuleName -> Maybe FastString -> IO FindResult -findExposedPackageModule _ _ _ = return (Found ModLocation_ Module_) - -mkModule :: UnitId -> ModuleName -> Module -mkModule _ _ = Module_ - -initTcInteractive :: HscEnv -> TcM a -> IO (Messages, Maybe a) -initTcInteractive _ _ = pure (Messages_, Nothing) - -initIfaceTcRn :: a -> TcRn b -initIfaceTcRn _ = TcM_ StubM_ - -mkTyConApp :: TyCon -> [Type] -> Type -mkTyConApp _ _ = Type_ - -lookupId :: Monad m => Name -> m Id -lookupId _ = return unitDataConId - -lookupTyCon :: Monad m => Name -> m TyCon -lookupTyCon _ = return TyCon_ - -mkRuntimeErrorApp :: Id -> Type -> String -> CoreExpr -mkRuntimeErrorApp _ _ _ = Lit LitNullAddr - -idName :: Id -> Name -idName _ = Name_ - -showPpr :: DynFlags -> a -> String -showPpr _ _ = "" - -lookupThing :: Monad m => Name -> m TyThing -lookupThing _ = return TyThing_ - -mkTyConTy :: TyCon -> Type -mkTyConTy _ = Type_ - -mkCoreApps :: CoreExpr -> [CoreExpr] -> CoreExpr -mkCoreApps _ _ = Lit LitNullAddr - -mkIntExpr :: DynFlags -> Integer -> CoreExpr -mkIntExpr _ _ = Lit LitNullAddr - -mkModuleName :: String -> ModuleName -mkModuleName _ = ModuleName_ - -noSrcSpan :: SrcSpan -noSrcSpan = SrcSpan_ - -throwGhcExceptionIO :: GhcException -> IO a -throwGhcExceptionIO = Exception.throwIO - -showSDoc :: DynFlags -> SDoc -> String -showSDoc _ _ = "" - -cannotFindModule :: DynFlags -> ModuleName -> FindResult -> SDoc -cannotFindModule _ _ _ = SDoc_ - -hsep :: [SDoc] -> SDoc -hsep _ = SDoc_ - -panic :: String -> a -panic = error - -lookupGRE_RdrName :: RdrName -> GlobalRdrEnv -> [GlobalRdrElt] -lookupGRE_RdrName _ _ = [] - -gresFromAvails :: Maybe ImportSpec -> [AvailInfo] -> [GlobalRdrElt] -gresFromAvails _ _ = [] - -mkGlobalRdrEnv :: [GlobalRdrElt] -> GlobalRdrEnv -mkGlobalRdrEnv _ = GlobalRdrEnv_ - -loadPluginInterface :: SDoc -> Module -> IfM lcl ModIface -loadPluginInterface _ _ = return (ModIface { mi_exports = [] }) - -getHscEnv :: Monad m => m HscEnv -getHscEnv = return (HscEnv { hsc_dflags = DynFlags_ }) - -type PackageFamInstEnv = FamInstEnv - -getPackageFamInstEnv :: CoreM PackageFamInstEnv -getPackageFamInstEnv = return FamInstEnv_ - -mkUnqual :: NameSpace -> FastString -> RdrName -mkUnqual _ _ = RdrName_ - -bindsOnlyPass :: (CoreProgram -> CoreM CoreProgram) -> ModGuts -> CoreM ModGuts -bindsOnlyPass _ mg = return mg - -varName, dataName, tcClsName :: NameSpace -varName = NameSpace_ -dataName = NameSpace_ -tcClsName = NameSpace_ - -tyConAppTyCon_maybe :: Type -> Maybe TyCon -tyConAppTyCon_maybe _ = Nothing - - -nameOccName :: Name -> OccName -nameOccName _ = undefined - -charTyConName :: Name -charTyConName = undefined - -noinlineIdName :: Name -noinlineIdName = undefined - -nilDataCon :: DataCon -nilDataCon = undefined - -dataConWorkId :: DataCon -> Id -dataConWorkId = undefined - -thNameToGhcName :: TH.Name -> CoreM (Maybe Name) -thNameToGhcName _ = undefined - -showSDocUnsafe :: SDoc -> String -showSDocUnsafe _ = undefined - -dropRuntimeRepArgs :: [Type] -> [Type] -dropRuntimeRepArgs _ = [] diff --git a/stubs/plutus-ghc-stub/src/TcRnMonad.hs b/stubs/plutus-ghc-stub/src/TcRnMonad.hs deleted file mode 100644 index 3a1aad47b25..00000000000 --- a/stubs/plutus-ghc-stub/src/TcRnMonad.hs +++ /dev/null @@ -1 +0,0 @@ -module TcRnMonad where diff --git a/stubs/plutus-ghc-stub/src/TcRnTypes.hs b/stubs/plutus-ghc-stub/src/TcRnTypes.hs deleted file mode 100644 index 7637bbd39b8..00000000000 --- a/stubs/plutus-ghc-stub/src/TcRnTypes.hs +++ /dev/null @@ -1,3 +0,0 @@ -module TcRnTypes (TcPlugin) where - -data TcPlugin = TcPlugin diff --git a/stubs/plutus-ghc-stub/src/TysPrim.hs b/stubs/plutus-ghc-stub/src/TysPrim.hs deleted file mode 100644 index f825d7ba209..00000000000 --- a/stubs/plutus-ghc-stub/src/TysPrim.hs +++ /dev/null @@ -1 +0,0 @@ -module TysPrim where From f81ebcb3cfbf23a0688adee0d8cbc3f7e4cc3aee Mon Sep 17 00:00:00 2001 From: Ziyang Liu Date: Wed, 25 Sep 2024 10:27:29 -0700 Subject: [PATCH 05/13] Remove the Plutus Platform page (#6506) --- .../essential-concepts/plutus-platform.mdx | 90 ------------------- 1 file changed, 90 deletions(-) delete mode 100644 doc/docusaurus/docs/essential-concepts/plutus-platform.mdx diff --git a/doc/docusaurus/docs/essential-concepts/plutus-platform.mdx b/doc/docusaurus/docs/essential-concepts/plutus-platform.mdx deleted file mode 100644 index 0ecd810aac0..00000000000 --- a/doc/docusaurus/docs/essential-concepts/plutus-platform.mdx +++ /dev/null @@ -1,90 +0,0 @@ ---- -sidebar_position: 15 ---- - -# Plutus platform - -The Plutus platform is a platform for writing *applications* that interact with a *distributed ledger* featuring *scripting* capabilities, in particular the [Cardano](../glossary.md#cardano) blockchain. - -## Example application - -What sort of "applications" are we talking about here? -As an example, let's think about an application that provides the function of helping a pair of users, Alice and Bob, who want to engage in an atomic swap of some assets stored on Cardano. - -### Alice initiates the swap - -```mermaid -graph TD; - A[Alice] -->|requests swap| App[Application]; - App -->|requests token lock| L[Ledger]; - L -->|confirms lock| App; - - classDef default fill:#33B6FF,stroke:#333,stroke-width:2px; -``` - -- **Alice:** tells the Application, "I want to do an escrowed swap with Bob, 50 Ada for my Special Token." -- **Application:** tells the Ledger, "I want to lock up Alice's Special Token so that it can only be unlocked if Bob completes the swap." -- **Ledger:** responds to the Application, "Ok, that change has settled." - -### Application interacts with Bob, Cardano and the ledger to execute the swap - -```mermaid -graph TD; - App[Application] -->|notifies Bob| B[Bob]; - B -->|agrees to swap| App; - App -->|executes swap on| C((Cardano)); - C -->|transaction processed| L[Ledger]; - L -->|checks conditions| D{Decision}; - D -- Yes --> L1[Ledger]; - L1 -->|confirms transaction| App; - - classDef default fill:#33B6FF,stroke:#333,stroke-width:2px; - class C database; - - style C fill:#33B6FF,stroke:#333,stroke-width:2px; -``` - - -- **Application:** tells Bob, "Hey, Alice wants to do a swap with you." -- **Bob:** tells the Application, "I want to take up Alice's swap." -- **Application:** communicates to Cardano, "I want to spend that locked output with Alice's Special Token while sending 50 of Bob's Ada to Alice." -- **Ledger:** checks with itself: "Does this transaction satisfy the conditions that were asked for? Yes it does!" -- **Ledger:** tells the Application, "Ok, that change has settled." - -### Application communicates that the swap completed - -```mermaid -graph TD; - App[Application] -->|notifies Alice: swap completed| A[Alice]; - App -->|notifies Bob: swap completed| B[Bob]; - - classDef default fill:#33B6FF,stroke:#333,stroke-width:2px; -``` - -- **Application:** tells Alice, "The swap is completed!" -- **Application:** tells Bob, "The swap is completed!" - -Alice and Bob don't interact directly, nor do they directly interact with the ledger. -Very few "smart" blockchain systems encourage their users to interact directly with the chain themselves, since this is usually complex and error-prone. -Rather, the users interact with some *application* that presents the world in a form that they can understand and interact with. - -Of course, such an application must want to do something with the ledger, otherwise you wouldn't need anything new. -Simple applications might do nothing more than submit basic transactions that transfer assets—imagine a simple "regular payments" application. -However, our main focus is on applications that *do* use smart features in order to have a kernel of trusted code that is validated as part of the ledger. - -This enables applications that are not possible otherwise. -Alice and Bob need trusted logic in order to perform their swap: a "dumb" application could submit the transactions transferring the assets, but would have no recourse against Bob defecting. -Using the smart features of the ledger ensures that Bob can't take Alice's token unless he *really does* send her the money, and it does this without involving a trusted third party. - -Creating and using the trusted kernel of code is the most technically difficult and security-sensitive part of the whole operation. -Nonetheless, writing the rest of the application contains plenty of complexity. -Amongst other things, an application needs to deal with the software around the ledger (wallets, nodes, etc.); distributed systems issues such as settlement delays, inconsistent state between parties, and rollbacks; and simple user-experience issues like upgrades, state management and synchronization. -Furthermore, while none of these are quite as security-critical as the trusted kernel, users certainly *can* be attacked through such applications, and even non-malicious bugs are likely to be quite upsetting when a user's money is at stake. - -Even simple applications must deal with this complexity, and for more advanced applications that deal with state across time, the difficulty is magnified. - -## Additional resources - -- Michael Peyton-Jones and Jann Mueller introduce the Plutus platform in [this session](https://youtu.be/usMPt8KpBeI?si=4zkS3J7Bq8aFxWbU) from the Cardano 2020 event. - -- The design of the platform is discussed in the [Plutus technical report](https://plutus.cardano.intersectmbo.org/resources/plutus-report.pdf). From fccd5cde68880c751565dce470d397acc303b123 Mon Sep 17 00:00:00 2001 From: Ziyang Liu Date: Wed, 25 Sep 2024 11:21:24 -0700 Subject: [PATCH 06/13] Make the auction example end-to-end (#6477) --- .../auction-smart-contract/_category_.json | 8 + .../end-to-end/_category_.json | 8 + .../end-to-end/closing-the-auction.md | 15 + .../end-to-end/generating-keys.md | 45 +++ .../end-to-end/getting-funds.md | 29 ++ .../auction-smart-contract/end-to-end/mint.md | 91 ++++++ .../end-to-end/placing-bids.md | 58 ++++ .../life-cycle.md | 43 ++- .../auction-smart-contract/on-chain-code.md | 157 ++++++++++ .../plutus-core-and-plutus-tx.md | 4 +- .../docs/essential-concepts/versions.md | 2 +- doc/docusaurus/docs/glossary.md | 2 +- .../docs/simple-example/_category_.json | 8 - .../alternatives-to-plutus-tx.md | 18 -- .../docs/simple-example/auction-properties.md | 15 - .../docs/simple-example/eutxo-model.md | 46 --- .../docs/simple-example/further-reading.md | 11 - .../docs/simple-example/libraries.md | 11 - .../docs/simple-example/off-chain-code.md | 17 -- .../docs/simple-example/plutus-tx-code.md | 139 --------- .../docs/simple-example/simple-example.md | 36 --- .../optimizing-scripts-with-asData.md | 48 +-- .../static/code/AuctionMintingPolicy.hs | 69 +++++ .../static/code/AuctionValidator.hs | 289 +++++++++++------- doc/docusaurus/static/code/bid.mjs | 137 +++++++++ doc/docusaurus/static/code/generate-keys.mjs | 27 ++ .../static/code/mint-token-for-auction.mjs | 86 ++++++ doc/docusaurus/static/code/send-lovelace.mjs | 29 ++ 28 files changed, 980 insertions(+), 468 deletions(-) create mode 100644 doc/docusaurus/docs/auction-smart-contract/_category_.json create mode 100644 doc/docusaurus/docs/auction-smart-contract/end-to-end/_category_.json create mode 100644 doc/docusaurus/docs/auction-smart-contract/end-to-end/closing-the-auction.md create mode 100644 doc/docusaurus/docs/auction-smart-contract/end-to-end/generating-keys.md create mode 100644 doc/docusaurus/docs/auction-smart-contract/end-to-end/getting-funds.md create mode 100644 doc/docusaurus/docs/auction-smart-contract/end-to-end/mint.md create mode 100644 doc/docusaurus/docs/auction-smart-contract/end-to-end/placing-bids.md rename doc/docusaurus/docs/{simple-example => auction-smart-contract}/life-cycle.md (85%) create mode 100644 doc/docusaurus/docs/auction-smart-contract/on-chain-code.md delete mode 100644 doc/docusaurus/docs/simple-example/_category_.json delete mode 100644 doc/docusaurus/docs/simple-example/alternatives-to-plutus-tx.md delete mode 100644 doc/docusaurus/docs/simple-example/auction-properties.md delete mode 100644 doc/docusaurus/docs/simple-example/eutxo-model.md delete mode 100644 doc/docusaurus/docs/simple-example/further-reading.md delete mode 100644 doc/docusaurus/docs/simple-example/libraries.md delete mode 100644 doc/docusaurus/docs/simple-example/off-chain-code.md delete mode 100644 doc/docusaurus/docs/simple-example/plutus-tx-code.md delete mode 100644 doc/docusaurus/docs/simple-example/simple-example.md create mode 100644 doc/docusaurus/static/code/AuctionMintingPolicy.hs create mode 100644 doc/docusaurus/static/code/bid.mjs create mode 100644 doc/docusaurus/static/code/generate-keys.mjs create mode 100644 doc/docusaurus/static/code/mint-token-for-auction.mjs create mode 100644 doc/docusaurus/static/code/send-lovelace.mjs diff --git a/doc/docusaurus/docs/auction-smart-contract/_category_.json b/doc/docusaurus/docs/auction-smart-contract/_category_.json new file mode 100644 index 00000000000..311002d7b81 --- /dev/null +++ b/doc/docusaurus/docs/auction-smart-contract/_category_.json @@ -0,0 +1,8 @@ +{ + "label": "Example: An Auction Smart Contract", + "position": 15, + "link": { + "type": "generated-index", + "description": "In this example we first present the Plutus Tx code for writing the on-chain validator script of a smart contract that controls the auction of an asset, which can be executed on the Cardano blockchain. We will then walk you through the steps to run it end-to-end on Cardano's Preview testnet." + } + } diff --git a/doc/docusaurus/docs/auction-smart-contract/end-to-end/_category_.json b/doc/docusaurus/docs/auction-smart-contract/end-to-end/_category_.json new file mode 100644 index 00000000000..14cb6e5d0df --- /dev/null +++ b/doc/docusaurus/docs/auction-smart-contract/end-to-end/_category_.json @@ -0,0 +1,8 @@ +{ + "label": "End to end", + "position": 10, + "link": { + "type": "generated-index", + "description": "We will now demonstrate the process of running the auction example end-to-end on Cardano's Preview testnet." + } +} diff --git a/doc/docusaurus/docs/auction-smart-contract/end-to-end/closing-the-auction.md b/doc/docusaurus/docs/auction-smart-contract/end-to-end/closing-the-auction.md new file mode 100644 index 00000000000..e79484062f8 --- /dev/null +++ b/doc/docusaurus/docs/auction-smart-contract/end-to-end/closing-the-auction.md @@ -0,0 +1,15 @@ +--- +sidebar_position: 25 +--- + +# Closing the Auction + +Once the auction's end time has elapsed, a transaction can be submitted to finalize the auction, distributing the token and the highest bid accordingly. +This transaction needs to do the following: + +- Spend the UTxO that contains the token being auctioned. +- If no bids were placed (which can be determined by examining the datum attached to the UTxO), the token should be returned to the seller's address. +- If at least one bid was placed, the token should be transferred to the highest bidder's address, and the highest bid amount should be sent to the seller's address. +- Set a validity interval that starts no earlier than the auction's end time. + +The off-chain code for building and submitting this transaction will be very similar to the code for the bidding transactions, so the details are left as an exercise. diff --git a/doc/docusaurus/docs/auction-smart-contract/end-to-end/generating-keys.md b/doc/docusaurus/docs/auction-smart-contract/end-to-end/generating-keys.md new file mode 100644 index 00000000000..3d38257596d --- /dev/null +++ b/doc/docusaurus/docs/auction-smart-contract/end-to-end/generating-keys.md @@ -0,0 +1,45 @@ +--- +sidebar_position: 5 +--- + +# Generating Keys and Addresses + +To start, clone the plutus-tx-template repository into the `on-chain` directory. +Make sure to have [NodeJS](https://nodejs.org/en) and [yarn](https://yarnpkg.com/) (or [npm](https://github.com/npm/cli), which comes bundled with NodeJS) installed. Then, create a separate `off-chain` directory, set up `package.json`, and add the required dependencies: + +``` +git clone git@github.com:IntersectMBO/plutus-tx-template.git on-chain +mkdir off-chain && cd $_ +yarn init -y +yarn add @meshsdk/core +yarn add cbor +``` + +We recommend using the Nix shell that comes with `plutus-tx-template` to run this example. +The Nix shell provides the correct versions of all dependencies, including GHC, Cabal, Node.js, and various C libraries. +To enter the nix shell, run + +``` +nix develop on-chain/ +``` + +The first run of `nix develop` may take some time so please be patient. + +We'll use [mesh](https://meshjs.dev/), a JavaScript framework, for writing off-chain code. +We'll use [Blockfrost](https://blockfrost.io/) as the blockchain provider, to avoid the need of running a local node. +If you don't have a Blockfrost account, you can sign up for one, and create a project for the Preview network. + +The first step is to generate keys and addresses for the seller and the bidders. +Add a new file named `off-chain/generate-keys.mjs`, with the following content: + + + +Then, generate keys and addresses for one seller and two bidders by running: + +``` +node generate-keys.mjs seller +node generate-keys.mjs bidder1 +node generate-keys.mjs bidder2 +``` + +This will create three files for each participant (seller, bidder1, and bidder2): a `.skey` file that contains a secret key, a `.addr` file that contains the corresponding wallet address, and a `.pkh` file that contains the corresponding public key hash. diff --git a/doc/docusaurus/docs/auction-smart-contract/end-to-end/getting-funds.md b/doc/docusaurus/docs/auction-smart-contract/end-to-end/getting-funds.md new file mode 100644 index 00000000000..e6e3fb49239 --- /dev/null +++ b/doc/docusaurus/docs/auction-smart-contract/end-to-end/getting-funds.md @@ -0,0 +1,29 @@ +--- +sidebar_position: 10 +--- + +# Getting Funds from the Faucet + +Next, we'll need to fund the wallet of each participant (seller, bidder1 and bidder2), in order to cover transaction fees and place bids. +We can get funds from Cardano's [testnet faucet](https://docs.cardano.org/cardano-testnets/tools/faucet/). + +To request funds, enter the seller's address into the address field and click "request funds." +This will deposit 10,000 (test) ADA into the seller's wallet. +Make sure you select the correct network (Preview). + +Since the faucet limits how frequently you can request funds, and 10,000 ADA is more than sufficient for this example, we'll share the 10,000 ADA among the seller, bidder1, and bidder2. +To do so, create a file named `off-chain/send-lovelace.mjs` with the following content: + + + +Substitute your Blockfrost project ID for `Replace with Blockfrost Project ID`. + +This Javascript module builds and submits a transaction that sends 1 billion Lovelace (equivalent to 1000 Ada) from the seller's wallet to the specified recipient. +Run the following commands: + +``` +node send-lovelace.mjs bidder1 +node send-lovelace.mjs bidder2 +``` + +After the transactions are confirmed and included in a block (usually within a minute), bidder1's and bidder2's wallets should each have 1000 Ada, and the seller's wallet should have approximately 8000 Ada (minus transaction fees), which you can verify on [Cardanoscan](https://preview.cardanoscan.io/). diff --git a/doc/docusaurus/docs/auction-smart-contract/end-to-end/mint.md b/doc/docusaurus/docs/auction-smart-contract/end-to-end/mint.md new file mode 100644 index 00000000000..ffc1bb204e9 --- /dev/null +++ b/doc/docusaurus/docs/auction-smart-contract/end-to-end/mint.md @@ -0,0 +1,91 @@ +--- +sidebar_position: 15 +--- + +# Minting the Token to be Auctioned + +Before we can start the auction, we need to mint a token to be auctioned. +To do so, we first must determine the token's currency symbol and name. +To mint or burn tokens with a specific currency symbol (`currencySymbol`), a Plutus script whose hash matches `currencySymbol` must be provided, and is used to validate the minting or burning action. +Therefore, we'll first write the on-chain script, then compute its hash and use it as the currency symbol. + +## On-chain Minting Policy Script + +The full minting policy code can be found at [AuctionMintingPolicy.hs](https://github.com/IntersectMBO/plutus-tx-template/blob/main/src/AuctionMintingPolicy.hs). +The main logic is in the following function: + + + +This script will pass if the following two conditions are met: + +1. The transaction is signed by a specific public key. +2. The transaction mints exactly one token, whose currency symbol matches the script's hash (i.e., `ownCurrencySymbol ctx`). + The token name can be anything. + +> :pushpin: **NOTE** +> +> A token minted in this way is _not_ considered a non-fungible token (NFT) because, while only one token can be minted in a single transaction, multiple transactions can mint additional tokens with the same currency symbol and token name. +> To create a truly unique token, you would need a more complex minting policy, but for simplicity, that is not covered here. + +## Compile and Generate Blueprint for the Minting Policy + +Next, we need to compile the minting policy script and create its blueprint. +To do so, we first need to supply a public key hash, which the minting policy will use for checking condition 1 above. +Assuming the seller is the one minting the token, this should be the seller's public key hash. +Open `GenMintingPolicyBlueprint.hs` in the `on-chain` directory, and replace `error "Replace with seller pkh"` with the content of `off-chain/seller.pkh`. + +The minting policy code comes with `plutus-tx-template`, so you can find it in the `on-chain` repository. +To compile it and generate the blueprint, navigate to the `on-chain` directory and run + +``` +cabal run gen-minting-policy-blueprint -- ../off-chain/plutus-auction-minting-policy.json +``` + +You may need to run `cabal update` before executing this command for the first time. + +This should produce a blueprint file named `off-chain/plutus-auction-minting-policy.json`. + +## Compile and Generate Blueprint for the Auction Validator + +One final step before minting the token: since we want to lock the minted token at the script address corresponding to the auction validator, +we must supply the parameters (i.e., `AuctionParams`) to the auction validator, compile the auction validator, and calculate its script address. + +Open `GenAuctionValidatorBlueprint.hs` in the `on-chain` directory, and replace all placeholders: +- Replace `error "Replace with sellerh pkh"` with the content of `off-chain/seller.pkh`. +- Replace `error "Replace with currency symbol"` with the minting policy hash, which you can find in the `hash` field in `off-chain/plutus-auction-minting-policy.json`. +- Replace `error "Replace with the auction's end time"` with a POSIX timestamp for a time in the near future (say 24 hours from now). + Note that the POSIX timestamp in Plutus is the number of _milliseconds_, rather than seconds, elapsed since January 1, 1970. + In other words, add three zeros to the usual POSIX timestamp. + For instance, the POSIX timestamp of September 1, 2024, 21:44:51 UTC, is 1725227091000. + +Then, navigate to the `on-chain` directory and run + +``` +cabal run gen-auction-validator-blueprint -- ../off-chain/plutus-auction-validator.json +``` + +This will generate a blueprint file named `off-chain/plutus-auction-validator.json`, which the off-chain code can read and calculate the auction validator's script address. + + +## Off-chain Code for Minting + +We are now ready to write and execute the off-chain code for minting. +Create a file named `off-chain/mint-token-for-auction.mjs` with the following content: + + + +Substitute your Blockfrost project ID for `Replace with Blockfrost Project ID`. + +This Javascript module uses the mesh library to build a transaction that mints a token (`tx.mintAsset`). +The token will have the currency symbol of the minting policy's hash, and a token name of `TokenToBeAuctioned`. +It will be sent to `auctionValidatorAddress`, with a datum corresponding to `Nothing`. +The transaction is signed by the seller (`seller.skey`), and then submitted to the Preview testnet. + +Run the coding using: + +``` +node mint-token-for-auction.mjs +``` + +and you should see a message "Minted a token at address ..." printed in the console. +Within a minute, you should be able to find the transaction using the transaction hash on [Cardanoscan](https://preview.cardanoscan.io/) and review its details. diff --git a/doc/docusaurus/docs/auction-smart-contract/end-to-end/placing-bids.md b/doc/docusaurus/docs/auction-smart-contract/end-to-end/placing-bids.md new file mode 100644 index 00000000000..547134e9dce --- /dev/null +++ b/doc/docusaurus/docs/auction-smart-contract/end-to-end/placing-bids.md @@ -0,0 +1,58 @@ +--- +sidebar_position: 20 +--- + +# Placing Bids + +Now we can start bidding. +Let's place a bid of 100 Ada from bidder1, followed by a bid of 200 Ada from bidder2. +Each transaction that places a bid must do the following: + +- Spend the UTxO that contains the token being auctioned. + For bidder1, the transaction that produced the UTxO is the one that minted the token. + For bidder2, the transaction that produced the UTxO is bidder1's transaction. + The address of this UTxO is always the auction validator's script address, so each bidding transaction must include the auction validator and a redeemer[^1]. +- Place a bid (via the redeemer) with an amount at least as high as the auction's minimum bid, and higher than the previous highest bid (if any). + The existence and the details of a previous highest bid can be determined by inspecting the datum attached to the aforementioned UTxO. + This is enforced by the auction validator's `sufficientBid` condition. +- Lock the token being auctioned, together with the bid amount, in a new UTxO at the auction validator's script address. + The new UTxO should also include a datum containing the details of this bid. + This is enforced by the auction validator's `correctOutput` condition. +- Refund the previous highest bid (if any) to its bidder's wallet address. + This is enforced by the auction validator's `refundsPreviousHighestBid` condition. +- Set a validity interval that ends no later than the auction's end time. + This is enforced by the auction validator's `validBidTime` condition. + +To submit these bidding transactions, create a file named `off-chain/bid.mjs` for the off-chain code, with the following content: + + + +This Javascript module builds and submits a transaction that does exactly the above. + +The following substitutions are needed: + +- Substitute your Blockfrost project ID for `Replace with Blockfrost Project ID`. +- Substitute a slot number no later than the auction's end time for `Replace with transaction expiration time`. + For instance, if you set the auction's end time to be approximately 24 hours from now, you can use a slot number corresponding to approximately 12 hours from now. + To determine the slot nmber, go to [Cardanoscan](https://preview.cardanoscan.io/), click on a recent transaction, take its Absolute Slot, and add 12 hours (43200) to it. + +Place the first bid by running + +``` +node bid.mjs bidder1 100000000 +``` + +Replace `` with the hash of the transaction we previously submitted for minting the token. +This hash is used by the off-chain code to locate the UTxO that contains the token. + +After the first bidding transaction is confirmed, we can submit the second bid from bidder2, with a similar command: + +``` +node bid.mjs bidder2 200000000 +``` + +Replace `` with the hash of the previous transaction. + +--- + +[^1]: Instead of including the script in the transaction, we can use a reference script, but to keep things simple, we won't discuss that here. diff --git a/doc/docusaurus/docs/simple-example/life-cycle.md b/doc/docusaurus/docs/auction-smart-contract/life-cycle.md similarity index 85% rename from doc/docusaurus/docs/simple-example/life-cycle.md rename to doc/docusaurus/docs/auction-smart-contract/life-cycle.md index b398bc65136..d90f21ff887 100644 --- a/doc/docusaurus/docs/simple-example/life-cycle.md +++ b/doc/docusaurus/docs/auction-smart-contract/life-cycle.md @@ -1,30 +1,30 @@ --- -sidebar_position: 25 +sidebar_position: 15 --- # Life cycle of the auction smart contract -With the Plutus script written, Alice is now ready to start the auction smart contract. -At the outset, Alice creates a script UTXO whose address is the hash of the Plutus script, whose value is the token to be auctioned, and whose datum is `Nothing`. -Recall that the datum represents the highest bid, and there's no bid yet. +With the Plutus script written, Alice is now ready to start the auction smart contract. +At the outset, Alice creates a script UTXO whose address is the hash of the Plutus script, whose value is the token to be auctioned, and whose datum is `Nothing`. +Recall that the datum represents the highest bid, and there's no bid yet. This script UTXO also contains the script itself, so that nodes validating transactions that try to spend this script UTXO have access to the script. ## Initial UTXO -Alice needs to create the initial UTXO transaction with the desired UTXO as an output. -The token being auctioned can either be minted by this transaction, or if it already exists in another UTXO on the ledger, the transaction should consume that UTXO as an input. +Alice needs to create the initial UTXO transaction with the desired UTXO as an output. +The token being auctioned can either be minted by this transaction, or if it already exists in another UTXO on the ledger, the transaction should consume that UTXO as an input. We will not go into the details here of how minting tokens works. ## The first bid -Suppose Bob, the first bidder, wants to bid 100 Ada for Alice's NFT. +Suppose Bob, the first bidder, wants to bid 100 Ada for Alice's NFT. In order to do this, Bob creates a transaction that has at least two inputs and at least one output. -The required inputs are (1) the script UTXO Alice created; (2) Bob's bid of 100 Ada. -The 100 Ada can come in one or multiple UTXOs. +The required inputs are (1) the script UTXO Alice created; (2) Bob's bid of 100 Ada. +The 100 Ada can come in one or multiple UTXOs. Note that the input UTXOs must have a total value of more than 100 Ada, because in addition to the bid amount, they also need to cover the transaction fee. -The required output is a script UTXO with the same address as the initial UTXO (since the Plutus script itself remains the same), which is known as a *continuing output*. +The required output is a script UTXO with the same address as the initial UTXO (since the Plutus script itself remains the same), which is known as a *continuing output*. This continuing output UTXO should contain: - a datum that contains Bob's wallet address and Bob's bid amount (100 Ada). @@ -34,41 +34,40 @@ This continuing output UTXO should contain: If the input UTXOs contain more Ada than 100 plus the transaction fee, then there should be additional output UTXOs that return the extra Ada. Again, verifying that the input value of a transaction minus the transaction fee equals the output value (unless the transaction is burning tokens) is the responsibility of the ledger, not the Plutus script. -In order for Bob's transaction to be able to spend the initial script UTXO Alice created, Bob's transaction must also contain a redeemer. -As shown in the code above, there are two kinds of redeemers in our example: `NewBid Bid` and `Payout`. +In order for Bob's transaction to be able to spend the initial script UTXO Alice created, Bob's transaction must also contain a redeemer. +As shown in the code above, there are two kinds of redeemers in our example: `NewBid Bid` and `Payout`. The redeemer in Bob's transaction is a `NewBid Bid` where the `Bid` contains Bob's wallet address and bid amount. ![First bid diagram](../../static/img/first-bid-simple-auction-v3.png) -Once Bob's transaction is submitted, the node validating this transaction will run the Plutus script, which checks a number of conditions like whether the bid happens before the deadline, and whether the bid is high enough. -If the checks pass and everything else about the transaction is valid, the transaction will go through and be included in a block. +Once Bob's transaction is submitted, the node validating this transaction will run the Plutus script, which checks a number of conditions like whether the bid happens before the deadline, and whether the bid is high enough. +If the checks pass and everything else about the transaction is valid, the transaction will go through and be included in a block. At this point, the initial UTXO created by Alice no longer exists on the ledger, since it has been spent by Bob's transaction. ## The second bid -Next, suppose a second bidder, Charlie, wants to outbid Bob. +Next, suppose a second bidder, Charlie, wants to outbid Bob. Charlie wants to bid 200 Ada. -Charlie will create another transaction. -This transaction should have an additional output compared to Bob's transaction: a UTXO that returns Bob's bid of 100 Ada. +Charlie will create another transaction. +This transaction should have an additional output compared to Bob's transaction: a UTXO that returns Bob's bid of 100 Ada. Recall that this is one of the conditions checked by the Plutus script; the transaction is rejected if the refund output is missing. ![Second bid diagram](../../static/img/second-bid-simple-auction-v3.png) -Charlie's transaction needs to spend the script UTXO produced by Bob's transaction, so it also needs a redeemer. +Charlie's transaction needs to spend the script UTXO produced by Bob's transaction, so it also needs a redeemer. The redeemer is a `NewBid Bid` where `Bid` contains Charlie's wallet address and bid amount. Charlie's transaction cannot spend the initial UTXO produced by Alice, since it has already been spent by Bob's transaction. ## Closing the auction -Let's assume that there won't be another bid. +Let's assume that there won't be another bid. Once the deadline has passed, the auction can be closed. -In order to do that, somebody has to create another transaction. -That could be Alice, who wants to collect the bid, or it could be Charlie, who wants to collect the NFT. +In order to do that, somebody has to create another transaction. +That could be Alice, who wants to collect the bid, or it could be Charlie, who wants to collect the NFT. It can be anybody, but Alice and Charlie have an incentive to create it. This transaction has one required input: the script UTXO produced by Charlie's transaction, and two required outputs: (1) the payment of the auctioned token to Charlie; (2) the payment of 200 Ada to Alice. ![Closing transaction diagram](../../static/img/closing-tx-simple-auction-v3.png) - diff --git a/doc/docusaurus/docs/auction-smart-contract/on-chain-code.md b/doc/docusaurus/docs/auction-smart-contract/on-chain-code.md new file mode 100644 index 00000000000..469742f265e --- /dev/null +++ b/doc/docusaurus/docs/auction-smart-contract/on-chain-code.md @@ -0,0 +1,157 @@ +--- +sidebar_position: 5 +--- + +# On-chain Code: The Auction Validator + +:::caution +The code in this example is not a production-ready implementation, as it is not optimized for security or efficiency. +It is provided purely as an example for illustration and ecudational purposes. +Refer to resources like **[Cardano Plutus Script Vulnerability Guide](https://library.mlabs.city/common-plutus-security-vulnerabilities)** for best practices on developing secure smart contracts. +::: + +# Auction Properties + +In this example, a seller wants to auction some asset she owns, represented as a non-fungible token (NFT) on Cardano. +She would like to create and deploy an auction smart contract with the following properties: + +- there is a minimum bid amount +- each bid must be higher than the previous highest bid (if any) +- once a new bid is made, the previous highest bid (if exists) is immediately refunded +- there is a deadline for placing bids; once the deadline has passed, new bids are no longer accepted, the asset can be transferred to the highest bidder (or to the seller if there are no bids), and the highest bid (if exists) can be transferred to the seller. + +# Plutus Tx Code + +Plutus Tx is a subset of Haskell, used to write on-chain code, also known as validators or scripts. +A Plutus Tx program is compiled into Plutus Core, which is interpreted on-chain. +The full Plutus Tx code for the auction smart contract can be found at [AuctionValidator.hs](https://github.com/IntersectMBO/plutus-tx-template/blob/main/src/AuctionValidator.hs). + + + +## Data types + +First, let's define the following data types and instances for the validator: + + + +The purpose of `makeLift` and `makeIsDataSchemaIndexed` will be explained later. + +Writing a Plutus Tx validator script for a smart contract often involves the following data types: + +### 1. Contract parameters + +These are fixed properties of the contract. You can put here values that will never change during the contract's life cycle. +In our example, it is the `AuctionParams` type, containing properties like seller and minimum bid. + +### 2. Datum + +This is part of a script UTXO. +It's commonly used to hold the state of the contract and values that can change throughout the contract's life cycle. +Our example requires only one piece of state: the current highest bid. +We use the `AuctionDatum` type to represent this. + +### 3. Redeemer + +This is an input to the Plutus script provided by the transaction that is trying to spend a script UTXO. +If a smart contract is regarded as a state machine, the redeemer would be the input that ticks the state machine. +In our example, it is the `AuctionRedeemer` type: one may either submit a new bid, or request to close the auction and pay out the winner and the seller, both of which lead to a new state of the auction. + +### 4. Script context + +This type contains the information of the transaction that the validator can inspect. +In our example, our validator verifies several conditions of the transaction; e.g., if it is a new bid, then it must be submitted before the auction's end time; the previous highest bid must be refunded to the previous bidder, etc. + +Different [ledger language versions](../working-with-scripts/ledger-language-version.md) use different script context types. +In this example we are writing a Plutus V2 scripts, so we import the `ScriptContext` data type from `PlutusLedgerApi.V2.Contexts`. +It can be easiely adapted for Plutus V1 or V3. + +> :pushpin: **NOTE** +> +> When writing a Plutus validator using Plutus Tx, it is advisable to turn off Haskell's `Prelude`. +> Usage of most functions and methods in `Prelude` should be replaced by their counterparts in the `plutus-tx` library, e.g., instead of the `==` from `base`, use `PlutusTx.Eq.==`. + +## Main Validator Function + +Now we are ready to introduce our main validator function. +The beginning of the function looks like the following: + + + +Depending on whether this transaction is attempting to submit a new bid or to request payout, the validator validates the corresponding set of conditions. + +### Sufficient Bid Condition + +The `sufficientBid` condition verifies that the bid amount is sufficient: + + + +### Valid Bid Time Condition + +The `validBidTime` condition verifies that the bid is submitted before the auction's deadline: + + + +Here, `to x` is the time interval ending at `x`, i.e., `(-∞, x]`. +`txInfoValidRange` is a transaction property. +It is the time interval in which the transaction is allowed to go through phase-1 validation. +`contains` takes two time intervals, and checks that the first interval completely includes the second. +Since the transaction may be validated at any point in the `txInfoValidRange` interval, we need to check that the entire interval lies within `(-∞, apEndTime params]`. + +The reason a script receives the `txInfoValidRange` interval instead of the exact time the script is run is due to [determinism](https://iohk.io/en/blog/posts/2021/09/06/no-surprises-transaction-validation-on-cardano/). +Using the exact time would be like calling a `getCurrentTime` function and branching based on the current time. +On the other hand, by using the `txInfoValidRange` interval, the same interval is always used by the same transaction. +If the current time when the transaction is validated is outside of the interval, the transaction is rejected immediately without running the script. + +Also note the tilde (`~`) in `~validBidTime = ...`. +When writing Plutus Tx it is [advisable](../using-plutus-tx/compiling-plutus-tx.md) to turn on the `Strict` extension, which generally improves script performance. +Doing so makes all bindings strict, which means, in this particular case, without the `~`, `validBidTime` would be evaluated even if the redeemer matches the `Payout` case, which doesn't need this condition. +Doing so results in unnecessary work or even unexpected evaluation failures. +The `~` makes `validBidTime` non-strict, i.e., only evaluated when used. + +On the other hand, it is unnecessary to add `~` to `sufficientBid`, since it has a function type, and a function cannot be evaluated further without receiving enough arguments. + +### Refunds Previous Highest Bid Condition + +The `refundsPreviousHighestBid` condition checks that the transaction pays the previous highest bid to the previous bidder: + + + +It uses `PlutusTx.find` to find the transaction output (a UTXO) that pays to the previous bidder the amount equivalent to the previous highest bid, and verifies that there is at least one such output. + +### Correct Output Condition + +The `correctOutput` condition verifies that the transaction produces a *continuing output* (see below for definition) containing the correct datum and value. +It has two subconditions: + +- `correctOutputDatum`: the datum should contain the new highest bid +- `correctOutputValue`: the value should contain (1) the token being auctioned, and (2) the bid amount. + + + +A "continuing output" is a transaction output that pays to the same script address from which we are currently spending. +Exactly one continuing output must be present in this example so that the next bidder can place a new bid. +The new bid, in turn, will need to spend the continuing output and get validated by the same script. + +If the transaction is requesting a payout, the validator will then verify the other three conditions: `validPayoutTime`, `sellerGetsHighestBid` and `highestBidderGetsAsset`. +These conditions are similar to the ones already explained, so their details are omitted. + +### Compiling the validator + +Finally, we need to compile the validator written in Plutus Tx into Plutus Core, using the Plutus Tx compiler: + + + +The type of a compiled Plutus V2 spending validator should be `CompiledCode (BuiltinData -> BuiltinData -> BuiltinData -> BuiltinUnit)`, as explained in [Plutus Ledger Language Version](../working-with-scripts/ledger-language-version.md). +The call to `PlutusTx.unsafeFromBuiltinData` is the reason we need the `PlutusTx.unstableMakeIsData` shown before, which derives `UnsafeFromData` instances. +And instead of returning a `Bool`, it simply returns `()`, and the validation succeeds if the script evaluates without error. + +Note that `AuctionParams` is _not_ an argument of the compiled validator. +`AuctionParams` contains contract properties that don't change, so it is simply built into the validator by partial application. +The partial application is done via `PlutusTx.unsafeApplyCode`. + +> :pushpin: **NOTE** +> +> It is worth noting that we must call `PlutusTx.compile` on the entire `auctionUntypedValidator`, rather than applying it to `params` before compiling, as in `$$(PlutusTx.compile [||auctionUntypedValidator params||])`. +> The latter won't work, because everything being compiled (inside `[||...||]`) must be known at compile time, but we won't be able to access `params` until runtime. +> Instead, once we have the `params` at runtime, we use `liftCode` to lift it into a Plutus Core term before calling `unsafeApplyCode`. +> This is the reason why we need the `Lift` instance for `AuctionParams`, derived via `PlutusTx.makeLift`. diff --git a/doc/docusaurus/docs/essential-concepts/plutus-core-and-plutus-tx.md b/doc/docusaurus/docs/essential-concepts/plutus-core-and-plutus-tx.md index 6badd194537..b4eb9a8572c 100644 --- a/doc/docusaurus/docs/essential-concepts/plutus-core-and-plutus-tx.md +++ b/doc/docusaurus/docs/essential-concepts/plutus-core-and-plutus-tx.md @@ -1,5 +1,5 @@ --- -sidebar_position: 10 +sidebar_position: 5 --- # Plutus Core and Plutus Tx @@ -42,4 +42,4 @@ See [Overview of Languages Compiling to UPLC](../delve-deeper/languages.md) for The formal details of Plutus Core are in its [specification](https://github.com/IntersectMBO/plutus#specifications-and-design). -PIR is discussed in [_Unraveling recursion: compiling an IR with recursion to System F_](https://iohk.io/en/research/library/papers/unraveling-recursion-compiling-an-ir-with-recursion-to-system-f/). \ No newline at end of file +PIR is discussed in [_Unraveling recursion: compiling an IR with recursion to System F_](https://iohk.io/en/research/library/papers/unraveling-recursion-compiling-an-ir-with-recursion-to-system-f/). diff --git a/doc/docusaurus/docs/essential-concepts/versions.md b/doc/docusaurus/docs/essential-concepts/versions.md index 43fd4f3f561..65f2fc7d679 100644 --- a/doc/docusaurus/docs/essential-concepts/versions.md +++ b/doc/docusaurus/docs/essential-concepts/versions.md @@ -1,5 +1,5 @@ --- -sidebar_position: 5 +sidebar_position: 10 --- # Different Notions of Version diff --git a/doc/docusaurus/docs/glossary.md b/doc/docusaurus/docs/glossary.md index 65ca3800e4b..74fb82ed3c5 100644 --- a/doc/docusaurus/docs/glossary.md +++ b/doc/docusaurus/docs/glossary.md @@ -1,5 +1,5 @@ --- -sidebar_position: 15 +sidebar_position: 25 --- # Glossary diff --git a/doc/docusaurus/docs/simple-example/_category_.json b/doc/docusaurus/docs/simple-example/_category_.json deleted file mode 100644 index 055fc46b7db..00000000000 --- a/doc/docusaurus/docs/simple-example/_category_.json +++ /dev/null @@ -1,8 +0,0 @@ -{ - "label": "Simple example", - "position": 30, - "link": { - "type": "generated-index", - "description": "This section walks you through a straightforward auction smart contract through a practical example, detailing the EUTXO model, how Plutus Tx integrates data types, validator functions and script execution." - } - } diff --git a/doc/docusaurus/docs/simple-example/alternatives-to-plutus-tx.md b/doc/docusaurus/docs/simple-example/alternatives-to-plutus-tx.md deleted file mode 100644 index 41fcec45308..00000000000 --- a/doc/docusaurus/docs/simple-example/alternatives-to-plutus-tx.md +++ /dev/null @@ -1,18 +0,0 @@ ---- -sidebar_position: 35 ---- - -# Alternatives to Plutus Tx - -There are languages other than Plutus Tx that can be compiled into Plutus Core. -We list some of them here for reference. -However, we are not endorsing them; we are not representing their qualities nor their state of development regarding their production-readiness. - -- [Aiken](https://github.com/txpipe/aiken/) -- [Hebi](https://github.com/OpShin/hebi) -- [Helios](https://github.com/hyperion-bt/helios) -- [OpShin](https://github.com/OpShin/opshin) -- [plu-ts](https://github.com/HarmonicLabs/plu-ts) -- [Plutarch](https://github.com/Plutonomicon/plutarch-core) -- [Pluto](https://github.com/Plutonomicon/pluto) - diff --git a/doc/docusaurus/docs/simple-example/auction-properties.md b/doc/docusaurus/docs/simple-example/auction-properties.md deleted file mode 100644 index 7ba9bee0d27..00000000000 --- a/doc/docusaurus/docs/simple-example/auction-properties.md +++ /dev/null @@ -1,15 +0,0 @@ ---- -sidebar_position: 15 ---- - -# Auction properties - -In this example, Alice wants to auction some asset she owns, represented as a non-fungible token (NFT) on Cardano. -She would like to create and deploy an auction smart contract with the following properties: - -- there is a minimum bid amount -- each bid must be higher than the previous highest bid (if any) -- once a new bid is made, the previous highest bid (if it exists) is immediately refunded -- there is a deadline for placing bids; once the deadline has passed, new bids are no longer accepted, the asset can be transferred to the highest bidder (or to the seller if there are no bids), and the highest bid (if one exists) can be transferred to the seller. - -Next, let's go through and discuss the Plutus Tx code we're using, in the next section, for this specific example of an auction smart contract. diff --git a/doc/docusaurus/docs/simple-example/eutxo-model.md b/doc/docusaurus/docs/simple-example/eutxo-model.md deleted file mode 100644 index c9660fec4bb..00000000000 --- a/doc/docusaurus/docs/simple-example/eutxo-model.md +++ /dev/null @@ -1,46 +0,0 @@ ---- -sidebar_position: 10 ---- - -# The EUTXO model, datum, redeemer and script context - -On the Cardano blockchain, a transaction contains an arbitrary number of inputs and an arbitrary number of outputs. -The effect of a transaction is to consume inputs and produce new outputs. - - - -UTXO (unspent transaction output) is the ledger model used by some blockchains, including bitcoin. -A UTXO is produced by a transaction, is immutable, and can only be spent once by another transaction. -In the original UTXO model, a UTXO contains a wallet address and a value (e.g., some amount of one or more currencies/tokens). -Inside a transaction, a UTXO is uniquely identified by the wallet address. -It can be spent by a transaction if the transaction is signed by the private key of the wallet address. - - - -The Extended UTXO model (EUTXO) extends the original model with a new kind of UTXO: script UTXO. -A script UTXO contains a value, a script (usually a Plutus script), a piece of data called *datum*, and is identified by the hash of the script. -For a transaction to spend it, the transaction must provide a piece of input data to the script, referred to as the *redeemer*. -The script is then run, and it must succeed in order for the transaction to be allowed to spend the UTXO. -In addition to the redeemer, the script also has access to the datum contained in the UTXO, as well as the details of the transaction trying to spend it. -This is referred to as *script context*. - - - -Note that the only thing a Plutus script does is to determine whether a transaction can spend the script UTXO that contains the script. -It is *not* responsible for such things as deciding whether it can spend a different UTXO, checking that the input value in a transaction equals the output value, or updating the state of the smart contract. -Consider it a pure function that returns `Bool`. -Checking transaction validity is done by the ledger rules, and updating the state of a smart contract is done by constructing the transaction to produce a new script UTXO with an updated datum. - - - -The immutability of UTXOs leads to the extremely useful property of completely predictable transaction fees. -The Plutus script in a transaction can be run off-chain to determine the fee before submitting the transaction onto the blockchain. -When the transaction is submitted, if some UTXOs it tries to spend have already been spent, the transaction is immediately rejected without penalty. -If all input UTXOs still exist, and the Plutus script is invoked, the on-chain behavior would be exactly identical to the off-chain behavior. -This could not be achieved if transaction inputs were mutable, such as is the case in Ethereum's account-based model. - -See also: - -- [Working with scripts](../category/working-with-scripts) for further reading about scripts -- [Understanding the Extended UTXO model](https://docs.cardano.org/learn/eutxo-explainer) - diff --git a/doc/docusaurus/docs/simple-example/further-reading.md b/doc/docusaurus/docs/simple-example/further-reading.md deleted file mode 100644 index 6f1a5467ff1..00000000000 --- a/doc/docusaurus/docs/simple-example/further-reading.md +++ /dev/null @@ -1,11 +0,0 @@ ---- -sidebar_position: 45 ---- - -# Further reading - -## The EUTXO model - -- [The Extended UTXO Model](https://iohk.io/en/research/library/papers/the-extended-utxo-model/) (Paper) -- [The EUTXO Handbook](https://www.essentialcardano.io/article/the-eutxo-handbook) -- Blog Post: Cardano's Extended UTXO accounting model—built to support multi-assets and smart contracts ([part 1](https://iohk.io/en/blog/posts/2021/03/11/cardanos-extended-utxo-accounting-model/), [part 2](https://iohk.io/en/blog/posts/2021/03/12/cardanos-extended-utxo-accounting-model-part-2/)) diff --git a/doc/docusaurus/docs/simple-example/libraries.md b/doc/docusaurus/docs/simple-example/libraries.md deleted file mode 100644 index ffc7dc22067..00000000000 --- a/doc/docusaurus/docs/simple-example/libraries.md +++ /dev/null @@ -1,11 +0,0 @@ ---- -sidebar_position: 30 ---- - -# Libraries for writing Plutus Tx scripts - -This auction example shows a relatively low-level way of writing scripts using Plutus Tx. -In practice, you may consider using a higher-level library that abstracts away some of the details. -For example, [plutus-apps](https://github.com/IntersectMBO/plutus-apps) provides a constraint library for writing Plutus Tx. -Using these libraries, writing a validator in Plutus Tx becomes a matter of defining state transactions and the corresponding constraints, e.g., the condition `refundsPreviousHighestBid` can simply be written as `Constraints.mustPayToPubKey bidder (lovelaceValue amt)`. - diff --git a/doc/docusaurus/docs/simple-example/off-chain-code.md b/doc/docusaurus/docs/simple-example/off-chain-code.md deleted file mode 100644 index a1319a96779..00000000000 --- a/doc/docusaurus/docs/simple-example/off-chain-code.md +++ /dev/null @@ -1,17 +0,0 @@ ---- -sidebar_position: 40 ---- - -# Off-chain code - -Since the main purpose of this example is to introduce Plutus Tx and Plutus Core, we walked through only the on-chain code, which is responsible for validating transactions (in the sense of determining whether a transaction is allowed to spend a UTXO). - -In addition to the on-chain code, one typically needs the accompanying off-chain code and services to perform tasks like building transactions, submitting transactions, deploying smart contracts, querying for available UTXOs on the chain, etc. - - - -A full suite of solutions is [in development](https://plutus-apps.readthedocs.io/en/latest/plutus/explanations/plutus-tools-component-descriptions.html). -See the [plutus-apps](https://github.com/IntersectMBO/plutus-apps) repo and its accompanying [Plutus tools SDK user guide](https://plutus-apps.readthedocs.io/en/latest/) for more details. - -Some other alternatives include [cardano-transaction-lib](https://github.com/Plutonomicon/cardano-transaction-lib) and [mesh](https://meshjs.dev/). -All these are based on the [Cardano API](https://github.com/IntersectMBO/cardano-api), a low-level API that provides the capability to do the off-chain work with a local running node. diff --git a/doc/docusaurus/docs/simple-example/plutus-tx-code.md b/doc/docusaurus/docs/simple-example/plutus-tx-code.md deleted file mode 100644 index 30a970ee07b..00000000000 --- a/doc/docusaurus/docs/simple-example/plutus-tx-code.md +++ /dev/null @@ -1,139 +0,0 @@ ---- -sidebar_position: 20 ---- - -# Plutus Tx code - -Recall that Plutus Tx is a subset of Haskell. -It is the source language one uses to write Plutus validators. -A Plutus Tx program is compiled into Plutus Core, which is interpreted on-chain. -The full Plutus Tx code for the auction smart contract can be found at [AuctionValidator.hs](https://github.com/IntersectMBO/plutus-tx-template/blob/main/app/AuctionValidator.hs). - - - -## Data types - -First, let's define the following data types and instances for the validator: - - - -The purpose of `makeLift` and `unstableMakeIsData` will be explained later. - -Typically, writing a Plutus Tx validator script for a smart contract involves four data types: - -### 1. Contract parameters - -These are fixed properties of the contract. -In our example, it is the `AuctionParams` type, containing properties like seller and minimum bid. - -### 2. Datum - -This is part of a script UTXO. -It should be thought of as the state of the contract. -Our example requires only one piece of state: the current highest bid. -We use the `AuctionDatum` type to represent this. - -### 3. Redeemer - -This is an input to the Plutus script provided by the transaction that is trying to spend a script UTXO. -If a smart contract is regarded as a state machine, the redeemer would be the input that ticks the state machine. -In our example, it is the `AuctionRedeemer` type: one may either submit a new bid, or request to close the auction and pay out the winner and the seller, both of which lead to a new state of the auction. - -### 4. Script context - -This type contains the information of the transaction that the validator can inspect. -In our example, our validator verifies several conditions of the transaction; e.g., if it is a new bid, then it must be submitted before the auction's end time; the previous highest bid must be refunded to the previous bidder, etc. - -The script context type is fixed for each Plutus language version. -For Plutus V2, for example, it is `PlutusLedgerApi.V2.Contexts.ScriptContext`. - -> :pushpin: **NOTE** -> -> When writing a Plutus validator using Plutus Tx, it is advisable to turn off Haskell's `Prelude`. -> Usage of most functions and methods in `Prelude` should be replaced by their counterparts in the `plutus-tx` library, e.g., `PlutusTx.Eq.==`. - -## Main validator function - -Now we are ready to introduce our main validator function. -The beginning of the function looks like the following: - - - -Depending on whether this transaction is attempting to submit a new bid or to request payout, the validator validates the corresponding set of conditions. - -### Sufficient bid condition - -The `sufficientBid` condition verifies that the bid amount is sufficient: - - - -### Valid bid time condition - -The `validBidTime` condition verifies that the bid is submitted before the auction's deadline: - - - -Here, `to x` is the time interval ending at `x`, i.e., `(-∞, x]`. -`txInfoValidRange` is a transaction property. -It is the time interval in which the transaction is allowed to go through phase-1 validation. -`contains` takes two time intervals, and checks that the first interval completely includes the second. -Since the transaction may be validated at any point in the `txInfoValidRange` interval, we need to check that the entire interval lies within `(-∞, apEndTime params]`. - -The reason we need the `txInfoValidRange` interval instead of using the exact time the transaction is validated is due to [determinism](https://iohk.io/en/blog/posts/2021/09/06/no-surprises-transaction-validation-on-cardano/). -Using the exact time would be like calling a `getCurrentTime` function and branching based on the current time. -On the other hand, by using the `txInfoValidRange` interval, the same interval is always used by the same transaction. - -### Refunds previous highest bid condition - -The `refundsPreviousHighestBid` condition checks that the transaction pays the previous highest bid to the previous bidder: - - - -It uses `PlutusTx.find` to find the transaction output (a UTXO) that pays to the previous bidder the amount equivalent to the previous highest bid, and verifies that there is at least one such output. - -`lovelaceValue amt` constructs a `Value` with `amt` Lovelaces (the subunit of the Ada currency). -`Value` is a multi-asset type that represents a collection of assets, including Ada. -An asset is identified by a (symbol, token) pair, where the symbol represents the policy that controls the minting and burning of tokens, and the token represents a particular kind of token manipulated by the policy. -`(adaSymbol, adaToken)` is the special identifier for Ada/Lovelace. - -### Correct new datum condition - -The `correctNewDatum` condition verifies that the transaction produces a *continuing output* containing the correct datum (the new highest bid): - - - -A "continuing output" is a transaction output that pays to the same script address from which we are currently spending. -Exactly one continuing output must be present in this example so that the next bidder can place a new bid. -The new bid, in turn, will need to spend the continuing output and get validated by the same validator script. - -If the transaction is requesting a payout, the validator will then verify the other three conditions: `validPayoutTime`,`sellerGetsHighestBid` and `highestBidderGetsAsset`. -These conditions are similar to the ones already explained, so their details are omitted. - -### Compiling the validator - -Finally, we need to compile the validator written in Plutus Tx into Plutus Core, using the Plutus Tx compiler: - - - -The type of the compiled validator is `CompiledCode (BuiltinData -> BuiltinData -> BuiltinData -> ())`, where type `BuiltinData -> BuiltinData -> BuiltinData -> ()` is also known as the *untyped validator*. -An untyped validator takes three `BuiltinData` arguments, representing the serialized datum, redeemer, and script context. -The call to `PlutusTx.unsafeFromBuiltinData` is the reason we need the `PlutusTx.unstableMakeIsData` shown before, which derives `UnsafeFromData` instances. -And instead of returning a `Bool`, it simply returns `()`, and the validation succeeds if the script evaluates without error. - -Note that `AuctionParams` is an argument of neither the untyped validator nor the final UPLC program. -`AuctionParams` contains contract properties that don't change, so it is simply built into the validator. - -Since the Plutus Tx compiler compiles `a` into `CompiledCode a`, we first use `auctionUntypedValidator` to obtain an untyped validator. -It takes `AuctionParams`, and returns an untyped validator. -We then define the `auctionValidatorScript` function, which takes `AuctionParams` and returns the compiled Plutus Core program. - -To create the Plutus validator script for a particular auction, we call `auctionValidatorScript` with the appropriate `AuctionParams`. -We will then be able to launch the auction on-chain by submitting a transaction that outputs a script UTXO with `Nothing` as the datum. - -> :pushpin: **NOTE** -> -> It is worth noting that we must call `PlutusTx.compile` on the entire `auctionUntypedValidator`, rather than applying it to `params` before compiling, as in `$$(PlutusTx.compile [||auctionUntypedValidator params||])`. -> The latter won't work, because everything being compiled (inside `[||...||]`) must be known at compile time, but `params` is not: it can differ at runtime depending on what kind of auction we want to run. -> Instead, we compile the entire `auctionUntypedValidator` into Plutus Core, then use `liftCode` to lift `params` into a Plutus Core term, and apply the compiled `auctionUntypedValidator` to it at the Plutus Core level. -> To do so, we need the `Lift` instance for `AuctionParams`, derived via `PlutusTx.makeLift`. - diff --git a/doc/docusaurus/docs/simple-example/simple-example.md b/doc/docusaurus/docs/simple-example/simple-example.md deleted file mode 100644 index f181751a844..00000000000 --- a/doc/docusaurus/docs/simple-example/simple-example.md +++ /dev/null @@ -1,36 +0,0 @@ ---- -sidebar_position: 5 ---- - -# Overview - -:::caution -This conceptual guide to an auction smart contract in Plutus introduces fundamentals for educational use. -However, it is not optimized for security or efficiency and should not be deployed in production environments. -This example simplifies some security aspects, leading to potential vulnerabilities. -For detailed insights on developing secure smart contracts, please refer to the **[Cardano Plutus Script Vulnerability Guide](https://library.mlabs.city/common-plutus-security-vulnerabilities)** by MLabs. -::: - -## About this example - -This example presents Plutus Tx code for a smart contract that controls the auction of an asset, which can be executed on the Cardano blockchain. -In a sense, the smart contract is acting as the auctioneer in that it enforces certain rules and requirements in order for the auction to occur successfully. - - - -Plutus Tx is a high-level language for writing the validation logic of the contract, the logic that determines whether a transaction is allowed to spend a UTXO. -Plutus Tx is not a new language, but rather a subset of Haskell, and it is compiled into Plutus Core, a low-level language based on higher-order polymorphic lambda calculus. -Plutus Core is the code that runs on-chain, i.e., by every node validating the transaction, using an interpreter known as the CEK machine. -A Plutus Core program included in a Cardano transaction is often referred to as Plutus script or Plutus validator. - - - -To develop and deploy a smart contract, you would also need off-chain code for building transactions, submitting transactions, deploying smart contracts, querying for available UTXOs on the chain and so on. -You may also want a front-end interface for your smart contract for better user experiences. -In this example, we are not covering these aspects. - - - - -Before we get to the Plutus Tx code, let's briefly go over some basic concepts, including UTXO, EUTXO, datum, redeemer, and script context. - diff --git a/doc/docusaurus/docs/using-plutus-tx/advanced-plutus-tx-concepts/optimizing-scripts-with-asData.md b/doc/docusaurus/docs/using-plutus-tx/advanced-plutus-tx-concepts/optimizing-scripts-with-asData.md index e4898dacb1c..72082e30a20 100644 --- a/doc/docusaurus/docs/using-plutus-tx/advanced-plutus-tx-concepts/optimizing-scripts-with-asData.md +++ b/doc/docusaurus/docs/using-plutus-tx/advanced-plutus-tx-concepts/optimizing-scripts-with-asData.md @@ -4,40 +4,40 @@ sidebar_position: 20 # Optimizing scripts with `asData` -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. +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. +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 approaches -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. +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. +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. +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. +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. +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. @@ -46,13 +46,13 @@ The Plutus Tx library provides some helper functions to make this second style e 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 [auction example](simple-example/simple-example.md), we would put the datatype declarations inside a Template Haskell quote and call `asData` on it. +For example, if we wanted to use it on the types from the [auction example](../../auction-smart-contract/on-chain-code.md), we would put the datatype declarations inside a Template Haskell quote and call `asData` on it. 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: -``` +``` PlutusTx.asData [d| data Bid' = Bid' {bBidder' :: PubKeyHash, bAmount' :: Lovelace} @@ -84,22 +84,22 @@ 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`. +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`. +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. +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`. +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 @@ -116,6 +116,6 @@ There are a number of tradeoffs to consider: 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. +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/docusaurus/static/code/AuctionMintingPolicy.hs b/doc/docusaurus/static/code/AuctionMintingPolicy.hs new file mode 100644 index 00000000000..388f63ede34 --- /dev/null +++ b/doc/docusaurus/static/code/AuctionMintingPolicy.hs @@ -0,0 +1,69 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE ImportQualifiedPost #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE Strict #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE ViewPatterns #-} +{-# OPTIONS_GHC -fno-full-laziness #-} +{-# OPTIONS_GHC -fno-ignore-interface-pragmas #-} +{-# OPTIONS_GHC -fno-omit-interface-pragmas #-} +{-# OPTIONS_GHC -fno-spec-constr #-} +{-# OPTIONS_GHC -fno-specialise #-} +{-# OPTIONS_GHC -fno-strictness #-} +{-# OPTIONS_GHC -fno-unbox-small-strict-fields #-} +{-# OPTIONS_GHC -fno-unbox-strict-fields #-} +{-# OPTIONS_GHC -fplugin-opt PlutusTx.Plugin:target-version=1.0.0 #-} + +module AuctionMintingPolicy where + +import PlutusCore.Version (plcVersion100) +import PlutusLedgerApi.V1.Value (flattenValue) +import PlutusLedgerApi.V2 (PubKeyHash, ScriptContext (..), TxInfo (..)) +import PlutusLedgerApi.V2.Contexts (ownCurrencySymbol, txSignedBy) +import PlutusTx +import PlutusTx.Prelude qualified as PlutusTx + +-- BLOCK1 +type AuctionMintingParams = PubKeyHash +type AuctionMintingRedeemer = () + +{-# INLINEABLE auctionTypedMintingPolicy #-} +auctionTypedMintingPolicy :: + AuctionMintingParams -> + AuctionMintingRedeemer -> + ScriptContext -> + Bool +auctionTypedMintingPolicy pkh _redeemer ctx = + txSignedBy txInfo pkh PlutusTx.&& mintedExactlyOneToken + where + txInfo = scriptContextTxInfo ctx + mintedExactlyOneToken = case flattenValue (txInfoMint txInfo) of + [(currencySymbol, _tokenName, quantity)] -> + currencySymbol PlutusTx.== ownCurrencySymbol ctx PlutusTx.&& quantity PlutusTx.== 1 + _ -> False +-- BLOCK2 + +auctionUntypedMintingPolicy :: + AuctionMintingParams -> + BuiltinData -> + BuiltinData -> + PlutusTx.BuiltinUnit +auctionUntypedMintingPolicy pkh redeemer ctx = + PlutusTx.check + ( auctionTypedMintingPolicy + pkh + (PlutusTx.unsafeFromBuiltinData redeemer) + (PlutusTx.unsafeFromBuiltinData ctx) + ) + +auctionMintingPolicyScript :: + AuctionMintingParams -> + CompiledCode (BuiltinData -> BuiltinData -> PlutusTx.BuiltinUnit) +auctionMintingPolicyScript pkh = + $$(PlutusTx.compile [||auctionUntypedMintingPolicy||]) + `PlutusTx.unsafeApplyCode` PlutusTx.liftCode plcVersion100 pkh diff --git a/doc/docusaurus/static/code/AuctionValidator.hs b/doc/docusaurus/static/code/AuctionValidator.hs index f719b04351f..df980bbab05 100644 --- a/doc/docusaurus/static/code/AuctionValidator.hs +++ b/doc/docusaurus/static/code/AuctionValidator.hs @@ -1,5 +1,8 @@ {-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE ImportQualifiedPost #-} {-# LANGUAGE MultiParamTypeClasses #-} @@ -8,84 +11,110 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE Strict #-} {-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE ViewPatterns #-} - +{-# OPTIONS_GHC -fno-full-laziness #-} {-# OPTIONS_GHC -fno-ignore-interface-pragmas #-} {-# OPTIONS_GHC -fno-omit-interface-pragmas #-} -{-# OPTIONS_GHC -fno-full-laziness #-} {-# OPTIONS_GHC -fno-spec-constr #-} {-# OPTIONS_GHC -fno-specialise #-} {-# OPTIONS_GHC -fno-strictness #-} -{-# OPTIONS_GHC -fno-unbox-strict-fields #-} {-# OPTIONS_GHC -fno-unbox-small-strict-fields #-} +{-# OPTIONS_GHC -fno-unbox-strict-fields #-} {-# OPTIONS_GHC -fplugin-opt PlutusTx.Plugin:target-version=1.0.0 #-} module AuctionValidator where +import GHC.Generics (Generic) + import PlutusCore.Version (plcVersion100) -import PlutusLedgerApi.V1 (Lovelace, POSIXTime, PubKeyHash, Value) -import PlutusLedgerApi.V1.Address (pubKeyHashAddress) +import PlutusLedgerApi.V1 (Lovelace, POSIXTime, PubKeyHash) +import PlutusLedgerApi.V1.Address (toPubKeyHash) import PlutusLedgerApi.V1.Interval (contains) -import PlutusLedgerApi.V1.Value (lovelaceValue) -import PlutusLedgerApi.V2 (Datum (..), OutputDatum (..), ScriptContext (..), TxInfo (..), - TxOut (..), from, to) +import PlutusLedgerApi.V1.Value (lovelaceValueOf, valueOf) +import PlutusLedgerApi.V2 (CurrencySymbol, Datum (..), OutputDatum (..), ScriptContext (..), + TokenName, TxInfo (..), TxOut (..), from, to) import PlutusLedgerApi.V2.Contexts (getContinuingOutputs) import PlutusTx import PlutusTx.AsData qualified as PlutusTx +import PlutusTx.Blueprint import PlutusTx.Prelude qualified as PlutusTx import PlutusTx.Show qualified as PlutusTx -- BLOCK1 +-- AuctionValidator.hs data AuctionParams = AuctionParams - { apSeller :: PubKeyHash, - -- ^ Seller's wallet address. The highest bid (if exists) will be sent to the seller. - -- If there is no bid, the asset auctioned will be sent to the seller. - apAsset :: Value, - -- ^ The asset being auctioned. It can be a single token, multiple tokens of the same - -- kind, or tokens of different kinds, and the token(s) can be fungible or non-fungible. - -- These can all be encoded as a `Value`. - apMinBid :: Lovelace, - -- ^ The minimum bid in Lovelace. - apEndTime :: POSIXTime - -- ^ The deadline for placing a bid. This is the earliest time the auction can be closed. + { apSeller :: PubKeyHash + -- ^ Seller's public key hash. The highest bid (if exists) will be sent to the seller. + -- If there is no bid, the asset auctioned will be sent to the seller. + , apCurrencySymbol :: CurrencySymbol + -- ^ The currency symbol of the token being auctioned. + , apTokenName :: TokenName + -- ^ The name of the token being auctioned. + -- These can all be encoded as a `Value`. + , apMinBid :: Lovelace + -- ^ The minimum bid in Lovelace. + , apEndTime :: POSIXTime + -- ^ The deadline for placing a bid. This is the earliest time the auction can be closed. } + deriving stock (Generic) + deriving anyclass (HasBlueprintDefinition) PlutusTx.makeLift ''AuctionParams +PlutusTx.makeIsDataSchemaIndexed ''AuctionParams [('AuctionParams, 0)] data Bid = Bid - { bBidder :: PubKeyHash, - -- ^ Bidder's wallet address. - bAmount :: Lovelace - -- ^ Bid amount in Lovelace. + { bAddr :: PlutusTx.BuiltinByteString + -- ^ Bidder's wallet address + , bPkh :: PubKeyHash + -- ^ Bidder's public key hash. + , bAmount :: Lovelace + -- ^ Bid amount in Lovelace. } + deriving stock (Generic) + deriving anyclass (HasBlueprintDefinition) PlutusTx.deriveShow ''Bid -PlutusTx.unstableMakeIsData ''Bid +PlutusTx.makeIsDataSchemaIndexed ''Bid [('Bid, 0)] instance PlutusTx.Eq Bid where {-# INLINEABLE (==) #-} bid == bid' = - bBidder bid PlutusTx.== bBidder bid' - PlutusTx.&& bAmount bid PlutusTx.== bAmount bid' + bPkh bid + PlutusTx.== bPkh bid' + PlutusTx.&& bAmount bid + PlutusTx.== bAmount bid' --- | Datum represents the state of a smart contract. In this case --- it contains the highest bid so far (if exists). -newtype AuctionDatum = AuctionDatum { adHighestBid :: Maybe Bid } - -PlutusTx.unstableMakeIsData ''AuctionDatum +{- | Datum represents the state of a smart contract. In this case +it contains the highest bid so far (if exists). +-} +newtype AuctionDatum = AuctionDatum {adHighestBid :: Maybe Bid} + deriving stock (Generic) + deriving newtype + ( HasBlueprintDefinition + , PlutusTx.ToData + , PlutusTx.FromData + , PlutusTx.UnsafeFromData + ) --- | 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. +{- | 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 stock (Generic) + deriving anyclass (HasBlueprintDefinition) -PlutusTx.unstableMakeIsData ''AuctionRedeemer --- BLOCK2 - +PlutusTx.makeIsDataSchemaIndexed ''AuctionRedeemer [('NewBid, 0), ('Payout, 1)] +-- BLOCK2 +-- AuctionValidator.hs {-# INLINEABLE auctionTypedValidator #-} --- | Given the auction parameters, determines whether the transaction is allowed to --- spend the UTXO. + +{- | Given the auction parameters, determines whether the transaction is allowed to +spend the UTXO. +-} auctionTypedValidator :: AuctionParams -> AuctionDatum -> @@ -100,98 +129,118 @@ auctionTypedValidator params (AuctionDatum highestBid) redeemer ctx@(ScriptConte NewBid bid -> [ -- The new bid must be higher than the highest bid. -- If this is the first bid, it must be at least as high as the minimum bid. - sufficientBid bid, - -- The bid is not too late. - validBidTime, - -- The previous highest bid should be refunded. - refundsPreviousHighestBid, - -- A correct new datum is produced, containing the new highest bid. - correctNewDatum bid + sufficientBid bid + , -- The bid is not too late. + validBidTime + , -- The previous highest bid should be refunded. + refundsPreviousHighestBid + , -- A correct new datum is produced, containing the new highest bid. + correctOutput bid ] Payout -> [ -- The payout is not too early. - validPayoutTime, - -- The seller gets the highest bid. - sellerGetsHighestBid, - -- The highest bidder gets the asset. + validPayoutTime + , -- The seller gets the highest bid. + sellerGetsHighestBid + , -- The highest bidder gets the asset. highestBidderGetsAsset ] -- BLOCK3 +-- AuctionValidator.hs sufficientBid :: Bid -> Bool - sufficientBid (Bid _ amt) = case highestBid of - Just (Bid _ amt') -> amt PlutusTx.> amt' - Nothing -> amt PlutusTx.>= apMinBid params + sufficientBid (Bid _ _ amt) = case highestBid of + Just (Bid _ _ amt') -> amt PlutusTx.> amt' + Nothing -> amt PlutusTx.>= apMinBid params -- BLOCK4 +-- AuctionValidator.hs validBidTime :: Bool - validBidTime = to (apEndTime params) `contains` txInfoValidRange txInfo + ~validBidTime = to (apEndTime params) `contains` txInfoValidRange txInfo -- BLOCK5 +-- AuctionValidator.hs refundsPreviousHighestBid :: Bool - refundsPreviousHighestBid = case highestBid of + ~refundsPreviousHighestBid = case highestBid of Nothing -> True - Just (Bid bidder amt) -> + Just (Bid _ bidderPkh amt) -> case PlutusTx.find - (\o -> txOutAddress o PlutusTx.== pubKeyHashAddress bidder - PlutusTx.&& txOutValue o PlutusTx.== lovelaceValue amt) + ( \o -> + (toPubKeyHash (txOutAddress o) PlutusTx.== Just bidderPkh) + PlutusTx.&& (lovelaceValueOf (txOutValue o) PlutusTx.== amt) + ) (txInfoOutputs txInfo) of Just _ -> True - Nothing -> PlutusTx.traceError ("Not found: refund output") + Nothing -> PlutusTx.traceError "Not found: refund output" -- BLOCK6 - correctNewDatum :: Bid -> Bool - correctNewDatum bid = case getContinuingOutputs ctx of - [o] -> case txOutDatum o of - OutputDatum (Datum newDatum) -> case PlutusTx.fromBuiltinData newDatum of - Just bid' -> - PlutusTx.traceIfFalse - ( "Invalid output datum: expected " - PlutusTx.<> PlutusTx.show bid - PlutusTx.<> ", but got " - PlutusTx.<> PlutusTx.show bid' - ) - (bid PlutusTx.== bid') - Nothing -> - PlutusTx.traceError - ( "Failed to decode output datum: " - PlutusTx.<> PlutusTx.show newDatum - ) - OutputDatumHash _ -> - PlutusTx.traceError "Expected OutputDatum, got OutputDatumHash" - NoOutputDatum -> - PlutusTx.traceError "Expected OutputDatum, got NoOutputDatum" +-- AuctionValidator.hs + currencySymbol :: CurrencySymbol + currencySymbol = apCurrencySymbol params + + tokenName :: TokenName + tokenName = apTokenName params + + correctOutput :: Bid -> Bool + correctOutput bid = case getContinuingOutputs ctx of + [o] -> + let correctOutputDatum = case txOutDatum o of + OutputDatum (Datum newDatum) -> case PlutusTx.fromBuiltinData newDatum of + Just (AuctionDatum (Just bid')) -> + PlutusTx.traceIfFalse + "Invalid output datum: contains a different Bid than expected" + (bid PlutusTx.== bid') + Just (AuctionDatum Nothing) -> + PlutusTx.traceError "Invalid output datum: expected Just Bid, got Nothing" + Nothing -> + PlutusTx.traceError "Failed to decode output datum" + OutputDatumHash _ -> + PlutusTx.traceError "Expected OutputDatum, got OutputDatumHash" + NoOutputDatum -> + PlutusTx.traceError "Expected OutputDatum, got NoOutputDatum" + + outValue = txOutValue o + + correctOutputValue = + (lovelaceValueOf outValue PlutusTx.== bAmount bid) + PlutusTx.&& (valueOf outValue currencySymbol tokenName PlutusTx.== 1) + in correctOutputDatum PlutusTx.&& correctOutputValue os -> PlutusTx.traceError ( "Expected exactly one continuing output, got " PlutusTx.<> PlutusTx.show (PlutusTx.length os) ) -- BLOCK7 +-- AuctionValidator.hs validPayoutTime :: Bool - validPayoutTime = from (apEndTime params) `contains` txInfoValidRange txInfo + ~validPayoutTime = from (apEndTime params) `contains` txInfoValidRange txInfo sellerGetsHighestBid :: Bool - sellerGetsHighestBid = case highestBid of + ~sellerGetsHighestBid = case highestBid of Nothing -> True - Just (Bid _ amt) -> + Just bid -> case PlutusTx.find ( \o -> - txOutAddress o PlutusTx.== pubKeyHashAddress (apSeller params) - PlutusTx.&& txOutValue o PlutusTx.== lovelaceValue amt + (toPubKeyHash (txOutAddress o) PlutusTx.== Just (apSeller params)) + PlutusTx.&& (lovelaceValueOf (txOutValue o) PlutusTx.== bAmount bid) ) (txInfoOutputs txInfo) of Just _ -> True - Nothing -> PlutusTx.traceError ("Not found: Output paid to seller") + Nothing -> PlutusTx.traceError "Not found: Output paid to seller" highestBidderGetsAsset :: Bool - highestBidderGetsAsset = case highestBid of - Nothing -> True - Just (Bid bidder _) -> - case PlutusTx.find - ( \o -> - txOutAddress o PlutusTx.== pubKeyHashAddress bidder - PlutusTx.&& txOutValue o PlutusTx.== apAsset params - ) - (txInfoOutputs txInfo) of - Just _ -> True - Nothing -> PlutusTx.traceError ("Not found: Output paid to highest bidder") + ~highestBidderGetsAsset = + let highestBidder = case highestBid of + -- If there are no bids, the asset should go back to the seller + Nothing -> apSeller params + Just bid -> bPkh bid + in case PlutusTx.find + ( \o -> + (toPubKeyHash (txOutAddress o) PlutusTx.== Just highestBidder) + PlutusTx.&& (valueOf (txOutValue o) currencySymbol tokenName PlutusTx.== 1) + ) + (txInfoOutputs txInfo) of + Just _ -> True + Nothing -> PlutusTx.traceError "Not found: Output paid to highest bidder" + -- BLOCK8 +-- AuctionValidator.hs {-# INLINEABLE auctionUntypedValidator #-} auctionUntypedValidator :: AuctionParams -> @@ -214,25 +263,31 @@ auctionValidatorScript :: 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) - |] +-- AuctionValidator.hs +PlutusTx.asData + [d| + data Bid' = Bid' + { bPkh' :: 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 +-- AuctionValidator.hs diff --git a/doc/docusaurus/static/code/bid.mjs b/doc/docusaurus/static/code/bid.mjs new file mode 100644 index 00000000000..5fd4b6cdeb8 --- /dev/null +++ b/doc/docusaurus/static/code/bid.mjs @@ -0,0 +1,137 @@ +import cbor from 'cbor' +import { + BlockfrostProvider, + MeshWallet, + Transaction, + deserializeDatum, + hexToString, + serializePlutusScript, + resolveScriptHash, + stringToHex +} from '@meshsdk/core' + +import fs from 'node:fs' + +const blockfrostKey = 'Replace with Blockfrost Project ID' +const blockchainProvider = new BlockfrostProvider(blockfrostKey) + +const previousTxHash = process.argv[2] +const bidder = process.argv[3] +const bidAmt = process.argv[4] + +const wallet = new MeshWallet({ + networkId: 0, + fetcher: blockchainProvider, + submitter: blockchainProvider, + key: { + type: 'root', + bech32: fs.readFileSync(`${bidder}.skey`).toString().trim() + } +}) + +const bidderAddr = fs.readFileSync(`${bidder}.addr`).toString() +const bidderPkh = fs.readFileSync(`${bidder}.pkh`).toString() + +const auctionValidatorBlueprint = JSON.parse( + fs.readFileSync('./plutus-auction-validator.json') +) + +const auctionValidator = { + code: cbor + .encode( + Buffer.from(auctionValidatorBlueprint.validators[0].compiledCode, 'hex') + ) + .toString('hex'), + version: 'V2' +} + +const auctionValidatorAddress = serializePlutusScript(auctionValidator).address + +const mintingPolicyBlueprint = JSON.parse( + fs.readFileSync('./plutus-auction-minting-policy.json') +) + +const mintingPolicy = { + code: cbor + .encode( + Buffer.from(mintingPolicyBlueprint.validators[0].compiledCode, 'hex') + ) + .toString('hex'), + version: 'V2' +} + +const mintingPolicyHash = resolveScriptHash( + mintingPolicy.code, + mintingPolicy.version +) + +const utxos = await blockchainProvider.fetchAddressUTxOs( + auctionValidatorAddress +) + +const utxoIn = utxos.find(utxo => { + return utxo.input.txHash == previousTxHash +}) + +if (!utxoIn) throw new Error(`utxo not found for ${previousTxHash}`) + +const datumIn = deserializeDatum(utxoIn.output.plutusData) + +var highestBidderAddress +var highestBidAmount + +if (datumIn.fields.length > 0) { + highestBidderAddress = hexToString(datumIn.fields[0].fields[0].bytes) + highestBidAmount = datumIn.fields[0].fields[2].int +} + +const bid = { + alternative: 0, + fields: [bidderAddr, bidderPkh, parseInt(bidAmt)] +} + +const redeemer = { + data: { + alternative: 0, + fields: [bid] + } +} + +const datumOut = { + alternative: 0, + fields: [bid] +} + +const tx = new Transaction({ initiator: wallet }) + .redeemValue({ + value: utxoIn, + script: auctionValidator, + redeemer: redeemer + }) + .sendAssets( + { + address: auctionValidatorAddress, + datum: { value: datumOut, inline: true } + }, + [ + { + unit: 'lovelace', + quantity: bidAmt + }, + { + unit: mintingPolicyHash + stringToHex('TokenToBeAuctioned'), + quantity: '1' + } + ] + ) + .setTimeToExpire('Replace with transaction expiration time') + +if (highestBidderAddress) { + tx.sendLovelace(highestBidderAddress, highestBidAmount.toString()) +} + +const unsignedTx = await tx.build() +const signedTx = await wallet.signTx(unsignedTx) +const txHash = await wallet.submitTx(signedTx) + +console.log(`Bid successful. Tx hash: ${txHash}`) diff --git a/doc/docusaurus/static/code/generate-keys.mjs b/doc/docusaurus/static/code/generate-keys.mjs new file mode 100644 index 00000000000..12da31023e7 --- /dev/null +++ b/doc/docusaurus/static/code/generate-keys.mjs @@ -0,0 +1,27 @@ +import { MeshWallet, deserializeAddress } from '@meshsdk/core' +import fs from 'node:fs' + +// generate a new secret key +const skey = MeshWallet.brew(true) + +// create a Mesh wallet with the secret key +const wallet = new MeshWallet({ + networkId: 0, + key: { + type: 'root', + bech32: skey + } +}) + +// obtain the address associated with the secret key +const address = wallet.getUnusedAddresses()[0] + +// derive PubKeyHash from the address +const pubKeyHash = deserializeAddress(address).pubKeyHash + +const filename = process.argv[2] + +// write the secret key, the address and the PubKeyHash to files +fs.writeFileSync(`${filename}.skey`, skey) +fs.writeFileSync(`${filename}.addr`, address) +fs.writeFileSync(`${filename}.pkh`, pubKeyHash) diff --git a/doc/docusaurus/static/code/mint-token-for-auction.mjs b/doc/docusaurus/static/code/mint-token-for-auction.mjs new file mode 100644 index 00000000000..63eddd341ba --- /dev/null +++ b/doc/docusaurus/static/code/mint-token-for-auction.mjs @@ -0,0 +1,86 @@ +import cbor from 'cbor' +import { + BlockfrostProvider, + MeshWallet, + Transaction, + serializePlutusScript, +} from '@meshsdk/core' + +import fs from 'node:fs' + +const blockfrostKey = 'Replace with Blockfrost Project ID' +const blockchainProvider = new BlockfrostProvider(blockfrostKey) + +const wallet = new MeshWallet({ + networkId: 0, + fetcher: blockchainProvider, + submitter: blockchainProvider, + key: { + type: 'root', + bech32: fs.readFileSync('seller.skey').toString().trim() + } +}) + +const auctionValidatorBlueprint = JSON.parse( + fs.readFileSync('./plutus-auction-validator.json') +) + +const auctionValidator = { + code: cbor + .encode( + Buffer.from(auctionValidatorBlueprint.validators[0].compiledCode, 'hex') + ) + .toString('hex'), + version: 'V2' +} + +const auctionValidatorAddress = serializePlutusScript(auctionValidator).address + +const mintingPolicyBlueprint = JSON.parse( + fs.readFileSync('./plutus-auction-minting-policy.json') +) + +const mintingPolicy = { + code: cbor + .encode( + Buffer.from(mintingPolicyBlueprint.validators[0].compiledCode, 'hex') + ) + .toString('hex'), + version: 'V2' +} + +// The `AuctionDatum` to be stored in the output. +const datumOut = { + alternative: 1, // Corresponds to `Nothing` + fields: [] +} + +// The token we are minting +const token = { + assetName: 'TokenToBeAuctioned', + assetQuantity: '1', + recipient: { + address: auctionValidatorAddress, + datum: { value: datumOut, inline: true } + } +} + +const walletAddress = wallet.getUsedAddresses()[0] + +// The redeemer for the minting policy, corresponding to `()`. +const redeemer = { + data: { + alternative: 0, + fields: [] + } +} + +const tx = new Transaction({ initiator: wallet }) +tx.mintAsset(mintingPolicy, token, redeemer) +const unsignedTx = await tx.setRequiredSigners([walletAddress]).build() +const signedTx = wallet.signTx(unsignedTx) +const txHash = await wallet.submitTx(signedTx) + +console.log( + `Minted a token at address ${auctionValidatorAddress}. Tx hash: ${txHash}` +) diff --git a/doc/docusaurus/static/code/send-lovelace.mjs b/doc/docusaurus/static/code/send-lovelace.mjs new file mode 100644 index 00000000000..2a4edcb2f78 --- /dev/null +++ b/doc/docusaurus/static/code/send-lovelace.mjs @@ -0,0 +1,29 @@ +import { BlockfrostProvider, MeshWallet, Transaction } from '@meshsdk/core' + +import fs from 'node:fs' + +const blockfrostKey = 'Replace with Blockfrost Project ID' +const blockchainProvider = new BlockfrostProvider(blockfrostKey) + +const recipient = fs.readFileSync(`${process.argv[2]}.addr`).toString() + +const wallet = new MeshWallet({ + networkId: 0, + fetcher: blockchainProvider, + submitter: blockchainProvider, + key: { + type: 'root', + bech32: fs.readFileSync('seller.skey').toString().trim() + } +}) + +// Send 1000 Ada +const unsignedTx = await new Transaction({ initiator: wallet }) + .sendLovelace(recipient, '1000000000') + .build() + +const signedTx = await wallet.signTx(unsignedTx) + +const txHash = await wallet.submitTx(signedTx) + +console.log(`1000 Ada sent. Recipient: ${recipient}, Tx hash: ${txHash}`) From 9bd2c9edc1cdd2252c06649950f1a66f8c2ebdd7 Mon Sep 17 00:00:00 2001 From: Ziyang Liu Date: Wed, 25 Sep 2024 13:05:50 -0700 Subject: [PATCH 07/13] Mark `&&` and `||` OPAQUE (#6510) --- .../bitwise/test/9.6/Ed25519.budget.golden | 4 +- .../bitwise/test/9.6/Ed25519.pir.golden | 70 +- ...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 +- .../test/9.6/knights10-4x4.budget.golden | 4 +- .../nofib/test/9.6/knights10-4x4.pir.golden | 839 +++++++++--------- .../nofib/test/9.6/knights10-4x4.size.golden | 2 +- .../nofib/test/9.6/queens4-bt.pir.golden | 23 +- .../nofib/test/9.6/queens4-bt.size.golden | 2 +- .../nofib/test/9.6/queens5-fc.budget.golden | 4 +- .../nofib/test/9.6/queens5-fc.pir.golden | 23 +- .../nofib/test/9.6/queens5-fc.size.golden | 2 +- plutus-tx/src/PlutusTx/Bool.hs | 60 +- 112 files changed, 711 insertions(+), 724 deletions(-) diff --git a/plutus-benchmark/bitwise/test/9.6/Ed25519.budget.golden b/plutus-benchmark/bitwise/test/9.6/Ed25519.budget.golden index ad6e596362f..dbd0d90d077 100644 --- a/plutus-benchmark/bitwise/test/9.6/Ed25519.budget.golden +++ b/plutus-benchmark/bitwise/test/9.6/Ed25519.budget.golden @@ -1,2 +1,2 @@ -({cpu: 2137056248968 -| mem: 7088454370}) \ No newline at end of file +({cpu: 2137056280968 +| mem: 7088454570}) \ No newline at end of file diff --git a/plutus-benchmark/bitwise/test/9.6/Ed25519.pir.golden b/plutus-benchmark/bitwise/test/9.6/Ed25519.pir.golden index ae399be67b1..c59f427b5e6 100644 --- a/plutus-benchmark/bitwise/test/9.6/Ed25519.pir.golden +++ b/plutus-benchmark/bitwise/test/9.6/Ed25519.pir.golden @@ -126,45 +126,49 @@ let !`$j` : Bool -> integer = \(cond : Bool) -> - let - ~`$j` : integer - = Bool_match - cond - {all dead. integer} - (/\dead -> x) - (/\dead -> - Bool_match - cond - {all dead. integer} - (/\dead -> xB) - (/\dead -> x) - {all dead. dead}) - {all dead. dead} - ~`$j` : integer - = Bool_match - cond - {all dead. integer} - (/\dead -> - Bool_match - cond - {all dead. integer} - (/\dead -> xAB) - (/\dead -> `$j`) - {all dead. dead}) - (/\dead -> `$j`) - {all dead. dead} - in Bool_match - cond + (Bool_match + cond + {all dead. Bool} + (/\dead -> + Bool_match + cond + {all dead. Bool} + (/\dead -> False) + (/\dead -> True) + {all dead. dead}) + (/\dead -> False) + {all dead. dead}) {all dead. integer} + (/\dead -> xA) (/\dead -> Bool_match - cond + (Bool_match + cond + {all dead. Bool} + (/\dead -> cond) + (/\dead -> False) + {all dead. dead}) {all dead. integer} - (/\dead -> `$j`) - (/\dead -> xA) + (/\dead -> xAB) + (/\dead -> + Bool_match + (Bool_match + (Bool_match + cond + {all dead. Bool} + (/\dead -> False) + (/\dead -> True) + {all dead. dead}) + {all dead. Bool} + (/\dead -> cond) + (/\dead -> False) + {all dead. dead}) + {all dead. integer} + (/\dead -> xB) + (/\dead -> x) + {all dead. dead}) {all dead. dead}) - (/\dead -> `$j`) {all dead. dead} in Bool_match 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 cd987c736d3..7ddd4ae857a 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: 286144915 -| mem: 1411365}) \ No newline at end of file +({cpu: 286752915 +| mem: 1415165}) \ 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 f50851e1157..4d327d277e3 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: 404984478 -| mem: 1735428}) \ No newline at end of file +({cpu: 406216478 +| mem: 1743128}) \ 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 5720beb2a5d..a39153e6e33 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: 970025702 -| mem: 5005418}) \ No newline at end of file +({cpu: 972969702 +| mem: 5023818}) \ 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 25f17695952..54b497ea697 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: 733346042 -| mem: 3414193}) \ No newline at end of file +({cpu: 735826042 +| mem: 3429693}) \ 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 125fda07b20..2ef170e88d1 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: 838521402 -| mem: 2440532}) \ No newline at end of file +({cpu: 841001402 +| mem: 2456032}) \ 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 3b79fbb52ee..98d29a393cf 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: 266907370 -| mem: 1323523}) \ No newline at end of file +({cpu: 267515370 +| mem: 1327323}) \ 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 cfce6546c05..4e71832a6bc 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: 725441759 -| mem: 3514770}) \ No newline at end of file +({cpu: 727393759 +| mem: 3526970}) \ 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 9e0cef20e0b..a24cc3c71cf 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: 708917036 -| mem: 3526929}) \ No newline at end of file +({cpu: 710245036 +| mem: 3535229}) \ 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 ba0ab0c83db..4a9c486edb4 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: 674717323 -| mem: 3204363}) \ No newline at end of file +({cpu: 676669323 +| mem: 3216563}) \ 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 bbf58fd78b6..c7f20d738cd 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: 994825658 -| mem: 4554193}) \ No newline at end of file +({cpu: 995673658 +| mem: 4559493}) \ 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 e67a83576d3..53d8bb72a53 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: 971605329 -| mem: 4185446}) \ No newline at end of file +({cpu: 972837329 +| mem: 4193146}) \ 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 505161449a2..5518352d1b2 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: 955927047 -| mem: 4741259}) \ No newline at end of file +({cpu: 957975047 +| mem: 4754059}) \ 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 3cb0aa69eb6..964056a9d8e 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: 1056957394 -| mem: 5193561}) \ No newline at end of file +({cpu: 1059005394 +| mem: 5206361}) \ 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 35c5c3c7596..304900920c4 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: 1294902269 -| mem: 6267210}) \ No newline at end of file +({cpu: 1297670269 +| mem: 6284510}) \ 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 6ca233ed8ea..b300d4806cd 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: 431885686 -| mem: 2162283}) \ No newline at end of file +({cpu: 432733686 +| mem: 2167583}) \ 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 7c39c2553f7..75c27b5dc0c 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: 684366441 -| mem: 3340211}) \ No newline at end of file +({cpu: 686318441 +| mem: 3352411}) \ 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 051bb129d5b..bea2b86103f 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: 449420894 -| mem: 2240375}) \ No newline at end of file +({cpu: 450540894 +| mem: 2247375}) \ 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 ab0a8cf66f3..9d7448f12c3 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: 687086636 -| mem: 3400483}) \ No newline at end of file +({cpu: 688606636 +| mem: 3409983}) \ 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 f6b783dffd2..4d9db318a8b 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: 269353310 -| mem: 1329825}) \ No newline at end of file +({cpu: 269961310 +| mem: 1333625}) \ 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 18024912e64..c9cc07723a8 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: 857074084 -| mem: 4113352}) \ No newline at end of file +({cpu: 859266084 +| mem: 4127052}) \ 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 3b3dabe41a6..f84275782b4 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: 705876042 -| mem: 3203809}) \ No newline at end of file +({cpu: 707588042 +| mem: 3214509}) \ 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 5808fad6357..64d93447207 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: 269407868 -| mem: 1329825}) \ No newline at end of file +({cpu: 270015868 +| mem: 1333625}) \ 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 b194c56b716..cbcb9694c52 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: 955332104 -| mem: 1270754}) \ No newline at end of file +({cpu: 956564104 +| mem: 1278454}) \ 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 7793070f4d7..29e85300f8e 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: 3865674919 -| mem: 1677986}) \ No newline at end of file +({cpu: 3866906919 +| mem: 1685686}) \ 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 899aae11ced..b68a8f6a2e9 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: 325508681 -| mem: 1593950}) \ No newline at end of file +({cpu: 326740681 +| mem: 1601650}) \ 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 3b79fbb52ee..98d29a393cf 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: 266907370 -| mem: 1323523}) \ No newline at end of file +({cpu: 267515370 +| mem: 1327323}) \ 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 19776d9d22a..cf35321d57e 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: 503494002 -| mem: 2553902}) \ No newline at end of file +({cpu: 505718002 +| mem: 2567802}) \ 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 54de08e9405..e4e05ebf78c 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: 1754786702 -| mem: 1680206}) \ No newline at end of file +({cpu: 1756018702 +| mem: 1687906}) \ 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 4d0c43a1ca0..20e771d9646 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: 841735320 -| mem: 3165952}) \ No newline at end of file +({cpu: 842967320 +| mem: 3173652}) \ 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 b46f0cc1a35..edc51185540 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: 717573728 -| mem: 3575895}) \ No newline at end of file +({cpu: 719285728 +| mem: 3586595}) \ 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 9888b08a277..044fc9a638d 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: 712741245 -| mem: 3313464}) \ No newline at end of file +({cpu: 714453245 +| mem: 3324164}) \ 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 53595531417..a3a0f077291 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: 1079129807 -| mem: 5463876}) \ No newline at end of file +({cpu: 1082649807 +| mem: 5485876}) \ 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 f6b783dffd2..4d9db318a8b 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: 269353310 -| mem: 1329825}) \ No newline at end of file +({cpu: 269961310 +| mem: 1333625}) \ 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 17d91714819..0dd1231d0ef 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: 419616222 -| mem: 2101967}) \ No newline at end of file +({cpu: 420736222 +| mem: 2108967}) \ 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 c5a9cf4e2d9..c04685e448d 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: 573056620 -| mem: 2881888}) \ No newline at end of file +({cpu: 574768620 +| mem: 2892588}) \ 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 f224f0d94e6..3ee45b04145 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: 691765597 -| mem: 3358236}) \ No newline at end of file +({cpu: 693717597 +| mem: 3370436}) \ 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 3b79fbb52ee..98d29a393cf 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: 266907370 -| mem: 1323523}) \ No newline at end of file +({cpu: 267515370 +| mem: 1327323}) \ 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 3baf5996950..554ee99d562 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: 749259900 -| mem: 3552144}) \ No newline at end of file +({cpu: 750971900 +| mem: 3562844}) \ 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 3b79fbb52ee..98d29a393cf 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: 266907370 -| mem: 1323523}) \ No newline at end of file +({cpu: 267515370 +| mem: 1327323}) \ 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 21b61f92f5e..496914f77e1 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: 963703900 -| mem: 4822893}) \ No newline at end of file +({cpu: 965511900 +| mem: 4834193}) \ 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 2f2bd79f095..547cfd8d330 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: 635103703 -| mem: 3167501}) \ No newline at end of file +({cpu: 636431703 +| mem: 3175801}) \ 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 e644eabe5da..0640c2869c4 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: 364085225 -| mem: 1624192}) \ No newline at end of file +({cpu: 365317225 +| mem: 1631892}) \ 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 c1316263032..a379d036cf1 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: 325146631 -| mem: 1569587}) \ No newline at end of file +({cpu: 325754631 +| mem: 1573387}) \ 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 7f15973e17a..2f9fd11ae5b 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: 332690133 -| mem: 1604053}) \ No newline at end of file +({cpu: 333298133 +| mem: 1607853}) \ 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 3b79fbb52ee..98d29a393cf 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: 266907370 -| mem: 1323523}) \ No newline at end of file +({cpu: 267515370 +| mem: 1327323}) \ 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 45ca7dabf76..8e310511158 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: 723991997 -| mem: 3668160}) \ No newline at end of file +({cpu: 726759997 +| mem: 3685460}) \ 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 3b79fbb52ee..98d29a393cf 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: 266907370 -| mem: 1323523}) \ No newline at end of file +({cpu: 267515370 +| mem: 1327323}) \ 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 ca9637c18cb..e77d06c6226 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: 444624366 -| mem: 2223667}) \ No newline at end of file +({cpu: 445472366 +| mem: 2228967}) \ 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 041be64758a..aa636e667e2 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: 970928544 -| mem: 4623867}) \ No newline at end of file +({cpu: 972640544 +| mem: 4634567}) \ 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 cd4cc22d864..9b5a37af395 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: 945989440 -| mem: 4637749}) \ No newline at end of file +({cpu: 947317440 +| mem: 4646049}) \ 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 51a5e1387c2..a42d53f2b8b 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: 474031895 -| mem: 2333205}) \ No newline at end of file +({cpu: 474879895 +| mem: 2338505}) \ 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 f6b783dffd2..4d9db318a8b 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: 269353310 -| mem: 1329825}) \ No newline at end of file +({cpu: 269961310 +| mem: 1333625}) \ 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 79f10628681..8118a2571ec 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: 689933591 -| mem: 3425916}) \ No newline at end of file +({cpu: 692413591 +| mem: 3441416}) \ 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 9ccf1278fbe..6b74554d6e3 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: 446445536 -| mem: 2231859}) \ No newline at end of file +({cpu: 447293536 +| mem: 2237159}) \ 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 ada638d9333..77970d0365c 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: 609929030 -| mem: 3050446}) \ No newline at end of file +({cpu: 611641030 +| mem: 3061146}) \ 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 3d71d16e03c..b414780d5a5 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: 2142028779 -| mem: 1842290}) \ No newline at end of file +({cpu: 2143260779 +| mem: 1849990}) \ 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 f48c81e4aec..eb420a2e5d2 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: 1188129473 -| mem: 4943730}) \ No newline at end of file +({cpu: 1189361473 +| mem: 4951430}) \ 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 f8a48886385..17a4edd445a 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: 976953101 -| mem: 4855053}) \ No newline at end of file +({cpu: 978761101 +| mem: 4866353}) \ 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 7793070f4d7..29e85300f8e 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: 3865674919 -| mem: 1677986}) \ No newline at end of file +({cpu: 3866906919 +| mem: 1685686}) \ 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 5d6adf8433d..74a13dc1460 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: 447015862 -| mem: 2229969}) \ No newline at end of file +({cpu: 447863862 +| mem: 2235269}) \ 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 3ea0d67eda1..f167ab5005e 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: 705982628 -| mem: 3392711}) \ No newline at end of file +({cpu: 708174628 +| mem: 3406411}) \ 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 2ae84abd69f..373b16cc361 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: 434386184 -| mem: 2168585}) \ No newline at end of file +({cpu: 435234184 +| mem: 2173885}) \ 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 d5e58782bc3..fc2b1bee58e 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: 739160627 -| mem: 3665642}) \ No newline at end of file +({cpu: 740872627 +| mem: 3676342}) \ 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 4c42892674d..bdde91d5112 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: 744734449 -| mem: 3783636}) \ No newline at end of file +({cpu: 747214449 +| mem: 3799136}) \ 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 f621e43d4b8..0e458d3b711 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: 633017451 -| mem: 3155825}) \ No newline at end of file +({cpu: 634345451 +| mem: 3164125}) \ 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 57790b935e4..883ec764c04 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: 448931998 -| mem: 2130306}) \ No newline at end of file +({cpu: 449539998 +| mem: 2134106}) \ 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 087712e0b05..f3a72aec057 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: 442402103 -| mem: 2126546}) \ No newline at end of file +({cpu: 443634103 +| mem: 2134246}) \ 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 c67e92c7089..21986d8ce58 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: 1189840944 -| mem: 4888092}) \ No newline at end of file +({cpu: 1192688944 +| mem: 4905892}) \ 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 27fad0758d7..710fa48ae42 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: 1074988029 -| mem: 5339496}) \ No newline at end of file +({cpu: 1078252029 +| mem: 5359896}) \ 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 899aae11ced..b68a8f6a2e9 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: 325508681 -| mem: 1593950}) \ No newline at end of file +({cpu: 326740681 +| mem: 1601650}) \ 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 f6b783dffd2..4d9db318a8b 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: 269353310 -| mem: 1329825}) \ No newline at end of file +({cpu: 269961310 +| mem: 1333625}) \ 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 c1ce5433ff4..e3e0022ac9a 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: 1003167014 -| mem: 4582099}) \ No newline at end of file +({cpu: 1004015014 +| mem: 4587399}) \ 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 7f15973e17a..2f9fd11ae5b 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: 332690133 -| mem: 1604053}) \ No newline at end of file +({cpu: 333298133 +| mem: 1607853}) \ 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 57790b935e4..883ec764c04 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: 448931998 -| mem: 2130306}) \ No newline at end of file +({cpu: 449539998 +| mem: 2134106}) \ 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 31cd9c21f63..f25da2036c5 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: 597824829 -| mem: 2954270}) \ No newline at end of file +({cpu: 600016829 +| mem: 2967970}) \ 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 c0aea55916e..c16ee6c19fd 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: 279542329 -| mem: 1300195}) \ No newline at end of file +({cpu: 279910329 +| mem: 1302495}) \ 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 606aa07bf07..1b3c10f2a4d 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: 533063898 -| mem: 2656202}) \ No newline at end of file +({cpu: 534775898 +| mem: 2666902}) \ 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 fcad729f804..f9edf9d01a4 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: 1280352131 -| mem: 6170852}) \ No newline at end of file +({cpu: 1282592131 +| mem: 6184852}) \ 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 196d412b58e..a5acc718869 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: 709198429 -| mem: 3550740}) \ No newline at end of file +({cpu: 710910429 +| mem: 3561440}) \ 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 e825e077a9c..9e330f06b93 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: 887667786 -| mem: 4468836}) \ No newline at end of file +({cpu: 889699786 +| mem: 4481536}) \ 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 2049e72cd0b..5b5a6c45060 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: 678677186 -| mem: 3419467}) \ No newline at end of file +({cpu: 680197186 +| mem: 3428967}) \ 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 dfe76e5b4f4..4a2ca3cc0cc 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: 758968265 -| mem: 3789760}) \ No newline at end of file +({cpu: 761448265 +| mem: 3805260}) \ 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 860f9dbdce9..d52a4c2821e 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: 948724459 -| mem: 1236410}) \ No newline at end of file +({cpu: 949956459 +| mem: 1244110}) \ 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 fbe1f7f81ef..9cbfb2ce363 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: 839348942 -| mem: 4184820}) \ No newline at end of file +({cpu: 842116942 +| mem: 4202120}) \ 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 8baddb85694..644f65a2f4f 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: 788045962 -| mem: 3895992}) \ No newline at end of file +({cpu: 790237962 +| mem: 3909692}) \ 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 9fc8477a037..09c8f653db9 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: 449652618 -| mem: 2241403}) \ No newline at end of file +({cpu: 450500618 +| mem: 2246703}) \ 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 f183f7dfed7..1b8aa9f9121 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: 17818201738 -| mem: 1107542}) \ No newline at end of file +({cpu: 17819433738 +| mem: 1115242}) \ 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 62ec611cf80..257ee9ae9d2 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: 963206761 -| mem: 4843569}) \ No newline at end of file +({cpu: 965254761 +| mem: 4856369}) \ 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 3b79fbb52ee..98d29a393cf 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: 266907370 -| mem: 1323523}) \ No newline at end of file +({cpu: 267515370 +| mem: 1327323}) \ 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 ef2239ec7b9..d8c9b65a2f0 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: 422062162 -| mem: 2108269}) \ No newline at end of file +({cpu: 423182162 +| mem: 2115269}) \ 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 b2e0de3960c..585c2f68fdc 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: 704423970 -| mem: 3548234}) \ No newline at end of file +({cpu: 706135970 +| mem: 3558934}) \ 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 7a7313e1abf..3aaac186e0f 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: 335930335 -| mem: 1547788}) \ No newline at end of file +({cpu: 337162335 +| mem: 1555488}) \ 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 64c3dd6d278..9e0646e0560 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: 357022633 -| mem: 1759368}) \ No newline at end of file +({cpu: 358254633 +| mem: 1767068}) \ 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 f6b783dffd2..4d9db318a8b 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: 269353310 -| mem: 1329825}) \ No newline at end of file +({cpu: 269961310 +| mem: 1333625}) \ 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 e55fdfed6c1..1a79d31d6a7 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: 867731409 -| mem: 2545354}) \ No newline at end of file +({cpu: 869683409 +| mem: 2557554}) \ 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 3b79fbb52ee..98d29a393cf 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: 266907370 -| mem: 1323523}) \ No newline at end of file +({cpu: 267515370 +| mem: 1327323}) \ 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 04f42eaebeb..8a8ee729b98 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: 602424691 -| mem: 2872106}) \ No newline at end of file +({cpu: 604376691 +| mem: 2884306}) \ 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 27889db5141..0e50dfcb56d 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: 689404030 -| mem: 2815274}) \ No newline at end of file +({cpu: 690636030 +| mem: 2822974}) \ 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 bce3f09301a..f89f259b83e 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: 3752661278 -| mem: 1183946}) \ No newline at end of file +({cpu: 3753893278 +| mem: 1191646}) \ 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 3cfa65f40cd..8923b09b413 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: 882819231 -| mem: 4314954}) \ No newline at end of file +({cpu: 885091231 +| mem: 4329154}) \ 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 8dfb48668a2..8e6b49028e2 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 @@ -12178 \ No newline at end of file +12183 \ No newline at end of file diff --git a/plutus-benchmark/nofib/test/9.6/knights10-4x4.budget.golden b/plutus-benchmark/nofib/test/9.6/knights10-4x4.budget.golden index 4177401b5b2..31561b0a542 100644 --- a/plutus-benchmark/nofib/test/9.6/knights10-4x4.budget.golden +++ b/plutus-benchmark/nofib/test/9.6/knights10-4x4.budget.golden @@ -1,2 +1,2 @@ -({cpu: 1519310000 -| mem: 7804412}) \ No newline at end of file +({cpu: 1532270000 +| mem: 7885412}) \ No newline at end of file diff --git a/plutus-benchmark/nofib/test/9.6/knights10-4x4.pir.golden b/plutus-benchmark/nofib/test/9.6/knights10-4x4.pir.golden index c8d0b721a34..d0e000f0965 100644 --- a/plutus-benchmark/nofib/test/9.6/knights10-4x4.pir.golden +++ b/plutus-benchmark/nofib/test/9.6/knights10-4x4.pir.golden @@ -1,32 +1,4 @@ (let - data Direction | Direction_match where - DL : Direction - DR : Direction - LD : Direction - LU : Direction - RD : Direction - RU : Direction - UL : Direction - UR : Direction - in - letrec - data (List :: * -> *) a | List_match where - Nil : List a - Cons : a -> List a -> List a - in - letrec - !go : List Direction -> integer - = \(ds : List Direction) -> - List_match - {Direction} - ds - {all dead. integer} - (/\dead -> 0) - (\(x : Direction) (xs : List Direction) -> - /\dead -> addInteger 1 (go xs)) - {all dead. dead} - in - let data Bool | Bool_match where True : Bool False : Bool @@ -35,6 +7,13 @@ Nothing : Maybe a data (Tuple2 :: * -> * -> *) a b | Tuple2_match where Tuple2 : a -> b -> Tuple2 a b + in + letrec + data (List :: * -> *) a | List_match where + Nil : List a + Cons : a -> List a -> List a + in + let data ChessSet | ChessSet_match where Board : integer -> @@ -151,6 +130,29 @@ /\dead -> addInteger 1 (go xs)) {all dead. dead} in + let + data Direction | Direction_match where + DL : Direction + DR : Direction + LD : Direction + LU : Direction + RD : Direction + RU : Direction + UL : Direction + UR : Direction + in + letrec + !go : List Direction -> integer + = \(ds : List Direction) -> + List_match + {Direction} + ds + {all dead. integer} + (/\dead -> 0) + (\(x : Direction) (xs : List Direction) -> + /\dead -> addInteger 1 (go xs)) + {all dead. dead} + in letrec !go : List (Tuple2 integer ChessSet) -> List (Tuple2 integer ChessSet) = \(ds : List (Tuple2 integer ChessSet)) -> @@ -605,10 +607,15 @@ (\(a : a) (as : List a) -> /\dead -> Bool_match - (`$dEq` ds a) + (Bool_match + (`$dEq` ds a) + {all dead. Bool} + (/\dead -> False) + (/\dead -> True) + {all dead. dead}) {all dead. Bool} - (/\dead -> False) (/\dead -> notIn {a} `$dEq` ds as) + (/\dead -> False) {all dead. dead}) {all dead. dead} in @@ -681,7 +688,13 @@ False) {all dead. Bool} (/\dead -> - equalsInteger b b') + ifThenElse + {Bool} + (equalsInteger + b + b') + True + False) (/\dead -> False) {all dead. dead}))) t @@ -1188,394 +1201,396 @@ (\(ds : ChessSet) (ds : List ChessSet) -> Cons {ChessSet} ds ds) (Nil {ChessSet}) - ~`$j` : List ChessSet - = let - !l : integer = go singles - in - Bool_match - (ifThenElse {Bool} (equalsInteger 0 l) True False) - {all dead. List ChessSet} - (/\dead -> - go - (quickSort - {Tuple2 integer ChessSet} - (CConsOrd - {Tuple2 integer ChessSet} - (\(eta : Tuple2 integer ChessSet) - (eta : Tuple2 integer ChessSet) -> - Tuple2_match - {integer} - {ChessSet} - eta - {Bool} - (\(a : integer) (b : ChessSet) -> - Tuple2_match - {integer} - {ChessSet} - eta - {Bool} - (\(a' : integer) - (b' : ChessSet) -> - Bool_match - (`$p1Ord` - {integer} - v - a - a') - {all dead. Bool} - (/\dead -> - `$p1Ord` - {ChessSet} - v - b - b') - (/\dead -> False) - {all dead. dead}))) - (\(ds : Tuple2 integer ChessSet) - (ds : Tuple2 integer ChessSet) -> - Tuple2_match - {integer} - {ChessSet} - ds - {Ordering} - (\(a : integer) (b : ChessSet) -> - Tuple2_match - {integer} - {ChessSet} - ds - {Ordering} - (\(a' : integer) -> - let - ~defaultBody : Ordering - = compare - {integer} - v - a - a' - in - \(b' : ChessSet) -> - Ordering_match - (compare - {integer} - v - a - a') - {all dead. Ordering} - (/\dead -> - compare - {ChessSet} - v - b - b') - (/\dead -> defaultBody) - (/\dead -> defaultBody) - {all dead. dead}))) - (\(x : Tuple2 integer ChessSet) - (y : Tuple2 integer ChessSet) -> - Tuple2_match - {integer} - {ChessSet} - x - {Bool} - (\(ipv : integer) - (ipv : ChessSet) -> - Tuple2_match - {integer} - {ChessSet} - y - {Bool} - (\(ipv : integer) - (ipv : ChessSet) -> - Ordering_match - (compare - {integer} - v - ipv - ipv) - {all dead. Bool} - (/\dead -> - Ordering_match - (compare - {ChessSet} - v - ipv - ipv) - {all dead. Bool} - (/\dead -> False) - (/\dead -> False) - (/\dead -> True) - {all dead. dead}) - (/\dead -> False) - (/\dead -> True) - {all dead. dead}))) - (\(x : Tuple2 integer ChessSet) - (y : Tuple2 integer ChessSet) -> - Tuple2_match - {integer} - {ChessSet} - x - {Bool} - (\(ipv : integer) - (ipv : ChessSet) -> - Tuple2_match - {integer} - {ChessSet} - y - {Bool} - (\(ipv : integer) - (ipv : ChessSet) -> - Ordering_match - (compare - {integer} - v - ipv - ipv) - {all dead. Bool} - (/\dead -> - Ordering_match - (compare - {ChessSet} - v - ipv - ipv) - {all dead. Bool} - (/\dead -> True) - (/\dead -> False) - (/\dead -> True) - {all dead. dead}) - (/\dead -> False) - (/\dead -> True) - {all dead. dead}))) - (\(x : Tuple2 integer ChessSet) - (y : Tuple2 integer ChessSet) -> - Tuple2_match - {integer} - {ChessSet} - x - {Bool} - (\(ipv : integer) - (ipv : ChessSet) -> - Tuple2_match - {integer} - {ChessSet} - y - {Bool} - (\(ipv : integer) - (ipv : ChessSet) -> - Ordering_match - (compare - {integer} - v - ipv - ipv) - {all dead. Bool} - (/\dead -> - Ordering_match - (compare - {ChessSet} - v - ipv - ipv) - {all dead. Bool} - (/\dead -> False) - (/\dead -> True) - (/\dead -> False) - {all dead. dead}) - (/\dead -> True) - (/\dead -> False) - {all dead. dead}))) - (\(x : Tuple2 integer ChessSet) - (y : Tuple2 integer ChessSet) -> - Tuple2_match - {integer} - {ChessSet} - x - {Bool} - (\(ipv : integer) - (ipv : ChessSet) -> - Tuple2_match - {integer} - {ChessSet} - y - {Bool} - (\(ipv : integer) - (ipv : ChessSet) -> - Ordering_match - (compare - {integer} - v - ipv - ipv) - {all dead. Bool} - (/\dead -> - Ordering_match - (compare - {ChessSet} - v - ipv - ipv) - {all dead. Bool} - (/\dead -> True) - (/\dead -> True) - (/\dead -> False) - {all dead. dead}) - (/\dead -> True) - (/\dead -> False) - {all dead. dead}))) - (\(x : Tuple2 integer ChessSet) - (y : Tuple2 integer ChessSet) -> - Tuple2_match - {integer} - {ChessSet} - x - {Tuple2 integer ChessSet} - (\(ipv : integer) - (ipv : ChessSet) -> - Tuple2_match - {integer} - {ChessSet} - y - {Tuple2 integer ChessSet} - (\(ipv : integer) - (ipv : ChessSet) -> - Ordering_match - (compare - {integer} - v - ipv - ipv) - {all dead. - Tuple2 - integer - ChessSet} - (/\dead -> - Ordering_match - (compare - {ChessSet} - v - ipv - ipv) - {all dead. - Tuple2 - integer - ChessSet} - (/\dead -> y) - (/\dead -> x) - (/\dead -> y) - {all dead. dead}) - (/\dead -> x) - (/\dead -> y) - {all dead. dead}))) - (\(x : Tuple2 integer ChessSet) - (y : Tuple2 integer ChessSet) -> - Tuple2_match - {integer} - {ChessSet} - x - {Tuple2 integer ChessSet} - (\(ipv : integer) - (ipv : ChessSet) -> - Tuple2_match - {integer} - {ChessSet} - y - {Tuple2 integer ChessSet} - (\(ipv : integer) - (ipv : ChessSet) -> - Ordering_match - (compare - {integer} - v - ipv - ipv) - {all dead. - Tuple2 - integer - ChessSet} - (/\dead -> - Ordering_match - (compare - {ChessSet} - v - ipv - ipv) - {all dead. - Tuple2 - integer - ChessSet} - (/\dead -> x) - (/\dead -> y) - (/\dead -> x) - {all dead. dead}) - (/\dead -> y) - (/\dead -> x) - {all dead. dead})))) - (descAndNo y))) - (/\dead -> - Bool_match - (ifThenElse - {Bool} - (equalsInteger 1 l) - True - False) - {all dead. List ChessSet} - (/\dead -> singles) - (/\dead -> Nil {ChessSet}) - {all dead. dead}) - {all dead. dead} in Bool_match - (canMoveTo - (Maybe_match - {Tuple2 integer integer} - ipv - {all dead. Tuple2 integer integer} - (\(tile : Tuple2 integer integer) -> - /\dead -> tile) - (/\dead -> error {Tuple2 integer integer}) - {all dead. dead}) - (deleteFirst y)) + (Bool_match + (canMoveTo + (Maybe_match + {Tuple2 integer integer} + ipv + {all dead. Tuple2 integer integer} + (\(tile : Tuple2 integer integer) -> + /\dead -> tile) + (/\dead -> error {Tuple2 integer integer}) + {all dead. dead}) + (deleteFirst y)) + {all dead. Bool} + (/\dead -> + let + !board : ChessSet + = Maybe_match + {Tuple2 integer integer} + ipv + {all dead. ChessSet} + (\(tile : Tuple2 integer integer) -> + /\dead -> + Board + ipv + (addInteger 1 ipv) + ipv + (Cons + {Tuple2 integer integer} + tile + ipv)) + (/\dead -> + let + !t : Tuple2 integer integer + = error {Tuple2 integer integer} + in + Board + ipv + (addInteger 1 ipv) + (Nothing {Tuple2 integer integer}) + (Cons + {Tuple2 integer integer} + t + ipv)) + {all dead. dead} + in + ifThenElse + {Bool} + (equalsInteger 0 (go (possibleMoves board))) + True + False) + (/\dead -> False) + {all dead. dead}) {all dead. List ChessSet} + (/\dead -> Nil {ChessSet}) (/\dead -> + let + !l : integer = go singles + in Bool_match - (let - !board : ChessSet - = Maybe_match - {Tuple2 integer integer} - ipv - {all dead. ChessSet} - (\(tile : Tuple2 integer integer) -> - /\dead -> - Board - ipv - (addInteger 1 ipv) - ipv - (Cons - {Tuple2 integer integer} - tile - ipv)) - (/\dead -> - let - !t : Tuple2 integer integer - = error {Tuple2 integer integer} - in - Board - ipv - (addInteger 1 ipv) - (Nothing {Tuple2 integer integer}) - (Cons {Tuple2 integer integer} t ipv)) - {all dead. dead} - in - ifThenElse - {Bool} - (equalsInteger 0 (go (possibleMoves board))) - True - False) + (ifThenElse {Bool} (equalsInteger 0 l) True False) {all dead. List ChessSet} - (/\dead -> Nil {ChessSet}) - (/\dead -> `$j`) + (/\dead -> + go + (quickSort + {Tuple2 integer ChessSet} + (CConsOrd + {Tuple2 integer ChessSet} + (\(eta : Tuple2 integer ChessSet) + (eta : Tuple2 integer ChessSet) -> + Tuple2_match + {integer} + {ChessSet} + eta + {Bool} + (\(a : integer) (b : ChessSet) -> + Tuple2_match + {integer} + {ChessSet} + eta + {Bool} + (\(a' : integer) + (b' : ChessSet) -> + Bool_match + (`$p1Ord` + {integer} + v + a + a') + {all dead. Bool} + (/\dead -> + `$p1Ord` + {ChessSet} + v + b + b') + (/\dead -> False) + {all dead. dead}))) + (\(ds : Tuple2 integer ChessSet) + (ds : Tuple2 integer ChessSet) -> + Tuple2_match + {integer} + {ChessSet} + ds + {Ordering} + (\(a : integer) (b : ChessSet) -> + Tuple2_match + {integer} + {ChessSet} + ds + {Ordering} + (\(a' : integer) -> + let + ~defaultBody : Ordering + = compare + {integer} + v + a + a' + in + \(b' : ChessSet) -> + Ordering_match + (compare + {integer} + v + a + a') + {all dead. Ordering} + (/\dead -> + compare + {ChessSet} + v + b + b') + (/\dead -> defaultBody) + (/\dead -> defaultBody) + {all dead. dead}))) + (\(x : Tuple2 integer ChessSet) + (y : Tuple2 integer ChessSet) -> + Tuple2_match + {integer} + {ChessSet} + x + {Bool} + (\(ipv : integer) + (ipv : ChessSet) -> + Tuple2_match + {integer} + {ChessSet} + y + {Bool} + (\(ipv : integer) + (ipv : ChessSet) -> + Ordering_match + (compare + {integer} + v + ipv + ipv) + {all dead. Bool} + (/\dead -> + Ordering_match + (compare + {ChessSet} + v + ipv + ipv) + {all dead. Bool} + (/\dead -> False) + (/\dead -> False) + (/\dead -> True) + {all dead. dead}) + (/\dead -> False) + (/\dead -> True) + {all dead. dead}))) + (\(x : Tuple2 integer ChessSet) + (y : Tuple2 integer ChessSet) -> + Tuple2_match + {integer} + {ChessSet} + x + {Bool} + (\(ipv : integer) + (ipv : ChessSet) -> + Tuple2_match + {integer} + {ChessSet} + y + {Bool} + (\(ipv : integer) + (ipv : ChessSet) -> + Ordering_match + (compare + {integer} + v + ipv + ipv) + {all dead. Bool} + (/\dead -> + Ordering_match + (compare + {ChessSet} + v + ipv + ipv) + {all dead. Bool} + (/\dead -> True) + (/\dead -> False) + (/\dead -> True) + {all dead. dead}) + (/\dead -> False) + (/\dead -> True) + {all dead. dead}))) + (\(x : Tuple2 integer ChessSet) + (y : Tuple2 integer ChessSet) -> + Tuple2_match + {integer} + {ChessSet} + x + {Bool} + (\(ipv : integer) + (ipv : ChessSet) -> + Tuple2_match + {integer} + {ChessSet} + y + {Bool} + (\(ipv : integer) + (ipv : ChessSet) -> + Ordering_match + (compare + {integer} + v + ipv + ipv) + {all dead. Bool} + (/\dead -> + Ordering_match + (compare + {ChessSet} + v + ipv + ipv) + {all dead. Bool} + (/\dead -> False) + (/\dead -> True) + (/\dead -> False) + {all dead. dead}) + (/\dead -> True) + (/\dead -> False) + {all dead. dead}))) + (\(x : Tuple2 integer ChessSet) + (y : Tuple2 integer ChessSet) -> + Tuple2_match + {integer} + {ChessSet} + x + {Bool} + (\(ipv : integer) + (ipv : ChessSet) -> + Tuple2_match + {integer} + {ChessSet} + y + {Bool} + (\(ipv : integer) + (ipv : ChessSet) -> + Ordering_match + (compare + {integer} + v + ipv + ipv) + {all dead. Bool} + (/\dead -> + Ordering_match + (compare + {ChessSet} + v + ipv + ipv) + {all dead. Bool} + (/\dead -> True) + (/\dead -> True) + (/\dead -> False) + {all dead. dead}) + (/\dead -> True) + (/\dead -> False) + {all dead. dead}))) + (\(x : Tuple2 integer ChessSet) + (y : Tuple2 integer ChessSet) -> + Tuple2_match + {integer} + {ChessSet} + x + {Tuple2 integer ChessSet} + (\(ipv : integer) + (ipv : ChessSet) -> + Tuple2_match + {integer} + {ChessSet} + y + {Tuple2 integer ChessSet} + (\(ipv : integer) + (ipv : ChessSet) -> + Ordering_match + (compare + {integer} + v + ipv + ipv) + {all dead. + Tuple2 + integer + ChessSet} + (/\dead -> + Ordering_match + (compare + {ChessSet} + v + ipv + ipv) + {all dead. + Tuple2 + integer + ChessSet} + (/\dead -> y) + (/\dead -> x) + (/\dead -> y) + {all dead. dead}) + (/\dead -> x) + (/\dead -> y) + {all dead. dead}))) + (\(x : Tuple2 integer ChessSet) + (y : Tuple2 integer ChessSet) -> + Tuple2_match + {integer} + {ChessSet} + x + {Tuple2 integer ChessSet} + (\(ipv : integer) + (ipv : ChessSet) -> + Tuple2_match + {integer} + {ChessSet} + y + {Tuple2 integer ChessSet} + (\(ipv : integer) + (ipv : ChessSet) -> + Ordering_match + (compare + {integer} + v + ipv + ipv) + {all dead. + Tuple2 + integer + ChessSet} + (/\dead -> + Ordering_match + (compare + {ChessSet} + v + ipv + ipv) + {all dead. + Tuple2 + integer + ChessSet} + (/\dead -> x) + (/\dead -> y) + (/\dead -> x) + {all dead. dead}) + (/\dead -> y) + (/\dead -> x) + {all dead. dead})))) + (descAndNo y))) + (/\dead -> + Bool_match + (ifThenElse + {Bool} + (equalsInteger 1 l) + True + False) + {all dead. List ChessSet} + (/\dead -> singles) + (/\dead -> Nil {ChessSet}) + {all dead. dead}) {all dead. dead}) - (/\dead -> `$j`) {all dead. dead})))) (\(ds : Tuple2 integer ChessSet) -> Tuple2_match diff --git a/plutus-benchmark/nofib/test/9.6/knights10-4x4.size.golden b/plutus-benchmark/nofib/test/9.6/knights10-4x4.size.golden index 4af39701d0b..6c14b486075 100644 --- a/plutus-benchmark/nofib/test/9.6/knights10-4x4.size.golden +++ b/plutus-benchmark/nofib/test/9.6/knights10-4x4.size.golden @@ -1 +1 @@ -2049 \ No newline at end of file +2056 \ No newline at end of file diff --git a/plutus-benchmark/nofib/test/9.6/queens4-bt.pir.golden b/plutus-benchmark/nofib/test/9.6/queens4-bt.pir.golden index 2fde40353ac..e330f3b30e6 100644 --- a/plutus-benchmark/nofib/test/9.6/queens4-bt.pir.golden +++ b/plutus-benchmark/nofib/test/9.6/queens4-bt.pir.golden @@ -183,27 +183,34 @@ ds {all dead. List a} (/\dead -> Nil {a}) - (\(y : a) (ys : List a) -> + (\(y : a) -> letrec - !go : List a -> List a + !go : List a -> Bool = \(ds : List a) -> List_match {a} ds - {all dead. List a} - (/\dead -> - Cons {a} y (nubBy' ys (Cons {a} y ds))) + {all dead. Bool} + (/\dead -> False) (\(x : a) (xs : List a) -> /\dead -> Bool_match (eq x y) - {all dead. List a} - (/\dead -> nubBy' ys ds) + {all dead. Bool} + (/\dead -> True) (/\dead -> go xs) {all dead. dead}) {all dead. dead} in - /\dead -> go ds) + \(ys : List a) -> + /\dead -> + Bool_match + (go ds) + {all dead. List a} + (/\dead -> nubBy' ys ds) + (/\dead -> + Cons {a} y (nubBy' ys (Cons {a} y ds))) + {all dead. dead}) {all dead. dead} in \(xs : List a) (ys : List a) -> diff --git a/plutus-benchmark/nofib/test/9.6/queens4-bt.size.golden b/plutus-benchmark/nofib/test/9.6/queens4-bt.size.golden index 7411188d973..93f881d119e 100644 --- a/plutus-benchmark/nofib/test/9.6/queens4-bt.size.golden +++ b/plutus-benchmark/nofib/test/9.6/queens4-bt.size.golden @@ -1 +1 @@ -1954 \ No newline at end of file +1960 \ No newline at end of file diff --git a/plutus-benchmark/nofib/test/9.6/queens5-fc.budget.golden b/plutus-benchmark/nofib/test/9.6/queens5-fc.budget.golden index a323a52ad4e..840df570e93 100644 --- a/plutus-benchmark/nofib/test/9.6/queens5-fc.budget.golden +++ b/plutus-benchmark/nofib/test/9.6/queens5-fc.budget.golden @@ -1,2 +1,2 @@ -({cpu: 180628654621 -| mem: 1032052766}) \ No newline at end of file +({cpu: 182013934621 +| mem: 1040710766}) \ No newline at end of file diff --git a/plutus-benchmark/nofib/test/9.6/queens5-fc.pir.golden b/plutus-benchmark/nofib/test/9.6/queens5-fc.pir.golden index 84a7b7e8c4f..6e444a39736 100644 --- a/plutus-benchmark/nofib/test/9.6/queens5-fc.pir.golden +++ b/plutus-benchmark/nofib/test/9.6/queens5-fc.pir.golden @@ -183,27 +183,34 @@ ds {all dead. List a} (/\dead -> Nil {a}) - (\(y : a) (ys : List a) -> + (\(y : a) -> letrec - !go : List a -> List a + !go : List a -> Bool = \(ds : List a) -> List_match {a} ds - {all dead. List a} - (/\dead -> - Cons {a} y (nubBy' ys (Cons {a} y ds))) + {all dead. Bool} + (/\dead -> False) (\(x : a) (xs : List a) -> /\dead -> Bool_match (eq x y) - {all dead. List a} - (/\dead -> nubBy' ys ds) + {all dead. Bool} + (/\dead -> True) (/\dead -> go xs) {all dead. dead}) {all dead. dead} in - /\dead -> go ds) + \(ys : List a) -> + /\dead -> + Bool_match + (go ds) + {all dead. List a} + (/\dead -> nubBy' ys ds) + (/\dead -> + Cons {a} y (nubBy' ys (Cons {a} y ds))) + {all dead. dead}) {all dead. dead} in \(xs : List a) (ys : List a) -> diff --git a/plutus-benchmark/nofib/test/9.6/queens5-fc.size.golden b/plutus-benchmark/nofib/test/9.6/queens5-fc.size.golden index 7411188d973..93f881d119e 100644 --- a/plutus-benchmark/nofib/test/9.6/queens5-fc.size.golden +++ b/plutus-benchmark/nofib/test/9.6/queens5-fc.size.golden @@ -1 +1 @@ -1954 \ No newline at end of file +1960 \ No newline at end of file diff --git a/plutus-tx/src/PlutusTx/Bool.hs b/plutus-tx/src/PlutusTx/Bool.hs index 29c150dd2ab..98328107047 100644 --- a/plutus-tx/src/PlutusTx/Bool.hs +++ b/plutus-tx/src/PlutusTx/Bool.hs @@ -8,28 +8,28 @@ import Prelude (Bool (..), otherwise) {- HLINT ignore -} +-- `(&&)` and `(||)` are handled specially in the plugin to make sure they can short-circuit. -- See Note [Lazy boolean operators] in the plugin. -{-# INLINE (&&) #-} --- | Logical AND +{-# OPAQUE (&&) #-} +-- | Logical AND. Short-circuits if the first argument evaluates to `False`. -- -- >>> True && False -- False -- infixr 3 && (&&) :: Bool -> Bool -> Bool --- See Note [Lazy patterns on function parameters] -(&&) l ~r = if l then r else False +(&&) l r = if l then r else False -{-# INLINE (||) #-} --- | Logical OR +{-# OPAQUE (||) #-} +-- | Logical OR. Short-circuits if the first argument evaluates to `True`. -- -- >>> True || False -- True -- infixr 2 || (||) :: Bool -> Bool -> Bool -(||) l ~r = if l then True else r +(||) l r = if l then True else r {-# INLINABLE not #-} -- | Logical negation @@ -39,49 +39,3 @@ infixr 2 || -- not :: Bool -> Bool not a = if a then False else True - -{- Note [Lazy patterns on function parameters] -In theory, Lazy patterns (~) on function parameters shouldn't make any difference. -This is because function applications in Plutus Tx are strict, so when passing an argument -to a function, the argument will be evaluated immediately, regardless of whether the -corresponding function parameter is lazy or strict. Specifically, both `f !x = body` and -`f ~x = body` in Plutus Tx are compiled into `let f = \x -> body` in PIR: - -``` -f ~x = body ----> (GHC Core) -f x = body ----> (PIR) -f = \x -> body - -f !x = body ----> (GHC Core) -f x = case x@x of { _ -> body } ----> (PIR) -f = \x -> let !x = x in body ----> (PIR inliner) -f = \x -> body -``` - -It doesn't matter whether or not the function is inlined by the PIR inliner, since the PIR -inliner does not change the semantics of the program. - -However, it *does* make a difference if the function is inlined by GHC. -Consider the Plutus Tx code `let f !x = t in f arg`. Here `arg` will be immediately evaluated before -being passed to `f` (as it should). But now consider `let f ~x = t in f arg`. Here GHC -may inline `f`, leading to `t [x := arg]` (recognize that the GHC inliner -also performs beta reduction, in addition to replacing `f` with its definition), where `arg` -may not be evaluated. GHC does so because it is a Haskell compiler and does not know that -Plutus Tx is a strict language. - -Therefore, lazy patterns should generally be avoided, since its semantics depend on -what the GHC inliner does. That said, we can use it in some cases to our advantage, -such as in `(&&)` and `(||)`. These logical operators would be much less useful if -they can't short-circuit. Using a lazy pattern on the second parameter helps achieve -the desirable effect, namely, the second parameter is only evaluated if needed, although -this is currently not guaranteed, GHC makes no promise to inline `(&&)` and `(||)`. -To guarantee that the second parameter is only evaluated -when needed, we can potentially use a particular source annotation to tell the PIR -inliner to inline and beta-reduce a function, which would achieve the same effect as if -it is unconditionally inlined by GHC. This is yet to be implemented. --} From f39a305169abb3840d241ab3cbc1b57c304ce2b1 Mon Sep 17 00:00:00 2001 From: Ramsay Taylor Date: Thu, 26 Sep 2024 06:50:34 +0100 Subject: [PATCH 08/13] Translation relation and decision procedure for the Float-Delay (#6482) * WIP * WIP * WIP * WIP * WIP * WIP - Most of the nFD->FD proof is done but I am now wondering if the application rules need the force in them... * Some progress on the FD->pureFD proof... Not completely sure it is going in a good direction... * Made the parameters to istranslation implicit, since they are encoded in the relation anyway * WIP * WIP * WIP - with crazy variable binding issues * Add 'forall DecEq' to 'Relation' * Roman's additions. * Workign Float-Delay translation relation and decision procedure. * Missed a definition * Now uses Purity, althought that is 'stub code' at the moment. * Now with added Purity... * Remove 'Terminating' from 'translation?' --------- Co-authored-by: effectfully --- .../src/VerifiedCompilation/Purity.lagda.md | 25 ++ .../VerifiedCompilation/UCaseOfCase.lagda.md | 16 +- .../VerifiedCompilation/UFloatDelay.lagda.md | 157 +++++++++ .../VerifiedCompilation/UForceDelay.lagda.md | 285 +++++++++++++--- .../UntypedTranslation.lagda.md | 313 +++++++++++------- .../VerifiedCompilation/UntypedViews.lagda.md | 2 +- 6 files changed, 619 insertions(+), 179 deletions(-) create mode 100644 plutus-metatheory/src/VerifiedCompilation/Purity.lagda.md create mode 100644 plutus-metatheory/src/VerifiedCompilation/UFloatDelay.lagda.md diff --git a/plutus-metatheory/src/VerifiedCompilation/Purity.lagda.md b/plutus-metatheory/src/VerifiedCompilation/Purity.lagda.md new file mode 100644 index 00000000000..140c3c2d70b --- /dev/null +++ b/plutus-metatheory/src/VerifiedCompilation/Purity.lagda.md @@ -0,0 +1,25 @@ +--- +title: VerifiedCompilation.Purity +layout: page +--- + +# Definitions of Purity for Terms +``` +module VerifiedCompilation.Purity where + +``` +## Imports + +``` +open import Untyped using (_⊢; case; builtin; _·_; force; `; ƛ; delay; con; constr; error) +open import Relation.Nullary using (Dec; yes; no; ¬_) + +``` +## Untyped Purity +``` +data UPure (X : Set) : (X ⊢) → Set where + FIXME : (t : X ⊢) → UPure X t + +isUPure? : {X : Set} → (t : X ⊢) → Dec (UPure X t) +isUPure? t = yes (FIXME t) +``` diff --git a/plutus-metatheory/src/VerifiedCompilation/UCaseOfCase.lagda.md b/plutus-metatheory/src/VerifiedCompilation/UCaseOfCase.lagda.md index 5b857251aba..2bcce6d9f3f 100644 --- a/plutus-metatheory/src/VerifiedCompilation/UCaseOfCase.lagda.md +++ b/plutus-metatheory/src/VerifiedCompilation/UCaseOfCase.lagda.md @@ -34,13 +34,13 @@ open import Data.List using (List; _∷_; []) ## Translation Relation This compiler stage only applies to the very specific case where an `IfThenElse` builtin exists in a `case` expression. -It moves the `IfThenElse` outside and creates two `case` expressions with each of the possible lists of cases. +It moves the `IfThenElse` outside and creates two `case` expressions with each of the possible lists of cases. This will just be an instance of the `Translation` relation once we define the "before" and "after" patterns. ``` data CoC : Relation where - isCoC : {X : Set} → (b : X ⊢) (tn fn : ℕ) (tt tt' ft ft' alts alts' : List (X ⊢)) → + isCoC : {X : Set} {{_ : DecEq X}} → (b : X ⊢) (tn fn : ℕ) (tt tt' ft ft' alts alts' : List (X ⊢)) → Pointwise (Translation CoC) alts alts' → Pointwise (Translation CoC) tt tt' → Pointwise (Translation CoC) ft ft' → @@ -76,7 +76,7 @@ isCoCCase? t | no ¬CoCCase = no λ { (isCoCCase b tn fn alts tt ft) → ¬CoCC (isconstr tn (allterms alts))) (isconstr fn (allterms tt))) (allterms ft)) } - + data CoCForce {X : Set} : (X ⊢) → Set where isCoCForce : (b : (X ⊢)) (tn fn : ℕ) (tt' ft' alts' : List (X ⊢)) → CoCForce (force ((((force (builtin ifThenElse)) · b) · (delay (case (constr tn tt') alts'))) · (delay (case (constr fn ft') alts')))) isCoCForce? : {X : Set} {{ _ : DecEq X }} → Unary.Decidable (CoCForce {X}) @@ -103,12 +103,12 @@ isUntypedCaseOfCase? : {X : Set} {{_ : DecEq X}} → Binary.Decidable (Translati isCoC? : {X : Set} {{_ : DecEq X}} → Binary.Decidable (CoC {X}) isCoC? ast ast' with (isCoCCase? ast) ×-dec (isCoCForce? ast') ... | no ¬cf = no λ { (isCoC b tn fn tt tt' ft ft' alts alts' x x₁ x₂) → ¬cf - (isCoCCase b tn fn tt ft alts , isCoCForce b tn fn tt' ft' alts') } + (isCoCCase b tn fn tt ft alts , isCoCForce b tn fn tt' ft' alts') } ... | yes (isCoCCase b tn fn tt ft alts , isCoCForce b₁ tn₁ fn₁ tt' ft' alts') with (b ≟ b₁) ×-dec (tn ≟ tn₁) ×-dec (fn ≟ fn₁) ×-dec (decPointwise isUntypedCaseOfCase? tt tt') ×-dec (decPointwise isUntypedCaseOfCase? ft ft') ×-dec (decPointwise isUntypedCaseOfCase? alts alts') ... | yes (refl , refl , refl , ttpw , ftpw , altpw) = yes (isCoC b tn fn tt tt' ft ft' alts alts' altpw ttpw ftpw) ... | no ¬p = no λ { (isCoC .b .tn .fn .tt .tt' .ft .ft' .alts .alts' x x₁ x₂) → ¬p (refl , refl , refl , x₁ , x₂ , x) } -isUntypedCaseOfCase? {X} = translation? {X} isCoC? +isUntypedCaseOfCase? {X} = translation? {X} isCoC? ``` ## Semantic Equivalence @@ -125,11 +125,11 @@ The `stepper` function uses the CEK machine to evaluate a term. Here we call it large gas budget and begin in an empty context (which assumes the term is closed). ``` --- TODO: Several approaches are possible. +-- TODO: Several approaches are possible. --semantic_equivalence : ∀ {X set} {ast ast' : ⊥ ⊢} -- → ⊥ ⊢̂ ast ⊳̂ ast' - -- + -- -- → (stepper maxsteps (Stack.ϵ ; [] ▻ ast)) ≡ (stepper maxsteps (Stack.ε ; [] ▻ ast')) --- ∀ {s : ℕ} → stepper s ast ≡ ⇔ ∃ { s' : ℕ } [ stepper s' ast' ≡ ] +-- ∀ {s : ℕ} → stepper s ast ≡ ⇔ ∃ { s' : ℕ } [ stepper s' ast' ≡ ] ``` diff --git a/plutus-metatheory/src/VerifiedCompilation/UFloatDelay.lagda.md b/plutus-metatheory/src/VerifiedCompilation/UFloatDelay.lagda.md new file mode 100644 index 00000000000..13cfefc4cf5 --- /dev/null +++ b/plutus-metatheory/src/VerifiedCompilation/UFloatDelay.lagda.md @@ -0,0 +1,157 @@ +--- +title: VerifiedCompilation.UFloatDelay +layout: page +--- + +# Float-Delay Translation Phase +``` +module VerifiedCompilation.UFloatDelay where + +``` +## Imports + +``` +open import VerifiedCompilation.Equality using (DecEq; _≟_;decPointwise) +open import VerifiedCompilation.UntypedViews using (Pred; isCase?; isApp?; isLambda?; isForce?; isBuiltin?; isConstr?; isDelay?; isTerm?; isVar?; allTerms?; iscase; isapp; islambda; isforce; isbuiltin; isconstr; isterm; allterms; isdelay; isvar) +open import VerifiedCompilation.UntypedTranslation using (Translation; translation?; Relation; convert; reflexive) +open import Relation.Nullary.Product using (_×-dec_) +open import Untyped using (_⊢; case; builtin; _·_; force; `; ƛ; delay; con; constr; error) +import Relation.Binary.PropositionalEquality as Eq +open Eq using (_≡_; refl; _≢_) +open import Data.Empty using (⊥) +open import Function using (case_of_) +open import Agda.Builtin.Maybe using (Maybe; just; nothing) +open import Data.List using (map; all) +open import Relation.Nullary using (Dec; yes; no; ¬_) +import Relation.Binary as Binary using (Decidable) +open import Data.Product using (_,_) +open import Data.Nat using (ℕ) +open import Data.List using (List) +open import Builtin using (Builtin) +open import RawU using (TmCon) +open import VerifiedCompilation.Purity using (UPure; isUPure?) +open import Data.List.Relation.Unary.All using (All; all?) + +variable + X : Set + x x' y y' : X ⊢ +``` +## Translation Relation + +This translation "floats" delays in applied terms into the abstraction, without inlining the whole term. +This is separate from inlining because the added `delay` may make it seem like a substantial increase in code +size, and so dissuade the inliner from executing. However, it may be that the laziness inside the resulting term +is more computationally efficient. + +This translation will only preserve semantics if the instances of the bound variable are under a `force` and if the applied term is "Pure". + +This requires a function to check all the bound variables are under `force`. The `AllForced` type +is defined in terms of the de Brujin index of the bound variable, since this will be incremented under +further lambdas. +``` + +data AllForced (X : Set){{ _ : DecEq X}} : X → (X ⊢) → Set where + var : (v : X) → {v' : X} → v' ≢ v → AllForced X v (` v') + forced : (v : X) → AllForced X v (force (` v)) + force : (v : X) → AllForced X v x' → AllForced X v (force x') + delay : (v : X) → AllForced X v x' → AllForced X v (delay x') + ƛ : (v : X) → {t : (Maybe X) ⊢} + → AllForced (Maybe X) (just v) t + → AllForced X v (ƛ t) + app : (v : X) + → AllForced X v x + → AllForced X v y + → AllForced X v (x · y) + error : {v : X} → AllForced X v error + builtin : {v : X} → {b : Builtin} → AllForced X v (builtin b) + con : {v : X} → {c : TmCon} → AllForced X v (con c) + case : (v : X) → {t : X ⊢} {ts : List (X ⊢)} + → AllForced X v t + → All (AllForced X v) ts + → AllForced X v (case t ts) + constr : (v : X) → {i : ℕ} {xs : List (X ⊢)} + → All (AllForced X v) xs + → AllForced X v (constr i xs) + +{-# TERMINATING #-} +isAllForced? : {{ _ : DecEq X}} → (v : X) → (t : X ⊢) → Dec (AllForced X v t) +isAllForced? v t with isForce? isTerm? t +... | yes (isforce (isterm t)) with isVar? t +... | no ¬var with isAllForced? v t +... | yes allForced = yes (force v allForced) +... | no ¬allForced = no λ { (forced .v) → ¬var (isvar v) ; (force .v p) → ¬allForced p } +isAllForced? v t | yes (isforce (isterm _)) | yes (isvar v₁) with v₁ ≟ v +... | yes refl = yes (forced v) +... | no v₁≢v = yes (force v (var v v₁≢v)) +isAllForced? v (` x) | no ¬force with x ≟ v +... | yes refl = no λ { (var .v x≢v) → x≢v refl} +... | no x≢v = yes (var v x≢v) +isAllForced? {X} v (ƛ t) | no ¬force with isAllForced? {Maybe X} (just v) t +... | yes p = yes (ƛ v p) +... | no ¬p = no λ { (ƛ .v p) → ¬p p} +isAllForced? v (t₁ · t₂) | no ¬force with (isAllForced? v t₁) ×-dec (isAllForced? v t₂) +... | yes (pt₁ , pt₂) = yes (app v pt₁ pt₂) +... | no ¬p = no λ { (app .v x₁ x₂) → ¬p (x₁ , x₂)} +isAllForced? v (force t) | no ¬force = no λ { (forced .v) → ¬force (isforce (isterm t)) ; (force .v x) → ¬force (isforce (isterm t)) } +isAllForced? v (delay t) | no ¬force with isAllForced? v t +... | yes p = yes (delay v p) +... | no ¬p = no λ { (delay .v pp) → ¬p pp} +isAllForced? v (con x) | no ¬force = yes con +isAllForced? v (constr i xs) | no ¬force with all? (isAllForced? v) xs +... | yes p = yes (constr v p) +... | no ¬p = no λ { (constr .v p) → ¬p p } +isAllForced? v (case t ts) | no ¬force with (isAllForced? v t) ×-dec (all? (isAllForced? v) ts) +... | yes (p₁ , p₂) = yes (case v p₁ p₂) +... | no ¬p = no λ { (case .v p₁ p₂) → ¬p ((p₁ , p₂)) } +isAllForced? v (builtin b) | no ¬force = yes builtin +isAllForced? v error | no ¬force = yes error +``` +The `delay` needs to be added to all bound variables. +``` +{-# TERMINATING #-} +subs-delay : {X : Set}{{de : DecEq X}} → (v : Maybe X) → (Maybe X ⊢) → (Maybe X ⊢) +subs-delay v (` x) with v ≟ x +... | yes refl = (delay (` x)) +... | no _ = (` x) +subs-delay v (ƛ t) = ƛ (subs-delay (just v) t) -- The de Brujin index has to be incremented +subs-delay v (t · t₁) = (subs-delay v t) · (subs-delay v t₁) +subs-delay v (force t) = force (subs-delay v t) -- This doesn't immediately apply Force-Delay +subs-delay v (delay t) = delay (subs-delay v t) +subs-delay v (con x) = con x +subs-delay v (constr i xs) = constr i (map (subs-delay v) xs) +subs-delay v (case t ts) = case (subs-delay v t) (map (subs-delay v) ts) +subs-delay v (builtin b) = builtin b +subs-delay v error = error + +``` +The translation relation is then fairly striaghtforward. + +``` +data FlD {X : Set} {{de : DecEq X}} : (X ⊢) → (X ⊢) → Set₁ where + floatdelay : {y y' : X ⊢} {x x' : (Maybe X) ⊢} + → Translation FlD (subs-delay nothing x) x' + → Translation FlD y y' + → UPure X y' + → FlD (ƛ x · (delay y)) (ƛ x' · y') + +FloatDelay : {X : Set} {{_ : DecEq X}} → (ast : X ⊢) → (ast' : X ⊢) → Set₁ +FloatDelay = Translation FlD + +``` +## Decision Procedure +``` + +isFloatDelay? : {X : Set} {{de : DecEq X}} → Binary.Decidable (FloatDelay {X}) + +{-# TERMINATING #-} +isFlD? : {X : Set} {{de : DecEq X}} → Binary.Decidable (FlD {X}) +isFlD? ast ast' with (isApp? (isLambda? isTerm?) (isDelay? isTerm?)) ast +... | no ¬match = no λ { (floatdelay x x₁ x₂) → ¬match ((isapp (islambda (isterm _)) (isdelay (isterm _)))) } +... | yes (isapp (islambda (isterm t₁)) (isdelay (isterm t₂))) with (isApp? (isLambda? isTerm?) isTerm?) ast' +... | no ¬match = no λ { (floatdelay x x₁ x₂) → ¬match ((isapp (islambda (isterm _)) (isterm _))) } +... | yes (isapp (islambda (isterm t₁')) (isterm t₂')) with (isFloatDelay? (subs-delay nothing t₁) t₁') ×-dec (isFloatDelay? t₂ t₂') ×-dec (isUPure? t₂') +... | no ¬p = no λ { (floatdelay x₁ x₂ x₃) → ¬p ((x₁ , x₂ , x₃))} +... | yes (p₁ , p₂ , pure) = yes (floatdelay p₁ p₂ pure) +isFloatDelay? = translation? isFlD? + +``` diff --git a/plutus-metatheory/src/VerifiedCompilation/UForceDelay.lagda.md b/plutus-metatheory/src/VerifiedCompilation/UForceDelay.lagda.md index c98902f096e..2f800fc86a9 100644 --- a/plutus-metatheory/src/VerifiedCompilation/UForceDelay.lagda.md +++ b/plutus-metatheory/src/VerifiedCompilation/UForceDelay.lagda.md @@ -13,7 +13,7 @@ module VerifiedCompilation.UForceDelay where ``` open import VerifiedCompilation.Equality using (DecEq; _≟_; decPointwise) open import VerifiedCompilation.UntypedViews using (Pred; isCase?; isApp?; isLambda?; isForce?; isBuiltin?; isConstr?; isDelay?; isTerm?; allTerms?; iscase; isapp; islambda; isforce; isbuiltin; isconstr; isterm; allterms; isdelay) -open import VerifiedCompilation.UntypedTranslation using (Translation; translation?; Relation) +open import VerifiedCompilation.UntypedTranslation using (Translation; translation?; Relation; convert; reflexive) open import Relation.Nullary.Product using (_×-dec_) open import Data.Product using (_,_) import Relation.Binary as Binary using (Decidable) @@ -21,10 +21,12 @@ open import Relation.Nullary using (Dec; yes; no; ¬_) open import Untyped using (_⊢; case; builtin; _·_; force; `; ƛ; delay; con; constr; error) import Relation.Binary.PropositionalEquality as Eq open Eq using (_≡_; refl) +open import Relation.Binary.PropositionalEquality.Core using (cong) open import Data.Empty using (⊥) open import Agda.Builtin.Maybe using (Maybe; just; nothing) -open import Data.Nat using (ℕ; zero; suc) +open import Data.Nat using (ℕ; zero; suc; _+_) open import Untyped.RenamingSubstitution using (weaken) +open import Data.List using (List; _∷_; []) ``` ## Translation Relation @@ -41,73 +43,262 @@ cancel out precisely. Ultimately they should be equivalent. ``` -data pureFD : Relation where - forcedelay : {X : Set} → (x x' : X ⊢) → Translation pureFD x x' → pureFD (force (delay x)) x' - pushfd : {X : Set} → (x : Maybe X ⊢) → (y : X ⊢) - → pureFD (force ((ƛ x) · y)) ((ƛ (force x)) · y) - transfd : {X : Set} → (x x'' x' : X ⊢) → Translation pureFD x x'' → Translation pureFD x'' x' → pureFD x x' - appfd : {X : Set} → (x : Maybe X ⊢) → (y : X ⊢) → pureFD ((ƛ x) · y) (ƛ (x · (weaken y))) - appfd⁻¹ : {X : Set} → (x : Maybe X ⊢) → (y : X ⊢) → pureFD (ƛ (x · (weaken y))) ((ƛ x) · y) - -data FD : ℕ → ℕ → Relation where - forcefd : (n nₐ : ℕ) → {X : Set} → (x x' : X ⊢) → FD (suc n) nₐ x x' → FD n nₐ (force x) x' - delayfd : (n nₐ : ℕ) → {X : Set} → (x x' : X ⊢) → FD n nₐ x x' → FD (suc n) nₐ (delay x) x' - lastdelay : (n nₐ : ℕ) → {X : Set} → (x x' : X ⊢) → Translation (FD zero zero) x x' → FD (suc zero) zero (delay x) x' - multiappliedfd : (n nₐ : ℕ) → {X : Set} → (x y x' y' : X ⊢) - → Translation (FD zero zero) y y' - → FD n (suc nₐ) (force x) x' - → FD n nₐ (force (x · y)) (x' · y') - multiabstractfd : (n nₐ : ℕ) → {X : Set} → (x x' : Maybe X ⊢) - → FD n nₐ (force x) x' - → FD n (suc nₐ) (force (ƛ x)) (ƛ x') +data pureFD {X : Set} {{de : DecEq X}} : X ⊢ → X ⊢ → Set₁ where + forcedelay : {x x' : X ⊢} → pureFD x x' → pureFD (force (delay x)) x' + pushfd : {x x' : Maybe X ⊢} → {y y' : X ⊢} + → pureFD x x' + → pureFD y y' + → pureFD (force ((ƛ x) · y)) ((ƛ (force x')) · y') + _⨾_ : {x x'' x' : X ⊢} + → pureFD x x'' + → pureFD x'' x' + → pureFD x x' + translationfd : {x x' : X ⊢} + → Translation pureFD x x' + → pureFD x x' + + appfd : {x : Maybe X ⊢} → {y z : X ⊢} → pureFD (((ƛ x) · y) · z) (ƛ (x · (weaken z)) · y) + appfd⁻¹ : {x : Maybe X ⊢} → {y z : X ⊢} → pureFD (ƛ (x · (weaken z)) · y) (((ƛ x) · y) · z) + +_ : pureFD {Maybe ⊥} (force (delay (` nothing))) (` nothing) +_ = forcedelay (translationfd Translation.var) + +forceappdelay : pureFD {Maybe ⊥} (force ((ƛ (delay (` nothing))) · (` nothing))) ((ƛ (` nothing)) · (` nothing)) +forceappdelay = (pushfd (translationfd (Translation.delay Translation.var)) (translationfd reflexive)) ⨾ (translationfd (Translation.app (Translation.ƛ (Translation.istranslation + (forcedelay (translationfd Translation.var)))) Translation.var)) + +_ : pureFD {Maybe ⊥} (force (force (delay (delay error)))) error +_ = translationfd (Translation.force (Translation.istranslation (forcedelay (translationfd reflexive)))) ⨾ forcedelay (translationfd Translation.error) + +_ : pureFD {Maybe ⊥} (force (force (ƛ (ƛ (delay (delay (` nothing))) · (` nothing)) · (` nothing)))) (ƛ (ƛ (` nothing) · (` nothing)) · (` nothing)) +_ = (translationfd (Translation.force (Translation.istranslation (pushfd (translationfd reflexive) (translationfd reflexive))))) ⨾ ((translationfd (Translation.force (Translation.app (Translation.ƛ (Translation.istranslation (pushfd (translationfd reflexive) (translationfd reflexive)))) reflexive))) ⨾ ( pushfd (translationfd reflexive) (translationfd reflexive) ⨾ ((translationfd (Translation.app (Translation.ƛ (Translation.istranslation (pushfd (translationfd reflexive) (translationfd reflexive)))) reflexive)) ⨾ (translationfd (Translation.app (Translation.ƛ (Translation.app (Translation.ƛ (Translation.istranslation ((translationfd (Translation.force (Translation.istranslation (forcedelay (translationfd (Translation.delay Translation.var)))))) ⨾ (forcedelay (translationfd Translation.var))))) reflexive)) reflexive))))) + +test4 : {X : Set} {{_ : DecEq X}} {N : Maybe (Maybe X) ⊢} {M M' : X ⊢} → pureFD (force (((ƛ (ƛ (delay N))) · M) · M')) (((ƛ (ƛ N)) · M) · M') +test4 = (translationfd (Translation.force (Translation.istranslation appfd))) ⨾ ((pushfd (translationfd reflexive) (translationfd reflexive)) ⨾ ((translationfd (Translation.app (Translation.ƛ (Translation.istranslation (pushfd (translationfd reflexive) (translationfd reflexive)))) reflexive )) ⨾ (translationfd (Translation.app (Translation.ƛ (Translation.app (Translation.ƛ (Translation.istranslation (forcedelay (translationfd reflexive)))) reflexive)) reflexive) ⨾ appfd⁻¹))) + +data FD {X : Set} {{_ : DecEq X}} : ℕ → ℕ → X ⊢ → X ⊢ → Set₁ where + forcefd : (n nₐ : ℕ) → {x x' : X ⊢} + → FD (suc n) nₐ x x' → FD n nₐ (force x) x' + delayfd : (n nₐ : ℕ) → {x x' : X ⊢} + → FD n nₐ x x' → FD (suc n) nₐ (delay x) x' + lastdelay : (n nₐ : ℕ) → {x x' : X ⊢} + → Translation (FD zero zero) x x' + → FD (suc zero) zero (delay x) x' + multiappliedfd : (n nₐ : ℕ) → {x y x' y' : X ⊢} + → Translation (FD zero zero) y y' + → FD n (suc nₐ) (force x) x' + → FD n nₐ (force (x · y)) (x' · y') + multiabstractfd : (n nₐ : ℕ) → {x x' : Maybe X ⊢} + → FD n nₐ (force x) x' + → FD n (suc nₐ) (force (ƛ x)) (ƛ x') + +_ : FD {⊥} zero zero (force (ƛ (delay error) · error)) (ƛ error · error) +_ = multiappliedfd zero zero Translation.error + (multiabstractfd zero zero + (forcefd zero zero (lastdelay zero zero Translation.error))) + +_ : FD {⊥} zero zero (force (delay error)) error +_ = forcefd zero zero (lastdelay zero zero Translation.error) + +_ : FD {⊥} zero zero (force (force (delay (delay error)))) error +_ = forcefd zero zero + (forcefd 1 zero + (delayfd 1 zero (lastdelay zero zero Translation.error))) + +_ : FD {Maybe ⊥} zero zero (force (force (ƛ (ƛ (delay (delay (` nothing))) · (` nothing)) · (` nothing)))) (ƛ (ƛ (` nothing) · (` nothing)) · (` nothing)) +_ = forcefd zero zero + (multiappliedfd 1 zero Translation.var + (multiabstractfd 1 zero + (multiappliedfd 1 zero Translation.var + (multiabstractfd 1 zero + (forcefd 1 zero + (delayfd 1 zero (lastdelay zero zero Translation.var))))))) ForceDelay : {X : Set} {{_ : DecEq X}} → (ast : X ⊢) → (ast' : X ⊢) → Set₁ ForceDelay = Translation (FD zero zero) + +t : ⊥ ⊢ +t = force (((ƛ (ƛ (delay error))) · error) · error) + +t' : ⊥ ⊢ +t' = ((ƛ (ƛ error)) · error) · error + +test-ffdd : FD {⊥} zero zero (force (force (delay (delay error)))) (error) +test-ffdd = forcefd zero zero + (forcefd 1 zero + (delayfd 1 zero (lastdelay zero zero Translation.error))) + +_ : pureFD t t' +_ = (translationfd (Translation.force (Translation.istranslation appfd))) + ⨾ ((pushfd (translationfd reflexive) (translationfd reflexive)) + ⨾ (translationfd (Translation.app (Translation.ƛ (Translation.istranslation ((pushfd ((translationfd reflexive)) (translationfd reflexive)) + ⨾ translationfd (Translation.app (Translation.ƛ (Translation.istranslation (forcedelay (translationfd Translation.error)))) Translation.error)))) Translation.error) + ⨾ appfd⁻¹)) + +_ : pureFD {⊥} (force (ƛ (ƛ (delay error) · error) · error)) (ƛ (ƛ error · error) · error) +_ = (pushfd (translationfd reflexive) (translationfd reflexive)) + ⨾ (translationfd (Translation.app (Translation.ƛ (Translation.istranslation ((pushfd (translationfd reflexive) (translationfd reflexive)) + ⨾ translationfd (Translation.app (Translation.ƛ (Translation.istranslation (forcedelay (translationfd Translation.error)))) Translation.error)))) Translation.error)) + +``` + +## FD implies pureFD + +The two counters in `FD` track the number of forces and applications removed, +to be "consumed" later. Consequently, at any stage we should be able to put +`n` forces and `nₐ` applications back on to the current term and have a valid +`pureFD` relation. + +``` +{- +forces : {X : Set} → ℕ → X ⊢ → X ⊢ +forces zero x = x +forces (suc n) x = forces n (force x) + +-- What actually gets applied? Does it matter?.... +-- The `y` in the FD rules gets handled separately, here it just +-- matters that there is an application that can be paired +-- with a lambda. `error` has the advantage that it is always +-- in scope, even if it is semantically silly. +applications : {X : Set} → List (X ⊢) → X ⊢ → X ⊢ +applications [] x = x +applications (y ∷ args) (force x) = applications args (force (x · y)) +applications (y ∷ args) x = applications args (x · y) -- Does this ever happen? + + +forces-translation : {X : Set} {{de : DecEq X}} {x x' : X ⊢} {R : Relation} → (n : ℕ) → Translation R {{de}} x x' → Translation R {{de}} (forces n x) (forces n x') +forces-translation zero xx' = xx' +forces-translation (suc n) xx' = forces-translation n (Translation.force xx') + +apps-translation : {X : Set}{{de : DecEq X}} {x x' : X ⊢}{R : Relation} → (n : ℕ) → Translation R {{de}} x x' → Translation R {{de}} (applications n x) (applications n x') +apps-translation zero t = t +apps-translation {x = x} {x' = x'} (suc n) t = {!!} + + +FD→pureFD : {X : Set}{{de : DecEq X}} {x x' : X ⊢} → FD {{de}} zero zero x x' → pureFD {{de}} x x' + +TFD→TpureFD : {X : Set}{{de : DecEq X}} {x x' : X ⊢} → Translation (FD zero zero) x x' → Translation pureFD {{de}} x x' +TFD→TpureFD = convert FD→pureFD + +nFD→pureFD : {X : Set}{{de : DecEq X}} {x x' : X ⊢} {n nₐ : ℕ} → FD n nₐ x x' → pureFD {{de}} (forces n (applications nₐ x)) x' +nFD→pureFD {n = zero} {nₐ = zero} p = FD→pureFD p +nFD→pureFD {n = suc n} {nₐ = zero} (forcefd .(suc n) .zero p) = nFD→pureFD p -- Fixme: is this correct? It might be because the forces are encoded in n +nFD→pureFD {n = suc n} {nₐ = zero} (delayfd .n .zero p) = (translationfd (forces-translation n (Translation.istranslation (forcedelay (translationfd reflexive))))) ⨾ (nFD→pureFD p) +nFD→pureFD {n = suc .0} {nₐ = zero} (lastdelay n nₐ p) = forcedelay (translationfd (TFD→TpureFD p)) +nFD→pureFD {n = suc n} {nₐ = zero} (multiappliedfd .(suc n) .zero x p) = {!!} +nFD→pureFD {n = zero} {nₐ = suc nₐ} (forcefd .zero .(suc nₐ) p) = {!!} +nFD→pureFD {n = zero} {nₐ = suc nₐ} (multiappliedfd .zero .(suc nₐ) p p₁) = {!!} +nFD→pureFD {x' = x'} {n = zero} {nₐ = suc nₐ} (multiabstractfd .zero .nₐ p) = (translationfd (apps-translation nₐ (Translation.istranslation (pushfd (translationfd {!!}) (translationfd reflexive))))) ⨾ translationfd (apps-translation {!!} {!!}) +nFD→pureFD {n = suc n} {nₐ = suc nₐ} p = {!!} + + +nFD→pureFD {n = suc n} {args = []} (forcefd .(suc n) .[] p) = nFD→pureFD p -- Fixme: is this correct? It might be because the forces are encoded in n +nFD→pureFD {n = suc n} {args = []} (delayfd .n .[] p) = (translationfd (forces-translation n (Translation.istranslation (forcedelay (translationfd reflexive))))) ⨾ nFD→pureFD p +--nFD→pureFD {n = suc .0} {args = zero} (lastdelay n args p) = forcedelay (translationfd (TFD→TpureFD p)) +nFD→pureFD {n = suc n} {args = []} (multiappliedfd .(suc n) .[] p₁ (forcefd .(suc n) _ p)) = {!!} +nFD→pureFD {n = suc n} {args = []} (multiappliedfd .(suc n) .[] p₁ (multiappliedfd .(suc n) _ x p)) = {!!} +nFD→pureFD {n = suc n} {args = []} (multiappliedfd .(suc n) .[] p₁ (multiabstractfd .(suc n) _ p)) = (translationfd (forces-translation (suc n) (Translation.istranslation (pushfd (translationfd reflexive) (translationfd (TFD→TpureFD p₁)))))) ⨾ ((translationfd (forces-translation (suc n) (Translation.app (Translation.ƛ (Translation.istranslation {!!})) {!!}))) ⨾ {!p!}) +nFD→pureFD {n = zero} {args = (y ∷ args)} (forcefd .zero .(y ∷ args) p) = {!!} +nFD→pureFD {n = zero} {args = (y ∷ args)} (multiappliedfd .zero .(y ∷ args) p p₁) = {!!} +nFD→pureFD {n = zero} {args = (y ∷ args)} (multiabstractfd .zero .args p) = {!!} ⨾ {!!} +nFD→pureFD {n = suc n} {args = (y ∷ args)} p = {!!} + + +FD→pureFD p = {!!} +-} +{- +{-# TERMINATING #-} +FD→pureFD {x = .(force (force _))} {x' = x'} (forcefd .zero .zero (forcefd .1 .zero p)) = (translationfd (Translation.force {!!})) ⨾ (FD→pureFD (forcefd zero zero {!!})) +FD→pureFD {x = .(force (delay _))} {x' = x'} (forcefd .zero .zero (delayfd .0 .zero p)) = forcedelay (FD→pureFD p) +--FD→pureFD {x = .(force (delay _))} {x' = x'} (forcefd .zero .zero (lastdelay n args p)) = forcedelay (translationfd (TFD→TpureFD p)) +FD→pureFD {x = .(force (force (_ · _)))} {x' = .(_ · _)} (forcefd .zero .zero (multiappliedfd .1 .zero p₁ p)) = {!!} +FD→pureFD {x = .(force (_ · _))} {x' = .(_ · _)} (multiappliedfd .zero .zero p₁ (forcefd .zero .1 p)) = {!!} +FD→pureFD {x = .(force ((_ · _) · _))} {x' = .((_ · _) · _)} (multiappliedfd .zero .zero p₁ (multiappliedfd .zero .1 x₁ p)) = {!!} +FD→pureFD {x = (force (ƛ x · y))} {x' = (ƛ x' · y')} (multiappliedfd .zero .zero p₁ (multiabstractfd .zero .0 p)) = (pushfd (translationfd reflexive) (translationfd reflexive)) ⨾ (translationfd (Translation.app (Translation.ƛ (Translation.istranslation (FD→pureFD p))) (TFD→TpureFD p₁))) +-} +{- +FD→pureFD {x = .(force (force (force (force _))))} {x' = x'} (forcefd .zero .zero (forcefd .1 .zero (forcefd .2 .zero (forcefd .3 .zero p)))) = {!!} +FD→pureFD {x = .(force (force (delay _)))} {x' = x'} (forcefd .zero .zero (forcefd .1 .zero (delayfd .1 .zero p))) = (translationfd (Translation.force (Translation.istranslation (forcedelay (translationfd reflexive))))) ⨾ FD→pureFD (forcefd zero zero p) +FD→pureFD {x = .(force (force (force (delay _))))} {x' = x'} (forcefd .zero .zero (forcefd .1 .zero (forcefd .2 .zero (delayfd .2 .zero p)))) = (translationfd (Translation.force (Translation.force (Translation.istranslation (forcedelay (translationfd reflexive)))))) ⨾ (FD→pureFD (forcefd zero zero (forcefd 1 zero p))) +FD→pureFD {x = .(force (force (force (force (_ · _)))))} {x' = .(_ · _)} (forcefd .zero .zero (forcefd .1 .zero (forcefd .2 .zero (multiappliedfd .3 .zero x p)))) = {!!} +FD→pureFD {x = .(force (force (force (_ · _))))} {x' = .(_ · _)} (forcefd .zero .zero (forcefd .1 .zero (multiappliedfd .2 .zero x p))) = {!!} +FD→pureFD {x = .(force (delay _))} {x' = x'} (forcefd .zero .zero (delayfd .0 .zero p)) = forcedelay (FD→pureFD p) +FD→pureFD {x = .(force (delay _))} {x' = x'} (forcefd .zero .zero (lastdelay n args p)) = forcedelay (translationfd (TFD→TpureFD p)) +FD→pureFD {x = (force (force (x · y)))} {x' = (x' · y')} (forcefd .zero .zero (multiappliedfd .1 .zero p p₁)) = {!!} +FD→pureFD {x = (force (x · y))} {x' = (x' · y')} (multiappliedfd .zero .zero p p₁) = {!!} +-} + + +{- +FD→pureFD : FD x x' → pureFD x x' + +TFD→TpureFD : Translation FD x x' → Translation pureFD x x' +TFD→TpureFD = convert FD→pureFD + +{-# TERMINATING #-} +FD→pureFD {x = (force (force x))} {x' = x'} (ffd (forcefd .zero (forcefd .1 p))) = transfd x' (Translation.istranslation (FD→pureFD (ffd (forcefd zero (forcefd 1 p))))) reflexive +FD→pureFD {x = (force (delay x))} {x' = x'} (ffd (forcefd .zero (delayfd .0 p))) = forcedelay x x' + (Translation.istranslation (FD→pureFD (ffd p))) +FD→pureFD {x = force (force (ƛ x · y))} {x' = ƛ x' · y'} (ffd (forcefd .zero (afd .1 (appfd .1 .zero p₁ p₂)))) = transfd (force (ƛ (force x) · y)) (Translation.force (Translation.istranslation (pushfd reflexive reflexive))) (Translation.istranslation (transfd ( ((force (ƛ (force x))) · y)) (Translation.istranslation {!!}) {!!})) +FD→pureFD {x = force (force ((x · x₁) · y))} {x' = x' · y'} (ffd (forcefd .zero (afd .1 (appfd .1 .zero p₁ p₂)))) = {!!} +FD→pureFD {x = force x} {x' = x'} (ffd (forcefd .zero (afd .1 (ffd .1 args x₁)))) = FD→pureFD (ffd (forcefd zero x₁)) +FD→pureFD {x = x} {x' = x'} (ffd (tfd n (Translation.istranslation p))) = FD→pureFD (ffd p) +FD→pureFD {x = x} {x' = x'} (ffd (tfd n p)) = transfd x' (TFD→TpureFD (Translation.istranslation (ffd (tfd n p)))) reflexive +FD→pureFD {x = force ((x · y) · z)} {x' = (x' · y') · z'} (ffd (afd .zero (appfd .zero .zero p (appfd .zero .1 p₁ p₂)))) = {!!} +FD→pureFD {x = force ((ƛ x) · y)} {x' = (ƛ x') · y'} (ffd (afd .zero (appfd .zero .zero p (absfd .zero .0 p₁ p₂)))) = transfd ((ƛ (force x) · y)) (Translation.istranslation (pushfd reflexive reflexive)) (Translation.app (Translation.ƛ (Translation.istranslation (FD→pureFD (ffd (afd zero p₂))))) (TFD→TpureFD p)) +FD→pureFD {x = x} {x' = x'} (ffd (afd .zero (ffd .zero args x₁))) = FD→pureFD (ffd x₁) +-} + + + ``` ## Decision Procedure ``` +{- + isForceDelay? : {X : Set} {{_ : DecEq X}} → Binary.Decidable (Translation (FD zero zero) {X}) {-# TERMINATING #-} -isFD? : {X : Set} {{_ : DecEq X}} → (n nₐ : ℕ) → Binary.Decidable (FD n nₐ {X}) +isFD? : {X : Set} {{_ : DecEq X}} → (n args : ℕ) → Binary.Decidable (FD n args {X}) -isFD? n nₐ ast ast' with isForce? isTerm? ast +isFD? n args ast ast' with isForce? isTerm? ast -- If it doesn't start with force then it isn't going to match this translation, unless we have some delays left -isFD? zero nₐ ast ast' | no ¬force = no λ { (forcefd .zero .nₐ x .ast' xx) → ¬force (isforce (isterm x)) ; (multiappliedfd .zero .nₐ x y x' y' x₁ xx) → ¬force (isforce (isterm (x · y))) ; (multiabstractfd .zero nₐ x x' xx) → ¬force (isforce (isterm (ƛ x))) } -isFD? (suc n) nₐ ast ast' | no ¬force with (isDelay? isTerm? ast) -... | no ¬delay = no λ { (forcefd .(suc n) .nₐ x .ast' xx) → ¬force (isforce (isterm x)) ; (delayfd .n .nₐ x .ast' xx) → ¬delay (isdelay (isterm x)) ; (lastdelay n nₐ x .ast' x₁) → ¬delay (isdelay (isterm x)) ; (multiappliedfd .(suc n) .nₐ x y x' y' x₁ xx) → ¬force (isforce (isterm (x · y))) ; (multiabstractfd .(suc n) nₐ x x' xx) → ¬force (isforce (isterm (ƛ x))) } -... | yes (isdelay (isterm t)) with (isForceDelay? t ast') ×-dec (n ≟ zero) ×-dec (nₐ ≟ zero) -... | yes (p , refl , refl) = yes (lastdelay zero zero t ast' p) -... | no ¬zero with isFD? n nₐ t ast' -... | no ¬p = no λ { (delayfd .n .nₐ .t .ast' xxx) → ¬p xxx ; (lastdelay n nₐ .t .ast' x) → ¬zero (x , refl , refl)} -... | yes p = yes (delayfd n nₐ t ast' p) +isFD? zero args ast ast' | no ¬force = no λ { (forcefd .zero .args xx) → ¬force (isforce (isterm _)) ; (multiappliedfd .zero .args x xx) → ¬force (isforce (isterm (_ · _))) ; (multiabstractfd .zero args xx) → ¬force (isforce (isterm (ƛ _))) } +isFD? (suc n) args ast ast' | no ¬force with (isDelay? isTerm? ast) +... | no ¬delay = no λ { (forcefd .(suc n) .args xx) → ¬force (isforce (isterm _)) ; (delayfd .n .args xx) → ¬delay (isdelay (isterm _)) ; (lastdelay n args x) → ¬delay (isdelay (isterm _)) ; (multiappliedfd .(suc n) .args x xx) → ¬force (isforce (isterm (_ · _))) ; (multiabstractfd .(suc n) args xx) → ¬force (isforce (isterm (ƛ _)))} +... | yes (isdelay (isterm t)) with (isForceDelay? t ast') ×-dec (n ≟ zero) ×-dec (args ≟ zero) +... | yes (p , refl , refl) = yes (lastdelay zero zero p) +... | no ¬zero with isFD? n args t ast' +... | no ¬p = no λ { (delayfd .n .args xx) → ¬p xx ; (lastdelay n args x) → ¬zero (x , refl , refl)} +... | yes p = yes (delayfd n args p) -- If there is an application we can increment the application counter -isFD? n nₐ ast ast' | yes (isforce (isterm t)) with (isApp? isTerm? isTerm?) t -isFD? n nₐ ast ast' | yes (isforce (isterm t)) | yes (isapp (isterm t₁) (isterm t₂)) with (isApp? isTerm? isTerm?) ast' -isFD? n nₐ ast ast' | yes (isforce (isterm t)) | yes (isapp (isterm t₁) (isterm t₂)) | no ¬isApp = no λ { (multiappliedfd .n .nₐ .t₁ .t₂ x' y' x xx) → ¬isApp (isapp (isterm x') (isterm y')) } -isFD? n nₐ ast ast' | yes (isforce (isterm t)) | yes (isapp (isterm t₁) (isterm t₂)) | yes (isapp (isterm t₁') (isterm t₂')) with (isFD? n (suc nₐ) (force t₁) t₁') ×-dec (isForceDelay? t₂ t₂') -... | yes (pfd , pfd2) = yes (multiappliedfd n nₐ t₁ t₂ t₁' t₂' pfd2 pfd) -... | no ¬FD = no λ { (multiappliedfd .n .nₐ .t₁ .t₂ .t₁' .t₂' x xx) → ¬FD (xx , x) } +isFD? n args ast ast' | yes (isforce (isterm t)) with (isApp? isTerm? isTerm?) t +isFD? n args ast ast' | yes (isforce (isterm t)) | yes (isapp (isterm t₁) (isterm t₂)) with (isApp? isTerm? isTerm?) ast' +isFD? n args ast ast' | yes (isforce (isterm t)) | yes (isapp (isterm t₁) (isterm t₂)) | no ¬isApp = no λ { (multiappliedfd .n .args x xx) → ¬isApp (isapp (isterm _) (isterm _)) } +isFD? n args ast ast' | yes (isforce (isterm t)) | yes (isapp (isterm t₁) (isterm t₂)) | yes (isapp (isterm t₁') (isterm t₂')) with (isFD? n (suc args) (force t₁) t₁') ×-dec (isForceDelay? t₂ t₂') +... | yes (pfd , pfd2) = yes (multiappliedfd n args pfd2 pfd) +... | no ¬FD = no λ { (multiappliedfd .n .args x xx) → ¬FD (xx , x) } -- If there is a lambda we can decrement the application counter unless we have reached zero -isFD? n nₐ ast ast' | yes (isforce (isterm t)) | no ¬isApp with (isLambda? isTerm? t) -isFD? n (suc nₐ ) ast ast' | yes (isforce (isterm t)) | no ¬isApp | yes (islambda (isterm t₂)) with (isLambda? isTerm?) ast' -... | no ¬ƛ = no λ { (multiabstractfd .n .nₐ .t₂ x' xx) → ¬ƛ (islambda (isterm x')) } -... | yes (islambda (isterm t₂')) with (isFD? n nₐ (force t₂) t₂') -... | yes p = yes (multiabstractfd n nₐ t₂ t₂' p) -... | no ¬p = no λ { (multiabstractfd .n .nₐ .t₂ .t₂' xx) → ¬p xx } +isFD? n args ast ast' | yes (isforce (isterm t)) | no ¬isApp with (isLambda? isTerm? t) +isFD? n (suc args ) ast ast' | yes (isforce (isterm t)) | no ¬isApp | yes (islambda (isterm t₂)) with (isLambda? isTerm?) ast' +... | no ¬ƛ = no λ { (multiabstractfd .n .args xx) → ¬ƛ (islambda (isterm _)) } +... | yes (islambda (isterm t₂')) with (isFD? n args (force t₂) t₂') +... | yes p = yes (multiabstractfd n args p) +... | no ¬p = no λ { (multiabstractfd .n .args xx) → ¬p xx } -- If we have zero in the application counter then we can't descend further -isFD? n zero ast ast' | yes (isforce (isterm t)) | no ¬isApp | yes (islambda (isterm t₂)) = no λ { (forcefd .n .zero .(ƛ t₂) .ast' ()) } +isFD? n zero ast ast' | yes (isforce (isterm t)) | no ¬isApp | yes (islambda (isterm t₂)) = no λ { (forcefd .n .zero ()) } -- If we have matched none of the patterns then we need to consider nesting. -isFD? n nₐ ast ast' | yes (isforce (isterm t)) | no ¬isApp | no ¬ƛ with isFD? (suc n) nₐ t ast' -... | yes p = yes (forcefd n nₐ t ast' p) -... | no ¬p = no λ { (forcefd .n .nₐ .t .ast' xx) → ¬p xx ; (multiappliedfd .n .nₐ x y x' y' x₁ xx) → ¬isApp (isapp (isterm x) (isterm y)) ; (multiabstractfd .n nₐ x x' xx) → ¬ƛ (islambda (isterm x)) } +isFD? n args ast ast' | yes (isforce (isterm t)) | no ¬isApp | no ¬ƛ with isFD? (suc n) args t ast' +... | yes p = yes (forcefd n args p) +... | no ¬p = no λ { (forcefd .n .args xx) → ¬p xx ; (multiappliedfd .n .args x xx) → ¬isApp (isapp (isterm _) (isterm _)) ; (multiabstractfd .n args xx) → ¬ƛ (islambda (isterm _)) } isForceDelay? = translation? (isFD? zero zero) +-} ``` diff --git a/plutus-metatheory/src/VerifiedCompilation/UntypedTranslation.lagda.md b/plutus-metatheory/src/VerifiedCompilation/UntypedTranslation.lagda.md index 4c1c1f604e9..6c6300774d5 100644 --- a/plutus-metatheory/src/VerifiedCompilation/UntypedTranslation.lagda.md +++ b/plutus-metatheory/src/VerifiedCompilation/UntypedTranslation.lagda.md @@ -12,6 +12,8 @@ import Relation.Unary as Unary using (Decidable) import Relation.Binary as Binary using (Decidable) open import Relation.Nullary.Product using (_×-dec_) open import Data.Product using (_,_) +open import Data.List using (List; []; _∷_) +open import Data.List.Relation.Binary.Pointwise.Base using (Pointwise) open import Relation.Nullary using (Dec; yes; no; ¬_) open import VerifiedCompilation.UntypedViews using (Pred; ListPred) open import Utils as U using (Maybe) @@ -26,168 +28,233 @@ open import VerifiedCompilation.Equality using (DecEq; _≟_; decPointwise) ``` The generic type of a Translation is that it matches one (or more) patterns on the left to one (or more) patterns on the right. If there are decision procedures to identify those patterns, -we can build a decision procedure to apply them recursivley down the AST structure. +we can build a decision procedure to apply them recursivley down the AST structure. ``` -Relation = { X : Set } → (X ⊢) → (X ⊢) → Set₁ +Relation = { X : Set } → {{_ : DecEq X}} → (X ⊢) → (X ⊢) → Set₁ -data Translation (R : Relation) : { X : Set } → (X ⊢) → (X ⊢) → Set₁ where - istranslation : { X : Set } → (ast ast' : X ⊢) → R ast ast' → Translation R ast ast' - var : { X : Set } → {x : X} → Translation R (` x) (` x) -- We assume we won't want to translate variables individually? - ƛ : { X : Set } → {x x' : Maybe X ⊢} +data Translation (R : Relation) { X : Set } {{_ : DecEq X}} : (X ⊢) → (X ⊢) → Set₁ where + istranslation : {ast ast' : X ⊢} → R ast ast' → Translation R ast ast' + var : {x : X} → Translation R (` x) (` x) -- We assume we won't want to translate variables individually? + ƛ : {x x' : Maybe X ⊢} → Translation R x x' ---------------------- - → Translation R (ƛ x) (ƛ x') - app : { X : Set } → {f t f' t' : X ⊢} → + → Translation R (ƛ x) (ƛ x') + app : {f t f' t' : X ⊢} → Translation R f f' → Translation R t t' → Translation R (f · t) (f' · t') - force : { X : Set } → {t t' : X ⊢} → + force : {t t' : X ⊢} → Translation R t t' → - Translation R (force t) (force t') - delay : { X : Set } → {t t' : X ⊢} → + Translation R (force t) (force t') + delay : {t t' : X ⊢} → Translation R t t' → - Translation R (delay t) (delay t') - con : { X : Set } → {tc : TmCon} → Translation R {X} (con tc) (con tc) - constr : { X : Set } → {xs xs' : List (X ⊢)} { n : ℕ } + Translation R (delay t) (delay t') + con : {tc : TmCon} → Translation R {X} (con tc) (con tc) + constr : {xs xs' : List (X ⊢)} { n : ℕ } → Pointwise (Translation R) xs xs' ------------------------ → Translation R (constr n xs) (constr n xs') - case : { X : Set } → {p p' : X ⊢} {alts alts' : List (X ⊢)} + case : {p p' : X ⊢} {alts alts' : List (X ⊢)} → Pointwise (Translation R) alts alts' -- recursive translation for the other case patterns → Translation R p p' ------------------------ → Translation R (case p alts) (case p' alts') - builtin : { X : Set } → {b : Builtin} → Translation R {X} (builtin b) (builtin b) - error : { X : Set } → Translation R {X} error error + builtin : {b : Builtin} → Translation R {X} (builtin b) (builtin b) + error : Translation R {X} error error ``` For the decision procedure we have the rather dissapointing 110 lines to demonstrate to Agda that, having determine that we aren't in the translation pattern, we are in fact, still not in the translation pattern -for each pair of term types. +for each pair of term types. + ``` --- Yes, I know, but for now... -{-# TERMINATING #-} -translation? : {X' : Set} {{ _ : DecEq X'}} → {R : Relation} → ({ X : Set } {{ _ : DecEq X}} → Binary.Decidable (R {X})) → Binary.Decidable (Translation R {X'}) -translation? isR? ast ast' with (isR? ast ast') -... | yes p = yes (istranslation ast ast' p) +open import Data.Product + +translation? + : {X' : Set} {{ _ : DecEq X'}} {R : Relation} + → ({ X : Set } {{ _ : DecEq X}} → Binary.Decidable (R {X})) + → Binary.Decidable (Translation R {X'}) + +decPointwiseTranslation? + : {X' : Set} {{ _ : DecEq X'}} {R : Relation} + → ({ X : Set } {{ _ : DecEq X}} → Binary.Decidable (R {X})) + → Binary.Decidable (Pointwise (Translation R {X'})) +decPointwiseTranslation? isR? [] [] = yes Pointwise.[] +decPointwiseTranslation? isR? [] (x ∷ ys) = no (λ ()) +decPointwiseTranslation? isR? (x ∷ xs) [] = no (λ ()) +decPointwiseTranslation? isR? (x ∷ xs) (y ∷ ys) + with translation? isR? x y | decPointwiseTranslation? isR? xs ys +... | yes p | yes q = yes (p Pointwise.∷ q) +... | yes _ | no ¬q = no λ where (_ Pointwise.∷ xs~ys) → ¬q xs~ys +... | no ¬p | _ = no λ where (x∼y Pointwise.∷ _) → ¬p x∼y + +translation? {{de}} isR? ast ast' with (isR? ast ast') +... | yes p = yes (istranslation p) translation? isR? (` x) ast' | no ¬p with (` x) ≟ ast' ... | yes refl = yes var ... | no ¬x=x = no λ { - (istranslation _ _ xx) → ¬p (xx); + (istranslation xx) → ¬p xx; var → ¬x=x refl } translation? isR? (ƛ ast) (ƛ ast') | no ¬p with translation? isR? ast ast' ... | yes p = yes (ƛ p) -... | no ¬pp = no (λ { (istranslation .(ƛ ast) .(ƛ ast') x) → ¬p x ; (ƛ xxx) → ¬pp xxx}) -translation? isR? (ƛ ast) (` x) | no ¬p = no λ { (istranslation _ _ x₁) → ¬p x₁ } -translation? isR? (ƛ ast) (ast'' · ast''') | no ¬p = no λ { (istranslation _ _ x₁) → ¬p x₁ } -translation? isR? (ƛ ast) (force ast'') | no ¬p = no λ { (istranslation _ _ x₁) → ¬p x₁ } -translation? isR? (ƛ ast) (delay ast'') | no ¬p = no λ { (istranslation _ _ x₁) → ¬p x₁ } -translation? isR? (ƛ ast) (con x) | no ¬p = no λ { (istranslation _ _ x₁) → ¬p x₁ } -translation? isR? (ƛ ast) (constr i xs) | no ¬p = no λ { (istranslation _ _ x₁) → ¬p x₁ } -translation? isR? (ƛ ast) (case ast'' ts) | no ¬p = no λ { (istranslation _ _ x₁) → ¬p x₁ } -translation? isR? (ƛ ast) (builtin b) | no ¬p = no λ { (istranslation _ _ x₁) → ¬p x₁ } -translation? isR? (ƛ ast) error | no ¬p = no λ { (istranslation _ _ x₁) → ¬p x₁ } - -translation? isR? (ast · ast₁) (` x) | no ¬p = no λ { (istranslation _ _ x₁) → ¬p x₁ } -translation? isR? (ast · ast₁) (ƛ ast') | no ¬p = no λ { (istranslation _ _ x₁) → ¬p x₁ } +... | no ¬pp = no (λ { (istranslation x) → ¬p x ; (ƛ xxx) → ¬pp xxx}) +translation? isR? (ƛ ast) (` x) | no ¬p = no λ { (istranslation x₁) → ¬p x₁ } +translation? isR? (ƛ ast) (ast'' · ast''') | no ¬p = no λ { (istranslation x₁) → ¬p x₁ } +translation? isR? (ƛ ast) (force ast'') | no ¬p = no λ { (istranslation x₁) → ¬p x₁ } +translation? isR? (ƛ ast) (delay ast'') | no ¬p = no λ { (istranslation x₁) → ¬p x₁ } +translation? isR? (ƛ ast) (con x) | no ¬p = no λ { (istranslation x₁) → ¬p x₁ } +translation? isR? (ƛ ast) (constr i xs) | no ¬p = no λ { (istranslation x₁) → ¬p x₁ } +translation? isR? (ƛ ast) (case ast'' ts) | no ¬p = no λ { (istranslation x₁) → ¬p x₁ } +translation? isR? (ƛ ast) (builtin b) | no ¬p = no λ { (istranslation x₁) → ¬p x₁ } +translation? isR? (ƛ ast) error | no ¬p = no λ { (istranslation x₁) → ¬p x₁ } + +translation? isR? (ast · ast₁) (` x) | no ¬p = no λ { (istranslation x₁) → ¬p x₁ } +translation? isR? (ast · ast₁) (ƛ ast') | no ¬p = no λ { (istranslation x₁) → ¬p x₁ } translation? isR? (ast · ast₁) (ast' · ast'') | no ¬p with (translation? isR? ast ast') ×-dec (translation? isR? ast₁ ast'') ... | yes (p , q) = yes (app p q) -... | no ¬ppqq = no λ { (istranslation _ _ x) → ¬p x ; (app ppp ppp₁) → ¬ppqq (ppp , ppp₁)} -translation? isR? (ast · ast₁) (force ast') | no ¬p = no λ { (istranslation _ _ x₁) → ¬p x₁ } -translation? isR? (ast · ast₁) (delay ast') | no ¬p = no λ { (istranslation _ _ x₁) → ¬p x₁ } -translation? isR? (ast · ast₁) (con x) | no ¬p = no λ { (istranslation _ _ x₁) → ¬p x₁ } -translation? isR? (ast · ast₁) (constr i xs) | no ¬p = no λ { (istranslation _ _ x₁) → ¬p x₁ } -translation? isR? (ast · ast₁) (case ast' ts) | no ¬p = no λ { (istranslation _ _ x₁) → ¬p x₁ } -translation? isR? (ast · ast₁) (builtin b) | no ¬p = no λ { (istranslation _ _ x₁) → ¬p x₁ } -translation? isR? (ast · ast₁) error | no ¬p = no λ { (istranslation _ _ x₁) → ¬p x₁ } - -translation? isR? (force ast) (` x) | no ¬p = no λ { (istranslation _ _ x₁) → ¬p x₁ } -translation? isR? (force ast) (ƛ ast') | no ¬p = no λ { (istranslation _ _ x₁) → ¬p x₁ } -translation? isR? (force ast) (ast' · ast'') | no ¬p = no λ { (istranslation _ _ x₁) → ¬p x₁ } +... | no ¬ppqq = no λ { (istranslation x) → ¬p x ; (app ppp ppp₁) → ¬ppqq (ppp , ppp₁)} +translation? isR? (ast · ast₁) (force ast') | no ¬p = no λ { (istranslation x₁) → ¬p x₁ } +translation? isR? (ast · ast₁) (delay ast') | no ¬p = no λ { (istranslation x₁) → ¬p x₁ } +translation? isR? (ast · ast₁) (con x) | no ¬p = no λ { (istranslation x₁) → ¬p x₁ } +translation? isR? (ast · ast₁) (constr i xs) | no ¬p = no λ { (istranslation x₁) → ¬p x₁ } +translation? isR? (ast · ast₁) (case ast' ts) | no ¬p = no λ { (istranslation x₁) → ¬p x₁ } +translation? isR? (ast · ast₁) (builtin b) | no ¬p = no λ { (istranslation x₁) → ¬p x₁ } +translation? isR? (ast · ast₁) error | no ¬p = no λ { (istranslation x₁) → ¬p x₁ } + +translation? isR? (force ast) (` x) | no ¬p = no λ { (istranslation x₁) → ¬p x₁ } +translation? isR? (force ast) (ƛ ast') | no ¬p = no λ { (istranslation x₁) → ¬p x₁ } +translation? isR? (force ast) (ast' · ast'') | no ¬p = no λ { (istranslation x₁) → ¬p x₁ } translation? isR? (force ast) (force ast') | no ¬p with translation? isR? ast ast' ... | yes p = yes (force p) -... | no ¬pp = no λ { (istranslation .(force ast) .(force ast') x) → ¬p x ; (force xxx) → ¬pp xxx } -translation? isR? (force ast) (delay ast') | no ¬p = no λ { (istranslation _ _ x₁) → ¬p x₁ } -translation? isR? (force ast) (con x) | no ¬p = no λ { (istranslation _ _ x₁) → ¬p x₁ } -translation? isR? (force ast) (constr i xs) | no ¬p = no λ { (istranslation _ _ x₁) → ¬p x₁ } -translation? isR? (force ast) (case ast' ts) | no ¬p = no λ { (istranslation _ _ x₁) → ¬p x₁ } -translation? isR? (force ast) (builtin b) | no ¬p = no λ { (istranslation _ _ x₁) → ¬p x₁ } -translation? isR? (force ast) error | no ¬p = no λ { (istranslation _ _ x₁) → ¬p x₁ } - -translation? isR? (delay ast) (` x) | no ¬p = no λ { (istranslation _ _ x₁) → ¬p x₁ } -translation? isR? (delay ast) (ƛ ast') | no ¬p = no λ { (istranslation _ _ x₁) → ¬p x₁ } -translation? isR? (delay ast) (ast' · ast'') | no ¬p = no λ { (istranslation _ _ x₁) → ¬p x₁ } -translation? isR? (delay ast) (force ast') | no ¬p = no λ { (istranslation _ _ x₁) → ¬p x₁ } +... | no ¬pp = no λ { (istranslation x) → ¬p x ; (force xxx) → ¬pp xxx } +translation? isR? (force ast) (delay ast') | no ¬p = no λ { (istranslation x₁) → ¬p x₁ } +translation? isR? (force ast) (con x) | no ¬p = no λ { (istranslation x₁) → ¬p x₁ } +translation? isR? (force ast) (constr i xs) | no ¬p = no λ { (istranslation x₁) → ¬p x₁ } +translation? isR? (force ast) (case ast' ts) | no ¬p = no λ { (istranslation x₁) → ¬p x₁ } +translation? isR? (force ast) (builtin b) | no ¬p = no λ { (istranslation x₁) → ¬p x₁ } +translation? isR? (force ast) error | no ¬p = no λ { (istranslation x₁) → ¬p x₁ } + +translation? isR? (delay ast) (` x) | no ¬p = no λ { (istranslation x₁) → ¬p x₁ } +translation? isR? (delay ast) (ƛ ast') | no ¬p = no λ { (istranslation x₁) → ¬p x₁ } +translation? isR? (delay ast) (ast' · ast'') | no ¬p = no λ { (istranslation x₁) → ¬p x₁ } +translation? isR? (delay ast) (force ast') | no ¬p = no λ { (istranslation x₁) → ¬p x₁ } translation? isR? (delay ast) (delay ast') | no ¬p with translation? isR? ast ast' ... | yes p = yes (delay p) -... | no ¬pp = no λ { (istranslation .(delay ast) .(delay ast') x) → ¬p x ; (delay xxx) → ¬pp xxx } -translation? isR? (delay ast) (con x) | no ¬p = no λ { (istranslation _ _ x₁) → ¬p x₁ } -translation? isR? (delay ast) (constr i xs) | no ¬p = no λ { (istranslation _ _ x₁) → ¬p x₁ } -translation? isR? (delay ast) (case ast' ts) | no ¬p = no λ { (istranslation _ _ x₁) → ¬p x₁ } -translation? isR? (delay ast) (builtin b) | no ¬p = no λ { (istranslation _ _ x₁) → ¬p x₁ } -translation? isR? (delay ast) error | no ¬p = no λ { (istranslation _ _ x₁) → ¬p x₁ } - -translation? isR? (con x) (` x₁) | no ¬p = no λ { (istranslation _ _ x₁) → ¬p x₁ } -translation? isR? (con x) (ƛ ast') | no ¬p = no λ { (istranslation _ _ x₁) → ¬p x₁ } -translation? isR? (con x) (ast' · ast'') | no ¬p = no λ { (istranslation _ _ x₁) → ¬p x₁ } -translation? isR? (con x) (force ast') | no ¬p = no λ { (istranslation _ _ x₁) → ¬p x₁ } -translation? isR? (con x) (delay ast') | no ¬p = no λ { (istranslation _ _ x₁) → ¬p x₁ } +... | no ¬pp = no λ { (istranslation x) → ¬p x ; (delay xxx) → ¬pp xxx } +translation? isR? (delay ast) (con x) | no ¬p = no λ { (istranslation x₁) → ¬p x₁ } +translation? isR? (delay ast) (constr i xs) | no ¬p = no λ { (istranslation x₁) → ¬p x₁ } +translation? isR? (delay ast) (case ast' ts) | no ¬p = no λ { (istranslation x₁) → ¬p x₁ } +translation? isR? (delay ast) (builtin b) | no ¬p = no λ { (istranslation x₁) → ¬p x₁ } +translation? isR? (delay ast) error | no ¬p = no λ { (istranslation x₁) → ¬p x₁ } + +translation? isR? (con x) (` x₁) | no ¬p = no λ { (istranslation x₁) → ¬p x₁ } +translation? isR? (con x) (ƛ ast') | no ¬p = no λ { (istranslation x₁) → ¬p x₁ } +translation? isR? (con x) (ast' · ast'') | no ¬p = no λ { (istranslation x₁) → ¬p x₁ } +translation? isR? (con x) (force ast') | no ¬p = no λ { (istranslation x₁) → ¬p x₁ } +translation? isR? (con x) (delay ast') | no ¬p = no λ { (istranslation x₁) → ¬p x₁ } translation? isR? (con x) (con x₁) | no ¬p with x ≟ x₁ ... | yes refl = yes con -... | no ¬x≟x₁ = no λ { (istranslation .(con x) .(con x₁) xx) → ¬p xx ; con → ¬x≟x₁ refl } -translation? isR? (con x) (constr i xs) | no ¬p = no λ { (istranslation _ _ x₁) → ¬p x₁ } -translation? isR? (con x) (case ast' ts) | no ¬p = no λ { (istranslation _ _ x₁) → ¬p x₁ } -translation? isR? (con x) (builtin b) | no ¬p = no λ { (istranslation _ _ x₁) → ¬p x₁ } -translation? isR? (con x) error | no ¬p = no λ { (istranslation _ _ x₁) → ¬p x₁ } - -translation? isR? (constr i xs) (` x) | no ¬p = no λ { (istranslation _ _ x₁) → ¬p x₁ } -translation? isR? (constr i xs) (ƛ ast') | no ¬p = no λ { (istranslation _ _ x₁) → ¬p x₁ } -translation? isR? (constr i xs) (ast' · ast'') | no ¬p = no λ { (istranslation _ _ x₁) → ¬p x₁ } -translation? isR? (constr i xs) (force ast') | no ¬p = no λ { (istranslation _ _ x₁) → ¬p x₁ } -translation? isR? (constr i xs) (delay ast') | no ¬p = no λ { (istranslation _ _ x₁) → ¬p x₁ } -translation? isR? (constr i xs) (con x) | no ¬p = no λ { (istranslation _ _ x₁) → ¬p x₁ } -translation? isR? (constr i xs) (constr i₁ xs₁) | no ¬p with (i ≟ i₁) ×-dec (decPointwise (translation? isR?) xs xs₁) +... | no ¬x≟x₁ = no λ { (istranslation xx) → ¬p xx ; con → ¬x≟x₁ refl } +translation? isR? (con x) (constr i xs) | no ¬p = no λ { (istranslation x₁) → ¬p x₁ } +translation? isR? (con x) (case ast' ts) | no ¬p = no λ { (istranslation x₁) → ¬p x₁ } +translation? isR? (con x) (builtin b) | no ¬p = no λ { (istranslation x₁) → ¬p x₁ } +translation? isR? (con x) error | no ¬p = no λ { (istranslation x₁) → ¬p x₁ } + +translation? isR? (constr i xs) (` x) | no ¬p = no λ { (istranslation x₁) → ¬p x₁ } +translation? isR? (constr i xs) (ƛ ast') | no ¬p = no λ { (istranslation x₁) → ¬p x₁ } +translation? isR? (constr i xs) (ast' · ast'') | no ¬p = no λ { (istranslation x₁) → ¬p x₁ } +translation? isR? (constr i xs) (force ast') | no ¬p = no λ { (istranslation x₁) → ¬p x₁ } +translation? isR? (constr i xs) (delay ast') | no ¬p = no λ { (istranslation x₁) → ¬p x₁ } +translation? isR? (constr i xs) (con x) | no ¬p = no λ { (istranslation x₁) → ¬p x₁ } +translation? isR? (constr i xs) (constr i₁ xs₁) | no ¬p with (i ≟ i₁) ×-dec (decPointwiseTranslation? isR? xs xs₁) ... | yes (refl , pxs) = yes (constr pxs) -... | no ¬ixs = no λ { (istranslation _ _ x) → ¬p x ; (constr x) → ¬ixs (refl , x) } -translation? isR? (constr i xs) (case ast' ts) | no ¬p = no λ { (istranslation _ _ x₁) → ¬p x₁ } -translation? isR? (constr i xs) (builtin b) | no ¬p = no λ { (istranslation _ _ x₁) → ¬p x₁ } -translation? isR? (constr i xs) error | no ¬p = no λ { (istranslation _ _ x₁) → ¬p x₁ } - -translation? isR? (case ast ts) (` x) | no ¬p = no λ { (istranslation _ _ x₁) → ¬p x₁ } -translation? isR? (case ast ts) (ƛ ast') | no ¬p = no λ { (istranslation _ _ x₁) → ¬p x₁ } -translation? isR? (case ast ts) (ast' · ast'') | no ¬p = no λ { (istranslation _ _ x₁) → ¬p x₁ } -translation? isR? (case ast ts) (force ast') | no ¬p = no λ { (istranslation _ _ x₁) → ¬p x₁ } -translation? isR? (case ast ts) (delay ast') | no ¬p = no λ { (istranslation _ _ x₁) → ¬p x₁ } -translation? isR? (case ast ts) (con x) | no ¬p = no λ { (istranslation _ _ x₁) → ¬p x₁ } -translation? isR? (case ast ts) (constr i xs) | no ¬p = no λ { (istranslation _ _ x₁) → ¬p x₁ } -translation? isR? (case ast ts) (case ast' ts₁) | no ¬p with (translation? isR? ast ast') ×-dec (decPointwise (translation? isR?) ts ts₁) +... | no ¬ixs = no λ { (istranslation x) → ¬p x ; (constr x) → ¬ixs (refl , x) } +translation? isR? (constr i xs) (case ast' ts) | no ¬p = no λ { (istranslation x₁) → ¬p x₁ } +translation? isR? (constr i xs) (builtin b) | no ¬p = no λ { (istranslation x₁) → ¬p x₁ } +translation? isR? (constr i xs) error | no ¬p = no λ { (istranslation x₁) → ¬p x₁ } + +translation? isR? (case ast ts) (` x) | no ¬p = no λ { (istranslation x₁) → ¬p x₁ } +translation? isR? (case ast ts) (ƛ ast') | no ¬p = no λ { (istranslation x₁) → ¬p x₁ } +translation? isR? (case ast ts) (ast' · ast'') | no ¬p = no λ { (istranslation x₁) → ¬p x₁ } +translation? isR? (case ast ts) (force ast') | no ¬p = no λ { (istranslation x₁) → ¬p x₁ } +translation? isR? (case ast ts) (delay ast') | no ¬p = no λ { (istranslation x₁) → ¬p x₁ } +translation? isR? (case ast ts) (con x) | no ¬p = no λ { (istranslation x₁) → ¬p x₁ } +translation? isR? (case ast ts) (constr i xs) | no ¬p = no λ { (istranslation x₁) → ¬p x₁ } +translation? isR? (case ast ts) (case ast' ts₁) | no ¬p with (translation? isR? ast ast') ×-dec (decPointwiseTranslation? isR? ts ts₁) ... | yes ( pa , pts ) = yes (case pts pa) -... | no ¬papts = no λ { (istranslation _ _ x) → ¬p x ; (case x xxx) → ¬papts (xxx , x) } -translation? isR? (case ast ts) (builtin b) | no ¬p = no λ { (istranslation _ _ x₁) → ¬p x₁ } -translation? isR? (case ast ts) error | no ¬p = no λ { (istranslation _ _ x₁) → ¬p x₁ } - -translation? isR? (builtin b) (` x) | no ¬p = no λ { (istranslation _ _ x₁) → ¬p x₁ } -translation? isR? (builtin b) (ƛ ast') | no ¬p = no λ { (istranslation _ _ x₁) → ¬p x₁ } -translation? isR? (builtin b) (ast' · ast'') | no ¬p = no λ { (istranslation _ _ x₁) → ¬p x₁ } -translation? isR? (builtin b) (force ast') | no ¬p = no λ { (istranslation _ _ x₁) → ¬p x₁ } -translation? isR? (builtin b) (delay ast') | no ¬p = no λ { (istranslation _ _ x₁) → ¬p x₁ } -translation? isR? (builtin b) (con x) | no ¬p = no λ { (istranslation _ _ x₁) → ¬p x₁ } -translation? isR? (builtin b) (constr i xs) | no ¬p = no λ { (istranslation _ _ x₁) → ¬p x₁ } -translation? isR? (builtin b) (case ast' ts) | no ¬p = no λ { (istranslation _ _ x₁) → ¬p x₁ } +... | no ¬papts = no λ { (istranslation x) → ¬p x ; (case x xxx) → ¬papts (xxx , x) } +translation? isR? (case ast ts) (builtin b) | no ¬p = no λ { (istranslation x₁) → ¬p x₁ } +translation? isR? (case ast ts) error | no ¬p = no λ { (istranslation x₁) → ¬p x₁ } + +translation? isR? (builtin b) (` x) | no ¬p = no λ { (istranslation x₁) → ¬p x₁ } +translation? isR? (builtin b) (ƛ ast') | no ¬p = no λ { (istranslation x₁) → ¬p x₁ } +translation? isR? (builtin b) (ast' · ast'') | no ¬p = no λ { (istranslation x₁) → ¬p x₁ } +translation? isR? (builtin b) (force ast') | no ¬p = no λ { (istranslation x₁) → ¬p x₁ } +translation? isR? (builtin b) (delay ast') | no ¬p = no λ { (istranslation x₁) → ¬p x₁ } +translation? isR? (builtin b) (con x) | no ¬p = no λ { (istranslation x₁) → ¬p x₁ } +translation? isR? (builtin b) (constr i xs) | no ¬p = no λ { (istranslation x₁) → ¬p x₁ } +translation? isR? (builtin b) (case ast' ts) | no ¬p = no λ { (istranslation x₁) → ¬p x₁ } translation? isR? (builtin b) (builtin b₁) | no ¬p with b ≟ b₁ ... | yes refl = yes builtin -... | no ¬b=b₁ = no λ { (istranslation _ _ x) → ¬p x ; builtin → ¬b=b₁ refl } -translation? isR? (builtin b) error | no ¬p = no λ { (istranslation _ _ x₁) → ¬p x₁ } - -translation? isR? error (` x) | no ¬p = no λ { (istranslation _ _ x₁) → ¬p x₁ } -translation? isR? error (ƛ ast') | no ¬p = no λ { (istranslation _ _ x₁) → ¬p x₁ } -translation? isR? error (ast' · ast'') | no ¬p = no λ { (istranslation _ _ x₁) → ¬p x₁ } -translation? isR? error (force ast') | no ¬p = no λ { (istranslation _ _ x₁) → ¬p x₁ } -translation? isR? error (delay ast') | no ¬p = no λ { (istranslation _ _ x₁) → ¬p x₁ } -translation? isR? error (con x) | no ¬p = no λ { (istranslation _ _ x₁) → ¬p x₁ } -translation? isR? error (constr i xs) | no ¬p = no λ { (istranslation _ _ x₁) → ¬p x₁ } -translation? isR? error (case ast' ts) | no ¬p = no λ { (istranslation _ _ x₁) → ¬p x₁ } -translation? isR? error (builtin b) | no ¬p = no λ { (istranslation _ _ x₁) → ¬p x₁ } +... | no ¬b=b₁ = no λ { (istranslation x) → ¬p x ; builtin → ¬b=b₁ refl } +translation? isR? (builtin b) error | no ¬p = no λ { (istranslation x₁) → ¬p x₁ } + +translation? isR? error (` x) | no ¬p = no λ { (istranslation x₁) → ¬p x₁ } +translation? isR? error (ƛ ast') | no ¬p = no λ { (istranslation x₁) → ¬p x₁ } +translation? isR? error (ast' · ast'') | no ¬p = no λ { (istranslation x₁) → ¬p x₁ } +translation? isR? error (force ast') | no ¬p = no λ { (istranslation x₁) → ¬p x₁ } +translation? isR? error (delay ast') | no ¬p = no λ { (istranslation x₁) → ¬p x₁ } +translation? isR? error (con x) | no ¬p = no λ { (istranslation x₁) → ¬p x₁ } +translation? isR? error (constr i xs) | no ¬p = no λ { (istranslation x₁) → ¬p x₁ } +translation? isR? error (case ast' ts) | no ¬p = no λ { (istranslation x₁) → ¬p x₁ } +translation? isR? error (builtin b) | no ¬p = no λ { (istranslation x₁) → ¬p x₁ } translation? isR? error error | no ¬p = yes error ``` +# Relations between Translations + +These functions can be useful when showing equivilence etc. between translation relations. + +``` +variable + R S : Relation + X : Set + x x' : X ⊢ + xs xs' : List (X ⊢) + +convert-pointwise : {{deX : DecEq X}} → (∀ {Y : Set} {{deY : DecEq Y}} {y y' : Y ⊢} → R {{deY}} y y' → S {{deY}} y y') → (Pointwise (R {{deX}}) xs xs' → Pointwise (S {{deX}}) xs xs') +convert-pointwise f Pointwise.[] = Pointwise.[] +convert-pointwise {R = R} {S = S} f (x∼y Pointwise.∷ p) = f x∼y Pointwise.∷ convert-pointwise {R = R} {S = S} f p + +{-# TERMINATING #-} +convert : {{deX : DecEq X}} → (∀ {Y : Set} {{deY : DecEq Y}} {y y' : Y ⊢} → R y y' → S y y') → (Translation R {{deX}} x x' → Translation S {{deX}} x x') +convert f (Translation.istranslation xx') = Translation.istranslation (f xx') +convert f Translation.var = Translation.var +convert f (Translation.ƛ xx') = Translation.ƛ (convert f xx') +convert f (Translation.app xx' xx'') = Translation.app (convert f xx') (convert f xx'') +convert f (Translation.force xx') = Translation.force (convert f xx') +convert f (Translation.delay xx') = Translation.delay (convert f xx') +convert f Translation.con = Translation.con +convert {R = R} {S = S} f (Translation.constr x) = Translation.constr (convert-pointwise {R = Translation R} {S = Translation S} (convert f) x) +convert f (case Pointwise.[] xx') = case Pointwise.[] (convert f xx') +convert {R = R} {S = S} f (case (x∼y Pointwise.∷ x) xx') = Translation.case (convert-pointwise {R = Translation R} {S = Translation S} (convert f) (x∼y Pointwise.∷ x)) (convert f xx') +convert f Translation.builtin = Translation.builtin +convert f Translation.error = Translation.error + +pointwise-reflexive : (∀ {X : Set} {{deX : DecEq X}} {x : X ⊢} → Translation R {{deX}} x x) → (∀ {X : Set} {{deX : DecEq X}} {xs : List (X ⊢)} → Pointwise (Translation R {{deX}}) xs xs) +pointwise-reflexive f {xs = List.[]} = Pointwise.[] +pointwise-reflexive f {xs = x List.∷ xs} = f Pointwise.∷ pointwise-reflexive f + +{-# TERMINATING #-} +reflexive : {{deX : DecEq X}} → Translation R {{deX}} x x +reflexive {x = ` x} = var +reflexive {x = ƛ x} = ƛ reflexive +reflexive {x = x · x₁} = app reflexive reflexive +reflexive {x = force x} = force reflexive +reflexive {x = delay x} = delay reflexive +reflexive {x = con x} = con +reflexive {x = constr i xs} = constr (pointwise-reflexive reflexive) +reflexive {x = case x ts} = case (pointwise-reflexive reflexive) reflexive +reflexive {x = builtin b} = builtin +reflexive {x = error} = error +``` diff --git a/plutus-metatheory/src/VerifiedCompilation/UntypedViews.lagda.md b/plutus-metatheory/src/VerifiedCompilation/UntypedViews.lagda.md index 6b80c4fc9e5..559fc0edd2c 100644 --- a/plutus-metatheory/src/VerifiedCompilation/UntypedViews.lagda.md +++ b/plutus-metatheory/src/VerifiedCompilation/UntypedViews.lagda.md @@ -29,7 +29,7 @@ to recognise that pattern and extract the variables. Following suggestions from Philip Wadler: creating Views for each Term type and then allowing them to accept arbitrary sub-views should make this reusable. We can create patterns using nested calls to these views, and decide them with nested calls to the -decision procedures. +decision procedures. ``` Pred : Set₁ From ad5e0f5aa28fd4d638ccbfbf78689a923fb61e0f Mon Sep 17 00:00:00 2001 From: Ramsay Taylor Date: Thu, 26 Sep 2024 09:10:30 +0100 Subject: [PATCH 09/13] WIP --- plutus-metatheory/src/VerifiedCompilation/UCSE.lagda.md | 1 + 1 file changed, 1 insertion(+) diff --git a/plutus-metatheory/src/VerifiedCompilation/UCSE.lagda.md b/plutus-metatheory/src/VerifiedCompilation/UCSE.lagda.md index 49dcbd240a0..95ff5216a02 100644 --- a/plutus-metatheory/src/VerifiedCompilation/UCSE.lagda.md +++ b/plutus-metatheory/src/VerifiedCompilation/UCSE.lagda.md @@ -24,6 +24,7 @@ open Eq using (_≡_; refl) open import Data.Empty using (⊥) open import Agda.Builtin.Maybe using (Maybe; just; nothing) open import Untyped.RenamingSubstitution using (_[_]) +--open import VerifiedCompilation.Purity using (UPure; isUPure?) ``` ## Translation Relation From 1f4a0b30fd483c1e6e4d7bf768fc9fd19330285e Mon Sep 17 00:00:00 2001 From: Ramsay Taylor Date: Thu, 26 Sep 2024 09:16:07 +0100 Subject: [PATCH 10/13] Now with fake purity... --- .../src/VerifiedCompilation/UCSE.lagda.md | 13 +++++++------ 1 file changed, 7 insertions(+), 6 deletions(-) diff --git a/plutus-metatheory/src/VerifiedCompilation/UCSE.lagda.md b/plutus-metatheory/src/VerifiedCompilation/UCSE.lagda.md index 95ff5216a02..d1b559cc2c4 100644 --- a/plutus-metatheory/src/VerifiedCompilation/UCSE.lagda.md +++ b/plutus-metatheory/src/VerifiedCompilation/UCSE.lagda.md @@ -24,7 +24,7 @@ open Eq using (_≡_; refl) open import Data.Empty using (⊥) open import Agda.Builtin.Maybe using (Maybe; just; nothing) open import Untyped.RenamingSubstitution using (_[_]) ---open import VerifiedCompilation.Purity using (UPure; isUPure?) +open import VerifiedCompilation.Purity using (UPure; isUPure?) ``` ## Translation Relation @@ -37,7 +37,8 @@ back in would yield the original expression. ``` data UCSE : Relation where - cse : {X : Set} {x' : Maybe X ⊢} {x e : X ⊢} + cse : {X : Set} {{ _ : DecEq X}} {x' : Maybe X ⊢} {x e : X ⊢} + → UPure X e → Translation UCSE x (x' [ e ]) → UCSE x ((ƛ x') · e) @@ -55,10 +56,10 @@ isUntypedCSE? : {X : Set} {{_ : DecEq X}} → Binary.Decidable (Translation UCSE {-# TERMINATING #-} isUCSE? : {X : Set} {{_ : DecEq X}} → Binary.Decidable (UCSE {X}) isUCSE? ast ast' with (isApp? (isLambda? isTerm?) isTerm?) ast' -... | no ¬match = no λ { (cse x) → ¬match (isapp (islambda (isterm _)) (isterm _)) } -... | yes (isapp (islambda (isterm x')) (isterm e)) with isUntypedCSE? ast (x' [ e ]) -... | no ¬p = no λ { (cse x) → ¬p x } -... | yes p = yes (cse p) +... | no ¬match = no λ { (cse up x) → ¬match (isapp (islambda (isterm _)) (isterm _)) } +... | yes (isapp (islambda (isterm x')) (isterm e)) with (isUntypedCSE? ast (x' [ e ])) ×-dec (isUPure? e) +... | no ¬p = no λ { (cse up x) → ¬p (x , up) } +... | yes (p , upure) = yes (cse upure p) isUntypedCSE? = translation? isUCSE? ``` From d871cfba6eee737fb9971a808d5c826ec67b313c Mon Sep 17 00:00:00 2001 From: Ramsay Taylor Date: Thu, 26 Sep 2024 09:42:13 +0100 Subject: [PATCH 11/13] Some WIP from the other branch that is needed here. --- .../src/VerifiedCompilation.lagda.md | 42 +++++++-------- .../VerifiedCompilation/UForceDelay.lagda.md | 51 +++++++++---------- 2 files changed, 46 insertions(+), 47 deletions(-) diff --git a/plutus-metatheory/src/VerifiedCompilation.lagda.md b/plutus-metatheory/src/VerifiedCompilation.lagda.md index 839f4c02c97..dc6ffb5227d 100644 --- a/plutus-metatheory/src/VerifiedCompilation.lagda.md +++ b/plutus-metatheory/src/VerifiedCompilation.lagda.md @@ -4,7 +4,7 @@ layout: page --- # Verified Compilation -## Introduction +## Introduction The verified compilation project is a formalization of the Untyped Plutus Core compiler optimisation transformations in Agda. The goal is to generate a formal proof that the optimisation component of the compiler has transformed the input program correctly @@ -19,7 +19,7 @@ the original and the optimised program. This is planned future work. The project is divided into several Agda modules, each of which is based on an optimisation stage of the compiler. They each contain the respective Agda formalisation of the program transformation and a decision procedure which takes -two programs as input and decides whether the transformation is applicable. +two programs as input and decides whether the transformation is applicable. This module is at the top of the project hierarchy and contains the main decision procedure which verifies the entire optimisation process. The final certification function receives a list of intermediate program ASTs produced by the compiler and outputs a file @@ -55,6 +55,8 @@ import Relation.Binary as Binary using (Decidable) open import VerifiedCompilation.UntypedTranslation using (Translation; Relation; translation?) import Relation.Binary as Binary using (Decidable) import Relation.Unary as Unary using (Decidable) + +open import VerifiedCompilation.UForceDelay as UFD using (isFD?) ``` ## Compiler optimisation traces @@ -62,7 +64,7 @@ import Relation.Unary as Unary using (Decidable) A `Trace` represents a sequence of optimisation transformations applied to a program. It is a list of pairs of ASTs, where each pair represents the before and after of a transformation application. The `IsTransformation` type is a sum type that represents the possible transformations which are implemented in their -respective modules. Adding a new transformation requires extending this type. +respective modules. Adding a new transformation requires extending this type. The `isTrace?` decision procedure is at the core of the certification process. It produces the proof that the given list of ASTs are in relation with one another according to the transformations implemented in the project. It is @@ -76,26 +78,26 @@ element of the next pair in the list. This might not be necessary if we decide t which produces a `Trace` always produces a correct one, although it might be useful to make this explicit in the type. **TODO**: The compiler should provide information on which transformation was applied at each step in the trace. -`IsTransformation?` is currently quadratic in the number of transformations, which is not ideal. +`IsTransformation?` is currently quadratic in the number of transformations, which is not ideal. ``` -data Trace (R : Relation) : { X : Set } → List ((X ⊢) × (X ⊢)) → Set₁ where - empty : {X : Set} → Trace R {X} [] - cons : {X : Set} {x x' : X ⊢} {xs : List ((X ⊢) × (X ⊢))} → R x x' → Trace R {X} xs → Trace R {X} ((x , x') ∷ xs) +data Trace (R : Relation) : { X : Set } {{_ : DecEq X}} → List ((X ⊢) × (X ⊢)) → Set₁ where + empty : {X : Set}{{_ : DecEq X}} → Trace R {X} [] + cons : {X : Set}{{_ : DecEq X}} {x x' : X ⊢} {xs : List ((X ⊢) × (X ⊢))} → R x x' → Trace R {X} xs → Trace R {X} ((x , x') ∷ xs) data IsTransformation : Relation where - isCoC : {X : Set} → (ast ast' : X ⊢) → UCC.CoC ast ast' → IsTransformation ast ast' - isFD : {X : Set} → (ast ast' : X ⊢) → UFD.FD zero zero ast ast' → IsTransformation ast ast' + isCoC : {X : Set}{{_ : DecEq X}} → (ast ast' : X ⊢) → UCC.CoC ast ast' → IsTransformation ast ast' + isFD : {X : Set}{{_ : DecEq X}} → (ast ast' : X ⊢) → UFD.FD zero zero ast ast' → IsTransformation ast ast' -isTrace? : {X : Set} {R : Relation} → Binary.Decidable (R {X}) → Unary.Decidable (Trace R {X}) +isTrace? : {X : Set} {{_ : DecEq X}} {R : Relation} → Binary.Decidable (R {X}) → Unary.Decidable (Trace R {X}) isTrace? {X} {R} isR? [] = yes empty isTrace? {X} {R} isR? ((x₁ , x₂) ∷ xs) with isTrace? {X} {R} isR? xs ... | no ¬p = no λ {(cons a as) → ¬p as} ... | yes p with isR? x₁ x₂ ... | no ¬p = no λ {(cons x x₁) → ¬p x} ... | yes p₁ = yes (cons p₁ p) - + isTransformation? : {X : Set} {{_ : DecEq X}} → Binary.Decidable (IsTransformation {X}) isTransformation? ast₁ ast₂ with UCC.isCoC? ast₁ ast₂ ... | scrt with UFD.isFD? zero zero ast₁ ast₂ @@ -114,8 +116,8 @@ The proof objects are converted to a textual representation which can be written **TODO**: Finish the implementation. A textual representation is not usually ideal, but it is a good starting point. ``` -showTranslation : {X : Set} {ast ast' : X ⊢} → Translation IsTransformation ast ast' → String -showTranslation (Translation.istranslation _ _ x) = "istranslation TODO" +showTranslation : {X : Set} {{_ : DecEq X}} {ast ast' : X ⊢} → Translation IsTransformation ast ast' → String +showTranslation (Translation.istranslation x) = "istranslation TODO" showTranslation Translation.var = "var" showTranslation (Translation.ƛ t) = "(ƛ " ++ showTranslation t ++ ")" showTranslation (Translation.app t t₁) = "(app " ++ showTranslation t ++ " " ++ showTranslation t₁ ++ ")" @@ -127,12 +129,12 @@ showTranslation (Translation.case x t) = "(case TODO " ++ showTranslation t ++ " showTranslation Translation.builtin = "builtin" showTranslation Translation.error = "error" -showTrace : {X : Set} {xs : List ((X ⊢) × (X ⊢))} → Trace (Translation IsTransformation) xs → String +showTrace : {X : Set} {{_ : DecEq X}} {xs : List ((X ⊢) × (X ⊢))} → Trace (Translation IsTransformation) xs → String showTrace empty = "empty" showTrace (cons x bla) = "(cons " ++ showTranslation x ++ showTrace bla ++ ")" -serializeTraceProof : {X : Set} {xs : List ((X ⊢) × (X ⊢))} → Dec (Trace (Translation IsTransformation) xs) → String -serializeTraceProof (no ¬p) = "no" +serializeTraceProof : {X : Set} {{_ : DecEq X}} {xs : List ((X ⊢) × (X ⊢))} → Dec (Trace (Translation IsTransformation) xs) → String +serializeTraceProof (no ¬p) = "no" serializeTraceProof (yes p) = "yes " ++ showTrace p ``` @@ -140,7 +142,7 @@ serializeTraceProof (yes p) = "yes " ++ showTrace p ## The certification function The `runCertifier` function is the top-level function which can be called by the compiler through the foreign function interface. -It represents the "impure top layer" which receives the list of ASTs produced by the compiler and writes the certificate +It represents the "impure top layer" which receives the list of ASTs produced by the compiler and writes the certificate generated by the `certifier` function to disk. Again, the `certifier` is generic for testing purposes but it is instantiated with the top-level decision procedures by the `runCertifier` function. @@ -167,7 +169,7 @@ buildPairs [] = [] buildPairs (x ∷ []) = (x , x) ∷ [] buildPairs (x₁ ∷ (x₂ ∷ xs)) = (x₁ , x₂) ∷ buildPairs (x₂ ∷ xs) -traverseEitherList : {A B E : Set} → (A → Either E B) → List A → Either E (List B) +traverseEitherList : {A B E : Set} → (A → Either E B) → List A → Either E (List B) traverseEitherList _ [] = inj₂ [] traverseEitherList f (x ∷ xs) with f x ... | inj₁ err = inj₁ err @@ -176,13 +178,13 @@ traverseEitherList f (x ∷ xs) with f x ... | inj₂ resList = inj₂ (x' ∷ resList) certifier - : {X : Set} + : {X : Set} {{_ : DecEq X}} → List Untyped → Unary.Decidable (Trace (Translation IsTransformation) {Maybe X}) → Either ScopeError String certifier {X} rawInput isRTrace? with traverseEitherList toWellScoped rawInput ... | inj₁ err = inj₁ err -... | inj₂ rawTrace = +... | inj₂ rawTrace = let inputTrace = buildPairs rawTrace in inj₂ (serializeTraceProof (isRTrace? inputTrace)) diff --git a/plutus-metatheory/src/VerifiedCompilation/UForceDelay.lagda.md b/plutus-metatheory/src/VerifiedCompilation/UForceDelay.lagda.md index 2f800fc86a9..9811c6e03be 100644 --- a/plutus-metatheory/src/VerifiedCompilation/UForceDelay.lagda.md +++ b/plutus-metatheory/src/VerifiedCompilation/UForceDelay.lagda.md @@ -256,49 +256,46 @@ FD→pureFD {x = x} {x' = x'} (ffd (afd .zero (ffd .zero args x₁))) = FD→pur ``` -{- - isForceDelay? : {X : Set} {{_ : DecEq X}} → Binary.Decidable (Translation (FD zero zero) {X}) {-# TERMINATING #-} -isFD? : {X : Set} {{_ : DecEq X}} → (n args : ℕ) → Binary.Decidable (FD n args {X}) +isFD? : {X : Set} {{_ : DecEq X}} → (n nₐ : ℕ) → Binary.Decidable (FD {X} n nₐ) -isFD? n args ast ast' with isForce? isTerm? ast +isFD? n nₐ ast ast' with isForce? isTerm? ast -- If it doesn't start with force then it isn't going to match this translation, unless we have some delays left -isFD? zero args ast ast' | no ¬force = no λ { (forcefd .zero .args xx) → ¬force (isforce (isterm _)) ; (multiappliedfd .zero .args x xx) → ¬force (isforce (isterm (_ · _))) ; (multiabstractfd .zero args xx) → ¬force (isforce (isterm (ƛ _))) } -isFD? (suc n) args ast ast' | no ¬force with (isDelay? isTerm? ast) -... | no ¬delay = no λ { (forcefd .(suc n) .args xx) → ¬force (isforce (isterm _)) ; (delayfd .n .args xx) → ¬delay (isdelay (isterm _)) ; (lastdelay n args x) → ¬delay (isdelay (isterm _)) ; (multiappliedfd .(suc n) .args x xx) → ¬force (isforce (isterm (_ · _))) ; (multiabstractfd .(suc n) args xx) → ¬force (isforce (isterm (ƛ _)))} -... | yes (isdelay (isterm t)) with (isForceDelay? t ast') ×-dec (n ≟ zero) ×-dec (args ≟ zero) +isFD? zero nₐ ast ast' | no ¬force = no λ { (forcefd .zero .nₐ xx) → ¬force (isforce (isterm _)) ; (multiappliedfd .zero .nₐ x xx) → ¬force (isforce (isterm (_ · _))) ; (multiabstractfd .zero nₐ xx) → ¬force (isforce (isterm (ƛ _))) } +isFD? (suc n) nₐ ast ast' | no ¬force with (isDelay? isTerm? ast) +... | no ¬delay = no λ { (forcefd .(suc n) .nₐ xx) → ¬force (isforce (isterm _)) ; (delayfd .n .nₐ xx) → ¬delay (isdelay (isterm _)) ; (lastdelay n nₐ x) → ¬delay (isdelay (isterm _)) ; (multiappliedfd .(suc n) .nₐ x xx) → ¬force (isforce (isterm (_ · _))) ; (multiabstractfd .(suc n) nₐ xx) → ¬force (isforce (isterm (ƛ _)))} +... | yes (isdelay (isterm t)) with (isForceDelay? t ast') ×-dec (n ≟ zero) ×-dec (nₐ ≟ zero) ... | yes (p , refl , refl) = yes (lastdelay zero zero p) -... | no ¬zero with isFD? n args t ast' -... | no ¬p = no λ { (delayfd .n .args xx) → ¬p xx ; (lastdelay n args x) → ¬zero (x , refl , refl)} -... | yes p = yes (delayfd n args p) +... | no ¬zero with isFD? n nₐ t ast' +... | no ¬p = no λ { (delayfd .n .nₐ xx) → ¬p xx ; (lastdelay n nₐ x) → ¬zero (x , refl , refl)} +... | yes p = yes (delayfd n nₐ p) -- If there is an application we can increment the application counter -isFD? n args ast ast' | yes (isforce (isterm t)) with (isApp? isTerm? isTerm?) t -isFD? n args ast ast' | yes (isforce (isterm t)) | yes (isapp (isterm t₁) (isterm t₂)) with (isApp? isTerm? isTerm?) ast' -isFD? n args ast ast' | yes (isforce (isterm t)) | yes (isapp (isterm t₁) (isterm t₂)) | no ¬isApp = no λ { (multiappliedfd .n .args x xx) → ¬isApp (isapp (isterm _) (isterm _)) } -isFD? n args ast ast' | yes (isforce (isterm t)) | yes (isapp (isterm t₁) (isterm t₂)) | yes (isapp (isterm t₁') (isterm t₂')) with (isFD? n (suc args) (force t₁) t₁') ×-dec (isForceDelay? t₂ t₂') -... | yes (pfd , pfd2) = yes (multiappliedfd n args pfd2 pfd) -... | no ¬FD = no λ { (multiappliedfd .n .args x xx) → ¬FD (xx , x) } +isFD? n nₐ ast ast' | yes (isforce (isterm t)) with (isApp? isTerm? isTerm?) t +isFD? n nₐ ast ast' | yes (isforce (isterm t)) | yes (isapp (isterm t₁) (isterm t₂)) with (isApp? isTerm? isTerm?) ast' +isFD? n nₐ ast ast' | yes (isforce (isterm t)) | yes (isapp (isterm t₁) (isterm t₂)) | no ¬isApp = no λ { (multiappliedfd .n .nₐ x xx) → ¬isApp (isapp (isterm _) (isterm _)) } +isFD? n nₐ ast ast' | yes (isforce (isterm t)) | yes (isapp (isterm t₁) (isterm t₂)) | yes (isapp (isterm t₁') (isterm t₂')) with (isFD? n (suc nₐ) (force t₁) t₁') ×-dec (isForceDelay? t₂ t₂') +... | yes (pfd , pfd2) = yes (multiappliedfd n nₐ pfd2 pfd) +... | no ¬FD = no λ { (multiappliedfd .n .nₐ x xx) → ¬FD (xx , x) } -- If there is a lambda we can decrement the application counter unless we have reached zero -isFD? n args ast ast' | yes (isforce (isterm t)) | no ¬isApp with (isLambda? isTerm? t) -isFD? n (suc args ) ast ast' | yes (isforce (isterm t)) | no ¬isApp | yes (islambda (isterm t₂)) with (isLambda? isTerm?) ast' -... | no ¬ƛ = no λ { (multiabstractfd .n .args xx) → ¬ƛ (islambda (isterm _)) } -... | yes (islambda (isterm t₂')) with (isFD? n args (force t₂) t₂') -... | yes p = yes (multiabstractfd n args p) -... | no ¬p = no λ { (multiabstractfd .n .args xx) → ¬p xx } +isFD? n nₐ ast ast' | yes (isforce (isterm t)) | no ¬isApp with (isLambda? isTerm? t) +isFD? n (suc nₐ ) ast ast' | yes (isforce (isterm t)) | no ¬isApp | yes (islambda (isterm t₂)) with (isLambda? isTerm?) ast' +... | no ¬ƛ = no λ { (multiabstractfd .n .nₐ xx) → ¬ƛ (islambda (isterm _)) } +... | yes (islambda (isterm t₂')) with (isFD? n nₐ (force t₂) t₂') +... | yes p = yes (multiabstractfd n nₐ p) +... | no ¬p = no λ { (multiabstractfd .n .nₐ xx) → ¬p xx } -- If we have zero in the application counter then we can't descend further isFD? n zero ast ast' | yes (isforce (isterm t)) | no ¬isApp | yes (islambda (isterm t₂)) = no λ { (forcefd .n .zero ()) } -- If we have matched none of the patterns then we need to consider nesting. -isFD? n args ast ast' | yes (isforce (isterm t)) | no ¬isApp | no ¬ƛ with isFD? (suc n) args t ast' -... | yes p = yes (forcefd n args p) -... | no ¬p = no λ { (forcefd .n .args xx) → ¬p xx ; (multiappliedfd .n .args x xx) → ¬isApp (isapp (isterm _) (isterm _)) ; (multiabstractfd .n args xx) → ¬ƛ (islambda (isterm _)) } +isFD? n nₐ ast ast' | yes (isforce (isterm t)) | no ¬isApp | no ¬ƛ with isFD? (suc n) nₐ t ast' +... | yes p = yes (forcefd n nₐ p) +... | no ¬p = no λ { (forcefd .n .nₐ xx) → ¬p xx ; (multiappliedfd .n .nₐ x xx) → ¬isApp (isapp (isterm _) (isterm _)) ; (multiabstractfd .n nₐ xx) → ¬ƛ (islambda (isterm _)) } isForceDelay? = translation? (isFD? zero zero) --} ``` From cdacf55bf90b6e5efc5e2bbc4264b047ef4c6d01 Mon Sep 17 00:00:00 2001 From: Ramsay Taylor Date: Thu, 26 Sep 2024 10:01:47 +0100 Subject: [PATCH 12/13] Tidy some Agda... --- plutus-metatheory/src/VerifiedCompilation.lagda.md | 2 -- 1 file changed, 2 deletions(-) diff --git a/plutus-metatheory/src/VerifiedCompilation.lagda.md b/plutus-metatheory/src/VerifiedCompilation.lagda.md index dc6ffb5227d..3796dea4635 100644 --- a/plutus-metatheory/src/VerifiedCompilation.lagda.md +++ b/plutus-metatheory/src/VerifiedCompilation.lagda.md @@ -55,8 +55,6 @@ import Relation.Binary as Binary using (Decidable) open import VerifiedCompilation.UntypedTranslation using (Translation; Relation; translation?) import Relation.Binary as Binary using (Decidable) import Relation.Unary as Unary using (Decidable) - -open import VerifiedCompilation.UForceDelay as UFD using (isFD?) ``` ## Compiler optimisation traces From f89b31422679bb9383820e17ccf0676961ef335c Mon Sep 17 00:00:00 2001 From: Ramsay Taylor Date: Thu, 26 Sep 2024 10:12:45 +0100 Subject: [PATCH 13/13] Agda... --- .../src/VerifiedCompilation/UForceDelay.lagda.md | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/plutus-metatheory/src/VerifiedCompilation/UForceDelay.lagda.md b/plutus-metatheory/src/VerifiedCompilation/UForceDelay.lagda.md index 2160e936e42..b5566e3d54f 100644 --- a/plutus-metatheory/src/VerifiedCompilation/UForceDelay.lagda.md +++ b/plutus-metatheory/src/VerifiedCompilation/UForceDelay.lagda.md @@ -256,7 +256,7 @@ FD→pureFD {x = x} {x' = x'} (ffd (afd .zero (ffd .zero args x₁))) = FD→pur ``` -{- + isForceDelay? : {X : Set} {{_ : DecEq X}} → Binary.Decidable (Translation (FD zero zero) {X}) @@ -299,6 +299,6 @@ isFD? n nₐ ast ast' | yes (isforce (isterm t)) | no ¬isApp | no ¬ƛ with isF ... | no ¬p = no λ { (forcefd .n .nₐ xx) → ¬p xx ; (multiappliedfd .n .nₐ x xx) → ¬isApp (isapp (isterm _) (isterm _)) ; (multiabstractfd .n nₐ xx) → ¬ƛ (islambda (isterm _)) } isForceDelay? = translation? (isFD? zero zero) --} + ```