Reduce number of warnings

We didn't ever look at missed-specialisations.

Author: tomsmeding

accelerate.cabal

@@ -560,7 +560,6 @@ library
         -O2
         -Wall
         -Wcompat
-        -Wmissed-specialisations
         -- -Wredundant-constraints
         -freduction-depth=100
         -fspec-constr-count=50

src/Data/Array/Accelerate/Debug/Internal/Stats.hs

@@ -208,11 +208,11 @@ pprTickCount counts =
 
 pprTickGroup :: [(Tick,Int)] -> Doc
 pprTickGroup []  = error "pprTickGroup"
-pprTickGroup grp =
+pprTickGroup grp@((groupRepr, _) : _) =
   hang 2 (vcat $ (pretty groupTotal <+> groupName)
                : [ pretty n <+> pprTickCtx t | (t,n) <- sortBy (flip (comparing snd)) grp ])
   where
-    groupName  = tickToStr (fst (head grp))
+    groupName  = tickToStr groupRepr
     groupTotal = sum [n | (_,n) <- grp]
 
 tickToTag :: Tick -> Int

src/Data/Array/Accelerate/Pretty/Graphviz.hs

@@ -216,9 +216,11 @@ prettyDelayedOpenAcc detail ctx aenv (Manifest pacc) =
       p'    <- prettyDelayedAfun detail aenv p
       f'    <- prettyDelayedAfun detail aenv f
       --
-      let PNode _ (Leaf (Nothing,xb)) fvs = x'
-          loop                            = nest 2 (sep ["awhile", pretty p', pretty f', xb ])
-      return $ PNode ident (Leaf (Nothing,loop)) fvs
+      case x' of
+        PNode _ (Leaf (Nothing,xb)) fvs ->
+          let loop = nest 2 (sep ["awhile", pretty p', pretty f', xb ])
+          in return $ PNode ident (Leaf (Nothing,loop)) fvs
+        _ -> internalError "replant did not return a Leaf"
 
     Apair a1 a2              -> genNodeId >>= prettyDelayedApair detail aenv a1 a2
 

src/Data/Array/Accelerate/Trafo/Sharing.hs

@@ -76,6 +76,7 @@ import Control.Monad.Fix
 import Data.Function                                                ( on )
 import Data.Hashable
 import Data.List                                                    ( elemIndex, findIndex, groupBy, partition )
+import qualified Data.List.NonEmpty                                 as NE
 import Data.Maybe
 import Data.Monoid                                                  ( Any(..) )
 import Data.Text.Lazy.Builder
@@ -819,10 +820,10 @@ convertSharingExp config lyt alyt env aenv exp@(ScopedExp lams _) = cvt exp
         nested :: HasCallStack => AST.OpenExp env' aenv' a -> [(TagR a, AST.OpenExp env' aenv' b)] -> AST.OpenExp env' aenv' b
         nested _ [(_,r)] = r
         nested s rs      =
-          let groups = groupBy (eqT `on` fst) rs
-              tags   = map (firstT . fst . head) groups
+          let groups = NE.groupBy (eqT `on` fst) rs
+              tags   = map (firstT . fst . NE.head) groups
               e      = prjT (fst (head rs)) s
-              rhs    = map (nested s . map (over _1 ignore)) groups
+              rhs    = map (nested s . map (over _1 ignore) . NE.toList) groups
           in
           AST.Case e (zip tags rhs) Nothing
 
@@ -1108,8 +1109,8 @@ freezeOccMap oc
       traceChunk "OccMap" (fromString (show ocl))
 
       return . IntMap.fromList
-             . map (\kvs -> (key (head kvs), kvs))
-             . groupBy sameKey
+             . map (\kvs -> (key (NE.head kvs), NE.toList kvs))
+             . NE.groupBy sameKey
              . map dropHeight
              $ ocl
   where

src/Data/Array/Accelerate/Trafo/Shrink.hs

@@ -217,7 +217,8 @@ strengthenShrunkLHS (LeftHandSideSingle _)   (LeftHandSideWildcard _) k = \ix ->
   SuccIdx ix' -> k ix'
 strengthenShrunkLHS (LeftHandSidePair l h)   (LeftHandSideWildcard t) k = strengthenShrunkLHS h (LeftHandSideWildcard t2) $ strengthenShrunkLHS l (LeftHandSideWildcard t1) k
   where
-    TupRpair t1 t2 = t
+    (t1, t2) = case t of TupRpair t1' t2' -> (t1', t2')
+                         _                -> internalError "Pair type was not TupRpair"
 strengthenShrunkLHS (LeftHandSideWildcard _) _                        _ = internalError "Second LHS defines more variables"
 strengthenShrunkLHS _                        _                        _ = internalError "Mismatch LHS single with LHS pair"