Commit cf032a22 authored by duog's avatar duog Committed by Ben Gamari

Several fixes to work with ghc-head

Reviewers: O26 nofib, michalt

Reviewed By: O26 nofib, michalt

Subscribers: michalt

Differential Revision: https://phabricator.haskell.org/D4391
parent 3ef116aa
...@@ -37,7 +37,7 @@ module HashTable ...@@ -37,7 +37,7 @@ module HashTable
) where ) where
#ifdef __GLASGOW_HASKELL__ #ifdef __GLASGOW_HASKELL__
import GHC.Base import GHC.Base hiding (mapM)
#else #else
import Prelude hiding ( lookup ) import Prelude hiding ( lookup )
#endif #endif
......
...@@ -14,11 +14,11 @@ repTree f g a = Branch a (map (repTree g f) (f a)) ...@@ -14,11 +14,11 @@ repTree f g a = Branch a (map (repTree g f) (f a))
#ifndef SEQ #ifndef SEQ
mapTree :: (a -> b) -> Tree a -> Tree b mapTree :: (a -> b) -> Tree a -> Tree b
mapTree f (Branch a l) mapTree f (Branch a l)
= fa `par` Branch fa (map (mapTree f) l `using` myParList) = fa `par` Branch fa (map (mapTree f) l `using` myParList)
where fa = f a where fa = f a
#else {- SEQ -} #else /* SEQ */
mapTree :: (a -> b) -> (Tree a) -> (Tree b) mapTree :: (a -> b) -> (Tree a) -> (Tree b)
mapTree f (Branch a l) = Branch (f a) (map (mapTree f) l) mapTree f (Branch a l) = Branch (f a) (map (mapTree f) l)
...@@ -38,4 +38,3 @@ parTree n (Branch a xs) = a `par` mySeqList (map (parTree (n-1)) xs) ...@@ -38,4 +38,3 @@ parTree n (Branch a xs) = a `par` mySeqList (map (parTree (n-1)) xs)
prune :: Int -> (Tree a) -> (Tree a) prune :: Int -> (Tree a) -> (Tree a)
prune 0 (Branch a l) = Branch a [] prune 0 (Branch a l) = Branch a []
prune n (Branch a l) = Branch a (map (prune (n-1)) l) prune n (Branch a l) = Branch a (map (prune (n-1)) l)
...@@ -59,7 +59,7 @@ main :: IO () ...@@ -59,7 +59,7 @@ main :: IO ()
main = do main = do
hSetBuffering stdout NoBuffering hSetBuffering stdout NoBuffering
[nthreads] <- fmap (map read) getArgs [nthreads] <- fmap (map read) getArgs
tids <- replicateM nthreads . mask $ \_ -> forkIO $ return () tids <- replicateM nthreads . mask_ $ forkIO $ return ()
m <- newEmptyMVar m <- newEmptyMVar
-- do it in a subthread to avoid bound-thread overhead -- do it in a subthread to avoid bound-thread overhead
forkIO $ do mapM_ killThread tids; putMVar m () forkIO $ do mapM_ killThread tids; putMVar m ()
......
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment