@@ -21,7 +21,6 @@ module Duct.Context
24−import Control.Applicative (Alternative(..))
25import Control.Concurrent (ThreadId)
24import Control.Concurrent (ThreadId)
26import Control.Concurrent.STM (TChan)
25import Control.Concurrent.STM (TChan)
27import Control.Exception (SomeException)
26import Control.Exception (SomeException)
@@ -29,7 +28,7 @@ import Control.Monad.State (MonadState, gets, modify, StateT,
29 MonadPlus(..), MonadIO(..))
28 MonadPlus(..), MonadIO(..))
30import qualified Control.Monad.Trans.State.Lazy as Lazy (get, gets, modify, put)
29import qualified Control.Monad.Trans.State.Lazy as Lazy (get, gets, modify, put)
31import Data.Dynamic (TypeRep, Typeable, typeOf)
30import Data.Dynamic (TypeRep, Typeable, typeOf)
32−import Data.IORef (IORef, modifyIORef)
31+import Data.IORef (IORef)
33import qualified Data.Map as M
32import qualified Data.Map as M
34import Unsafe.Coerce (unsafeCoerce)
33import Unsafe.Coerce (unsafeCoerce)
35import GHC.Prim (Any)
34import GHC.Prim (Any)
@@ -162,14 +161,13 @@ saveContext m f =
163-- pop the top function from the continuation stack, create the next closure,
162-- pop the top function from the continuation stack, create the next closure,
164-- set it as the current closure and return it.
163-- set it as the current closure and return it.
165−restoreContext :: (Alternative f, Monad m) => Maybe a -> StateT Context m (f b)
164+restoreContext :: (MonadPlus m1, Monad m) => Maybe a -> StateT Context m (m1 b)
166restoreContext x = do
165restoreContext x = do
167 -- XXX fstack must be non-empty when this is called.
166 -- XXX fstack must be non-empty when this is called.
168 ctx@Context { fstack = f:fs } <- Lazy.get
167 ctx@Context { fstack = f:fs } <- Lazy.get
170 let mres = case x of
169 let mres = case x of
171− -- XXX use mzero instead
172− Nothing -> empty
170+ Nothing -> mzero
173 Just y -> (unsafeCoerce f) y
171 Just y -> (unsafeCoerce f) y
175 Lazy.put ctx { currentm = unsafeCoerce mres, fstack = fs }
173 Lazy.put ctx { currentm = unsafeCoerce mres, fstack = fs }