Use HashMap in the cache, rather than Map

Change-Id: Id0000000bf170ed4f4b6ddbc897430205b45c9aa

cabal.project

@@ -101,8 +101,8 @@ source-repository-package
 source-repository-package
     type: git
     location: https://github.com/kadena-io/pact-5.git
-    tag: ebb66271ecce7cac1a7901a15658ad1b8233743a
-    --sha256: 1c362q6jpiq7gndypxci5bdpcm7hxbpg90fim4c977pxphsbiv1k
+    tag: 827d01b384fb2c6b3d84fea51aff41a1c81ea04e
+    --sha256: 13ja4zwjwc5h5rmlan5dsasn7mj3g9613hnyhkfrjw5zkbrw7ipl
 
 source-repository-package
     type: git

src/Chainweb/Pact/Backend/InMemDb.hs

@@ -22,8 +22,8 @@ module Chainweb.Pact.Backend.InMemDb
 import Prelude hiding (lookup)
 import Control.Lens
 import Data.ByteString (ByteString)
-import Data.Map.Strict(Map)
-import Data.Map.Strict qualified as Map
+import Data.HashMap.Strict(HashMap)
+import Data.HashMap.Strict qualified as HashMap
 
 import Pact.Core.Persistence
 import Pact.Core.Builtin
@@ -33,6 +33,8 @@ import Pact.Core.Names
 import Pact.Core.Namespace
 import Pact.Core.DefPacts.Types
 import Pact.Core.IR.Term (ModuleCode)
+import Data.Hashable
+import Data.Maybe
 
 data Entry a
     = ReadEntry !Int !a
@@ -45,13 +47,12 @@ data Entry a
 makePrisms ''Entry
 
 data Store = Store
-    -- TODO: hashmap instead of map? Or maybe an intmap?
-    { userTables :: Map TableName (Map RowKey (Entry RowData))
-    , keySets :: Map KeySetName (Entry KeySet)
-    , modules :: Map ModuleName (Entry (ModuleData CoreBuiltin Info))
-    , namespaces :: Map NamespaceName (Entry Namespace)
-    , defPacts :: Map DefPactId (Entry (Maybe DefPactExec))
-    , moduleSources :: Map HashedModuleName (Entry ModuleCode)
+    { userTables :: HashMap TableName (HashMap RowKey (Entry RowData))
+    , keySets :: HashMap KeySetName (Entry KeySet)
+    , modules :: HashMap ModuleName (Entry (ModuleData CoreBuiltin Info))
+    , namespaces :: HashMap NamespaceName (Entry Namespace)
+    , defPacts :: HashMap DefPactId (Entry (Maybe DefPactExec))
+    , moduleSources :: HashMap HashedModuleName (Entry ModuleCode)
     }
     deriving (Show, Eq)
 
@@ -65,42 +66,36 @@ insert
 insert d k v Store {..} = case d of
     DUserTables tn -> Store
         { userTables =
-            Map.insertWith
-                (\new old -> mergeEntries old new)
-                tn (Map.singleton k v) userTables
+            userTables & at tn %~ Just . insertProperlyInto . fromMaybe mempty
         , ..}
     DKeySets -> Store {keySets = insertProperlyInto keySets, ..}
     DModules -> Store {modules = insertProperlyInto modules, ..}
     DNamespaces -> Store {namespaces = insertProperlyInto namespaces, ..}
     DDefPacts -> Store {defPacts = insertProperlyInto defPacts, ..}
     DModuleSource -> Store {moduleSources = insertProperlyInto moduleSources, ..}
     where
-    insertProperlyInto :: Ord k => Map k (Entry v) -> Map k (Entry v)
-    insertProperlyInto m = Map.insertWith takeLatestEntry k v m
+    insertProperlyInto :: Hashable k => HashMap k (Entry v) -> HashMap k (Entry v)
+    insertProperlyInto m = HashMap.insertWith (\new old -> takeLatestEntry old new) k v m
 
 lookup
     :: Domain k v CoreBuiltin Info
     -> k -> Store -> Maybe (Entry v)
 lookup d k Store {..} = case d of
-    DUserTables tn -> Map.lookup tn userTables >>= Map.lookup k
-    DKeySets -> Map.lookup k keySets
-    DModules -> Map.lookup k modules
-    DNamespaces -> Map.lookup k namespaces
-    DDefPacts -> Map.lookup k defPacts
-    DModuleSource -> Map.lookup k moduleSources
+    DUserTables tn -> HashMap.lookup tn userTables >>= HashMap.lookup k
+    DKeySets -> HashMap.lookup k keySets
+    DModules -> HashMap.lookup k modules
+    DNamespaces -> HashMap.lookup k namespaces
+    DDefPacts -> HashMap.lookup k defPacts
+    DModuleSource -> HashMap.lookup k moduleSources
 
 keys :: Domain k v CoreBuiltin Info -> Store -> [k]
 keys d Store {..} = case d of
-    DUserTables tn -> maybe [] Map.keys $ Map.lookup tn userTables
-    DKeySets -> Map.keys keySets
-    DModules -> Map.keys modules
-    DNamespaces -> Map.keys namespaces
-    DDefPacts -> Map.keys defPacts
-    DModuleSource -> Map.keys moduleSources
-
-mergeEntries :: Ord k => Map k (Entry a) -> Map k (Entry a) -> Map k (Entry a)
-mergeEntries oldMap newMap =
-    Map.unionWith takeLatestEntry oldMap newMap
+    DUserTables tn -> maybe [] HashMap.keys $ HashMap.lookup tn userTables
+    DKeySets -> HashMap.keys keySets
+    DModules -> HashMap.keys modules
+    DNamespaces -> HashMap.keys namespaces
+    DDefPacts -> HashMap.keys defPacts
+    DModuleSource -> HashMap.keys moduleSources
 
 takeLatestEntry :: Entry a -> Entry a -> Entry a
 takeLatestEntry ReadEntry {} newEntry = newEntry

src/Chainweb/Pact5/Backend/ChainwebPactDb.hs

@@ -87,6 +87,7 @@ import qualified Data.ByteString.Char8 as B8
 import qualified Data.DList as DL
 import Data.List(sort)
 import qualified Data.HashSet as HashSet
+import qualified Data.HashMap.Strict as HashMap
 import qualified Data.Map.Strict as M
 import Data.Maybe
 import qualified Data.Text as T
@@ -693,23 +694,29 @@ commitBlockStateToDatabase db hsh bh blockHandle = do
         -> IO ()
     backendWriteUpdateBatch store = do
         writeTable (domainToTableName Pact.DKeySets)
-            $ M.mapMaybeWithKey (prepRow . convKeySetName) $ InMemDb.keySets store
+            $ mapMaybe (uncurry $ prepRow . convKeySetName)
+            $ HashMap.toList (InMemDb.keySets store)
 
         writeTable (domainToTableName Pact.DModules)
-            $ M.mapMaybeWithKey (prepRow . convModuleName) $ InMemDb.modules store
+            $ mapMaybe (uncurry $ prepRow . convModuleName)
+            $ HashMap.toList (InMemDb.modules store)
 
         writeTable (domainToTableName Pact.DNamespaces)
-            $ M.mapMaybeWithKey (prepRow . convNamespaceName) $ InMemDb.namespaces store
+            $ mapMaybe (uncurry $ prepRow . convNamespaceName)
+            $ HashMap.toList (InMemDb.namespaces store)
 
         writeTable (domainToTableName Pact.DDefPacts)
-            $ M.mapMaybeWithKey (prepRow . convPactId) $ InMemDb.defPacts store
+            $ mapMaybe (uncurry $ prepRow . convPactId)
+            $ HashMap.toList (InMemDb.defPacts store)
 
         writeTable (domainToTableName Pact.DModuleSource)
-            $ M.mapMaybeWithKey (prepRow . convHashedModuleName) $ InMemDb.moduleSources store
+            $ mapMaybe (uncurry $ prepRow . convHashedModuleName)
+            $ HashMap.toList (InMemDb.moduleSources store)
 
         iforM_ (InMemDb.userTables store) $ \tableName tableContents -> do
             writeTable (domainToTableName (Pact.DUserTables tableName))
-                $ M.mapMaybeWithKey (prepRow . convRowKey) tableContents
+                $ mapMaybe (uncurry $ prepRow . convRowKey)
+                $ HashMap.toList tableContents
 
         where
         domainToTableName = SQ3.Utf8 . T.encodeUtf8 . Pact.renderDomain
@@ -721,7 +728,7 @@ commitBlockStateToDatabase db hsh bh blockHandle = do
                 ]
         prepRow _ InMemDb.ReadEntry {} = Nothing
 
-        writeTable :: SQ3.Utf8 -> M.Map k [SType] -> IO ()
+        writeTable :: SQ3.Utf8 -> [[SType]] -> IO ()
         writeTable table writes = when (not (null writes)) $ do
             execMulti db q writes
             markTableMutation table bh
@@ -743,9 +750,8 @@ commitBlockStateToDatabase db hsh bh blockHandle = do
             , SBlob (runPutS (encodeBlockHash hsh))
             , SInt (fromIntegral t)
             ]
-      where
-        stmt =
-          "INSERT INTO BlockHistory ('blockheight','hash','endingtxid') VALUES (?,?,?);"
+        where
+        stmt = "INSERT INTO BlockHistory ('blockheight','hash','endingtxid') VALUES (?,?,?);"
 
     createUserTable :: SQ3.Utf8 -> IO ()
     createUserTable tablename = do
@@ -756,7 +762,7 @@ commitBlockStateToDatabase db hsh bh blockHandle = do
     -- to drop it if we rewind past this block.
     markTableCreation tablename =
         exec' db insertstmt insertargs
-      where
+        where
         insertstmt = "INSERT OR IGNORE INTO VersionedTableCreation VALUES (?,?)"
         insertargs = [SText tablename, SInt (fromIntegral bh)]
 
@@ -766,9 +772,9 @@ commitBlockStateToDatabase db hsh bh blockHandle = do
         let txs = _pendingSuccessfulTxs $ _blockHandlePending blockHandle
         dbIndexTransactions txs
 
-      where
+        where
         toRow b = [SBlob b, SInt (fromIntegral bh)]
         dbIndexTransactions txs = do
             let rows = map toRow $ toList txs
-            execMulti db "INSERT INTO TransactionIndex (txhash, blockheight) \
-                         \ VALUES (?, ?)" rows
+            let q = "INSERT INTO TransactionIndex (txhash, blockheight) VALUES (?, ?)"
+            execMulti db q rows

test/unit/Chainweb/Test/Pact5/TransactionExecTest.hs

@@ -40,8 +40,8 @@ import Control.Monad.Reader
 import Control.Monad.Trans.Resource
 import Data.Decimal
 import Data.Functor.Product
+import Data.HashMap.Strict qualified as HashMap
 import Data.IORef
-import Data.Map qualified as Map
 import Data.Maybe (fromMaybe)
 import Data.Set qualified as Set
 import Data.String (fromString)
@@ -467,9 +467,9 @@ applyCmdSpec rdb = readFromAfterGenesis v rdb $ do
             ? P.fun _pendingWrites
             ? P.checkAll
                 [ P.fun InMemDb.userTables
-                    ? P.alignExact ? Map.fromList
+                    ? P.alignExact ? HashMap.fromList
                         [ TableName "coin-table" (ModuleName "coin" Nothing) :=>
-                            P.alignExact ? Map.fromList
+                            P.alignExact ? HashMap.fromList
                                 [ RowKey "NoMiner" :=>
                                     P.match InMemDb._WriteEntry P.succeed
                                 , RowKey "sender00" :=>
@@ -478,7 +478,7 @@ applyCmdSpec rdb = readFromAfterGenesis v rdb $ do
                         ]
 
                 , P.fun InMemDb.modules
-                    ? P.alignExact ? Map.fromList
+                    ? P.alignExact ? HashMap.fromList
                         [ ModuleName "coin" Nothing :=>
                             P.match InMemDb._ReadEntry P.succeed
                         ]
@@ -889,7 +889,7 @@ testWritesFromFailedTxDontMakeItIn rdb = readFromAfterGenesis v rdb $ do
             ? P.fail "no writes made to module table"
         , P.fun InMemDb.userTables
             ? P.match (ix (TableName "coin-table" (ModuleName "coin" Nothing)))
-            ? P.alignExact ? Map.fromList
+            ? P.alignExact ? HashMap.fromList
                 [ RowKey "NoMiner" :=> P.match InMemDb._WriteEntry P.succeed
                 , RowKey "sender00" :=> P.match InMemDb._WriteEntry P.succeed
                 ]