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

Drop support for GHC prior to GHC 7.8

The recent overflow check made the code stop working w/ prior versions
of GHC. But there's little benefit in support much older GHCs, so it's
easier to just cut the support window.
parent db07d534
No related branches found
No related tags found
No related merge requests found
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;
......
{-# 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# ->
......
{-# 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
......
{-# 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)
......
......@@ -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
......
# 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*
......
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