IntersectMBO · effectfully · Apr 16, 2023 · Apr 11, 2023 · Mar 28, 2023 · Mar 29, 2023
diff --git a/plutus-benchmark/ed25519-throughput/Main.hs b/plutus-benchmark/ed25519-throughput/Main.hs
@@ -37,6 +37,7 @@ import Data.ByteString (ByteString)
 import Data.ByteString qualified as BS
 import Data.ByteString.Hash qualified as Hash
 import Data.Foldable (traverse_)
+import Data.SatInt
 import Flat qualified
 import Hedgehog.Internal.Gen qualified as G
 import Hedgehog.Internal.Range qualified as R
@@ -190,7 +191,7 @@ evaluate (UPLC.Program _ _ prog) =
       (_res, Cek.TallyingSt _ budget, _logs) ->
           let ExCPU cpu = exBudgetCPU budget
               ExMemory mem = exBudgetMemory budget
-          in (fromIntegral cpu, fromIntegral mem)
+          in (fromSatInt cpu, fromSatInt mem)
 
 -- | Evaluate a script and print out the serialised size and the CPU and memory
 -- usage, both as absolute values and percentages of the maxima specified in the

diff --git a/plutus-benchmark/lists/exe/Main.hs b/plutus-benchmark/lists/exe/Main.hs
@@ -11,6 +11,7 @@ import Text.Printf (printf)
 import PlutusBenchmark.Common (Term)
 import PlutusBenchmark.Lists.Sort
 
+import Data.SatInt
 import PlutusCore qualified as PLC
 import PlutusCore.Evaluation.Machine.ExBudget (ExBudget (..))
 import PlutusCore.Evaluation.Machine.ExBudgetingDefaults qualified as PLC
@@ -23,7 +24,8 @@ getBudgetUsage term =
       Cek.runCekDeBruijn PLC.defaultCekParameters Cek.counting Cek.noEmitter term
     of
       (Left _, _)                 -> Nothing
-      (Right _, Cek.CountingSt c) -> let ExCPU cpu = exBudgetCPU c in Just $ fromIntegral cpu
+      (Right _, Cek.CountingSt c) ->
+          let ExCPU cpu = exBudgetCPU c in Just $ fromSatInt cpu
 
 getCekSteps :: Term -> Maybe Integer
 getCekSteps term =
@@ -34,7 +36,7 @@ getCekSteps term =
       (Right _, Cek.TallyingSt (Cek.CekExTally counts) _) ->
           let getCount k =
                   case H.lookup k counts of
-                    Just v  -> let ExCPU n = exBudgetCPU v in fromIntegral n
+                    Just v  -> let ExCPU n = exBudgetCPU v in fromSatInt n
                     Nothing -> 0
               allNodeTags =
                 fmap

diff --git a/plutus-benchmark/nofib/exe/Main.hs b/plutus-benchmark/nofib/exe/Main.hs
@@ -13,6 +13,7 @@ import Control.Monad.Trans.Except (runExceptT)
 import Data.ByteString qualified as BS
 import Data.Char (isSpace)
 import Data.Foldable (traverse_)
+import Data.SatInt
 import Flat qualified
 import Options.Applicative as Opt hiding (action)
 import System.Exit (exitFailure)
@@ -250,7 +251,7 @@ measureBudget compiledCode =
           let (_, UPLC.TallyingSt _ budget) = UPLC.runCekNoEmit PLC.defaultCekParameters UPLC.tallying $ program ^. UPLC.progTerm
               ExCPU cpu = exBudgetCPU budget
               ExMemory mem = exBudgetMemory budget
-          in (Hs.fromIntegral cpu, Hs.fromIntegral mem)
+          in (fromSatInt cpu, fromSatInt mem)
 
 getInfo :: (Hs.String, CompiledCode a) -> (Hs.String, Integer, Integer, Integer)
 getInfo (name, code) =

diff --git a/plutus-core/changelog.d/20230403_145946_effectfully_lazy_costing.md b/plutus-core/changelog.d/20230403_145946_effectfully_lazy_costing.md
@@ -0,0 +1,3 @@
+### Changed
+
+- Made costing lazier to speed things up and increase expressiveness. #5239
diff --git a/plutus-core/cost-model/budgeting-bench/Benchmarks/Nops.hs b/plutus-core/cost-model/budgeting-bench/Benchmarks/Nops.hs
@@ -20,7 +20,7 @@ import PlutusCore
 import PlutusCore.Builtin
 import PlutusCore.Evaluation.Machine.BuiltinCostModel hiding (BuiltinCostModel)
 import PlutusCore.Evaluation.Machine.ExBudgetingDefaults
-import PlutusCore.Evaluation.Machine.ExMemory (ExMemoryUsage)
+import PlutusCore.Evaluation.Machine.ExMemoryUsage (ExMemoryUsage)
 import PlutusCore.Evaluation.Machine.MachineParameters
 import PlutusCore.Pretty
 import PlutusPrelude

diff --git a/plutus-core/cost-model/budgeting-bench/Benchmarks/Unit.hs b/plutus-core/cost-model/budgeting-bench/Benchmarks/Unit.hs
@@ -3,7 +3,7 @@
 module Benchmarks.Unit (makeBenchmarks) where
 
 import PlutusCore
-import PlutusCore.Evaluation.Machine.ExMemory
+import PlutusCore.Evaluation.Machine.ExMemoryUsage
 
 import Common
 import Generators

diff --git a/plutus-core/cost-model/budgeting-bench/Common.hs b/plutus-core/cost-model/budgeting-bench/Common.hs
@@ -12,7 +12,7 @@ import PlutusCore hiding (Constr)
 import PlutusCore.Compiler.Erase
 import PlutusCore.Data
 import PlutusCore.Evaluation.Machine.ExBudgetingDefaults
-import PlutusCore.Evaluation.Machine.ExMemory
+import PlutusCore.Evaluation.Machine.ExMemoryUsage
 import PlutusCore.Evaluation.Machine.MachineParameters
 import PlutusCore.MkPlc
 import PlutusCore.Pretty (Pretty)

diff --git a/plutus-core/cost-model/budgeting-bench/Generators.hs b/plutus-core/cost-model/budgeting-bench/Generators.hs
@@ -3,7 +3,8 @@
 module Generators where
 
 import PlutusCore.Data
-import PlutusCore.Evaluation.Machine.ExMemory (ExMemoryUsage (..))
+import PlutusCore.Evaluation.Machine.CostStream (sumCostStream)
+import PlutusCore.Evaluation.Machine.ExMemoryUsage (ExMemoryUsage (..), flattenCostRose)
 
 import Control.Monad
 import Data.Bits
@@ -222,5 +223,7 @@ dataSample = genDataSample (take 500 $ cycle dataParams)
 -- objects.
 dataSampleForEq :: [Data]
 dataSampleForEq =
-    take 400 . filter (\d -> memoryUsage d < 1000000) . genDataSample . take 1000 $
+    take 400 . filter (\d -> budgetUsage d < 1000000) . genDataSample . take 1000 $
         cycle ((20, (1,1,1)):dataParams)
+  where
+    budgetUsage = sumCostStream . flattenCostRose . memoryUsage
diff --git a/plutus-core/cost-model/create-cost-model/CreateBuiltinCostModel.hs b/plutus-core/cost-model/create-cost-model/CreateBuiltinCostModel.hs
@@ -9,7 +9,9 @@
 module CreateBuiltinCostModel where
 
 import PlutusCore.Evaluation.Machine.BuiltinCostModel
+import PlutusCore.Evaluation.Machine.CostStream
 import PlutusCore.Evaluation.Machine.ExMemory
+import PlutusCore.Evaluation.Machine.ExMemoryUsage
 
 import Barbies (bmap, bsequence)
 import Control.Applicative (Const (Const, getConst))
@@ -21,6 +23,7 @@ import Data.Coerce (coerce)
 import Data.Csv (FromNamedRecord, FromRecord, HasHeader (HasHeader), decode, parseNamedRecord, (.:))
 import Data.Either.Extra (maybeToEither)
 import Data.Functor.Compose (Compose (Compose))
+import Data.SatInt
 import Data.Text (Text)
 import Data.Text.Encoding qualified as T (encodeUtf8)
 import Data.Vector (Vector, find)
@@ -33,7 +36,7 @@ import Language.R.QQ (r)
 -- | Convert microseconds represented as a float to picoseconds represented as a
 -- CostingInteger.  We round up to be sure we don't underestimate anything.
 microToPico :: Double -> CostingInteger
-microToPico = ceiling . (1e6 *)
+microToPico = unsafeToSatInt . ceiling . (1e6 *)
 
 {- See CostModelGeneration.md for a description of what this does. -}
 
@@ -289,7 +292,7 @@ boolMemModel = ModelTwoArgumentsConstantCost 1
 
 
 memoryUsageAsCostingInteger :: ExMemoryUsage a => a -> CostingInteger
-memoryUsageAsCostingInteger x = coerce $ memoryUsage x
+memoryUsageAsCostingInteger = coerce . sumCostStream . flattenCostRose . memoryUsage
 
 
 ---------------- Integers ----------------

diff --git a/plutus-core/cost-model/test/TestCostModels.hs b/plutus-core/cost-model/test/TestCostModels.hs
@@ -15,14 +15,17 @@
 import PlutusCore.DataFilePaths qualified as DFP
 import PlutusCore.Evaluation.Machine.BuiltinCostModel
 import PlutusCore.Evaluation.Machine.ExBudget (ExBudget (..))
+import PlutusCore.Evaluation.Machine.ExBudgetStream (sumExBudgetStream)
 import PlutusCore.Evaluation.Machine.ExMemory
+import PlutusCore.Evaluation.Machine.ExMemoryUsage
 
 import CreateBuiltinCostModel
 import TH
 
 import Control.Applicative (Const, getConst)
 import Control.Monad.Morph (MFunctor, hoist, lift)
 import Data.Coerce (coerce)
+import Data.SatInt
 import Data.String (fromString)
 import Unsafe.Coerce (unsafeCoerce)
 
@@ -77,8 +80,8 @@ numberOfTests = 100
 memUsageGen :: Gen CostingInteger
 memUsageGen =
     Gen.choice [small, large]
-        where small = Gen.integral (Range.constant 0 2)
-              large = Gen.integral (Range.linear 0 5000)
+        where small = unsafeToSatInt <$> Gen.integral (Range.constant 0 2)
+              large = unsafeToSatInt <$> Gen.integral (Range.linear 0 5000)
 
 -- A type alias to make our signatures more concise.  This type is a record in
 -- which every field refers to an R SEXP (over some state s), the lm model for
@@ -96,12 +99,12 @@ data TestDomain
   | BelowDiagonal
 
 -- Approximate equality
-(~=) :: Integral a => a -> a -> Bool
+(~=) :: CostingInteger -> CostingInteger -> Bool
 x ~= y
   | x==0 && y==0 = True
   | otherwise = err < 1/100
-    where x' = fromIntegral x :: Double
-          y' = fromIntegral y :: Double
+    where x' = fromSatInt x :: Double
+          y' = fromSatInt y :: Double
           err = abs ((x'-y')/y')
 
 -- Runs property tests in the `R` Monad.
@@ -142,7 +145,7 @@ propertyR prop = withTests numberOfTests $ property $ unsafeHoist unsafeRunRegio
 -}
 newtype ExM = ExM CostingInteger
 instance ExMemoryUsage ExM where
-    memoryUsage (ExM n) = ExMemory n
+    memoryUsage (ExM n) = singletonRose n
 
 -- Creates the model on the R side, loads the parameters over to Haskell, and
 -- runs both models with a bunch of ExMemory combinations and compares the
@@ -158,11 +161,13 @@ testPredictOne haskellModelFun modelR1 = propertyR $ do
     predictR :: MonadR m => CostingInteger -> m CostingInteger
     predictR x =
         let
-            xD = fromIntegral x :: Double
+            xD = fromSatInt x :: Double
         in
           microToPico . fromSomeSEXP <$> [r|predict(modelR_hs, data.frame(x_mem=xD_hs))[[1]]|]
     predictH :: CostingInteger -> CostingInteger
-    predictH x = coerce $ exBudgetCPU $ runCostingFunOneArgument modelH (ExM x)
+    predictH x =
+      coerce $ exBudgetCPU $ sumExBudgetStream $
+        runCostingFunOneArgument modelH (ExM x)
     sizeGen = memUsageGen
   x <- forAll sizeGen
   byR <- lift $ predictR x
@@ -184,13 +189,15 @@ testPredictTwo haskellModelFun modelR1 domain = propertyR $ do
     predictR :: MonadR m => CostingInteger -> CostingInteger -> m CostingInteger
     predictR x y =
       let
-        xD = fromIntegral x :: Double
-        yD = fromIntegral y :: Double
+        xD = fromSatInt x :: Double
+        yD = fromSatInt y :: Double
       in
         microToPico . fromSomeSEXP <$>
           [r|predict(modelR_hs, data.frame(x_mem=xD_hs, y_mem=yD_hs))[[1]]|]
     predictH :: CostingInteger -> CostingInteger -> CostingInteger
-    predictH x y = coerce $ exBudgetCPU $ runCostingFunTwoArguments modelH (ExM x) (ExM y)
+    predictH x y =
+      coerce $ exBudgetCPU $ sumExBudgetStream $
+        runCostingFunTwoArguments modelH (ExM x) (ExM y)
     sizeGen = case domain of
                 Everywhere    -> twoArgs
                 OnDiagonal    -> memUsageGen >>= \x -> pure (x,x)
@@ -212,15 +219,16 @@ testPredictThree haskellModelFun modelR1 = propertyR $ do
     predictR :: MonadR m => CostingInteger -> CostingInteger -> CostingInteger -> m CostingInteger
     predictR x y z =
       let
-        xD = fromIntegral x :: Double
-        yD = fromIntegral y :: Double
-        zD = fromIntegral z :: Double
+        xD = fromSatInt x :: Double
+        yD = fromSatInt y :: Double
+        zD = fromSatInt z :: Double
       in
         microToPico . fromSomeSEXP <$>
           [r|predict(modelR_hs, data.frame(x_mem=xD_hs, y_mem=yD_hs, z_mem=zD_hs))[[1]]|]
     predictH :: CostingInteger -> CostingInteger -> CostingInteger -> CostingInteger
     predictH x y z =
-      coerce $ exBudgetCPU $ runCostingFunThreeArguments modelH (ExM x) (ExM y) (ExM z)
+      coerce $ exBudgetCPU $ sumExBudgetStream $
+        runCostingFunThreeArguments modelH (ExM x) (ExM y) (ExM z)
     sizeGen = (,,) <$> memUsageGen <*> memUsageGen <*> memUsageGen
   (x, y, z) <- forAll sizeGen
   byR <- lift $ predictR x y z
@@ -240,12 +248,12 @@ testPredictSix haskellModelFun modelR1 = propertyR $ do
              -> CostingInteger -> CostingInteger -> CostingInteger -> m CostingInteger
     predictR x y z u v  w =
       let
-        xD = fromIntegral x :: Double
-        yD = fromIntegral y :: Double
-        zD = fromIntegral z :: Double
-        uD = fromIntegral u :: Double
-        vD = fromIntegral v :: Double
-        wD = fromIntegral w :: Double
+        xD = fromSatInt x :: Double
+        yD = fromSatInt y :: Double
+        zD = fromSatInt z :: Double
+        uD = fromSatInt u :: Double
+        vD = fromSatInt v :: Double
+        wD = fromSatInt w :: Double
       in
         microToPico . fromSomeSEXP <$>
           [r|predict(modelR_hs, data.frame(x_mem=xD_hs, y_mem=yD_hs, z_mem=zD_hs,
@@ -257,8 +265,9 @@ testPredictSix haskellModelFun modelR1 = propertyR $ do
       -> CostingInteger
       -> CostingInteger
       -> CostingInteger
-    predictH x y z u v w = coerce $ exBudgetCPU $ runCostingFunSixArguments modelH
-                                                     (ExM x) (ExM y) (ExM z) (ExM u) (ExM v) (ExM w)
+    predictH x y z u v w =
+      coerce $ exBudgetCPU $ sumExBudgetStream $
+        runCostingFunSixArguments modelH (ExM x) (ExM y) (ExM z) (ExM u) (ExM v) (ExM w)
     sizeGen =
       (,,,,,) <$> memUsageGen <*> memUsageGen <*> memUsageGen <*> memUsageGen <*> memUsageGen
         <*> memUsageGen

diff --git a/plutus-core/executables/src/PlutusCore/Executable/Common.hs b/plutus-core/executables/src/PlutusCore/Executable/Common.hs
@@ -81,6 +81,7 @@ import Data.List (intercalate, nub)
 import Data.List qualified as List
 import Data.Maybe (fromJust)
 import Data.Proxy (Proxy (..))
+import Data.SatInt
 import Data.Text qualified as T
 import Data.Text.IO qualified as T
 import Flat (Flat)
@@ -219,9 +220,7 @@ printBudgetStateTally term model (Cek.CekExTally costs) = do
     f l e = case e of (Cek.BBuiltinApp b, cost) -> (b, cost) : l; _ -> l
     builtinsAndCosts = List.foldl f [] (H.toList costs)
     builtinCosts = mconcat (map snd builtinsAndCosts)
-    -- \^ Total builtin evaluation time (according to the models) in picoseconds
-    -- (units depend on BuiltinCostModel.costMultiplier)
-    getCPU b = let ExCPU b' = exBudgetCPU b in fromIntegral b' :: Double
+    getCPU b = let ExCPU b' = exBudgetCPU b in fromSatInt b' :: Double
     totalCost = getSpent Cek.BStartup <> totalComputeCost <> builtinCosts
     totalTime =
         (getCPU $ getSpent Cek.BStartup) + getCPU totalComputeCost + getCPU builtinCosts

diff --git a/plutus-core/plutus-core.cabal b/plutus-core/plutus-core.cabal
@@ -99,10 +99,13 @@ library
     PlutusCore.Evaluation.Machine.CostingFun.Core
     PlutusCore.Evaluation.Machine.CostingFun.JSON
     PlutusCore.Evaluation.Machine.CostModelInterface
+    PlutusCore.Evaluation.Machine.CostStream
     PlutusCore.Evaluation.Machine.ExBudget
     PlutusCore.Evaluation.Machine.ExBudgetingDefaults
+    PlutusCore.Evaluation.Machine.ExBudgetStream
     PlutusCore.Evaluation.Machine.Exception
     PlutusCore.Evaluation.Machine.ExMemory
+    PlutusCore.Evaluation.Machine.ExMemoryUsage
     PlutusCore.Evaluation.Machine.MachineParameters
     PlutusCore.Evaluation.Machine.MachineParameters.Default
     PlutusCore.Evaluation.Result
@@ -365,6 +368,7 @@ test-suite untyped-plutus-core-test
     DeBruijn.UnDeBruijnify
     Evaluation.Builtins
     Evaluation.Builtins.Common
+    Evaluation.Builtins.Costing
     Evaluation.Builtins.Definition
     Evaluation.Builtins.MakeRead
     Evaluation.Builtins.SignatureVerification
@@ -380,6 +384,7 @@ test-suite untyped-plutus-core-test
     , base                                            >=4.9 && <5
     , bytestring
     , cardano-crypto-class
+    , dlist
     , flat                                            <0.5
     , hedgehog
     , index-envs
@@ -388,11 +393,13 @@ test-suite untyped-plutus-core-test
     , plutus-core:{plutus-core, plutus-core-testlib}  ^>=1.4
     , pretty-show
     , prettyprinter
+    , QuickCheck
     , split
     , tasty
     , tasty-golden
     , tasty-hedgehog
     , tasty-hunit
+    , tasty-quickcheck
     , text
 
 executable plc
Original file line number	Diff line number	Diff line change
		@@ -0,0 +1,3 @@
		### Changed

		- Made costing lazier to speed things up and increase expressiveness. #5239