SCP-3392 UPLC simplifier

plutus-benchmark/nofib/test/Spec.hs

@@ -46,7 +46,7 @@ testClausify = testGroup "clausify"
                , testCase "formula3" $ mkClausifyTest Clausify.F3
                , testCase "formula4" $ mkClausifyTest Clausify.F4
                , testCase "formula5" $ mkClausifyTest Clausify.F5
-               , Tx.fitsInto "formula1 (size)" (Clausify.mkClausifyCode Clausify.F1) 5190
+               , Tx.fitsInto "formula1 (size)" (Clausify.mkClausifyCode Clausify.F1) 4700
                , runTestNested $ Tx.goldenBudget "formulaBudget" $ Clausify.mkClausifyCode Clausify.F1
                ]
 
@@ -64,7 +64,7 @@ testKnights = testGroup "knights"  -- Odd sizes call "error" because there are n
               , testCase "depth 100, 4x4" $ mkKnightsTest 100 4
               , testCase "depth 100, 6x6" $ mkKnightsTest 100 6
               , testCase "depth 100, 8x8" $ mkKnightsTest 100 8
-              , Tx.fitsInto "depth 10, 4x4 (size)" (Knights.mkKnightsCode 10 4) 3669
+              , Tx.fitsInto "depth 10, 4x4 (size)" (Knights.mkKnightsCode 10 4) 3299
               , runTestNested $ Tx.goldenBudget "knightsBudget" $ Knights.mkKnightsCode 10 4
               ]
 
@@ -92,7 +92,7 @@ testQueens = testGroup "queens"
                , testCase "Fc"    $ mkQueensTest 5 Queens.Fc
                , runTestNested    $ Tx.goldenBudget "queens5budget" $ Queens.mkQueensCode 5 Queens.Bt
                ]
-             , Tx.fitsInto "Bt (size)" (Queens.mkQueensCode 5 Queens.Bt) 3127
+             , Tx.fitsInto "Bt (size)" (Queens.mkQueensCode 5 Queens.Bt) 2707
              ]
 
 ---------------- Primes ----------------

plutus-benchmark/nofib/test/formulaBudget.budget.golden

@@ -1,3 +1,3 @@
-({ cpu: 52200152258
-| mem: 174669548
+({ cpu: 48384265940
+| mem: 161852948
 })

plutus-benchmark/nofib/test/knightsBudget.budget.golden

@@ -1,3 +1,3 @@
-({ cpu: 10654421928
-| mem: 33460972
+({ cpu: 9147401987
+| mem: 28399272
 })

plutus-benchmark/nofib/test/queens4budget.budget.golden

@@ -1,3 +1,3 @@
-({ cpu: 19730440366
-| mem: 62692642
+({ cpu: 17257762943
+| mem: 54387542
 })

plutus-benchmark/nofib/test/queens5budget.budget.golden

@@ -1,3 +1,3 @@
-({ cpu: 263250282408
-| mem: 828489180
+({ cpu: 230666353932
+| mem: 719047980
 })

plutus-core/common/PlutusCore/InlineUtils.hs

@@ -0,0 +1,9 @@
+module PlutusCore.InlineUtils (InlineHints(..)) where
+
+import Data.Semigroup (Any (..))
+
+newtype InlineHints name a = InlineHints { shouldInline :: a -> name -> Bool }
+    deriving (Semigroup, Monoid) via (a -> name -> Any)
+
+instance Show (InlineHints name a) where
+    show _ = "<inline hints>"

plutus-core/executables/pir/Main.hs

@@ -76,7 +76,7 @@ compile opts pirT = do
     let pirCtx = defaultCompilationCtx plcTcConfig
     runExcept $ flip runReaderT pirCtx $ runQuoteT $ PIR.compileTerm pirT
   where
-    set' :: Lens' PIR.CompilationOpts b -> (COpts -> b) -> PIRCompilationCtx a -> PIRCompilationCtx a
+    set' :: Lens' (PIR.CompilationOpts a) b -> (COpts -> b) -> PIRCompilationCtx a -> PIRCompilationCtx a
     set' pirOpt opt = set (PIR.ccOpts . pirOpt) (opt opts)
 
     defaultCompilationCtx :: PLC.TypeCheckConfig PLC.DefaultUni PLC.DefaultFun -> PIRCompilationCtx a

plutus-core/plutus-core.cabal

@@ -143,6 +143,7 @@ library
         UntypedPlutusCore.Evaluation.Machine.Cek.Internal
         UntypedPlutusCore.Parser
         UntypedPlutusCore.Rename
+        UntypedPlutusCore.MkUPlc
         UntypedPlutusCore.Check.Scope
         UntypedPlutusCore.Check.Uniques
         UntypedPlutusCore.Core.Type
@@ -191,6 +192,7 @@ library
         PlutusCore.Eq
         PlutusCore.Evaluation.Machine.ExBudgetingDefaults
         PlutusCore.Lexer.Type
+        PlutusCore.InlineUtils
         PlutusCore.Parsable
         PlutusCore.Parser.Internal
         PlutusCore.ParserCommon
@@ -220,6 +222,7 @@ library
         PlutusIR.TypeCheck.Internal
 
         UntypedPlutusCore.Analysis.Definitions
+        UntypedPlutusCore.Analysis.Usages
         UntypedPlutusCore.Core
         UntypedPlutusCore.Core.Instance
         UntypedPlutusCore.Core.Instance.Eq
@@ -236,9 +239,11 @@ library
         UntypedPlutusCore.Evaluation.Machine.Cek.EmitterMode
         UntypedPlutusCore.Mark
         UntypedPlutusCore.Rename.Internal
+        UntypedPlutusCore.Simplify
         UntypedPlutusCore.Size
         UntypedPlutusCore.Subst
-        UntypedPlutusCore.Transform.Simplify
+        UntypedPlutusCore.Transform.ForceDelay
+        UntypedPlutusCore.Transform.Inline
 
         Data.Aeson.Flatten
         Data.Aeson.THReader
@@ -452,6 +457,7 @@ test-suite untyped-plutus-core-test
         bytestring -any,
         hedgehog -any,
         flat -any,
+        lens -any,
         mtl -any,
         plutus-core -any,
         plutus-core-testlib -any,

plutus-core/plutus-ir/src/PlutusIR/Analysis/Usages.hs

@@ -1,6 +1,6 @@
 {-# LANGUAGE FlexibleContexts #-}
 -- | Functions for computing variable usage inside terms and types.
-module PlutusIR.Analysis.Usages (runTermUsages, runTypeUsages, Usages, isUsed, isUsedOnce, allUsed) where
+module PlutusIR.Analysis.Usages (runTermUsages, runTypeUsages, Usages, getUsageCount, allUsed) where
 
 import PlutusIR
 
@@ -26,15 +26,11 @@ addUsage n usages =
         old = Map.findWithDefault 0 u usages
     in Map.insert u (old+1) usages
 
--- | Check if @n@ is used at least once.
-isUsed :: (PLC.HasUnique n unique) => n -> Usages -> Bool
-isUsed n usages = Map.findWithDefault 0 (n ^. PLC.unique . coerced) usages > 0
+-- | Get the usage count of @n@.
+getUsageCount :: (PLC.HasUnique n unique) => n -> Usages -> Int
+getUsageCount n usages = Map.findWithDefault 0 (n ^. PLC.unique . coerced) usages
 
--- | Check if @n@ is used exactly once.
-isUsedOnce :: (PLC.HasUnique n unique) => n -> Usages -> Bool
-isUsedOnce n usages = Map.findWithDefault 0 (n ^. PLC.unique . coerced) usages == 1
-
--- | Get a set of all used @n@s.
+-- | Get a set of @n@s which are used at least once.
 allUsed :: Usages -> Set.Set PLC.Unique
 allUsed usages = Map.keysSet $ Map.filter (> 0) usages
 

plutus-core/plutus-ir/src/PlutusIR/Compiler.hs

@@ -12,6 +12,7 @@ module PlutusIR.Compiler (
     AsTypeError (..),
     AsTypeErrorExt (..),
     Provenance (..),
+    DatatypeComponent (..),
     noProvenance,
     CompilationOpts,
     coOptimize,
@@ -22,6 +23,7 @@ module PlutusIR.Compiler (
     coDoSimplifierUnwrapCancel,
     coDoSimplifierBeta,
     coDoSimplifierInline,
+    coInlineHints,
     coProfile,
     defaultCompilationOpts,
     CompilationCtx,
@@ -64,10 +66,10 @@ import PlutusPrelude
 data Pass uni fun =
   Pass { _name      :: String
        , _shouldRun :: forall m e a.   Compiling m e uni fun a => m Bool
-       , _pass      :: forall m e a b. Compiling m e uni fun a => Term TyName Name uni fun b -> m (Term TyName Name uni fun b)
+       , _pass      :: forall m e a. Compiling m e uni fun a => Term TyName Name uni fun (Provenance a) -> m (Term TyName Name uni fun (Provenance a))
        }
 
-onOption :: Compiling m e uni fun a => Lens' CompilationOpts Bool -> m Bool
+onOption :: Compiling m e uni fun a => Lens' (CompilationOpts a) Bool -> m Bool
 onOption coOpt = view (ccOpts . coOpt)
 
 isVerbose :: Compiling m e uni fun a => m Bool
@@ -95,7 +97,7 @@ availablePasses :: [Pass uni fun]
 availablePasses =
     [ Pass "unwrap cancel"        (onOption coDoSimplifierUnwrapCancel)       (pure . Unwrap.unwrapCancel)
     , Pass "beta"                 (onOption coDoSimplifierBeta)               (pure . Beta.beta)
-    , Pass "inline"               (onOption coDoSimplifierInline)             Inline.inline
+    , Pass "inline"               (onOption coDoSimplifierInline)             (\t -> do { hints <- asks (view (ccOpts . coInlineHints)); Inline.inline hints t })
     ]
 
 -- | Actual simplifier
@@ -108,7 +110,7 @@ simplify = foldl' (>=>) pure (map applyPass availablePasses)
 simplifyTerm
   :: forall m e uni fun a b. (Compiling m e uni fun a, b ~ Provenance a)
   => Term TyName Name uni fun b -> m (Term TyName Name uni fun b)
-simplifyTerm = runIfOpts $ simplify'
+simplifyTerm = runIfOpts simplify'
     -- NOTE: we need at least one pass of dead code elimination
     where
         simplify' :: Term TyName Name uni fun b -> m (Term TyName Name uni fun b)