picnoir/hnix
1
0
Fork 0
Code Issues Pull requests Releases Wiki Activity

If an exception occurs when forcing a thunk, cleanup the "active" bit

Browse source
This commit is contained in:
John Wiegley 2018-08-05 12:00:43 -04:00
parent edaf59b56a
commit 8e664631e2
No known key found for this signature in database
GPG key ID: C144D8F4F19FE630
1 changed files with 9 additions and 5 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

14
src/Nix/Thunk.hs
View file

@ -1,7 +1,7 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveFoldable #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE CPP #-}
#if ENABLE_TRACING
{-# LANGUAGE BangPatterns #-}
@ -10,12 +10,13 @@
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeFamilies #-}
module Nix.Thunk where
import Control.Exception
import Control.Exception hiding (catch)
import Control.Monad.Catch
import Data.Typeable
@ -66,7 +67,8 @@ buildThunk action =
#endif
<$> newVar False <*> newVar (Deferred action)
forceThunk :: (MonadVar m, MonadThrow m) => Thunk m v -> (v -> m a) -> m a
forceThunk :: (MonadVar m, MonadThrow m, MonadCatch m)
=> Thunk m v -> (v -> m a) -> m a
forceThunk (Value ref) k = k ref
#if ENABLE_TRACING
forceThunk (Thunk n active ref) k = do
@ -89,9 +91,11 @@ forceThunk (Thunk _ active ref) k = do
#if ENABLE_TRACING
traceM $ "Forcing " ++ show n
#endif
v <- action
writeVar ref (Computed v)
v <- catch action $ \(e :: SomeException) -> do
_ <- atomicModifyVar active (False,)
throwM e
_ <- atomicModifyVar active (False,)
writeVar ref (Computed v)
k v
forceEffects :: MonadVar m => Thunk m v -> (v -> m a) -> m a