Add commuteEquals to simplifier pass.

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

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

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

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