From 638adf0f5684fa625e1bd91e47d3402a7ff335f2 Mon Sep 17 00:00:00 2001
From: Marcin Szamotulski <coot@coot.me>
Date: Mon, 30 Dec 2024 07:52:22 +0100
Subject: [PATCH 1/4] io-sim: more general ppTrace_ type signature

---
 io-sim/CHANGELOG.md                     | 1 +
 io-sim/src/Control/Monad/IOSim/Types.hs | 2 +-
 2 files changed, 2 insertions(+), 1 deletion(-)

diff --git a/io-sim/CHANGELOG.md b/io-sim/CHANGELOG.md
index 897deecc..36fe2775 100644
--- a/io-sim/CHANGELOG.md
+++ b/io-sim/CHANGELOG.md
@@ -22,6 +22,7 @@
   - `selectTraceEventsSayWithTime'`
   is more general.  These functions now accepts trace with any result, rather
   than one that finishes with `SimResult`.
+- More polymorphic `ppTrace_` type signature.
 
 ## 1.6.0.0
 
diff --git a/io-sim/src/Control/Monad/IOSim/Types.hs b/io-sim/src/Control/Monad/IOSim/Types.hs
index dcbe36e6..9b8530ad 100644
--- a/io-sim/src/Control/Monad/IOSim/Types.hs
+++ b/io-sim/src/Control/Monad/IOSim/Types.hs
@@ -938,7 +938,7 @@ ppTrace tr = Trace.ppTrace
 
 -- | Like 'ppTrace' but does not show the result value.
 --
-ppTrace_ :: SimTrace a -> String
+ppTrace_ :: Trace.Trace a SimEvent -> String
 ppTrace_ tr = Trace.ppTrace
                 (const "")
                 (ppSimEvent timeWidth tidWidth labelWidth)

From b59fda21eeec32d045c2988fad6d3bcacb7e3b5b Mon Sep 17 00:00:00 2001
From: Marcin Szamotulski <coot@coot.me>
Date: Wed, 8 Jan 2025 08:52:44 +0100
Subject: [PATCH 2/4] io-classes:mtl: newArray for MArray ContTSTM instance

It is needed since `array-0.5.7` used by `ghc-9.8.4`.  In other `MArray`
instances we provide it, so let's do the same for this instance.
---
 io-classes/mtl/Control/Monad/Class/MonadSTM/Trans.hs | 2 --
 1 file changed, 2 deletions(-)

diff --git a/io-classes/mtl/Control/Monad/Class/MonadSTM/Trans.hs b/io-classes/mtl/Control/Monad/Class/MonadSTM/Trans.hs
index e31dc928..d3cbe06b 100644
--- a/io-classes/mtl/Control/Monad/Class/MonadSTM/Trans.hs
+++ b/io-classes/mtl/Control/Monad/Class/MonadSTM/Trans.hs
@@ -54,9 +54,7 @@ instance ( MonadSTM m, MArray e a (STM m) ) => MArray e a (ContTSTM r m) where
     getNumElements    = ContTSTM . getNumElements
     unsafeRead arr    = ContTSTM . unsafeRead arr
     unsafeWrite arr i = ContTSTM . unsafeWrite arr i
-#if __GLASGOW_HASKELL__ >= 910
     newArray idxs     = ContTSTM . newArray idxs
-#endif
 
 
 -- note: this (and the following) instance requires 'UndecidableInstances'

From 000874c1d0df5a51fcee7f17fae7598d06b28be0 Mon Sep 17 00:00:00 2001
From: Marcin Szamotulski <coot@coot.me>
Date: Wed, 8 Jan 2025 09:13:20 +0100
Subject: [PATCH 3/4] gha: use llvm@14 on MacOS

---
 .github/workflows/haskell.yml | 6 +++---
 1 file changed, 3 insertions(+), 3 deletions(-)

diff --git a/.github/workflows/haskell.yml b/.github/workflows/haskell.yml
index 8fc201a1..08ff08bb 100644
--- a/.github/workflows/haskell.yml
+++ b/.github/workflows/haskell.yml
@@ -32,9 +32,9 @@ jobs:
     - name: Install LLVM (macOS)
       if: runner.os == 'macOS' && matrix.ghc == '8.10'
       run: |
-        brew install llvm@13
-        echo "LLVM_CONFIG=$(brew --prefix llvm@13)/bin/llvm-config" >> $GITHUB_ENV
-        echo "$(brew --prefix llvm@13)/bin" >> $GITHUB_PATH
+        brew install llvm@14
+        echo "LLVM_CONFIG=$(brew --prefix llvm@14)/bin/llvm-config" >> $GITHUB_ENV
+        echo "$(brew --prefix llvm@14)/bin" >> $GITHUB_PATH
 
     - name: Verify LLVM installation
       if: runner.os == 'macOS' && matrix.ghc == '8.10'

From c035dead23388a4a7f9d6997a250cf538f96d84a Mon Sep 17 00:00:00 2001
From: Marcin Szamotulski <coot@coot.me>
Date: Wed, 8 Jan 2025 12:57:14 +0100
Subject: [PATCH 4/4] io-sim:test - refactored traceNoDuplicates

Refactored `traceNoDuplicates` so that `GHC` doesn't put `r` outside of
the function.  This could also be achieved with `-fno-full-laziness`.
---
 io-sim/test/Test/Control/Monad/IOSimPOR.hs | 30 +++++++++++++++++-----
 1 file changed, 23 insertions(+), 7 deletions(-)

diff --git a/io-sim/test/Test/Control/Monad/IOSimPOR.hs b/io-sim/test/Test/Control/Monad/IOSimPOR.hs
index 74c44d0e..b4d85f01 100644
--- a/io-sim/test/Test/Control/Monad/IOSimPOR.hs
+++ b/io-sim/test/Test/Control/Monad/IOSimPOR.hs
@@ -434,15 +434,31 @@ doit n = do
   threadDelay 1
   readTVarIO r
 
-
-traceNoDuplicates :: (Testable prop1, Show a1) => ((a1 -> a2 -> a2) -> prop1) -> Property
-traceNoDuplicates k = r `pseq` (k addTrace .&&. maximum (traceCounts ()) == 1)
+traceNoDuplicates :: forall a b.
+                     (Show a)
+                  => ((a -> b -> b) -> Property)
+                  -> Property
+-- this NOINLINE pragma is useful for debugging if `r` didn't flow outside of
+-- `traceNoDuplicate`.
+{-# NOINLINE traceNoDuplicates #-}
+traceNoDuplicates k = unsafePerformIO $ do
+    r <- newIORef (Map.empty :: Map String Int)
+    return $ r `pseq`
+             (k (addTrace r) .&&. counterexample "trace counts" (maximum (Map.elems (traceCounts r)) === 1))
   where
-    r = unsafePerformIO $ newIORef (Map.empty :: Map String Int)
-    addTrace t x = unsafePerformIO $ do
-      atomicModifyIORef r (\m->(Map.insertWith (+) (show t) 1 m,()))
+    addTrace :: IORef (Map String Int) -> a -> b -> b
+    addTrace r t x = unsafePerformIO $ do
+      let s = show t
+      atomicModifyIORef r
+        (\m->
+          let m' = Map.insertWith (+) s 1 m
+          in (m', ())
+        )
       return x
-    traceCounts () = unsafePerformIO $ Map.elems <$> readIORef r
+
+    traceCounts :: IORef (Map String Int) -> Map String Int
+    traceCounts r = unsafePerformIO $ readIORef r
+
 
 -- | Checks that IOSimPOR is capable of analysing an infinite simulation
 -- lazily.