From 86100751ca5fbdd45ed2c6da68db3251b3c4c475 Mon Sep 17 00:00:00 2001
From: BinderDavid <dbinder1989@googlemail.com>
Date: Mon, 24 Oct 2022 22:21:53 +0000
Subject: [PATCH] Replace use of "Strict" typeclass by use of deepseq library
---
.gitlab-ci.yml | 2 +-
hpc-bin.cabal | 3 ++-
src/HpcCombine.hs | 38 +++-----------------------------------
3 files changed, 6 insertions(+), 37 deletions(-)
diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml
index b07637e..8f017e0 100644
--- a/.gitlab-ci.yml
+++ b/.gitlab-ci.yml
@@ -3,4 +3,4 @@ build:
tags:
- "x86_64-linux"
script:
- - "cabal build -w $GHC"
+ - "cabal update && cabal build -w $GHC"
diff --git a/hpc-bin.cabal b/hpc-bin.cabal
index df43362..da9deaa 100644
--- a/hpc-bin.cabal
+++ b/hpc-bin.cabal
@@ -42,11 +42,12 @@ library
autogen-modules: Paths_hpc_bin
build-depends: base >= 4 && < 5,
+ deepseq >= 1.4.7 && < 1.5,
directory >= 1 && < 1.4,
filepath >= 1 && < 1.5,
containers >= 0.1 && < 0.7,
array >= 0.1 && < 0.6,
- hpc >= 0.6.1 && < 0.7
+ hpc >= 0.6.2 && < 0.7
if flag(build-tool-depends)
build-tool-depends: happy:happy >= 1.20.0
diff --git a/src/HpcCombine.hs b/src/HpcCombine.hs
index 864b105..f23ce8e 100644
--- a/src/HpcCombine.hs
+++ b/src/HpcCombine.hs
@@ -10,7 +10,8 @@ import Trace.Hpc.Util
import HpcFlags
-import Control.Monad
+import Control.DeepSeq ( force )
+import Control.Monad ( foldM )
import qualified Data.Set as Set
import qualified Data.Map as Map
@@ -125,7 +126,7 @@ map_main _ _ = hpcError map_plugin $ "to many .tix files specified"
mergeTixFile :: Flags -> (Integer -> Integer -> Integer) -> Tix -> String -> IO Tix
mergeTixFile flags fn tix file_name = do
Just new_tix <- readTix file_name
- return $! strict $ mergeTix (mergeModule flags) fn tix (filterTix flags new_tix)
+ return $! force $ mergeTix (mergeModule flags) fn tix (filterTix flags new_tix)
-- could allow different numbering on the module info,
-- as long as the total is the same; will require normalization.
@@ -162,36 +163,3 @@ mergeTix modComb f
fm2 = Map.fromList [ (tixModuleName tix,tix)
| tix <- t2
]
-
-
--- What I would give for a hyperstrict :-)
--- This makes things about 100 times faster.
-class Strict a where
- strict :: a -> a
-
-instance Strict Integer where
- strict i = i
-
-instance Strict Int where
- strict i = i
-
-instance Strict Hash where -- should be fine, because Hash is a newtype round an Int
- strict i = i
-
-instance Strict Char where
- strict i = i
-
-instance Strict a => Strict [a] where
- strict (a:as) = (((:) $! strict a) $! strict as)
- strict [] = []
-
-instance (Strict a, Strict b) => Strict (a,b) where
- strict (a,b) = (((,) $! strict a) $! strict b)
-
-instance Strict Tix where
- strict (Tix t1) =
- Tix $! strict t1
-
-instance Strict TixModule where
- strict (TixModule m1 p1 i1 t1) =
- ((((TixModule $! strict m1) $! strict p1) $! strict i1) $! strict t1)
--
GitLab