Skip to content

Commit 59968d0

Browse files
cootcoot
committed
io-sim: more strict bindings
1 parent dffbbfd commit 59968d0

File tree

1 file changed

+45
-45
lines changed

1 file changed

+45
-45
lines changed

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

Lines changed: 45 additions & 45 deletions
Original file line numberDiff line numberDiff line change
@@ -289,37 +289,37 @@ schedule !thread@Thread{
289289
schedule thread' simstate
290290

291291
GetWallTime k -> do
292-
let clockid = threadClockId thread
293-
clockoff = clocks Map.! clockid
294-
walltime = timeSinceEpoch time `addUTCTime` clockoff
295-
thread' = thread { threadControl = ThreadControl (k walltime) ctl }
292+
let !clockid = threadClockId thread
293+
!clockoff = clocks Map.! clockid
294+
!walltime = timeSinceEpoch time `addUTCTime` clockoff
295+
!thread' = thread { threadControl = ThreadControl (k walltime) ctl }
296296
schedule thread' simstate
297297

298298
SetWallTime walltime' k -> do
299-
let clockid = threadClockId thread
300-
clockoff = clocks Map.! clockid
301-
walltime = timeSinceEpoch time `addUTCTime` clockoff
302-
clockoff' = addUTCTime (diffUTCTime walltime' walltime) clockoff
303-
thread' = thread { threadControl = ThreadControl k ctl }
304-
simstate' = simstate { clocks = Map.insert clockid clockoff' clocks }
299+
let !clockid = threadClockId thread
300+
!clockoff = clocks Map.! clockid
301+
!walltime = timeSinceEpoch time `addUTCTime` clockoff
302+
!clockoff' = addUTCTime (diffUTCTime walltime' walltime) clockoff
303+
!thread' = thread { threadControl = ThreadControl k ctl }
304+
!simstate' = simstate { clocks = Map.insert clockid clockoff' clocks }
305305
schedule thread' simstate'
306306

307307
UnshareClock k -> do
308-
let clockid = threadClockId thread
309-
clockoff = clocks Map.! clockid
310-
clockid' = let ThreadId i = tid in ClockId i -- reuse the thread id
311-
thread' = thread { threadControl = ThreadControl k ctl
312-
, threadClockId = clockid' }
313-
simstate' = simstate { clocks = Map.insert clockid' clockoff clocks }
308+
let !clockid = threadClockId thread
309+
!clockoff = clocks Map.! clockid
310+
!clockid' = let ThreadId i = tid in ClockId i -- reuse the thread id
311+
!thread' = thread { threadControl = ThreadControl k ctl
312+
, threadClockId = clockid' }
313+
!simstate' = simstate { clocks = Map.insert clockid' clockoff clocks }
314314
schedule thread' simstate'
315315

316316
-- we treat negative timers as cancelled ones; for the record we put
317317
-- `EventTimerCreated` and `EventTimerCancelled` in the trace; This differs
318318
-- from `GHC.Event` behaviour.
319319
NewTimeout d k | d < 0 -> do
320-
let t = NegativeTimeout nextTmid
321-
expiry = d `addTime` time
322-
thread' = thread { threadControl = ThreadControl (k t) ctl }
320+
let !t = NegativeTimeout nextTmid
321+
!expiry = d `addTime` time
322+
!thread' = thread { threadControl = ThreadControl (k t) ctl }
323323
trace <- schedule thread' simstate { nextTmid = succ nextTmid }
324324
return (SimTrace time tid tlbl (EventTimerCreated nextTmid nextVid expiry) $
325325
SimTrace time tid tlbl (EventTimerCancelled nextTmid) $
@@ -332,10 +332,10 @@ schedule !thread@Thread{
332332
!tvar' <- execNewTVar (succ nextVid)
333333
(Just $ "<<timeout " ++ show (unTimeoutId nextTmid) ++ ">>")
334334
False
335-
let expiry = d `addTime` time
336-
t = Timeout tvar tvar' nextTmid
337-
timers' = PSQ.insert nextTmid expiry (TimerVars tvar tvar') timers
338-
thread' = thread { threadControl = ThreadControl (k t) ctl }
335+
let !expiry = d `addTime` time
336+
!t = Timeout tvar tvar' nextTmid
337+
!timers' = PSQ.insert nextTmid expiry (TimerVars tvar tvar') timers
338+
!thread' = thread { threadControl = ThreadControl (k t) ctl }
339339
trace <- schedule thread' simstate { timers = timers'
340340
, nextVid = succ (succ nextVid)
341341
, nextTmid = succ nextTmid }
@@ -344,8 +344,8 @@ schedule !thread@Thread{
344344
-- we do not follow `GHC.Event` behaviour here; updating a timer to the past
345345
-- effectively cancels it.
346346
UpdateTimeout (Timeout _tvar _tvar' tmid) d k | d < 0 -> do
347-
let timers' = PSQ.delete tmid timers
348-
thread' = thread { threadControl = ThreadControl k ctl }
347+
let !timers' = PSQ.delete tmid timers
348+
!thread' = thread { threadControl = ThreadControl k ctl }
349349
trace <- schedule thread' simstate { timers = timers' }
350350
return (SimTrace time tid tlbl (EventTimerCancelled tmid) trace)
351351

@@ -354,9 +354,9 @@ schedule !thread@Thread{
354354
-- to race using a timeout with updating or cancelling it
355355
let updateTimeout_ Nothing = ((), Nothing)
356356
updateTimeout_ (Just (_p, v)) = ((), Just (expiry, v))
357-
expiry = d `addTime` time
358-
timers' = snd (PSQ.alter updateTimeout_ tmid timers)
359-
thread' = thread { threadControl = ThreadControl k ctl }
357+
!expiry = d `addTime` time
358+
!timers' = snd (PSQ.alter updateTimeout_ tmid timers)
359+
!thread' = thread { threadControl = ThreadControl k ctl }
360360
trace <- schedule thread' simstate { timers = timers' }
361361
return (SimTrace time tid tlbl (EventTimerUpdated tmid expiry) trace)
362362

@@ -366,8 +366,8 @@ schedule !thread@Thread{
366366
schedule thread' simstate
367367

368368
CancelTimeout (Timeout tvar _tvar' tmid) k -> do
369-
let timers' = PSQ.delete tmid timers
370-
thread' = thread { threadControl = ThreadControl k ctl }
369+
let !timers' = PSQ.delete tmid timers
370+
!thread' = thread { threadControl = ThreadControl k ctl }
371371
!written <- execAtomically' (runSTM $ writeTVar tvar TimeoutCancelled)
372372
(!wakeup, wokeby) <- threadsUnblockedByWrites written
373373
mapM_ (\(SomeTVar var) -> unblockAllThreadsFromTVar var) written
@@ -389,21 +389,21 @@ schedule !thread@Thread{
389389
schedule thread' simstate
390390

391391
Fork a k -> do
392-
let nextId = threadNextTId thread
393-
tid' = childThreadId tid nextId
394-
thread' = thread { threadControl = ThreadControl (k tid') ctl
395-
, threadNextTId = succ nextId }
396-
thread'' = Thread { threadId = tid'
397-
, threadControl = ThreadControl (runIOSim a)
398-
ForkFrame
399-
, threadBlocked = False
400-
, threadMasking = threadMasking thread
401-
, threadThrowTo = []
402-
, threadClockId = threadClockId thread
403-
, threadLabel = Nothing
404-
, threadNextTId = 1
405-
}
406-
threads' = Map.insert tid' thread'' threads
392+
let !nextId = threadNextTId thread
393+
!tid' = childThreadId tid nextId
394+
!thread' = thread { threadControl = ThreadControl (k tid') ctl
395+
, threadNextTId = succ nextId }
396+
!thread'' = Thread { threadId = tid'
397+
, threadControl = ThreadControl (runIOSim a)
398+
ForkFrame
399+
, threadBlocked = False
400+
, threadMasking = threadMasking thread
401+
, threadThrowTo = []
402+
, threadClockId = threadClockId thread
403+
, threadLabel = Nothing
404+
, threadNextTId = 1
405+
}
406+
!threads' = Map.insert tid' thread'' threads
407407
trace <- schedule thread' simstate { runqueue = Deque.snoc tid' runqueue
408408
, threads = threads' }
409409
return (SimTrace time tid tlbl (EventThreadForked tid') trace)

0 commit comments

Comments
 (0)