@@ -109,75 +109,15 @@ restoreStack :: MonadState EventF m => t -> m ()
109109restoreStack fs = modify $ \EventF {..} ->
110110 EventF { event = Nothing, fcomp = (unsafeCoerce fs), .. }
111111
112−instance MonadIO m => Applicative (AsyncT m) where
112+instance Monad m => Applicative (AsyncT m) where
113113 pure a = AsyncT . return $ Just a
114−
115− f <*> g = AsyncT $ do
116− rf <- liftIO $ newIORef (Nothing,[])
117− rg <- liftIO $ newIORef (Nothing,[])
118− fs <- getContinuations
119−
120− let hasWait (_:Wait:_) = True
121− hasWait _ = False
122−
123− appf k = AsyncT $ do
124− Log rec _ full <- getData `onNothing` return (Log False [] [])
125− (liftIO $ writeIORef rf (Just k,full))
126− (x, full2)<- liftIO $ readIORef rg
127− when (hasWait full ) $
128− let full'= head full: full2
129− in (setData $ Log rec full' full')
130− return $ Just (unsafeCoerce k) <*> x
131−
132− appg x = AsyncT $ do
133− Log rec _ full <- getData `onNothing` return (Log False [] [])
134− liftIO $ writeIORef rg (Just x, full)
135− (k,full1) <- liftIO $ readIORef rf
136− when (hasWait full) $
137− let full'= head full: full1
138− in (setData $ Log rec full' full')
139− return $ unsafeCoerce k <*> Just x
140−
141− setContinuation f appf fs
142−
143− k <- runAsyncT f
144− was <- getData `onNothing` return NoRemote
145− when (was == WasParallel) $ setData NoRemote
146−
147− Log recovery _ full <- getData `onNothing` return (Log False [] [])
148−
149−
150−
151− if was== WasRemote || (not recovery && was == NoRemote && isNothing k )
152− -- if the first operand was a remote request
153− -- (so this node is not master and hasn't to execute the whole expression)
154− -- or it was not an asyncronous term (a normal term without async or parallel
155− -- like primitives) and is nothing
156− then do
157− restoreStack fs
158− return Nothing
159− else do
160− when (isJust k) $ liftIO $ writeIORef rf (k,full)
161− -- when necessary since it maybe WasParallel and Nothing
162−
163− setContinuation g appg fs
164−
165− x <- runAsyncT g
166− Log _ _ full' <- getData `onNothing` return (Log False [] [])
167− liftIO $ writeIORef rg (x,full')
168− restoreStack fs
169− k'' <- if was== WasParallel
170− then do
171− (k',_) <- liftIO $ readIORef rf -- since k may have been updated by a parallel f
172− return k'
173− else return k
174− return $ k'' <*> x
114+ m1 <*> m2 = do { x1 <- m1; x2 <- m2; return (x1 x2) }
175115
176116------------------------------------------------------------------------------
177117-- Alternative
178118------------------------------------------------------------------------------
179119
180−instance MonadIO m => Alternative (AsyncT m) where
120+instance Monad m => Alternative (AsyncT m) where
181121 empty = AsyncT $ return Nothing
182122 (<|>) x y = AsyncT $ do
183123 mx <- runAsyncT x
@@ -203,41 +143,30 @@ tailsafe :: [a] -> [a]
203143tailsafe [] = []
204144tailsafe (_:xs) = xs
205145
206−-- | Set the current closure and continuation for the current statement
207−setEventCont :: Monad m => AsyncT m a -> (a -> AsyncT m b) -> StateM m EventF
208−setEventCont x f = do
209− EventF { fcomp = fs, .. } <- get
210− let cont = EventF { xcomp = x
211− , fcomp = unsafeCoerce f : unsafeCoerce fs
212− , .. }
213− put cont
214− return cont
215−
216−-- | Reset the closure and continuation. Remove inner binds that the previous
217−-- computations may have stacked in the list of continuations.
218−resetEventCont :: forall m a b. MonadIO m
219− => Maybe a -> EventF -> StateM m (AsyncT m b -> AsyncT m b)
220−resetEventCont mx _ = do
221− EventF { fcomp = fs, .. } <- get
222− let f my = case my of
223− Nothing -> (empty :: AsyncT m a)
224− Just x -> unsafeCoerce (head fs) x
225− put $ EventF { xcomp = f mx
226− , fcomp = tailsafe (unsafeCoerce fs)
227− , .. }
228− return id
229−
230−instance MonadIO m => Monad (AsyncT m) where
146+instance Monad m => Monad (AsyncT m) where
231147 return = pure
232− x >>= f = AsyncT $ do
233− c <- setEventCont x f
234− mk <- runAsyncT x
235− _ <- resetEventCont mk c
236− case mk of
237− Just k -> runAsyncT (f k)
238− Nothing -> return Nothing
239−
240−instance MonadIO m => MonadPlus (AsyncT m) where
148+ m >>= f = AsyncT $ do
149+ -- save m in xcomp and add f to the head of fcomp
150+ -- _ <- setEventCont m f
151+ modify $ \EventF { fcomp = fs, .. } ->
152+ EventF { xcomp = unsafeCoerce m, fcomp = unsafeCoerce f : fs, .. }
153+
154+ -- run m under this modified environment
155+ mres <- runAsyncT m
156+ -- remove the head of fcomp apply it to mres and that becomes the new xcomp.
157+ -- is head of fcomp always the same as f?
158+ let res = case mres of
159+ Nothing -> empty
160+ Just x -> f x
161+
162+ -- XXX why would we have more than one continuation? Can we have just one
163+ -- instead of a list and remove it after every bind?
164+ modify $ \EventF { fcomp = fs, .. } ->
165+ EventF { xcomp = unsafeCoerce res, fcomp = tailsafe fs, .. }
166+
167+ runAsyncT res
168+
169+instance Monad m => MonadPlus (AsyncT m) where
241170 mzero = empty
242171 mplus = (<|>)
243172