Skip to content
Snippets Groups Projects
Commit 616527a9 authored by Herbert Valerio Riedel's avatar Herbert Valerio Riedel :man_dancing:
Browse files

Clean up warnings and restore GHC 7.6 compatibility


This commit

 - removes redundant imports
 - removes obsolete `{-# OPTIONS_GHC -#include "HsBase.h" #-}`
 - adds a forgotten guard to one `isTrue#` occurence
 - adds a few explicit `_ <-` binds to avoid unused-binds warning
 - relax `base` build-dep version constraint to include GHC 7.6
 - remove warning-disabling `OPTIONS_GHC` from modules
 - adds `ghc-options: -Wall` to `array.cabal` file as the code base
   now warning-free on GHC 7.6 and GHC HEAD

Signed-off-by: Herbert Valerio Riedel's avatarHerbert Valerio Riedel <hvr@gnu.org>
parent cc3eafa2
No related branches found
No related tags found
No related merge requests found
{-# LANGUAGE BangPatterns, CPP, RankNTypes, MagicHash, UnboxedTuples, MultiParamTypeClasses, FlexibleInstances, FlexibleContexts, DeriveDataTypeable, UnliftedFFITypes #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
{-# OPTIONS_HADDOCK hide #-}
-- XXX With a GHC 6.9 we get a spurious
-- Data/Array/Base.hs:26:0:
-- Warning: Module `Data.Ix' is imported, but nothing from it is used,
-- except perhaps instances visible in `Data.Ix'
-- To suppress this warning, use: import Data.Ix()
-- The -fno-warn-unused-imports works around that bug
-----------------------------------------------------------------------------
-- |
......@@ -32,18 +25,16 @@ import Foreign.C.Types
import Foreign.StablePtr
import Data.Char
import GHC.Arr ( STArray, unsafeIndex )
import GHC.Arr ( STArray )
import qualified GHC.Arr as Arr
import qualified GHC.Arr as ArrST
import GHC.ST ( ST(..), runST )
import GHC.Base
import GHC.Word ( Word(..) )
import GHC.Ptr ( Ptr(..), FunPtr(..), nullPtr, nullFunPtr )
import GHC.Float ( Float(..), Double(..) )
import GHC.Stable ( StablePtr(..) )
import GHC.Int ( Int8(..), Int16(..), Int32(..), Int64(..) )
import GHC.Word ( Word8(..), Word16(..), Word32(..), Word64(..) )
import GHC.IO ( IO(..), stToIO )
import GHC.IO ( stToIO )
import GHC.IOArray ( IOArray(..),
newIOArray, unsafeReadIOArray, unsafeWriteIOArray )
import Data.Typeable
......@@ -1039,7 +1030,11 @@ instance MArray (STUArray s) Bool (ST s) where
{-# INLINE unsafeRead #-}
unsafeRead (STUArray _ _ _ marr#) (I# i#) = ST $ \s1# ->
case readWordArray# marr# (bOOL_INDEX i#) s1# of { (# s2#, e# #) ->
#if __GLASGOW_HASKELL__ > 706
(# s2#, isTrue# ((e# `and#` bOOL_BIT i#) `neWord#` int2Word# 0#) :: Bool #) }
#else
(# s2#, (e# `and#` bOOL_BIT i# `neWord#` int2Word# 0#) :: Bool #) }
#endif
{-# INLINE unsafeWrite #-}
unsafeWrite (STUArray _ _ _ marr#) (I# i#) e = ST $ \s1# ->
case bOOL_INDEX i# of { j# ->
......
{-# LANGUAGE MagicHash, UnliftedFFITypes #-}
{-# OPTIONS_GHC -#include "HsBase.h" #-}
{-# OPTIONS_GHC -w #-} --tmp
-----------------------------------------------------------------------------
-- |
-- Module : Data.Array.IO
......@@ -41,10 +40,7 @@ import Foreign
import Foreign.C
import GHC.Exts (MutableByteArray#, RealWorld)
import GHC.Arr
import GHC.IORef
import GHC.IO.Handle
import GHC.IO.Buffer
import GHC.IO.Exception
-- ---------------------------------------------------------------------------
......@@ -70,7 +66,7 @@ hGetArray handle (IOUArray (STUArray _l _u n ptr)) count
-- allocate a separate area of memory and copy.
allocaBytes count $ \p -> do
r <- hGetBuf handle p count
memcpy_ba_ptr ptr p (fromIntegral r)
_ <- memcpy_ba_ptr ptr p (fromIntegral r)
return r
foreign import ccall unsafe "memcpy"
......@@ -93,7 +89,7 @@ hPutArray handle (IOUArray (STUArray _l _u n raw)) count
-- as in hGetArray, we would like to use the array directly, but
-- we can't be sure that the MutableByteArray# is pinned.
allocaBytes count $ \p -> do
memcpy_ptr_ba p raw (fromIntegral count)
_ <- memcpy_ptr_ba p raw (fromIntegral count)
hPutBuf handle p count
foreign import ccall unsafe "memcpy"
......
{-# LANGUAGE Trustworthy #-}
{-# OPTIONS_GHC -#include "HsBase.h" #-}
{-# OPTIONS_GHC -w #-} --tmp
-----------------------------------------------------------------------------
-- |
-- Module : Data.Array.IO.Safe
......
......@@ -32,7 +32,8 @@ library
Trustworthy,
UnboxedTuples,
UnliftedFFITypes
build-depends: base >= 4.7 && < 5
build-depends: base >= 4.6 && < 5
ghc-options: -Wall
exposed-modules:
Data.Array
Data.Array.Base
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment