diff --git a/plutus-core/plutus-core.cabal b/plutus-core/plutus-core.cabal index b4fd619085d..8f0ae4566e3 100644 --- a/plutus-core/plutus-core.cabal +++ b/plutus-core/plutus-core.cabal @@ -476,6 +476,7 @@ library plutus-ir PlutusIR.Subst PlutusIR.Transform.Beta PlutusIR.Transform.CaseReduce + PlutusIR.Transform.CommuteConst PlutusIR.Transform.DeadCode PlutusIR.Transform.EvaluateBuiltins PlutusIR.Transform.Inline.CallSiteInline diff --git a/plutus-core/plutus-ir/src/PlutusIR/Compiler.hs b/plutus-core/plutus-ir/src/PlutusIR/Compiler.hs index 0ff3bdbdd47..b1d3b50536a 100644 --- a/plutus-core/plutus-ir/src/PlutusIR/Compiler.hs +++ b/plutus-core/plutus-ir/src/PlutusIR/Compiler.hs @@ -54,6 +54,7 @@ import PlutusIR.Compiler.Types import PlutusIR.Error import PlutusIR.Transform.Beta qualified as Beta import PlutusIR.Transform.CaseReduce qualified as CaseReduce +import PlutusIR.Transform.CommuteConst qualified as CommuteConst import PlutusIR.Transform.DeadCode qualified as DeadCode import PlutusIR.Transform.EvaluateBuiltins qualified as EvaluateBuiltins import PlutusIR.Transform.Inline.Inline qualified as Inline @@ -126,6 +127,7 @@ availablePasses = ver <- view ccBuiltinVer Inline.inline hints ver t ) + , Pass "commuteConst" (onOption coDoSimplifiercommuteConst) CommuteConst.commuteConst ] -- | Actual simplifier diff --git a/plutus-core/plutus-ir/src/PlutusIR/Compiler/Types.hs b/plutus-core/plutus-ir/src/PlutusIR/Compiler/Types.hs index 92d8e359893..4ec3ba11e60 100644 --- a/plutus-core/plutus-ir/src/PlutusIR/Compiler/Types.hs +++ b/plutus-core/plutus-ir/src/PlutusIR/Compiler/Types.hs @@ -82,6 +82,7 @@ data CompilationOpts a = CompilationOpts { , _coMaxSimplifierIterations :: Int , _coDoSimplifierUnwrapCancel :: Bool , _coDoSimplifierCaseReduce :: Bool + , _coDoSimplifiercommuteConst :: Bool , _coDoSimplifierBeta :: Bool , _coDoSimplifierInline :: Bool , _coDoSimplifierKnownCon :: Bool @@ -106,6 +107,7 @@ defaultCompilationOpts = CompilationOpts , _coMaxSimplifierIterations = 12 , _coDoSimplifierUnwrapCancel = True , _coDoSimplifierCaseReduce = True + , _coDoSimplifiercommuteConst = True , _coDoSimplifierKnownCon = True , _coDoSimplifierBeta = True , _coDoSimplifierInline = True diff --git a/plutus-core/plutus-ir/src/PlutusIR/Transform/CommuteConst.hs b/plutus-core/plutus-ir/src/PlutusIR/Transform/CommuteConst.hs new file mode 100644 index 00000000000..fe178e80af6 --- /dev/null +++ b/plutus-core/plutus-ir/src/PlutusIR/Transform/CommuteConst.hs @@ -0,0 +1,57 @@ +{-# LANGUAGE GADTs #-} +{-# LANGUAGE TypeApplications #-} + +module PlutusIR.Transform.CommuteConst (commuteConst) where + +import Data.Typeable +import PlutusCore qualified as PLC +import PlutusIR + +{- | 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, although we might expect that `equalsInteger` is +the one that will benefit the most. Plutonomy only commutes `EqualsInteger`. +-} + +commuteConstDefault :: + forall m tyname name uni a. + ( PLC.MonadQuote m + ) => Term tyname name uni PLC.DefaultFun a -> + m (Term tyname name uni PLC.DefaultFun a) +commuteConstDefault (Apply ann (Builtin annB PLC.EqualsInteger) (Apply ann1 x y@(Constant{}))) = + pure $ Apply ann (Builtin annB PLC.EqualsInteger) (Apply ann1 y x) +commuteConstDefault (Apply ann (Builtin annB PLC.EqualsByteString) (Apply ann1 x y@(Constant{}))) = + pure $ Apply ann (Builtin annB PLC.EqualsByteString) (Apply ann1 y x) +commuteConstDefault (Apply ann (Builtin annB PLC.EqualsString) (Apply ann1 x y@(Constant{}))) = + pure $ Apply ann (Builtin annB PLC.EqualsString) (Apply ann1 y x) +commuteConstDefault (Apply ann (Builtin annB PLC.AddInteger) (Apply ann1 x y@(Constant{}))) = + pure $ Apply ann (Builtin annB PLC.AddInteger) (Apply ann1 y x) +commuteConstDefault (Apply ann (Builtin annB PLC.MultiplyInteger) (Apply ann1 x y@(Constant{}))) = + pure $ Apply ann (Builtin annB PLC.MultiplyInteger) (Apply ann1 y x) +commuteConstDefault tm = pure tm + +commuteConst :: forall m tyname name uni fun a. + ( PLC.MonadQuote m, Typeable fun + ) => Term tyname name uni fun a -> m (Term tyname name uni fun a) +commuteConst = case eqT @fun @PLC.DefaultFun of + Just Refl -> commuteConstDefault + Nothing -> \x -> pure x