Skip to content

Commit

Permalink
Introduce StableHashMap to support hashable-1.5.0.0 (#1378)
Browse files Browse the repository at this point in the history
* Introduce StableHashMap to support hashable-1.5.0.0

* add test cases for StableHashable

* tests for StableHashMap
  • Loading branch information
larskuhtz authored Nov 4, 2024
1 parent 058da31 commit 1027a1f
Show file tree
Hide file tree
Showing 27 changed files with 3,130 additions and 124 deletions.
3 changes: 3 additions & 0 deletions pact.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -203,6 +203,7 @@ library
Pact.Types.Verifier
Pact.Types.Version
Pact.Utils.Servant
Pact.Utils.StableHashMap

other-modules:
Pact.Crypto.WebAuthn.Cose.PublicKey
Expand Down Expand Up @@ -448,6 +449,7 @@ test-suite hspec
, directory
, errors
, filepath
, hashable
, hspec
, lens
, mod
Expand All @@ -474,6 +476,7 @@ test-suite hspec
Test.Pact.Native.Pairing
Test.Pact.Parse
Test.Pact.Utils.LegacyValue
Test.Pact.Utils.StableHashMap

if flag(build-tool)
cpp-options: -DBUILD_TOOL
Expand Down
9 changes: 5 additions & 4 deletions src-tool/Pact/Analyze/Check.hs
Original file line number Diff line number Diff line change
Expand Up @@ -106,6 +106,7 @@ import Pact.Analyze.Translate
import Pact.Analyze.Types
import Pact.Analyze.Util
import Pact.Types.Exp
import qualified Pact.Utils.StableHashMap as SHM

smtConfig :: SBV.SMTConfig
smtConfig = SBV.z3
Expand Down Expand Up @@ -766,7 +767,7 @@ parseModuleModelDecl exps = traverse parseDecl exps where

-- | Organize the module's refs by type
moduleRefs :: ModuleData Ref -> ModuleRefs
moduleRefs (ModuleData _ refMap _) = foldl' f noRefs (HM.toList refMap)
moduleRefs (ModuleData _ refMap _) = foldl' f noRefs (SHM.toList refMap)
where
f accum (name, ref) = case ref of
Ref (TDef (Def{_dDefType, _dDefBody}) _) ->
Expand Down Expand Up @@ -1137,7 +1138,7 @@ getFunChecks env@(CheckEnv tables consts propDefs moduleData _cs _g de _) refs =
scopeCheckInterface
:: Set Text
-- ^ A set of table, definition and property names in scope
-> HM.HashMap Text Ref
-> SHM.StableHashMap Text Ref
-- ^ The set of refs to check
-> [ScopeError]
scopeCheckInterface globalNames refs = refs <&&> \case
Expand Down Expand Up @@ -1229,7 +1230,7 @@ verifyModule mDebug de modules moduleData@(ModuleData modDef allRefs _) = runExc
globalNames = Set.unions $ fmap Set.fromList
[ fmap _tableName tables
, HM.keys propDefs
, HM.keys allRefs
, SHM.keys allRefs
]
scopeErrors = scopeCheckInterface globalNames allRefs

Expand Down Expand Up @@ -1322,7 +1323,7 @@ verifyCheck de moduleData funName check checkType = do
moduleName = moduleDefName $ moduleData ^. mdModule
modules = HM.fromList [(moduleName, moduleData)]
moduleFun :: ModuleData Ref -> Text -> Maybe Ref
moduleFun ModuleData{..} name = name `HM.lookup` _mdRefMap
moduleFun ModuleData{..} name = name `SHM.lookup` _mdRefMap
modRefs = moduleRefs moduleData

caps <- moduleCapabilities de [moduleData]
Expand Down
4 changes: 2 additions & 2 deletions src/Pact/Bench.hs
Original file line number Diff line number Diff line change
Expand Up @@ -21,7 +21,6 @@ import Data.Aeson
import Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import Data.Default
import qualified Data.HashMap.Strict as HM
import qualified Data.Map.Strict as M
import qualified Data.Set as S
import Data.Text (unpack, pack, intercalate)
Expand Down Expand Up @@ -60,6 +59,7 @@ import Pact.Types.Capability
import Pact.Runtime.Utils
import Pact.JSON.Legacy.Value
import qualified Pact.JSON.Encode as J
import qualified Pact.Utils.StableHashMap as SHM

-- | Flags for enabling file-based perf bracketing,
-- see 'mkFilePerf' below.
Expand Down Expand Up @@ -191,7 +191,7 @@ runPactExec pt msg ss cdata benchMod dbEnv pc = do
e <- set eeAdvice pt <$> setupEvalEnv dbEnv entity Transactional md (versionedNativesRefStore ec)
prodGasEnv permissiveNamespacePolicy noSPVSupport def ec
let s = perfInterpreter pt $ defaultInterpreterState $
maybe id (const . initStateModules . HM.singleton (ModuleName "bench" Nothing)) benchMod
maybe id (const . initStateModules . SHM.singleton (ModuleName "bench" Nothing)) benchMod
(r :: Either SomeException EvalResult) <- try $! evalExec s e pc
r' <- eitherDie ("runPactExec': " ++ msg) $ fmapL show r
return $!! _erOutput r'
Expand Down
3 changes: 2 additions & 1 deletion src/Pact/Coverage.hs
Original file line number Diff line number Diff line change
Expand Up @@ -38,6 +38,7 @@ import Pact.Types.Pretty
import Pact.Types.Term hiding (App(..),Object(..),Step(..))
import Pact.Types.Typecheck
import Pact.Types.Runtime (ModuleData(..))
import qualified Pact.Utils.StableHashMap as SHM

mkCoverageAdvice :: IO (IORef LcovReport,Advice)
mkCoverageAdvice = newIORef mempty >>= \r -> return (r,Advice $ cover r)
Expand Down Expand Up @@ -78,7 +79,7 @@ cover ref i ctx = case _iInfo i of
postModule :: MonadIO m => ModuleData Ref -> m ()
postModule (ModuleData (MDModule _m) modDefs _) = do
((modFuns,modLines),_) <- liftIO $ runTC 0 False $
foldM walkDefs (mempty,mempty) (HM.elems modDefs)
foldM walkDefs (mempty,mempty) (SHM.elems modDefs)
let (fn,_l) = parseInf i
newRep = mkFileLcov fn modFuns mempty modLines
liftIO $ modifyIORef ref (<> newRep)
Expand Down
Loading

0 comments on commit 1027a1f

Please sign in to comment.