Inline fully saturated applications in UPLC (#5323)

IntersectMBO · Jun 5, 2023 · acedf56 · acedf56
1 parent cce5fbf
commit acedf56
Show file tree

Hide file tree

Showing 97 changed files with 1,618 additions and 1,809 deletions.
diff --git a/plutus-benchmark/nofib/test/Spec.hs b/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) 3766
+               , Tx.fitsInto "formula1 (size)" (Clausify.mkClausifyCode Clausify.F1) 3304
                , runTestNested $
                   Tx.goldenBudget "formulaBudget" $ Clausify.mkClausifyCode Clausify.F1
                ]
@@ -65,7 +65,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) 2806
+              , Tx.fitsInto "depth 10, 4x4 (size)" (Knights.mkKnightsCode 10 4) 2560
               , runTestNested $ Tx.goldenBudget "knightsBudget" $ Knights.mkKnightsCode 10 4
               ]
 
@@ -95,7 +95,7 @@ testQueens = testGroup "queens"
                , runTestNested    $ Tx.goldenBudget "queens5budget" $
                   Queens.mkQueensCode 5 Queens.Bt
                ]
-             , Tx.fitsInto "Bt (size)" (Queens.mkQueensCode 5 Queens.Bt) 2123
+             , Tx.fitsInto "Bt (size)" (Queens.mkQueensCode 5 Queens.Bt) 1940
              ]
 
 ---------------- Primes ----------------

diff --git a/plutus-benchmark/nofib/test/formulaBudget.budget.golden b/plutus-benchmark/nofib/test/formulaBudget.budget.golden
@@ -1,2 +1,2 @@
-({cpu: 10595833908
-| mem: 44538048})
+({cpu: 9146695908
+| mem: 38237448})
diff --git a/plutus-benchmark/nofib/test/knightsBudget.budget.golden b/plutus-benchmark/nofib/test/knightsBudget.budget.golden
@@ -1,2 +1,2 @@
-({cpu: 5031561298
-| mem: 17450940})
+({cpu: 4484460298
+| mem: 15072240})
diff --git a/plutus-benchmark/nofib/test/queens4budget.budget.golden b/plutus-benchmark/nofib/test/queens4budget.budget.golden
@@ -1,2 +1,2 @@
-({cpu: 10355382305
-| mem: 38134342})
+({cpu: 9369717305
+| mem: 33848842})
diff --git a/plutus-benchmark/nofib/test/queens5budget.budget.golden b/plutus-benchmark/nofib/test/queens5budget.budget.golden
@@ -1,2 +1,2 @@
-({cpu: 140864292648
-| mem: 505174580})
+({cpu: 128906178648
+| mem: 453182780})
diff --git a/plutus-benchmark/script-contexts/test/Spec.hs b/plutus-benchmark/script-contexts/test/Spec.hs
@@ -20,7 +20,7 @@ testCheckSc1 = testGroup "checkScriptContext1"
         runTermCek $ compiledCodeToTerm $ mkCheckScriptContext1Code (mkScriptContext 4)
     , testCase "fails on 5" $ assertBool "evaluation succeeded" $ isEvaluationFailure $
         runTermCek $ compiledCodeToTerm $ mkCheckScriptContext1Code (mkScriptContext 5)
-    , Tx.fitsInto "checkScriptContext1 (size)" (mkCheckScriptContext1Code (mkScriptContext 1)) 1985
+    , Tx.fitsInto "checkScriptContext1 (size)" (mkCheckScriptContext1Code (mkScriptContext 1)) 1963
     , runTestNested $ Tx.goldenBudget "checkScriptContext1-4" $
         mkCheckScriptContext1Code (mkScriptContext 4)
     , runTestNested $ Tx.goldenBudget "checkScriptContext1-20" $
@@ -33,7 +33,7 @@ testCheckSc2 = testGroup "checkScriptContext2"
           runTermCek $ compiledCodeToTerm $ mkCheckScriptContext2Code (mkScriptContext 4)
     , testCase "succeed on 5" $ assertBool "evaluation failed" $ isEvaluationSuccess $
           runTermCek $ compiledCodeToTerm $ mkCheckScriptContext2Code (mkScriptContext 5)
-    , Tx.fitsInto "checkScriptContext2 (size)" (mkCheckScriptContext2Code (mkScriptContext 1)) 1919
+    , Tx.fitsInto "checkScriptContext2 (size)" (mkCheckScriptContext2Code (mkScriptContext 1)) 1897
     , runTestNested $ Tx.goldenBudget "checkScriptContext2-4" $
           mkCheckScriptContext2Code (mkScriptContext 4)
     , runTestNested $ Tx.goldenBudget "checkScriptContext2-20" $

diff --git a/plutus-benchmark/script-contexts/test/checkScriptContext1-20.budget.golden b/plutus-benchmark/script-contexts/test/checkScriptContext1-20.budget.golden
@@ -1,2 +1,2 @@
-({cpu: 432991997
-| mem: 1354769})
+({cpu: 419053997
+| mem: 1294169})
diff --git a/plutus-benchmark/script-contexts/test/checkScriptContext1-4.budget.golden b/plutus-benchmark/script-contexts/test/checkScriptContext1-4.budget.golden
@@ -1,2 +1,2 @@
-({cpu: 125059245
-| mem: 393393})
+({cpu: 122161245
+| mem: 380793})
diff --git a/plutus-benchmark/script-contexts/test/checkScriptContext2-20.budget.golden b/plutus-benchmark/script-contexts/test/checkScriptContext2-20.budget.golden
@@ -1,2 +1,2 @@
-({cpu: 413790508
-| mem: 1292426})
+({cpu: 399852508
+| mem: 1231826})
diff --git a/plutus-benchmark/script-contexts/test/checkScriptContext2-4.budget.golden b/plutus-benchmark/script-contexts/test/checkScriptContext2-4.budget.golden
@@ -1,2 +1,2 @@
-({cpu: 119465388
-| mem: 375882})
+({cpu: 116567388
+| mem: 363282})
diff --git a/plutus-benchmark/script-contexts/test/checkScriptContextEqualityTerm-20.budget.golden b/plutus-benchmark/script-contexts/test/checkScriptContextEqualityTerm-20.budget.golden
@@ -1,2 +1,2 @@
-({cpu: 595428251
-| mem: 2430846})
+({cpu: 573072251
+| mem: 2333646})
diff --git a/plutus-core/changelog.d/20230523_132138_unsafeFixIO_app_inline_uplc.md b/plutus-core/changelog.d/20230523_132138_unsafeFixIO_app_inline_uplc.md
@@ -0,0 +1,3 @@
+### Added
+
+- Callsite inlining for UPLC.
diff --git a/plutus-core/plutus-ir/src/PlutusIR/Transform/CommuteFnWithConst.hs b/plutus-core/plutus-ir/src/PlutusIR/Transform/CommuteFnWithConst.hs
@@ -91,6 +91,23 @@ isCommutative = \case
   VerifyEd25519Signature          -> False
   VerifyEcdsaSecp256k1Signature   -> False
   VerifySchnorrSecp256k1Signature -> False
+  Bls12_381_G1_add                -> False
+  Bls12_381_G1_neg                -> False
+  Bls12_381_G1_scalarMul          -> False
+  Bls12_381_G1_equal              -> False
+  Bls12_381_G1_hashToGroup        -> False
+  Bls12_381_G1_compress           -> False
+  Bls12_381_G1_uncompress         -> False
+  Bls12_381_G2_add                -> False
+  Bls12_381_G2_neg                -> False
+  Bls12_381_G2_scalarMul          -> False
+  Bls12_381_G2_equal              -> False
+  Bls12_381_G2_hashToGroup        -> False
+  Bls12_381_G2_compress           -> False
+  Bls12_381_G2_uncompress         -> False
+  Bls12_381_millerLoop            -> False
+  Bls12_381_mulMlResult           -> False
+  Bls12_381_finalVerify           -> False
     -- Strings
   AppendString                    -> False
   EqualsString                    -> True

diff --git a/plutus-core/plutus-ir/src/PlutusIR/Transform/Inline/CallSiteInline.hs b/plutus-core/plutus-ir/src/PlutusIR/Transform/Inline/CallSiteInline.hs
@@ -106,14 +106,14 @@ perform beta reduction.
 {- | Computes the 'Utils.Arity' of a term. Also returns the function body, for checking whether
 it's `Utils.acceptable`.
 -}
-computeArity ::
+splitParams ::
   Term tyname name uni fun ann ->
   (Arity tyname name, Term tyname name uni fun ann)
-computeArity = \case
+splitParams = \case
   LamAbs _ n _ body ->
-    let (nextArgs, nextBody) = computeArity body in (TermParam n : nextArgs, nextBody)
+    let (nextArgs, nextBody) = splitParams body in (TermParam n : nextArgs, nextBody)
   TyAbs _ n _ body ->
-    let (nextArgs, nextBody) = computeArity body in (TypeParam n : nextArgs, nextBody)
+    let (nextArgs, nextBody) = splitParams body in (TypeParam n : nextArgs, nextBody)
   -- Whenever we encounter a body that is not a lambda or type abstraction, we are done counting
   tm -> ([], tm)
 

diff --git a/plutus-core/plutus-ir/src/PlutusIR/Transform/Inline/Inline.hs b/plutus-core/plutus-ir/src/PlutusIR/Transform/Inline/Inline.hs
@@ -33,7 +33,7 @@ import Control.Monad.State (evalStateT, modify')
 
 import Algebra.Graph qualified as G
 import Data.Map qualified as Map
-import PlutusIR.Transform.Inline.CallSiteInline (computeArity, inlineSaturatedApp)
+import PlutusIR.Transform.Inline.CallSiteInline (inlineSaturatedApp, splitParams)
 import Witherable (Witherable (wither))
 
 {- Note [Inlining approach and 'Secrets of the GHC Inliner']
@@ -237,7 +237,7 @@ processSingleBinding body = \case
             -- this binding is going to be unconditionally inlined
             Nothing -> pure Nothing
             Just rhs -> do
-                let (arity, bodyToCheck) = computeArity rhs
+                let (arity, bodyToCheck) = splitParams rhs
                 -- when we encounter a binding, we add it to
                 -- the global map `Utils.NonRecInScopeSet`.
                 -- The `varRhs` added to the map has been unconditionally inlined.

diff --git a/plutus-core/plutus-ir/test/TransformSpec.hs b/plutus-core/plutus-ir/test/TransformSpec.hs
@@ -27,7 +27,7 @@ import PlutusIR.Transform.Beta qualified as Beta
 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.CallSiteInline (computeArity)
+import PlutusIR.Transform.Inline.CallSiteInline (splitParams)
 import PlutusIR.Transform.Inline.Inline qualified as Inline
 import PlutusIR.Transform.KnownCon qualified as KnownCon
 import PlutusIR.Transform.LetFloatIn qualified as LetFloatIn
@@ -298,7 +298,7 @@ nameCapture =
 computeArityTest :: TestNested
 computeArityTest = testNested "computeArityTest" $
         map
-            (goldenPir (computeArity . runQuote . PLC.rename) pTerm)
+            (goldenPir (splitParams . runQuote . PLC.rename) pTerm)
             [ "var" -- from inline tests, testing let terms
             , "tyvar"
             , "single"

diff --git a/plutus-core/plutus-ir/test/recursion/factorial.golden b/plutus-core/plutus-ir/test/recursion/factorial.golden
@@ -2,38 +2,38 @@
   1.1.0
   [
     [
-      (lam s_512 [ s_512 s_512 ])
+      (lam s_545 [ s_545 s_545 ])
       (lam
-        s_513
+        s_546
         (lam
-          x_514
+          x_547
           [
             (lam
-              factorial_515
+              factorial_548
               [
                 [
                   [
                     [
                       (force (builtin ifThenElse))
-                      [ [ (builtin equalsInteger) (con integer 0) ] x_514 ]
+                      [ [ (builtin equalsInteger) (con integer 0) ] x_547 ]
                     ]
-                    (lam u_516 (con integer 1))
+                    (lam u_549 (con integer 1))
                   ]
                   (lam
-                    u_517
+                    u_550
                     [
-                      [ (builtin multiplyInteger) x_514 ]
+                      [ (builtin multiplyInteger) x_547 ]
                       [
-                        factorial_515
-                        [ [ (builtin subtractInteger) x_514 ] (con integer 1) ]
+                        factorial_548
+                        [ [ (builtin subtractInteger) x_547 ] (con integer 1) ]
                       ]
                     ]
                   )
                 ]
                 (con unit ())
               ]
             )
-            [ s_513 s_513 ]
+            [ s_546 s_546 ]
           ]
         )
       )

diff --git a/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Core.hs b/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Core.hs
@@ -1,7 +1,27 @@
-module UntypedPlutusCore.Core
-    ( module Export
-    ) where
+{-# LANGUAGE LambdaCase #-}
+
+module UntypedPlutusCore.Core (
+  module Export,
+  splitParams,
+  splitApplication,
+) where
 
 import UntypedPlutusCore.Core.Instance as Export
 import UntypedPlutusCore.Core.Plated as Export
 import UntypedPlutusCore.Core.Type as Export
+
+import Data.Bifunctor
+
+-- | Strips off lambda binders.
+splitParams :: Term name uni fun a -> ([name], Term name uni fun a)
+splitParams = \case
+  LamAbs _ n t -> first (n :) (splitParams t)
+  t            -> ([], t)
+
+-- | Strip off arguments
+splitApplication :: Term name uni fun a -> (Term name uni fun a, [(a, Term name uni fun a)])
+splitApplication = go []
+  where
+    go acc = \case
+      Apply ann fun arg -> go ((ann, arg) : acc) fun
+      t                 -> (t, acc)
diff --git a/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/MkUPlc.hs b/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/MkUPlc.hs
@@ -1,7 +1,6 @@
 -- editorconfig-checker-disable-file
-module UntypedPlutusCore.MkUPlc (UVarDecl (..), uvarDeclName, uvarDeclAnn, mkVar, mkIterApp, mkIterLamAbs, Def(..), UTermDef) where
+module UntypedPlutusCore.MkUPlc (UVarDecl (..), uvarDeclName, uvarDeclAnn, mkVar, mkIterLamAbs, Def(..), UTermDef) where
 
-import Data.List
 import PlutusCore.MkPlc (Def (..))
 import UntypedPlutusCore.Core.Type
 
@@ -12,14 +11,6 @@ type UTermDef name uni fun ann = Def (UVarDecl name ann) (Term name uni fun ann)
 mkVar :: ann -> UVarDecl name ann -> Term name uni fun ann
 mkVar ann = Var ann . _uvarDeclName
 
--- | Make an iterated application.
-mkIterApp
-    :: ann
-    -> Term name uni fun ann -- ^ @f@
-    -> [Term name uni fun ann] -- ^@[ x0 ... xn ]@
-    -> Term name uni fun ann -- ^ @[f x0 ... xn ]@
-mkIterApp ann = foldl' (Apply ann)
-
 -- | Lambda abstract a list of names.
 mkIterLamAbs
     :: [UVarDecl name ann]