Add gas costs for transcendentals

gasmodel/Main.hs

@@ -13,10 +13,10 @@ import Pact.Core.GasModel.ModuleLoadBench as ModuleLoad
 main :: IO ()
 main = do
   C.defaultMain
-    [ ModuleLoad.benchmarks
-    , ContractBench.allBenchmarks
+    [ ContractBench.allBenchmarks
     , BuiltinsGas.benchmarks
     , Serialization.benchmarks
+    , ModuleLoad.benchmarks
     ]
 
 

gasmodel/Pact/Core/GasModel/BuiltinsGas.hs

@@ -103,7 +103,7 @@ benchArithBinOp op pdb =
     [ runNativeBenchmark pdb title [text|($op $x $x.0)|] | (title, x) <- vals ]
   ]
   where
-  vals = take 3 $ enumExpText 1_000 1_000_000
+  vals = take 10 $ enumExpText 10 10
 
 benchPow :: BuiltinBenches
 benchPow pdb =
@@ -113,14 +113,14 @@ benchPow pdb =
     , (yTitle, y) <- take 3 $ enumExpText 1_000 100
     ]
   , C.bgroup "float"
-    [ runNativeBenchmark pdb title [text|(^ $x.0 $x.0)|] | (title, x) <- floatVals ]
+    [ runNativeBenchmark pdb title [text|(^ 2 $x.0)|] | (title, x) <- floatVals ]
   , C.bgroup "float_int"
-    [ runNativeBenchmark pdb title [text|(^ $x.0 $x)|] | (title, x) <- floatVals ]
+    [ runNativeBenchmark pdb title [text|(^ 2 $x)|] | (title, x) <- floatVals ]
   , C.bgroup "int_float"
-    [ runNativeBenchmark pdb title [text|(^ $x $x.0)|] | (title, x) <- floatVals ]
+    [ runNativeBenchmark pdb title [text|(^ 2 $x.0)|] | (title, x) <- floatVals ]
   ]
   where
-  floatVals = take 3 $ enumExpText 10 3
+  floatVals = take 10 $ enumExpText 10 10
 
 benchArithUnOp :: T.Text -> BuiltinBenches
 benchArithUnOp op pdb =
@@ -130,7 +130,7 @@ benchArithUnOp op pdb =
     [ runNativeBenchmark pdb title [text|($op $x.0)|] | (title, x) <- vals ]
   ]
   where
-  vals = take 3 $ enumExpText 1_000 1_000_000
+  vals = take 7 $ enumExpText 10 10
 
 benchAddNonArithOverloads :: BuiltinBenches
 benchAddNonArithOverloads pdb =

gasmodel/Pact/Core/GasModel/ModuleLoadBench.hs

@@ -124,7 +124,7 @@ moduleDataName = \case
 
 benchmarks :: Benchmark
 benchmarks = C.env mkPdb $ \ ~(pdb) ->
-    C.bgroup "Module load benches" (runModuleLoadBench pdb <$> [1..100])
+    C.bgroup "Module load benches" (runModuleLoadBench pdb <$> [1..1])
   where
   mkPdb = do
     pdb <- mockPactDb serialisePact_lineinfo

pact-tests/gas-goldens/builtinGas.golden

@@ -9,7 +9,7 @@
 =: 401
 >: 464
 >=: 464
-^: 536
+^: 968
 abs: 200
 acquire-module-admin: 297894
 add-time: 750
@@ -48,7 +48,7 @@ enforce-guard: 3566
 enforce-keyset: 3566
 enforce-verifier: 10150
 enumerate: 824
-exp: 10000
+exp: 4534
 filter: 4460
 floor: 400
 fold-db: 40525850
@@ -70,8 +70,8 @@ keys: 40525650
 keyset-ref-guard: 10425
 length: 1101
 list-modules: 100000
-ln: 12000
-log: 6000
+ln: 2016
+log: 2090
 make-list: 225
 map: 1715
 minutes: 276
@@ -99,10 +99,10 @@ reverse: 800
 round: 400
 scalar-mult: 360400
 select: 40525800
-shift: 1070
+shift: 1286
 show: 1400
 sort: 1400
-sqrt: 12000
+sqrt: 2022
 str-to-int: 708
 str-to-list: 751
 take: 2200

pact/Pact/Core/Gas/TableGasModel.hs

@@ -180,6 +180,48 @@ intDivCost !lop !rop
        else MilliGas $ fromIntegral (nbits * nbits `quot` 6400)
 {-# INLINE intDivCost #-}
 
+transExpCost :: Integer -> MilliGas
+transExpCost !power = MilliGas total
+  where
+  nDigitsBase, nDigitsPower, totalMults, k_const, operandSizeAverage :: SatWord
+  -- totalMults: Total number of multiplications (worst-case scenario)
+  -- For exponentiation by squaring, total multiplications T_m = 2L - 2
+  !totalMults = 2 * nDigitsPower - 2
+  -- n0: Number of bits in the base k
+  !nDigitsBase = fromIntegral (numberOfBits 3) -- (numberOfBits 2718281828459045090795598298427648842334747314453125)
+  !nDigitsPower = fromIntegral (numberOfBits power)
+  !k_const = 1 -- Our constant for karasuba mult per mul in terms of milligas
+  -- Constant for karasuba algorithm
+  alpha :: Double
+  alpha = 2.5
+  -- operandSizeAvg: Average operand size in bits (geometric mean)
+  -- operandSizeAvg = n0 * 2^((L - 1) / 2)
+  --
+  -- This calculation accounts for the exponential growth of operand sizes due to squaring.
+  -- The exponent (L - 1) / 2 represents the average number of squarings,
+  -- since operand size doubles with each squaring.
+  !operandSizeAverage =
+    nDigitsBase * (ceiling ((2 :: Double) ** (fromIntegral (nDigitsPower - 1) / 2)))
+  -- Note:
+  -- The exponential growth factor p^(alpha / 2) is already included in (operandSizeAvg ** alpha)
+  -- due to the properties of exponents:
+  --
+  --   (operandSizeAvg) ** alpha
+  -- = [n0 * 2^((L - 1) / 2)] ** alpha
+  -- = n0^alpha * 2^((L - 1) * alpha / 2)
+  --
+  -- Since 2^((L - 1) * alpha / 2) = [2^(L - 1)]^(alpha / 2)
+  -- and 2^(L - 1) ≈ p (when p is a power of 2),
+  -- we have:
+  --
+  --   2^((L - 1) * alpha / 2) = p^(alpha / 2)
+  --
+  -- Therefore, (operandSizeAvg ** alpha) includes the p^(alpha / 2) term,
+  -- and we do not need to multiply by it separately.
+  !total =
+    totalMults * k_const * ceiling (fromIntegral operandSizeAverage ** alpha)
+
+
 -- | Int shifting needs a bit of an adjustment.
 -- It's hilariously fast, but it can also create numbers of hilariously large sizes
 --
@@ -233,9 +275,9 @@ intPowCost !base !power = MilliGas total
   !nDigitsBase = fromIntegral (numberOfBits base)
   !nDigitsPower = fromIntegral (numberOfBits power)
   !k_const = 1 -- Our constant for karasuba mult per mul in terms of milligas
-  -- Constant for karasuba algorithm
+  -- Constant for multiplication in general
   alpha :: Double
-  alpha = 1.585
+  alpha = 2
   -- operandSizeAvg: Average operand size in bits (geometric mean)
   -- operandSizeAvg = n0 * 2^((L - 1) / 2)
   --
@@ -376,6 +418,31 @@ runTableModel nativeTable GasCostConfig{..} = \case
       -- and the execution time grows linearly, hence it's about 10 milligas per key/value pair in the object
       let objSizeFactor = 10
       in MilliGas $ fromIntegral $ objSize * textCompareCost key * objSizeFactor
+  GTranscendental top -> case top of
+    TransExp p -> transExpCost p
+    -- The estimated cost of computing log n is:
+    -- for some number with `n` bits, `log(2^n) = n (log 2)`
+    -- So computing `ln k` has a cost proportional to `n`.
+    -- Assuming the multiplication cost is `n log n * (log (log n))
+    -- for large
+    -- Note: p is nonzero
+    TransLn p -> MilliGas (cost_ln p)
+    TransLogBase base num ->
+      MilliGas (cost_ln base + cost_ln num)
+    -- For square root, we use the formula, for n bits:
+    -- n * log n * (log (log n))
+    TransSqrt p
+      | p > 0 ->
+      let !n = numberOfBits p
+          n_flt = (fromIntegral n :: Double)
+      in MilliGas $ fromIntegral n * ceiling (log n_flt) * ceiling (log (log n_flt))
+      | otherwise -> MilliGas 0
+    where
+    cost_ln :: Integer -> SatWord
+    cost_ln p =
+      let !n = numberOfBits p
+          !n_flt = (fromIntegral n :: Double)
+      in fromIntegral n * ceiling ((log n_flt) ** 2) * ceiling (log (log n_flt))
   GCapOp op -> case op of
     CapOpRequire cnt ->
       let mgPerCap = 100
@@ -434,10 +501,10 @@ coreBuiltinGasCost GasCostConfig{..} = MilliGas . \case
   CoreCeilingPrec -> _gcNativeBasicWork
   CoreFloorPrec -> _gcNativeBasicWork
   -- Todo: transcendental functions are definitely over_gassed
-  CoreExp -> 5_000
-  CoreLn -> 6_000
-  CoreSqrt -> 6_000
-  CoreLogBase -> 3_000
+  CoreExp -> 2_000
+  CoreLn -> 1_000
+  CoreSqrt -> 1_000
+  CoreLogBase -> 1_000
   -- note: length, take and drop are constant time
   -- for vector and string, but variable for maps
   CoreLength -> _gcNativeBasicWork

pact/Pact/Core/Gas/Types.hs

@@ -54,6 +54,7 @@ module Pact.Core.Gas.Types
 
   , freeGasModel
   , GasCostConfig(..)
+  , TranscendentalCost(..)
   , module Pact.Core.SatWord
   ) where
 
@@ -305,11 +306,19 @@ data GasArgs b
   | GModuleOp ModuleOp
   -- ^ The cost of integrating module deps, which is essentially a map union
   -- Map union is O(m*log(n/m+1)) where 0 < m <= n
+  | GTranscendental !TranscendentalCost
   | GStrOp !StrOp
   | GObjOp !ObjOp
   | GCapOp !CapOp
   deriving (Show, Eq, Generic, NFData)
 
+data TranscendentalCost
+  = TransExp !Integer -- Exponent integral part will dominate the work
+  | TransSqrt !Integer -- Integer part of
+  | TransLn !Integer -- Integer part of ln
+  | TransLogBase !Integer !Integer -- We will compute this as Ln(num) / Ln(base)
+  deriving (Eq, Show, Generic, NFData)
+
 data ModuleOp
   = MOpLoadModule !Int
   -- ^ Cost of loading module, the first element is the size of the module, the second and third

pact/Pact/Core/IR/Eval/CEK/CoreBuiltin.hs

@@ -220,7 +220,7 @@ rawPow info b cont handler _env = \case
     when (base == 0 && pow < 0) $
       throwExecutionError info (FloatingPointError "zero to a negative power is undefined")
     let integralPart = floor pow
-    chargeGasArgs info $ GIntegerOpCost PrimOpPow (decimalMantissa base) integralPart
+    chargeGasArgs info $ GIntegerOpCost PrimOpPow (floor base) integralPart
     result <- guardNanOrInf info $ MPFR.mpfr_pow base pow
     returnCEKValue cont handler (VLiteral (LDecimal result))
 
@@ -230,6 +230,7 @@ rawLogBase info b cont handler _env = \case
     checkArgs base n
     let base' = Decimal 0 base
         n' = Decimal 0 n
+    chargeGasArgs info (GTranscendental (TransLogBase base n))
     result <- guardNanOrInf info $  MPFR.mpfr_log base' n'
     returnCEKValue cont handler (VLiteral (LInteger (round result)))
   [VLiteral (LDecimal base), VLiteral (LDecimal arg)] -> do
@@ -242,6 +243,7 @@ rawLogBase info b cont handler _env = \case
   where
   decLogBase base arg = do
     checkArgs base arg
+    chargeGasArgs info (GTranscendental (TransLogBase (ceiling base) (ceiling arg)))
     result <- guardNanOrInf info $ MPFR.mpfr_log base arg
     returnCEKValue cont handler (VLiteral (LDecimal result))
 
@@ -352,9 +354,11 @@ rawExp :: (IsBuiltin b) => NativeFunction e b i
 rawExp info b cont handler _env = \case
   [VLiteral (LInteger i)] -> do
     let i' = Decimal 0 i
+    chargeGasArgs info (GTranscendental (TransExp i))
     result <- guardNanOrInf info $ MPFR.mpfr_exp i'
     returnCEKValue cont handler (VLiteral (LDecimal result))
   [VLiteral (LDecimal e)] -> do
+    chargeGasArgs info (GTranscendental (TransExp (decimalMantissa e)))
     result <- guardNanOrInf info $ MPFR.mpfr_exp e
     returnCEKValue cont handler (VLiteral (LDecimal result))
   args -> argsError info b args
@@ -363,9 +367,11 @@ rawLn :: (IsBuiltin b) => NativeFunction e b i
 rawLn info b cont handler _env = \case
   [VLiteral (LInteger i)] -> do
     let i' = Decimal 0 i
+    chargeGasArgs info (GTranscendental (TransLn i))
     result <- checkArgAndCompute i'
     returnCEKValue cont handler (VLiteral (LDecimal result))
   [VLiteral (LDecimal e)] -> do
+    chargeGasArgs info (GTranscendental (TransLn (ceiling e)))
     result <- checkArgAndCompute e
     returnCEKValue cont handler (VLiteral (LDecimal result))
   args -> argsError info b args
@@ -379,10 +385,12 @@ rawSqrt info b cont handler _env = \case
   [VLiteral (LInteger i)] -> do
     when (i < 0) $ throwExecutionError info (ArithmeticException "Square root must be non-negative")
     let i' = Decimal 0 i
+    chargeGasArgs info (GTranscendental (TransSqrt i))
     result <- guardNanOrInf info $ MPFR.mpfr_sqrt i'
     returnCEKValue cont handler (VLiteral (LDecimal result))
   [VLiteral (LDecimal e)] -> do
     when (e < 0) $ throwExecutionError info (ArithmeticException "Square root must be non-negative")
+    chargeGasArgs info (GTranscendental (TransSqrt (decimalMantissa e)))
     result <- guardNanOrInf info $ MPFR.mpfr_sqrt e
     returnCEKValue cont handler (VLiteral (LDecimal result))
   args -> argsError info b args

pact/Pact/Core/IR/Eval/Direct/CoreBuiltin.hs

@@ -223,7 +223,7 @@ rawPow info b _env = \case
     when (base == 0 && pow < 0) $
       throwExecutionError info (FloatingPointError "zero to a negative power is undefined")
     let integralPart = floor pow
-    chargeGasArgs info $ GIntegerOpCost PrimOpPow (decimalMantissa base) integralPart
+    chargeGasArgs info $ GIntegerOpCost PrimOpPow (floor base) integralPart
     result <- guardNanOrInf info $ MPFR.mpfr_pow base pow
     return (VLiteral (LDecimal (result)))
 
@@ -233,6 +233,7 @@ rawLogBase info b _env = \case
     checkArgs base n
     let base' = Decimal 0 base
         n' = Decimal 0 n
+    chargeGasArgs info (GTranscendental (TransLogBase base n))
     result <- guardNanOrInf info $ MPFR.mpfr_log base' n'
     return (VLiteral (LInteger (round result)))
   [VLiteral (LDecimal base), VLiteral (LDecimal arg)] -> do
@@ -245,6 +246,7 @@ rawLogBase info b _env = \case
   where
   decLogBase base arg = do
     checkArgs base arg
+    chargeGasArgs info (GTranscendental (TransLogBase (ceiling base) (ceiling arg)))
     result <- guardNanOrInf info $ MPFR.mpfr_log base arg
     return (VLiteral (LDecimal result))
   checkArgs :: (Num a, Ord a) => a -> a -> EvalM e b i ()
@@ -353,9 +355,11 @@ rawExp :: (IsBuiltin b) => NativeFunction e b i
 rawExp info b _env = \case
   [VLiteral (LInteger i)] -> do
     let i' = Decimal 0 i
+    chargeGasArgs info (GTranscendental (TransExp i))
     result <- guardNanOrInf info $ MPFR.mpfr_exp i'
     return (VLiteral (LDecimal result))
   [VLiteral (LDecimal e)] -> do
+    chargeGasArgs info (GTranscendental (TransExp (decimalMantissa e)))
     result <- guardNanOrInf info $ MPFR.mpfr_exp e
     return (VLiteral (LDecimal result))
   args -> argsError info b args
@@ -364,9 +368,11 @@ rawLn :: (IsBuiltin b) => NativeFunction e b i
 rawLn info b _env = \case
   [VLiteral (LInteger i)] -> do
     let i' = Decimal 0 i
+    chargeGasArgs info (GTranscendental (TransLn i))
     result <- checkArgAndCompute i'
     return (VLiteral (LDecimal result))
   [VLiteral (LDecimal e)] -> do
+    chargeGasArgs info (GTranscendental (TransLn (ceiling e)))
     result <- checkArgAndCompute e
     return (VLiteral (LDecimal result))
   args -> argsError info b args
@@ -380,10 +386,12 @@ rawSqrt info b _env = \case
   [VLiteral (LInteger i)] -> do
     when (i < 0) $ throwExecutionError info (ArithmeticException "Square root must be non-negative")
     let i' = Decimal 0 i
+    chargeGasArgs info (GTranscendental (TransSqrt i))
     result <- guardNanOrInf info $ MPFR.mpfr_sqrt i'
     return (VLiteral (LDecimal result))
   [VLiteral (LDecimal e)] -> do
     when (e < 0) $ throwExecutionError info (ArithmeticException "Square root must be non-negative")
+    chargeGasArgs info (GTranscendental (TransSqrt (decimalMantissa e)))
     result <- guardNanOrInf info $ MPFR.mpfr_sqrt e
     return (VLiteral (LDecimal result))
   args -> argsError info b args