dph-prim-par: warning police
authorBen Lippmeier <benl@ouroborus.net>
Tue, 30 Aug 2011 06:06:49 +0000 (16:06 +1000)
committerBen Lippmeier <benl@ouroborus.net>
Tue, 30 Aug 2011 06:06:49 +0000 (16:06 +1000)
dph-prim-par/Data/Array/Parallel/Unlifted/Distributed/Arrays.hs
dph-prim-par/Data/Array/Parallel/Unlifted/Distributed/Basics.hs
dph-prim-par/Data/Array/Parallel/Unlifted/Distributed/Combinators.hs
dph-prim-par/Data/Array/Parallel/Unlifted/Distributed/DistST.hs
dph-prim-par/Data/Array/Parallel/Unlifted/Distributed/Gang.hs
dph-prim-par/Data/Array/Parallel/Unlifted/Distributed/Scalars.hs
dph-prim-par/Data/Array/Parallel/Unlifted/Distributed/TheGang.hs
dph-prim-par/Data/Array/Parallel/Unlifted/Distributed/Types/Tuple.hs
dph-prim-par/dph-prim-par.cabal
dph-prim-seq/Data/Array/Parallel/Unlifted/Sequential/Segmented/UVSegd.hs

index 4004cd1..b30b988 100644 (file)
@@ -1,3 +1,4 @@
+{-# OPTIONS -Wall -fno-warn-orphans -fno-warn-missing-signatures #-}
 {-# LANGUAGE EmptyDataDecls, ScopedTypeVariables #-}
 {-# LANGUAGE CPP #-}
 #include "fusion-phases.h"
@@ -6,22 +7,23 @@
 module Data.Array.Parallel.Unlifted.Distributed.Arrays (
   lengthD, splitLenD, splitLenIdxD,
   splitAsD, splitD, joinLengthD, joinD, splitJoinD, joinDM,
-  splitSegdD, splitSegdD', splitSD,
+  splitSegdD, splitSegdD', joinSegdD, splitSD,
 
   permuteD, bpermuteD, atomicUpdateD,
 
   Distribution, balanced, unbalanced
 ) where
 import Data.Array.Parallel.Base ( ST, runST)
-import Data.Array.Parallel.Unlifted.Sequential.Vector as Seq
 import Data.Array.Parallel.Unlifted.Sequential.Segmented
 import Data.Array.Parallel.Unlifted.Distributed.Gang
 import Data.Array.Parallel.Unlifted.Distributed.DistST
 import Data.Array.Parallel.Unlifted.Distributed.Types
-import Data.Array.Parallel.Unlifted.Distributed.Basics
 import Data.Array.Parallel.Unlifted.Distributed.Combinators
 import Data.Array.Parallel.Unlifted.Distributed.Scalars
 
+import Data.Array.Parallel.Unlifted.Sequential.Vector   (Vector, MVector, Unbox, (!))
+import qualified Data.Array.Parallel.Unlifted.Sequential.Vector as Seq
+
 import Data.Bits ( shiftR )
 import Control.Monad ( when )
 
@@ -135,7 +137,7 @@ joinD_impl g !darr = checkGangD (here "joinD") g darr $
   where
     (!di,!n) = scanD g (+) 0 $ lengthD darr
     copy :: forall s. MVector s a -> Int -> Vector a -> DistST s ()
-    copy ma i arr = stToDistST (Seq.copy (mslice i (Seq.length arr) ma) arr)
+    copy ma i arr = stToDistST (Seq.copy (Seq.mslice i (Seq.length arr) ma) arr)
 
 
 -- | Split a vector over a gang, run a distributed computation, then
@@ -162,7 +164,7 @@ joinDM g darr = checkGangD (here "joinDM") g darr $
   where
     (!di,!n) = scanD g (+) 0 $ lengthD darr
     --
-    copy ma i arr = stToDistST (Seq.copy (mslice i (Seq.length arr) ma) arr)
+    copy ma i arr = stToDistST (Seq.copy (Seq.mslice i (Seq.length arr) ma) arr)
 
 
 {-# RULES
@@ -246,14 +248,14 @@ splitSegdD g !segd = mapD g lengthsToUSegd
                    $ splitAsD g d lens
   where
     !d = snd
-       . mapAccumLD g chunk 0
+       . mapAccumLD g chunks 0
        . splitLenD g
        $ elementsUSegd segd
 
     n    = lengthUSegd segd
     lens = lengthsUSegd segd
 
-    chunk !i !k = let !j = go i k
+    chunks !i !k = let !j = go i k
                   in (j,j-i)
 
     go !i !k | i >= n    = i
@@ -322,9 +324,10 @@ splitSegdD' g !segd = imapD g mk
                      (# lens, l, o #) -> ((lengthsToUSegd lens,l),o)
 
 
-joinSegD :: Gang -> Dist USegd -> USegd
-{-# INLINE_DIST joinSegD #-}
-joinSegD g = lengthsToUSegd
+
+joinSegdD :: Gang -> Dist USegd -> USegd
+{-# INLINE_DIST joinSegdD #-}
+joinSegdD g = lengthsToUSegd
            . joinD g unbalanced
            . mapD g lengthsUSegd
 
index 4d2a4cd..ee63c1a 100644 (file)
@@ -1,3 +1,5 @@
+{-# OPTIONS -Wall -fno-warn-orphans -fno-warn-missing-signatures #-}
+
 -- | Basic operations on distributed types.
 module Data.Array.Parallel.Unlifted.Distributed.Basics (
   eqD, neqD, toD, fromD
index 5787ad5..a3d65e2 100644 (file)
@@ -1,3 +1,4 @@
+{-# OPTIONS -Wall -fno-warn-orphans -fno-warn-missing-signatures #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE CPP #-}
 #include "fusion-phases.h"
@@ -15,12 +16,10 @@ import Data.Array.Parallel.Base ( ST, runST)
 import Data.Array.Parallel.Unlifted.Distributed.Gang
 import Data.Array.Parallel.Unlifted.Distributed.Types
 import Data.Array.Parallel.Unlifted.Distributed.DistST
-import Debug.Trace
 
 
 here s = "Data.Array.Parallel.Unlifted.Distributed.Combinators." ++ s
 
-
 -- | Create a distributed value, given a function that makes the value in each thread.
 generateD :: DT a => Gang -> (Int -> a) -> Dist a
 {-# NOINLINE generateD #-}
@@ -154,11 +153,11 @@ mapAccumLD g f acc !d = checkGangD (here "mapAccumLD") g d $
   where
     !n = gangSize g
     go :: MDist b s -> Int -> acc -> ST s acc
-    go md i acc | i == n    = return acc
-                | otherwise = case f acc (d `indexD` i) of
-                                (acc',b) -> do
+    go md i acc' | i == n    = return acc'
+                 | otherwise = case f acc' (d `indexD` i) of
+                                (acc'',b) -> do
                                               writeMD md i b
-                                              go md (i+1) acc'
+                                              go md (i+1) acc''
                                 
 
 -- Versions that work on DistST -----------------------------------------------
index 58a6c92..f45d55d 100644 (file)
@@ -1,3 +1,4 @@
+{-# OPTIONS -Wall -fno-warn-orphans -fno-warn-missing-signatures #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 -- | Distributed ST computations.
 --
@@ -44,7 +45,7 @@ myIndex = DistST return
 --   The lifted computation should be data parallel.
 stToDistST :: ST s a -> DistST s a
 {-# INLINE stToDistST #-}
-stToDistST p = DistST $ \i -> p
+stToDistST p = DistST $ \_ -> p
 
 
 -- | Yields the 'Dist' element owned by the current thread.
index 882179d..a3486d1 100644 (file)
@@ -1,3 +1,4 @@
+{-# OPTIONS -Wall -fno-warn-orphans -fno-warn-missing-signatures #-}
 {-# LANGUAGE CPP #-}
 
 -- | Gang primitives.
@@ -20,13 +21,15 @@ module Data.Array.Parallel.Unlifted.Distributed.Gang (
 import GHC.IO
 import GHC.ST
 import GHC.Conc                  ( forkOn )
-import GHC.Exts                  ( traceEvent )
-
 import Control.Concurrent.MVar
 import Control.Exception         ( assert )
-import Control.Monad             ( zipWithM, zipWithM_ )
+import Control.Monad
 
+#if TRACE_GANG
+import GHC.Exts                  ( traceEvent )
 import System.Time ( ClockTime(..), getClockTime )
+#endif 
+
 
 -- Requests and operations on them --------------------------------------------
 -- | The 'Req' type encapsulates work requests for individual members of a gang. 
@@ -53,7 +56,7 @@ newReq p
 waitReq :: Req -> IO ()
 waitReq req
  = case req of
-       ReqDo     fn varDone    -> takeMVar varDone
+       ReqDo     _ varDone     -> takeMVar varDone
        ReqShutdown varDone     -> takeMVar varDone
 
 
@@ -159,7 +162,9 @@ gangIO      :: Gang
        -> (Int -> IO ())
        -> IO ()
 
-gangIO (Gang n [] busy)  p = mapM_ p [0 .. n-1]
+gangIO (Gang n [] _)  p 
+ = mapM_ p [0 .. n-1]
+
 #if SEQ_IF_GANG_BUSY
 gangIO (Gang n mvs busy) p 
  = do  traceGang   "gangIO: issuing work requests (SEQ_IF_GANG_BUSY)"
@@ -170,7 +175,7 @@ gangIO (Gang n mvs busy) p
         then mapM_ p [0 .. n-1]
         else do
                parIO n mvs p
-               swapMVar busy False
+               _ <- swapMVar busy False
                return ()
 #else
 gangIO (Gang n mvs busy) p = parIO n mvs p
@@ -190,7 +195,7 @@ parIO n mvs p
        reqs    <- sequence . replicate n $ newReq p
 
        traceGang "parIO: issuing requests"
-       zipWithM putMVar mvs reqs
+       zipWithM_ putMVar mvs reqs
 
        traceGang "parIO: waiting for requests to complete"
        mapM_ waitReq reqs
index e6250b6..1b61391 100644 (file)
@@ -1,3 +1,4 @@
+{-# OPTIONS -Wall -fno-warn-orphans -fno-warn-missing-signatures #-}
 -- | Distributed scalars.
 --   With a distributed value like (Dist Int), each thread has its own integer, 
 --   which may or may not have the same values as the ones on other threads.
index 337b34d..59b0942 100644 (file)
@@ -1,19 +1,25 @@
+{-# OPTIONS -Wall -fno-warn-orphans -fno-warn-missing-signatures #-}
 
--- DPH programs always used a single, shared gang of threads.
+-- DPH programs use a single, shared gang of threads.
 -- The gang exists at top level, and is initialised unsafely.
 -- 
--- The Vectoriser guarantees that the gang is only used by a single
--- computation at a time.
+-- The vectoriser guarantees that the gang is only used by a single
+-- computation at a time. This is true because the program produced
+-- by the vector only uses flat parallelism, so parallel computations
+-- don't invoke further parallel computations.
+--
+-- If the vectorised program tries to use nested parallelism then
+--  1) There is a bug in the vectoriser.
+--  2) We'll get an exception at runtime.
 --
 module Data.Array.Parallel.Unlifted.Distributed.TheGang (
   theGang
 ) where
-
 import Data.Array.Parallel.Unlifted.Distributed.Gang 
-
 import System.IO.Unsafe (unsafePerformIO)
 import GHC.Conc (numCapabilities)
 
+
 theGang :: Gang
 {-# NOINLINE theGang #-}
 theGang = unsafePerformIO (forkGang numCapabilities)
index d9eaa4e..75e8ead 100644 (file)
@@ -23,7 +23,7 @@ instance (DT a, DT b) => DT (a,b) where
   data MDist (a,b) s = MDProd !(MDist a s) !(MDist b s)
 
   indexD d i
-   = (fstD d `indexD` i,sndD d `indexD` i)
+   = (fstD d `indexD` i, sndD d `indexD` i)
 
   newMD g
    = liftM2 MDProd (newMD g) (newMD g)
index 7a113ca..4dab2a9 100644 (file)
@@ -47,7 +47,7 @@ Library
 
   Extensions: TypeFamilies, GADTs, RankNTypes,
               BangPatterns, MagicHash, UnboxedTuples, TypeOperators
-  GHC-Options: -Odph -funbox-strict-fields -fcpr-off
+  GHC-Options: -Odph -funbox-strict-fields -fcpr-off -Werror
 
   Build-Depends:  
         base     == 4.4.*,
index 00f2c83..eb990ab 100644 (file)
@@ -41,8 +41,8 @@ import Data.Array.Parallel.Pretty
 --   Or alternatively: represents an index space transformation between
 --   indices for the nested array and indices for the physical data.
 --   
---   TODO: It'd probably be better to represent the vsegids as a lens instead
---         of a vector of segids. Much of the time the vsegids are just [0..n] 
+--   TODO: It'd probably be better to represent the vsegids as a lens (function)
+--         instead of a vector of segids. Much of the time the vsegids are just [0..n] 
 --
 data UVSegd 
         = UVSegd