Merge pull request #1771 from input-output-hk/mrBliss/optimise-balance

Optimise the balance function
IntersectMBO · Aug 11, 2020 · b82a339 · b82a339
2 parents 87a8fc7 + 4cf4a93
commit b82a339
Show file tree

Hide file tree

Showing 2 changed files with 6 additions and 5 deletions.
diff --git a/shelley/chain-and-ledger/executable-spec/src/Shelley/Spec/Ledger/STS/Chain.hs b/shelley/chain-and-ledger/executable-spec/src/Shelley/Spec/Ledger/STS/Chain.hs
@@ -363,7 +363,7 @@ data AdaPots = AdaPots
   deriving (Show, Eq)
 
 -- | Calculate the total ada pots in the chain state
-totalAdaPots :: Crypto crypto => ChainState crypto -> AdaPots
+totalAdaPots :: ChainState crypto -> AdaPots
 totalAdaPots (ChainState nes _ _ _ _ _ _) =
   AdaPots
     { treasuryAdaPot = treasury_,
@@ -381,7 +381,7 @@ totalAdaPots (ChainState nes _ _ _ _ _ _) =
     circulation = balance u
 
 -- | Calculate the total ada in the chain state
-totalAda :: Crypto crypto => ChainState crypto -> Coin
+totalAda :: ChainState crypto -> Coin
 totalAda cs =
   treasuryAdaPot + reservesAdaPot + rewardsAdaPot + utxoAdaPot + depositsAdaPot + feesAdaPot
   where

diff --git a/shelley/chain-and-ledger/executable-spec/src/Shelley/Spec/Ledger/UTxO.hs b/shelley/chain-and-ledger/executable-spec/src/Shelley/Spec/Ledger/UTxO.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE BangPatterns #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DerivingVia #-}
@@ -223,10 +224,10 @@ makeWitnessesFromScriptKeys txbodyHash hashKeyMap scriptHashes =
    in makeWitnessesVKey txbodyHash (Map.elems witKeys)
 
 -- | Determine the total balance contained in the UTxO.
-balance :: Crypto crypto => UTxO crypto -> Coin
-balance (UTxO utxo) = foldr addCoins 0 utxo
+balance :: UTxO crypto -> Coin
+balance (UTxO utxo) = fromIntegral $ Map.foldl' addCoins 0 utxo
   where
-    addCoins (TxOut _ a) b = a + b
+    addCoins !b (TxOutCompact _ a) = a + b
 
 -- | Determine the total deposit amount needed.
 -- The block may (legitimately) contain multiple registration certificates