Add MPFR trans functions

.github/workflows/applications.yml

@@ -53,6 +53,11 @@ jobs:
         ghc --version
         cabal --version
 
+    - name: Setting up MPFR (Ubuntu)
+      if: startsWith(matrix.os, 'ubuntu-')
+      shell: bash
+      run: sudo apt-get update && sudo apt-get install -y libmpfr-dev
+
     # Project Setup
     - name: Create cabal.project.local
       shell: bash
@@ -197,7 +202,7 @@ jobs:
         FROM ubuntu:${OS#ubuntu-}
         LABEL com.pact.docker.image.compiler="ghc-${{ matrix.ghc }}"
         LABEL com.pact.docker.image.os="${{ matrix.os }}"
-        RUN apt-get update && apt-get install -y ca-certificates libgmp10 libssl3 zlib1g locales && rm -rf /var/lib/apt/lists/* && locale-gen en_US.UTF-8 && update-locale LC_ALL=en_US.UTF-8 LANG=en_US.UTF-8
+        RUN apt-get update && apt-get install -y ca-certificates libgmp10 libmpfr-dev libssl3 zlib1g locales && rm -rf /var/lib/apt/lists/* && locale-gen en_US.UTF-8 && update-locale LC_ALL=en_US.UTF-8 LANG=en_US.UTF-8
         ENV LANG=en_US.UTF-8
         WORKDIR /pact
         COPY pact/pact .

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-tests/pact-tests/ops.repl

@@ -419,12 +419,12 @@
 (expect "^ integer decimal" 9.0 (^ 81 0.5))
 (expect "^ decimal integer" 15.625 (^ 2.5 3))
 
-;  (expect
-;   "hugenum regression"
-;   12020.67042599064370733685791492462158203125
-;   (^
-;    15.034465284692086701747761395233132973944448512421004399685858401206740385711739229018307610943234609057822959334669087436253689423614206061665462283698768757790600552385430913941421707844383369633809803959413869974997415115322843838226312287673293352959835
-;    3.466120406090666777582519661568003549307295836842780244500133445635634490670936927006970368136648330889718447039413255137656971927890831071689768359173260960739254160211017410322799793419223796996260056081828170546988461285168124170297427792046640116184356))
+ (expect
+  "hugenum regression"
+  12020.67042599064370733685791492462158203125
+  (^
+   15.034465284692086701747761395233132973944448512421004399685858401206740385711739229018307610943234609057822959334669087436253689423614206061665462283698768757790600552385430913941421707844383369633809803959413869974997415115322843838226312287673293352959835
+   3.466120406090666777582519661568003549307295836842780244500133445635634490670936927006970368136648330889718447039413255137656971927890831071689768359173260960739254160211017410322799793419223796996260056081828170546988461285168124170297427792046640116184356))
 
 "===== truncating"
 (expect "round" 100 (round 100.1))

pact-tng.cabal

@@ -203,21 +203,6 @@ library
     , alex:alex
     , happy:happy
 
-  c-sources:
-    cbits/musl/__math_invalid.c
-    cbits/musl/__math_divzero.c
-    cbits/musl/__math_oflow.c
-    cbits/musl/__math_uflow.c
-    cbits/musl/__math_xflow.c
-    cbits/musl/exp.c
-    cbits/musl/exp_data.c
-    cbits/musl/log.c
-    cbits/musl/log_data.c
-    cbits/musl/pow.c
-    cbits/musl/pow_data.c
-    cbits/musl/sqrt.c
-    cbits/musl/sqrt_data.c
-
   other-modules:
     -- TODO: Uncomment once this is finally fixed
     -- and stops crapping out both LSP and our CI:
@@ -298,7 +283,7 @@ library
     Pact.Core.IR.ModuleHashing
     Pact.Core.IR.ConstEval
 
-    Pact.Core.Trans.TOps
+    Pact.Core.Trans.MPFR
     Pact.Core.Version
 
     -- Repl
@@ -324,6 +309,8 @@ library
     -- Hyperlane
     Pact.Crypto.Hyperlane
 
+  extra-libraries: mpfr
+
 library pact-lsp
   import: pact-common
   hs-source-dirs: pact-lsp

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