diff --git a/plutus-core/plutus-core.cabal b/plutus-core/plutus-core.cabal index 7483e6d8be9..8a563a85227 100644 --- a/plutus-core/plutus-core.cabal +++ b/plutus-core/plutus-core.cabal @@ -497,7 +497,6 @@ library plutus-ir PlutusIR.Subst PlutusIR.Transform.Beta PlutusIR.Transform.CaseReduce - PlutusIR.Transform.CommuteFnWithConst PlutusIR.Transform.DeadCode PlutusIR.Transform.EvaluateBuiltins PlutusIR.Transform.Inline.CallSiteInline @@ -510,7 +509,9 @@ library plutus-ir PlutusIR.Transform.NonStrict PlutusIR.Transform.RecSplit PlutusIR.Transform.Rename - PlutusIR.Transform.Rewrite + PlutusIR.Transform.RewriteRules + PlutusIR.Transform.RewriteRules.CommuteFnWithConst + PlutusIR.Transform.RewriteRules.DecodeEncodeUtf8 PlutusIR.Transform.StrictifyBindings PlutusIR.Transform.Substitute PlutusIR.Transform.ThunkRecursions @@ -583,8 +584,7 @@ test-suite plutus-ir-test PlutusIR.Purity.Tests PlutusIR.Scoping.Tests PlutusIR.Transform.Beta.Tests - PlutusIR.Transform.CommuteFnWithConst.Tests - PlutusIR.Transform.Rewrite.Tests + PlutusIR.Transform.RewriteRules.Tests PlutusIR.Transform.DeadCode.Tests PlutusIR.Transform.EvaluateBuiltins.Tests PlutusIR.Transform.Inline.Tests diff --git a/plutus-core/plutus-ir/src/PlutusIR/Compiler.hs b/plutus-core/plutus-ir/src/PlutusIR/Compiler.hs index fb857f41aaa..5a3aead1093 100644 --- a/plutus-core/plutus-ir/src/PlutusIR/Compiler.hs +++ b/plutus-core/plutus-ir/src/PlutusIR/Compiler.hs @@ -55,7 +55,6 @@ import PlutusIR.Compiler.Types import PlutusIR.Error import PlutusIR.Transform.Beta qualified as Beta import PlutusIR.Transform.CaseReduce qualified as CaseReduce -import PlutusIR.Transform.CommuteFnWithConst qualified as CommuteFnWithConst import PlutusIR.Transform.DeadCode qualified as DeadCode import PlutusIR.Transform.EvaluateBuiltins qualified as EvaluateBuiltins import PlutusIR.Transform.Inline.Inline qualified as Inline @@ -66,7 +65,7 @@ import PlutusIR.Transform.LetMerge qualified as LetMerge import PlutusIR.Transform.NonStrict qualified as NonStrict import PlutusIR.Transform.RecSplit qualified as RecSplit import PlutusIR.Transform.Rename () -import PlutusIR.Transform.Rewrite qualified as Rewrite +import PlutusIR.Transform.RewriteRules qualified as RewriteRules import PlutusIR.Transform.StrictifyBindings qualified as StrictifyBindings import PlutusIR.Transform.ThunkRecursions qualified as ThunkRec import PlutusIR.Transform.Unwrap qualified as Unwrap @@ -137,8 +136,7 @@ availablePasses = ) , Pass "rewrite rules" (onOption coDoSimplifierRewrite) (\ t -> do binfo <- view ccBuiltinsInfo - pure $ Rewrite.userRewrite binfo t) - , Pass "commuteFnWithConst" (onOption coDoSimplifiercommuteFnWithConst) (pure . CommuteFnWithConst.commuteFnWithConst) + pure $ RewriteRules.userRewrite binfo t) ] -- | Actual simplifier diff --git a/plutus-core/plutus-ir/src/PlutusIR/Transform/Rewrite.hs b/plutus-core/plutus-ir/src/PlutusIR/Transform/RewriteRules.hs similarity index 57% rename from plutus-core/plutus-ir/src/PlutusIR/Transform/Rewrite.hs rename to plutus-core/plutus-ir/src/PlutusIR/Transform/RewriteRules.hs index 385ceab47b8..531a3469f0c 100644 --- a/plutus-core/plutus-ir/src/PlutusIR/Transform/Rewrite.hs +++ b/plutus-core/plutus-ir/src/PlutusIR/Transform/RewriteRules.hs @@ -1,13 +1,18 @@ {-# LANGUAGE GADTs #-} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE PatternSynonyms #-} -module PlutusIR.Transform.Rewrite where +module PlutusIR.Transform.RewriteRules + ( module Export + , userRewrite + , defaultUniRewriteRules + ) where + +import PlutusIR.Transform.RewriteRules.CommuteFnWithConst as Export +import PlutusIR.Transform.RewriteRules.DecodeEncodeUtf8 as Export import PlutusCore.Default import PlutusIR.Analysis.Builtins import PlutusIR -import Data.Monoid +import Data.Monoid import Control.Lens userRewrite :: (Semigroup a, t ~ Term tyname name uni fun a) @@ -21,16 +26,8 @@ userRewrite bi t = defaultUniRewriteRules :: RewriteRules DefaultUni DefaultFun defaultUniRewriteRules = RewriteRules $ combineRules -- rules are applied from left to right because of Dual - [ decodeEncode + [ decodeEncodeUtf8 + , commuteFnWithConst ] where combineRules = foldMap (Dual . Endo) - -decodeEncode :: Semigroup a => Term tyname name uni DefaultFun a -> Term tyname name uni DefaultFun a -decodeEncode = \case - BA DecodeUtf8 a1 a2 (BA EncodeUtf8 a3 a4 t) -> - -- place the missed annotations inside the rewritten term - (<> a1 <> a2 <> a3 <> a4) <$> t - t -> t - -pattern BA b a1 a2 t <- Apply a1 (Builtin a2 b) t diff --git a/plutus-core/plutus-ir/src/PlutusIR/Transform/CommuteFnWithConst.hs b/plutus-core/plutus-ir/src/PlutusIR/Transform/RewriteRules/CommuteFnWithConst.hs similarity index 81% rename from plutus-core/plutus-ir/src/PlutusIR/Transform/CommuteFnWithConst.hs rename to plutus-core/plutus-ir/src/PlutusIR/Transform/RewriteRules/CommuteFnWithConst.hs index 8b2e2cfc24c..e9ece4ce994 100644 --- a/plutus-core/plutus-ir/src/PlutusIR/Transform/CommuteFnWithConst.hs +++ b/plutus-core/plutus-ir/src/PlutusIR/Transform/RewriteRules/CommuteFnWithConst.hs @@ -1,6 +1,5 @@ {-# LANGUAGE GADTs #-} {-# LANGUAGE LambdaCase #-} -{-# LANGUAGE TypeApplications #-} {- | Commute such that constants are the first arguments. Consider: @@ -28,63 +27,55 @@ might expect that `equalsInteger` is the one that will benefit the most. Plutonomy only commutes `EqualsInteger` in their `commEquals`. -} -module PlutusIR.Transform.CommuteFnWithConst - (commuteFnWithConst - , commuteDefaultFun) - where +module PlutusIR.Transform.RewriteRules.CommuteFnWithConst + ( commuteFnWithConst + ) where -import Control.Lens (over) -import Data.Typeable (Typeable, eqT) import PlutusCore.Default -import PlutusIR.Core.Plated (termSubterms) import PlutusIR.Core.Type (Term (Apply, Builtin, Constant)) isConstant :: Term tyname name uni fun a -> Bool -isConstant Constant{} = True -isConstant _ = False +isConstant = \case + Constant{} -> True + _ -> False -commuteDefaultFun :: +commuteFnWithConst :: forall tyname name uni a. Term tyname name uni DefaultFun a -> Term tyname name uni DefaultFun a -commuteDefaultFun = over termSubterms commuteDefaultFun . localCommute - where - localCommute tm@(Apply ann (Apply ann1 (Builtin annB fun) x) y@Constant{}) - | isCommutative fun && not (isConstant x) = - Apply ann (Apply ann1 (Builtin annB fun) y) x - | otherwise = tm - localCommute tm = tm - -commuteFnWithConst :: forall tyname name uni fun a. Typeable fun => - Term tyname name uni fun a -> Term tyname name uni fun a -commuteFnWithConst = case eqT @fun @DefaultFun of - Just Refl -> commuteDefaultFun - Nothing -> id +commuteFnWithConst = \case + Apply ann1 (Apply ann2 (Builtin ann3 fun) arg1) arg2 + | isCommutative fun + , not (isConstant arg1) + , isConstant arg2 + -> Apply ann1 (Apply ann2 (Builtin ann3 fun) arg2) arg1 + t -> t -- | Returns whether a `DefaultFun` is commutative. Not using -- catchall to make sure that this function catches newly added `DefaultFun`. isCommutative :: DefaultFun -> Bool isCommutative = \case AddInteger -> True - SubtractInteger -> False MultiplyInteger -> True + EqualsInteger -> True + EqualsByteString -> True + EqualsString -> True + EqualsData -> True + -- verbose laid down, to revisit this function if a new builtin is added + SubtractInteger -> False DivideInteger -> False QuotientInteger -> False RemainderInteger -> False ModInteger -> False - EqualsInteger -> True LessThanInteger -> False LessThanEqualsInteger -> False - -- Bytestrings AppendByteString -> False ConsByteString -> False SliceByteString -> False LengthOfByteString -> False IndexByteString -> False - EqualsByteString -> True LessThanByteString -> False LessThanEqualsByteString -> False - -- Cryptography and hashes Sha2_256 -> False Sha3_256 -> False Blake2b_224 -> False @@ -110,27 +101,19 @@ isCommutative = \case Bls12_381_millerLoop -> False Bls12_381_mulMlResult -> False Bls12_381_finalVerify -> False - -- Strings AppendString -> False - EqualsString -> True EncodeUtf8 -> False DecodeUtf8 -> False - -- Bool IfThenElse -> False - -- Unit ChooseUnit -> False - -- Tracing Trace -> False - -- Pairs FstPair -> False SndPair -> False - -- Lists ChooseList -> False MkCons -> False HeadList -> False TailList -> False NullList -> False - -- Data ChooseData -> False ConstrData -> False MapData -> False @@ -142,7 +125,6 @@ isCommutative = \case UnListData -> False UnIData -> False UnBData -> False - EqualsData -> True SerialiseData -> False MkPairData -> False MkNilData -> False diff --git a/plutus-core/plutus-ir/src/PlutusIR/Transform/RewriteRules/DecodeEncodeUtf8.hs b/plutus-core/plutus-ir/src/PlutusIR/Transform/RewriteRules/DecodeEncodeUtf8.hs new file mode 100644 index 00000000000..aa981186af8 --- /dev/null +++ b/plutus-core/plutus-ir/src/PlutusIR/Transform/RewriteRules/DecodeEncodeUtf8.hs @@ -0,0 +1,46 @@ +{-# LANGUAGE GADTs #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE PatternSynonyms #-} + +{- | Commute such that constants are the first arguments. Consider: + +(1) equalsInteger 1 x + +(2) equalsInteger x 1 + +We have unary application, so these are two partial applications: + +(1) (equalsInteger 1) x + +(2) (equalsInteger x) 1 + +With (1), we can share the `equalsInteger 1` node, and it will be the same across any place where +we do this. + +With (2), both the nodes here include x, which is a variable that will likely be different in other +invocations of `equalsInteger`. So the second one is harder to share, which is worse for CSE. + +So commuting `equalsInteger` so that it has the constant first both a) makes various occurrences of +`equalsInteger` more likely to look similar, and b) gives us a maximally-shareable node for CSE. + +This applies to any commutative builtin function that takes constants as arguments, although we +might expect that `equalsInteger` is the one that will benefit the most. +Plutonomy only commutes `EqualsInteger` in their `commEquals`. +-} + +module PlutusIR.Transform.RewriteRules.DecodeEncodeUtf8 + ( decodeEncodeUtf8 + ) where + +import PlutusCore.Default +import PlutusIR + + +decodeEncodeUtf8 :: Semigroup a => Term tyname name uni DefaultFun a -> Term tyname name uni DefaultFun a +decodeEncodeUtf8 = \case + BA DecodeUtf8 a1 a2 (BA EncodeUtf8 a3 a4 t) -> + -- place the missed annotations inside the rewritten term + (<> a1 <> a2 <> a3 <> a4) <$> t + t -> t + +pattern BA b a1 a2 t <- Apply a1 (Builtin a2 b) t diff --git a/plutus-core/plutus-ir/test/PlutusIR/Scoping/Tests.hs b/plutus-core/plutus-ir/test/PlutusIR/Scoping/Tests.hs index 6c2ea97ddbb..c23a233e1d8 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Scoping/Tests.hs +++ b/plutus-core/plutus-ir/test/PlutusIR/Scoping/Tests.hs @@ -6,7 +6,7 @@ import PlutusIR.Generators.AST import PlutusIR.Mark import PlutusIR.Transform.Beta import PlutusIR.Transform.CaseReduce -import PlutusIR.Transform.CommuteFnWithConst +import PlutusIR.Transform.RewriteRules.CommuteFnWithConst import PlutusIR.Transform.DeadCode import PlutusIR.Transform.EvaluateBuiltins import PlutusIR.Transform.Inline.Inline qualified as Inline @@ -32,8 +32,8 @@ test_names = testGroup "names" pure . beta , T.test_scopingGood "case-of-known-constructor" genTerm T.BindingRemovalNotOk T.PrerenameYes $ pure . caseReduce - , T.test_scopingGood "'commuteDefaultFun'" genTerm T.BindingRemovalNotOk T.PrerenameYes $ - pure . commuteDefaultFun + , T.test_scopingGood "commuteFnWithConst" genTerm T.BindingRemovalNotOk T.PrerenameYes $ + pure . commuteFnWithConst , -- We say that it's fine to remove bindings, because they never actually get removed, -- because the scope checking machinery doesn't create unused bindings, every binding -- gets referenced at some point at least once (usually very close to the binding site). diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/CommuteFnWithConst/Tests.hs b/plutus-core/plutus-ir/test/PlutusIR/Transform/CommuteFnWithConst/Tests.hs deleted file mode 100644 index b6f7d12db59..00000000000 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/CommuteFnWithConst/Tests.hs +++ /dev/null @@ -1,19 +0,0 @@ -module PlutusIR.Transform.CommuteFnWithConst.Tests where - -import Test.Tasty -import Test.Tasty.Extras - -import PlutusIR.Parser -import PlutusIR.Test -import PlutusIR.Transform.CommuteFnWithConst qualified as CommuteFnWithConst - -test_commuteDefaultFun :: TestTree -test_commuteDefaultFun = runTestNestedIn ["plutus-ir/test/PlutusIR/Transform"] $ - testNested "CommuteFnWithConst" $ - map - (goldenPir CommuteFnWithConst.commuteDefaultFun pTerm) - [ "equalsInt" -- this tests that the function works on equalInteger - , "divideInt" -- this tests that the function excludes not commutative functions - , "multiplyInt" -- this tests that the function works on multiplyInteger - , "let" -- this tests that it works in the subterms - ] diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/Rewrite/Tests.hs b/plutus-core/plutus-ir/test/PlutusIR/Transform/Rewrite/Tests.hs deleted file mode 100644 index ae8eb2aca10..00000000000 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/Rewrite/Tests.hs +++ /dev/null @@ -1,22 +0,0 @@ -module PlutusIR.Transform.Rewrite.Tests where - -import PlutusIR.Parser -import PlutusIR.Test -import PlutusIR.Analysis.Builtins -import PlutusIR.Transform.Rewrite qualified as Rewrite - -import Data.Default.Class -import Control.Lens -import Test.Tasty -import Test.Tasty.Extras - - -test_commuteDefaultFun :: TestTree -test_commuteDefaultFun = runTestNestedIn ["plutus-ir/test/PlutusIR/Transform"] $ - testNested "Rewrite" $ - fmap - (goldenPir (Rewrite.userRewrite builtinsInfo) pTerm) - [ "decodeEncodeUtf8" - ] - where - builtinsInfo = def & rewriteRules .~ Rewrite.defaultUniRewriteRules diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/RewriteRules/Tests.hs b/plutus-core/plutus-ir/test/PlutusIR/Transform/RewriteRules/Tests.hs new file mode 100644 index 00000000000..f9f6dcefcf3 --- /dev/null +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/RewriteRules/Tests.hs @@ -0,0 +1,25 @@ +module PlutusIR.Transform.RewriteRules.Tests where + +import PlutusIR.Parser +import PlutusIR.Test +import PlutusIR.Analysis.Builtins +import PlutusIR.Transform.RewriteRules as RewriteRules + +import Data.Default.Class +import Control.Lens +import Test.Tasty +import Test.Tasty.Extras + +test_RewriteRules :: TestTree +test_RewriteRules = runTestNestedIn ["plutus-ir/test/PlutusIR/Transform"] $ + testNested "RewriteRules" $ + fmap + (goldenPir (RewriteRules.userRewrite builtinsInfo) pTerm) + [ "decodeEncodeUtf8" + , "equalsInt" -- this tests that the function works on equalInteger + , "divideInt" -- this tests that the function excludes not commutative functions + , "multiplyInt" -- this tests that the function works on multiplyInteger + , "let" -- this tests that it works in the subterms + ] + where + builtinsInfo = def & rewriteRules .~ RewriteRules.defaultUniRewriteRules diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/Rewrite/decodeEncodeUtf8 b/plutus-core/plutus-ir/test/PlutusIR/Transform/RewriteRules/decodeEncodeUtf8 similarity index 100% rename from plutus-core/plutus-ir/test/PlutusIR/Transform/Rewrite/decodeEncodeUtf8 rename to plutus-core/plutus-ir/test/PlutusIR/Transform/RewriteRules/decodeEncodeUtf8 diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/Rewrite/decodeEncodeUtf8.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/RewriteRules/decodeEncodeUtf8.golden similarity index 100% rename from plutus-core/plutus-ir/test/PlutusIR/Transform/Rewrite/decodeEncodeUtf8.golden rename to plutus-core/plutus-ir/test/PlutusIR/Transform/RewriteRules/decodeEncodeUtf8.golden diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/CommuteFnWithConst/divideInt b/plutus-core/plutus-ir/test/PlutusIR/Transform/RewriteRules/divideInt similarity index 100% rename from plutus-core/plutus-ir/test/PlutusIR/Transform/CommuteFnWithConst/divideInt rename to plutus-core/plutus-ir/test/PlutusIR/Transform/RewriteRules/divideInt diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/CommuteFnWithConst/divideInt.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/RewriteRules/divideInt.golden similarity index 100% rename from plutus-core/plutus-ir/test/PlutusIR/Transform/CommuteFnWithConst/divideInt.golden rename to plutus-core/plutus-ir/test/PlutusIR/Transform/RewriteRules/divideInt.golden diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/CommuteFnWithConst/equalsInt b/plutus-core/plutus-ir/test/PlutusIR/Transform/RewriteRules/equalsInt similarity index 100% rename from plutus-core/plutus-ir/test/PlutusIR/Transform/CommuteFnWithConst/equalsInt rename to plutus-core/plutus-ir/test/PlutusIR/Transform/RewriteRules/equalsInt diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/CommuteFnWithConst/equalsInt.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/RewriteRules/equalsInt.golden similarity index 100% rename from plutus-core/plutus-ir/test/PlutusIR/Transform/CommuteFnWithConst/equalsInt.golden rename to plutus-core/plutus-ir/test/PlutusIR/Transform/RewriteRules/equalsInt.golden diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/CommuteFnWithConst/let b/plutus-core/plutus-ir/test/PlutusIR/Transform/RewriteRules/let similarity index 100% rename from plutus-core/plutus-ir/test/PlutusIR/Transform/CommuteFnWithConst/let rename to plutus-core/plutus-ir/test/PlutusIR/Transform/RewriteRules/let diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/CommuteFnWithConst/let.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/RewriteRules/let.golden similarity index 100% rename from plutus-core/plutus-ir/test/PlutusIR/Transform/CommuteFnWithConst/let.golden rename to plutus-core/plutus-ir/test/PlutusIR/Transform/RewriteRules/let.golden diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/CommuteFnWithConst/multiplyInt b/plutus-core/plutus-ir/test/PlutusIR/Transform/RewriteRules/multiplyInt similarity index 100% rename from plutus-core/plutus-ir/test/PlutusIR/Transform/CommuteFnWithConst/multiplyInt rename to plutus-core/plutus-ir/test/PlutusIR/Transform/RewriteRules/multiplyInt diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/CommuteFnWithConst/multiplyInt.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/RewriteRules/multiplyInt.golden similarity index 100% rename from plutus-core/plutus-ir/test/PlutusIR/Transform/CommuteFnWithConst/multiplyInt.golden rename to plutus-core/plutus-ir/test/PlutusIR/Transform/RewriteRules/multiplyInt.golden