fixup! io-sim: Add support for unique symbol generation

Author: LSLeary

io-sim/src/Control/Monad/IOSim/CommonTypes.hs

@@ -205,10 +205,10 @@ ppLabelled pp Labelled { l_labelled = a, l_label = Nothing  } = pp a
 ppLabelled pp Labelled { l_labelled = a, l_label = Just lbl } = concat ["Labelled ", pp a, " ", lbl]
 
 -- | Abstract unique symbols à la "Data.Unique".
-type role IOSimUnique nominal
 newtype IOSimUnique s = MkUnique{ unMkUnique :: Integer }
   deriving stock   (Eq, Ord)
   deriving newtype (Hashable, NFData)
+type role IOSimUnique nominal
 
 --
 -- Utils

io-sim/src/Control/Monad/IOSim/Internal.hs

@@ -635,8 +635,10 @@ schedule !thread@Thread{
 
     NewUnique k -> do
       let thread'   = thread{ threadControl = ThreadControl (k nextUniq) ctl }
-          simstate' = simstate{ nextUniq = MkUnique (unMkUnique nextUniq + 1) }
-      schedule thread' simstate'
+          n         = unMkUnique nextUniq
+          simstate' = simstate{ nextUniq = MkUnique (n + 1) }
+      SimTrace time tid tlbl (EventUniqueCreated n)
+        <$> schedule thread' simstate'
 
 
 threadInterruptible :: Thread s a -> Bool

io-sim/src/Control/Monad/IOSim/Types.hs

@@ -1064,6 +1064,9 @@ data SimEventType
   | EventThreadUnhandled SomeException
   -- ^ thread terminated by an unhandled exception
 
+  | EventUniqueCreated Integer
+  -- ^ created the n-th 'IOSimUnique'
+
   --
   -- STM events
   --
@@ -1171,6 +1174,7 @@ ppSimEventType = \case
   EventThreadFinished -> "ThreadFinished"
   EventThreadUnhandled a ->
     "ThreadUnhandled " ++ show a
+  EventUniqueCreated n -> "UniqueCreated " ++ show n
   EventTxCommitted written created mbEff ->
     concat [ "TxCommitted ",
              ppList (ppLabelled show) written, " ",

io-sim/src/Control/Monad/IOSimPOR/Internal.hs

@@ -818,8 +818,10 @@ schedule thread@Thread{
 
     NewUnique k -> do
       let thread'   = thread{ threadControl = ThreadControl (k nextUniq) ctl }
-          simstate' = simstate{ nextUniq = MkUnique (unMkUnique nextUniq + 1) }
-      schedule thread' simstate'
+          n         = unMkUnique nextUniq
+          simstate' = simstate{ nextUniq = MkUnique (n + 1) }
+      SimPORTrace time tid tstep tlbl (EventUniqueCreated n)
+        <$> schedule thread' simstate'
 
 
 threadInterruptible :: Thread s a -> Bool