X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Flib%2Fconcurrent%2FMerge.lhs;h=395bd2ff05f78e31d0b829187d4e3e1e0ad47907;hb=192b2bc9a0e943438faff225b0f82a8d7804a733;hp=39f1c4ce2f974fce969842f30d889d9cd5f7d7ff;hpb=1dc014c52d3371585fda5ecb188abec598a8c37c;p=ghc-hetmet.git

diff --git a/ghc/lib/concurrent/Merge.lhs b/ghc/lib/concurrent/Merge.lhs
index 39f1c4c..395bd2f 100644
--- a/ghc/lib/concurrent/Merge.lhs
+++ b/ghc/lib/concurrent/Merge.lhs
@@ -6,87 +6,14 @@
 Avoiding the loss of ref. transparency by attaching the merge to the
 IO monad.
 
+(The ops. are now defined in Concurrent to avoid module loop trouble).
+
 \begin{code}
 module Merge
-
 	(
-	 mergeIO,	--:: [a]   -> [a] -> IO [a]
-	 nmergeIO	--:: [[a]] -> IO [a]
+	  mergeIO
+	, nmergeIO
 	) where
 
-import Semaphore
-import PrelConc
-import PrelIOBase
-
-max_buff_size = 1
-
-mergeIO :: [a] -> [a] -> IO [a]
-nmergeIO :: [[a]] -> IO [a]
-
-#ifndef __CONCURRENT_HASKELL__
-
-mergeIO _ _  = return []
-nmergeIO _   = return []
-
-#else
-
-mergeIO ls rs
- = newEmptyMVar		       >>= \ tail_node ->
-   newMVar tail_node	       >>= \ tail_list ->
-   newQSem max_buff_size       >>= \ e ->
-   newMVar 2                   >>= \ branches_running ->
-   let
-    buff = (tail_list,e)
-   in
-    forkIO (suckIO branches_running buff ls) >>
-    forkIO (suckIO branches_running buff rs) >>
-    takeMVar tail_node	>>= \ val ->
-    signalQSem e 	>>
-    return val
-
-type Buffer a 
- = (MVar (MVar [a]), QSem)
-
-suckIO :: MVar Int -> Buffer a -> [a] -> IO ()
-
-suckIO branches_running buff@(tail_list,e) vs
- = case vs of
-	[] -> takeMVar branches_running >>= \ val ->
-	      if val == 1 then
-		 takeMVar tail_list     >>= \ node ->
-		 putMVar node []        >>
-		 putMVar tail_list node
-	      else 	
-  		 putMVar branches_running (val-1)
-	(x:xs) ->
-		waitQSem e 	   		 >>
-		takeMVar tail_list 		 >>= \ node ->
-	        newEmptyMVar 	   		 >>= \ next_node ->
-		unsafeInterleaveIO (
-			takeMVar next_node  >>= \ x ->
-			signalQSem e	    >>
-			return x)	         >>= \ next_node_val ->
-		putMVar node (x:next_node_val)   >>
-		putMVar tail_list next_node 	 >>
-		suckIO branches_running buff xs
-
-nmergeIO lss
- = let
-    len = length lss
-   in
-    newEmptyMVar	  >>= \ tail_node ->
-    newMVar tail_node	  >>= \ tail_list ->
-    newQSem max_buff_size >>= \ e ->
-    newMVar len		  >>= \ branches_running ->
-    let
-     buff = (tail_list,e)
-    in
-    mapIO (\ x -> forkIO (suckIO branches_running buff x)) lss >>
-    takeMVar tail_node	>>= \ val ->
-    signalQSem e 	>>
-    return val
-  where
-    mapIO f xs = accumulate (map f xs)
-
-#endif {- __CONCURRENT_HASKELL__ -}
+import Concurrent
 \end{code}