diff --git a/.travis.yml b/.travis.yml index e42cee5dfd0b3e3629c411f464106b289777e492..cfffef35c39e4c5348dc74f5ae65770ce8dfc6cd 100644 --- a/.travis.yml +++ b/.travis.yml @@ -1,9 +1,8 @@ env: - - GHCVER=7.4.1 - - GHCVER=7.4.2 - - GHCVER=7.6.1 - - GHCVER=7.6.2 - - GHCVER=7.6.3 + - GHCVER=7.8.4 + - GHCVER=7.10.3 + - GHCVER=8.0.2 + - GHCVER=8.2.1 - GHCVER=head matrix: @@ -13,22 +12,22 @@ matrix: before_install: - sudo add-apt-repository -y ppa:hvr/ghc - sudo apt-get update - - sudo apt-get install cabal-install-1.18 ghc-$GHCVER - - export PATH=/opt/ghc/$GHCVER/bin:$PATH + - sudo apt-get install cabal-install-head ghc-$GHCVER + - export PATH=/opt/ghc/bin:$PATH install: - - cabal-1.18 update + - cabal update - ghc --version script: - - cabal-1.18 configure -v2 - - cabal-1.18 build - - cabal-1.18 check - - cabal-1.18 sdist - - export SRC_TGZ=$(cabal-1.18 info . | awk '{print $2 ".tar.gz";exit}') ; + - cabal configure -v2 + - cabal build + - cabal check + - cabal sdist + - export SRC_TGZ=$(cabal info . | awk '{print $2 ".tar.gz";exit}') ; cd dist/; if [ -f "$SRC_TGZ" ]; then - cabal-1.18 install "$SRC_TGZ"; + cabal install "$SRC_TGZ"; else echo "expected '$SRC_TGZ' not found"; exit 1; diff --git a/Data/Array/Base.hs b/Data/Array/Base.hs index 36db53fad387e5320b042dcdfc9e939ce37238d1..8cc319cacceb3785019e877e24b2eab7061cb7aa 100644 --- a/Data/Array/Base.hs +++ b/Data/Array/Base.hs @@ -1,7 +1,5 @@ {-# LANGUAGE BangPatterns, CPP, RankNTypes, MagicHash, UnboxedTuples, MultiParamTypeClasses, FlexibleInstances, FlexibleContexts, DeriveDataTypeable, UnliftedFFITypes #-} -#if __GLASGOW_HASKELL__ >= 708 {-# LANGUAGE RoleAnnotations #-} -#endif {-# OPTIONS_HADDOCK hide #-} ----------------------------------------------------------------------------- @@ -36,9 +34,6 @@ import GHC.Base ( IO(..), divInt# ) import GHC.Exts import GHC.Ptr ( nullPtr, nullFunPtr ) import GHC.Stable ( StablePtr(..) ) -#if !MIN_VERSION_base(4,6,0) -import GHC.Exts ( Word(..) ) -#endif import GHC.Int ( Int8(..), Int16(..), Int32(..), Int64(..) ) import GHC.Word ( Word8(..), Word16(..), Word32(..), Word64(..) ) import GHC.IO ( stToIO ) @@ -404,10 +399,8 @@ instance IArray Arr.Array e where -- data UArray i e = UArray !i !i !Int ByteArray# deriving Typeable -#if __GLASGOW_HASKELL__ >= 708 -- There are class-based invariants on both parameters. See also #9220. type role UArray nominal nominal -#endif {-# INLINE unsafeArrayUArray #-} unsafeArrayUArray :: (MArray (STUArray s) e (ST s), Ix i) @@ -504,11 +497,7 @@ instance IArray UArray Bool where {-# INLINE unsafeArray #-} unsafeArray lu ies = runST (unsafeArrayUArray lu ies False) {-# INLINE unsafeAt #-} -#if __GLASGOW_HASKELL__ > 706 unsafeAt (UArray _ _ _ arr#) (I# i#) = isTrue# -#else - unsafeAt (UArray _ _ _ arr#) (I# i#) = -#endif ((indexWordArray# arr# (bOOL_INDEX i#) `and#` bOOL_BIT i#) `neWord#` int2Word# 0#) @@ -991,19 +980,13 @@ instance MArray (STArray s) e (Lazy.ST s) where -- 'STArray' provides. data STUArray s i e = STUArray !i !i !Int (MutableByteArray# s) deriving Typeable -#if __GLASGOW_HASKELL__ >= 708 -- The "ST" parameter must be nominal for the safety of the ST trick. -- The other parameters have class constraints. See also #9220. type role STUArray nominal nominal nominal -#endif instance Eq (STUArray s i e) where STUArray _ _ _ arr1# == STUArray _ _ _ arr2# = -#if __GLASGOW_HASKELL__ > 706 isTrue# (sameMutableByteArray# arr1# arr2#) -#else - sameMutableByteArray# arr1# arr2# -#endif {-# INLINE unsafeNewArraySTUArray_ #-} unsafeNewArraySTUArray_ :: Ix i @@ -1037,11 +1020,7 @@ 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# -> diff --git a/Data/Array/IO/Internals.hs b/Data/Array/IO/Internals.hs index c934cc5ccc8e1cda01884c5ab1efc559c5f2750b..4f784de86890fb408a9773b02b32e83987c82127 100644 --- a/Data/Array/IO/Internals.hs +++ b/Data/Array/IO/Internals.hs @@ -1,8 +1,6 @@ {-# LANGUAGE DeriveDataTypeable, FlexibleInstances, MultiParamTypeClasses, CPP #-} -#if __GLASGOW_HASKELL__ >= 708 {-# LANGUAGE RoleAnnotations #-} -#endif {-# OPTIONS_HADDOCK hide #-} ----------------------------------------------------------------------------- @@ -54,10 +52,8 @@ import GHC.IOArray (IOArray(..)) -- newtype IOUArray i e = IOUArray (STUArray RealWorld i e) deriving Typeable -#if __GLASGOW_HASKELL__ >= 708 -- Both parameters have class-based invariants. See also #9220. type role IOUArray nominal nominal -#endif instance Eq (IOUArray i e) where IOUArray s1 == IOUArray s2 = s1 == s2 diff --git a/Data/Array/Storable/Internals.hs b/Data/Array/Storable/Internals.hs index 6741bb12d6bb7edd58b29fbb3fe0d2736729c23d..3fcd73a0fc370e3875967c3a88d5818b09387eb8 100644 --- a/Data/Array/Storable/Internals.hs +++ b/Data/Array/Storable/Internals.hs @@ -1,7 +1,4 @@ -{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, CPP #-} -#if __GLASGOW_HASKELL__ >= 708 -{-# LANGUAGE RoleAnnotations #-} -#endif +{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, RoleAnnotations #-} {-# OPTIONS_HADDOCK hide #-} ----------------------------------------------------------------------------- -- | @@ -31,10 +28,8 @@ import Foreign hiding (newArray) -- |The array type data StorableArray i e = StorableArray !i !i Int !(ForeignPtr e) -#if __GLASGOW_HASKELL__ >= 708 -- Both parameters have class-based invariants. See also #9220. type role StorableArray nominal nominal -#endif instance Storable e => MArray StorableArray e IO where getBounds (StorableArray l u _ _) = return (l,u) diff --git a/array.cabal b/array.cabal index f52e562fd3c218084d1cf55bb92376e193ac7555..58b8cf137535afc7071170cd3fb74faa49534249 100644 --- a/array.cabal +++ b/array.cabal @@ -9,7 +9,7 @@ synopsis: Mutable and immutable arrays category: Data Structures build-type: Simple cabal-version: >=1.10 -tested-with: GHC==7.6.3, GHC==7.6.2, GHC==7.6.1, GHC==7.4.2, GHC==7.4.1 +tested-with: GHC==8.2.1, GHC==8.0.2, GHC==7.10.3, GHC==7.8.4 description: In addition to providing the "Data.Array" module <http://www.haskell.org/onlinereport/haskell2010/haskellch14.html as specified in the Haskell 2010 Language Report>, @@ -37,7 +37,7 @@ library Trustworthy, UnboxedTuples, UnliftedFFITypes - build-depends: base >= 4.5 && < 4.11 + build-depends: base >= 4.7 && < 4.11 ghc-options: -Wall exposed-modules: Data.Array diff --git a/changelog.md b/changelog.md index 8421c2357c7e01a961180c2cb75059035fa7efc9..209f2f06f66281b64c5769bb9b2ff8d9fcadbeda 100644 --- a/changelog.md +++ b/changelog.md @@ -1,9 +1,10 @@ # Changelog for [`array` package](http://hackage.haskell.org/package/array) -## 0.5.1.2 *TBD* +## 0.5.1.2 *May 2017* * Bundled with GHC 8.2.1 - * Overflow check in `unsafeNewArray` + * Overflow check in `unsafeNewArray` (#229) + * Drop support for GHC versions prior to GHC 7.8 ## 0.5.1.1 *Apr 2016*