Commit 875e542a authored by Ryan Scott's avatar Ryan Scott Committed by Herbert Valerio Riedel

Drop all old .patch and .cabal files

parent 58c01ef7
From 73cc4b2894bb667cdeb63d7304616cf89bf70a68 Mon Sep 17 00:00:00 2001
From: Ryan Scott <ryan.gl.scott@gmail.com>
Date: Tue, 23 Jan 2018 21:18:43 -0500
Subject: [PATCH 1/2] Fix the build with GHC 8.4
---
Setup.hs | 21 +++++++++++++++++++--
1 file changed, 19 insertions(+), 2 deletions(-)
diff --git a/Setup.hs b/Setup.hs
index df711cf..8f27fde 100755
--- a/Setup.hs
+++ b/Setup.hs
@@ -18,6 +18,12 @@ import Distribution.PackageDescription (FlagName(..), mkFlagName)
import Distribution.PackageDescription (FlagName(..))
#endif
+#if MIN_VERSION_Cabal(2,1,0)
+import Distribution.Types.GenericPackageDescription (mkFlagAssignment, unFlagAssignment)
+#else
+import Distribution.Types.GenericPackageDescription (FlagAssignment)
+#endif
+
import Distribution.Verbosity (silent)
import System.Info (os)
import qualified Control.Exception as E (tryJust, throw)
@@ -29,6 +35,14 @@ import Data.List
mkFlagName = FlagName
#endif
+#if !(MIN_VERSION_Cabal(2,1,0))
+mkFlagAssignment :: [(FlagName, Bool)] -> FlagAssignment
+mkFlagAssignment = id
+
+unFlagAssignment :: FlagAssignment -> [(FlagName, Bool)]
+unFlagAssignment = id
+#endif
+
-- On macOS we're checking whether OpenSSL library is avaiable
-- and if not, we're trying to find Homebrew or MacPorts OpenSSL installations.
--
@@ -51,7 +65,7 @@ conf descr cfg = do
case c of
Right lbi -> return lbi -- library was found
Left e
- | configConfigurationsFlags cfg
+ | unFlagAssignment (configConfigurationsFlags cfg)
`intersect` [(mkFlagName f, True) | f <- flags] /= [] ->
E.throw e
-- flag was set but library still wasn't found
@@ -86,7 +100,10 @@ multipleFound fs = unlines
, "to specify location of installed OpenSSL library."
]
-setFlag f c = c { configConfigurationsFlags = go (configConfigurationsFlags c) }
+setFlag f c = c { configConfigurationsFlags = mkFlagAssignment
+ $ go
+ $ unFlagAssignment
+ $ configConfigurationsFlags c }
where go [] = []
go (x@(n, _):xs)
| n == f = (f, True) : xs
From 7abc6d490b3914037e6c538b911470303afda111 Mon Sep 17 00:00:00 2001
From: Ryan Scott <ryan.gl.scott@gmail.com>
Date: Tue, 23 Jan 2018 21:30:58 -0500
Subject: [PATCH 2/2] Compat with older Cabals
---
Setup.hs | 4 ++--
1 file changed, 2 insertions(+), 2 deletions(-)
diff --git a/Setup.hs b/Setup.hs
index 8f27fde..d7287d1 100755
--- a/Setup.hs
+++ b/Setup.hs
@@ -19,9 +19,9 @@ import Distribution.PackageDescription (FlagName(..))
#endif
#if MIN_VERSION_Cabal(2,1,0)
-import Distribution.Types.GenericPackageDescription (mkFlagAssignment, unFlagAssignment)
+import Distribution.PackageDescription (mkFlagAssignment, unFlagAssignment)
#else
-import Distribution.Types.GenericPackageDescription (FlagAssignment)
+import Distribution.PackageDescription (FlagAssignment)
#endif
import Distribution.Verbosity (silent)
diff -ru JuicyPixels-3.2.8.3.orig/src/Codec/Picture/Metadata.hs JuicyPixels-3.2.8.3/src/Codec/Picture/Metadata.hs
--- JuicyPixels-3.2.8.3.orig/src/Codec/Picture/Metadata.hs 2016-09-04 14:18:57.000000000 +0200
+++ JuicyPixels-3.2.8.3/src/Codec/Picture/Metadata.hs 2017-09-18 11:42:24.571084437 +0200
@@ -45,6 +45,7 @@
import Data.Monoid( Monoid, mempty, mappend )
import Data.Word( Word )
#endif
+import Data.Semigroup( Semigroup(..) )
import Control.DeepSeq( NFData( .. ) )
@@ -168,9 +169,12 @@
}
deriving (Show, NFData)
+instance Semigroup Metadatas where
+ (<>) = union
+
instance Monoid Metadatas where
mempty = empty
- mappend = union
+ mappend = (<>)
-- | Right based union
union :: Metadatas -> Metadatas -> Metadatas
Only in JuicyPixels-3.2.8.3/src/Codec/Picture: Metadata.hs~
diff -ru JuicyPixels-3.2.9.1/src/Codec/Picture/Metadata.hs JuicyPixels-3.2.9.1-patched/src/Codec/Picture/Metadata.hs
--- JuicyPixels-3.2.9.1/src/Codec/Picture/Metadata.hs 2017-11-11 17:35:34.000000000 +0800
+++ JuicyPixels-3.2.9.1-patched/src/Codec/Picture/Metadata.hs 2017-12-08 12:22:34.000000000 +0800
@@ -46,7 +46,7 @@
import Data.Monoid( Monoid, mempty, mappend )
import Data.Word( Word )
#endif
-
+import Data.Semigroup( Semigroup(..) )
import Control.DeepSeq( NFData( .. ) )
import qualified Data.Foldable as F
@@ -169,9 +169,12 @@
}
deriving (Show, NFData)
+instance Semigroup Metadatas where
+ (<>) = union
+
instance Monoid Metadatas where
mempty = empty
- mappend = union
+ mappend = (<>)
-- | Right based union
union :: Metadatas -> Metadatas -> Metadatas
diff -ru JuicyPixels-3.2.9.2/src/Codec/Picture/Metadata.hs JuicyPixels-3.2.9.2-patched/src/Codec/Picture/Metadata.hs
--- JuicyPixels-3.2.9.2/src/Codec/Picture/Metadata.hs 2017-11-11 17:35:34.000000000 +0800
+++ JuicyPixels-3.2.9.2-patched/src/Codec/Picture/Metadata.hs 2018-01-10 12:49:40.000000000 +0800
@@ -46,7 +46,7 @@
import Data.Monoid( Monoid, mempty, mappend )
import Data.Word( Word )
#endif
-
+import Data.Semigroup( Semigroup(..) )
import Control.DeepSeq( NFData( .. ) )
import qualified Data.Foldable as F
@@ -169,9 +169,12 @@
}
deriving (Show, NFData)
+instance Semigroup Metadatas where
+ (<>) = union
+
instance Monoid Metadatas where
mempty = empty
- mappend = union
+ mappend = (<>)
-- | Right based union
union :: Metadatas -> Metadatas -> Metadatas
diff -ru JuicyPixels-3.2.9.3.orig/src/Codec/Picture/Metadata.hs JuicyPixels-3.2.9.3/src/Codec/Picture/Metadata.hs
--- JuicyPixels-3.2.9.3.orig/src/Codec/Picture/Metadata.hs 2017-11-11 04:35:34.000000000 -0500
+++ JuicyPixels-3.2.9.3/src/Codec/Picture/Metadata.hs 2018-01-25 10:20:07.641487188 -0500
@@ -38,7 +38,7 @@
-- * Conversion functions
, dotsPerMeterToDotPerInch
- , dotPerInchToDotsPerMeter
+ , dotPerInchToDotsPerMeter
, dotsPerCentiMeterToDotPerInch
) where
@@ -171,7 +171,12 @@
instance Monoid Metadatas where
mempty = empty
+#if !MIN_VERSION_base(4,11,0)
mappend = union
+#else
+instance Semigroup Metadatas where
+ (<>) = union
+#endif
-- | Right based union
union :: Metadatas -> Metadatas -> Metadatas
diff -ru List-0.6.0.orig/src/Control/Monad/ListT.hs List-0.6.0/src/Control/Monad/ListT.hs
--- List-0.6.0.orig/src/Control/Monad/ListT.hs 2016-10-31 09:42:01.000000000 +0100
+++ List-0.6.0/src/Control/Monad/ListT.hs 2017-09-17 11:20:22.403495565 +0200
@@ -30,6 +30,7 @@
import Control.Monad.IO.Class (MonadIO(..))
import Control.Monad.Trans.Class (MonadTrans(..))
import Data.Monoid (Monoid(..))
+import Data.Semigroup
newtype ListT m a =
ListT { runListT :: m (ListItem (ListT m) a) }
@@ -46,9 +47,12 @@
where
step x = return . consFunc x . joinL
+instance Monad m => Semigroup (ListT m a) where
+ (<>) = flip (foldrL' cons)
+
instance Monad m => Monoid (ListT m a) where
mempty = ListT $ return Nil
- mappend = flip (foldrL' cons)
+ mappend = (<>)
instance Monad m => Functor (ListT m) where
fmap func = foldrL' (cons . func) mempty
Only in List-0.6.0/src/Control/Monad: ListT.hs~
From 11f8791c3b29db3351c89cc85faa2dc8068a55ce Mon Sep 17 00:00:00 2001
From: Kosyrev Serge <serge.kosyrev@iohk.io>
Date: Sat, 13 Jan 2018 19:51:44 +0300
Subject: [PATCH] Data.Memotrie: Semigroup instane for :->: (GHC 8.4 compat)
---
src/Data/MemoTrie.hs | 5 +++++
1 file changed, 5 insertions(+)
diff --git a/src/Data/MemoTrie.hs b/src/Data/MemoTrie.hs
index 8ea692e..fafe16d 100644
--- a/src/Data/MemoTrie.hs
+++ b/src/Data/MemoTrie.hs
@@ -587,7 +587,12 @@ instance HasTrie a => Monad ((:->:) a) where
instance (HasTrie a, Monoid b) => Monoid (a :->: b) where
mempty = trie mempty
+#if !MIN_VERSION_base(4,11,0)
mappend = inTrie2 mappend
+#else
+instance (HasTrie a, Semigroup b) => Semigroup (a :->: b) where
+ (<>) = inTrie2 (<>)
+#endif
instance HasTrie a => Functor ((:->:) a) where
fmap f = inTrie (fmap f)
diff -ru OneTuple-0.2.1.orig/Data/Tuple/OneTuple.hs OneTuple-0.2.1/Data/Tuple/OneTuple.hs
--- OneTuple-0.2.1.orig/Data/Tuple/OneTuple.hs 2009-03-24 13:25:57.000000000 -0400
+++ OneTuple-0.2.1/Data/Tuple/OneTuple.hs 2018-01-25 13:37:54.729786042 -0500
@@ -1,4 +1,4 @@
-
+{-# LANGUAGE CPP #-}
-- |OneTuple fills the /tuple gap/ with a singleton tuple.
--
-- OneTuple /does not support/ the usual parenthesized tuple syntax.
@@ -22,6 +22,9 @@
import Data.Foldable
import Data.Ix
import Data.Monoid
+#if MIN_VERSION_base(4,9,0)
+import Data.Semigroup (Semigroup(..))
+#endif
import Data.Traversable
-- |OneTuple is the singleton tuple data type.
@@ -68,9 +71,18 @@
(OneTuple x) >>= f = f x
return = OneTuple
+#if MIN_VERSION_base(4,9,0)
+instance (Semigroup a) => Semigroup (OneTuple a) where
+ OneTuple x <> OneTuple y = OneTuple (x <> y)
+ sconcat = Prelude.foldr1 (<>)
+ stimes n (OneTuple a) = OneTuple (stimes n a)
+#endif
+
instance (Monoid a) => Monoid (OneTuple a) where
mempty = OneTuple mempty
+#if !(MIN_VERSION_base(4,11,0))
mappend (OneTuple x) (OneTuple y) = OneTuple (mappend x y)
+#endif
mconcat = Prelude.foldr1 mappend
instance MonadFix OneTuple where
diff -ru accelerate-1.1.1.0.orig/Data/Array/Accelerate/Classes/FromIntegral.hs accelerate-1.1.1.0/Data/Array/Accelerate/Classes/FromIntegral.hs
--- accelerate-1.1.1.0.orig/Data/Array/Accelerate/Classes/FromIntegral.hs 2017-09-20 23:08:58.000000000 -0400
+++ accelerate-1.1.1.0/Data/Array/Accelerate/Classes/FromIntegral.hs 2018-01-23 13:08:52.889390481 -0500
@@ -61,10 +61,16 @@
TyConI (DataD _ _ _ _ cons _) <- reify name
#endif
let
+ -- This is what a constructor such as IntegralNumType will be reified
+ -- as prior to GHC 8.4...
dig (NormalC _ [(_, AppT (ConT n) (VarT _))]) = digItOut n
#if __GLASGOW_HASKELL__ < 800
dig (ForallC _ _ (NormalC _ [(_, AppT (ConT _) (ConT n))])) = return [n]
#else
+ -- ...but this is what IntegralNumType will be reified as on GHC 8.4
+ -- and later, after the changes described in
+ -- https://ghc.haskell.org/trac/ghc/wiki/Migration/8.4#TemplateHaskellreificationchangesforGADTs
+ dig (ForallC _ _ (GadtC _ [(_, AppT (ConT n) (VarT _))] _)) = digItOut n
dig (GadtC _ _ (AppT (ConT _) (ConT n))) = return [n]
#endif
dig _ = error "Unexpected case generating FromIntegral instances"
diff -ru accelerate-1.1.1.0.orig/Data/Array/Accelerate/Classes/ToFloating.hs accelerate-1.1.1.0/Data/Array/Accelerate/Classes/ToFloating.hs
--- accelerate-1.1.1.0.orig/Data/Array/Accelerate/Classes/ToFloating.hs 2017-05-08 23:19:50.000000000 -0400
+++ accelerate-1.1.1.0/Data/Array/Accelerate/Classes/ToFloating.hs 2018-01-23 13:07:42.681388713 -0500
@@ -57,10 +57,16 @@
TyConI (DataD _ _ _ _ cons _) <- reify name
#endif
let
+ -- This is what a constructor such as IntegralNumType will be reified
+ -- as prior to GHC 8.4...
dig (NormalC _ [(_, AppT (ConT n) (VarT _))]) = digItOut n
#if __GLASGOW_HASKELL__ < 800
dig (ForallC _ _ (NormalC _ [(_, AppT (ConT _) (ConT n))])) = return [n]
#else
+ -- ...but this is what IntegralNumType will be reified as on GHC 8.4
+ -- and later, after the changes described in
+ -- https://ghc.haskell.org/trac/ghc/wiki/Migration/8.4#TemplateHaskellreificationchangesforGADTs
+ dig (ForallC _ _ (GadtC _ [(_, AppT (ConT n) (VarT _))] _)) = digItOut n
dig (GadtC _ _ (AppT (ConT _) (ConT n))) = return [n]
#endif
dig _ = error "Unexpected case generating ToFloating instances"
diff -ru accelerate-1.1.1.0.orig/Data/Array/Accelerate/Data/Fold.hs accelerate-1.1.1.0/Data/Array/Accelerate/Data/Fold.hs
--- accelerate-1.1.1.0.orig/Data/Array/Accelerate/Data/Fold.hs 2017-05-08 23:19:50.000000000 -0400
+++ accelerate-1.1.1.0/Data/Array/Accelerate/Data/Fold.hs 2018-01-23 13:20:48.461408502 -0500
@@ -78,7 +78,7 @@
-> Acc (Array sh o)
runFold (Fold tally summarise) is
= A.map summarise
- $ A.fold (<>) mempty
+ $ A.fold mappend mempty
$ A.map tally is
diff -ru accelerate-1.1.1.0.orig/Data/Array/Accelerate/Data/Monoid.hs accelerate-1.1.1.0/Data/Array/Accelerate/Data/Monoid.hs
--- accelerate-1.1.1.0.orig/Data/Array/Accelerate/Data/Monoid.hs 2017-07-16 23:17:03.000000000 -0400
+++ accelerate-1.1.1.0/Data/Array/Accelerate/Data/Monoid.hs 2018-01-23 13:19:27.581406465 -0500
@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
@@ -33,7 +34,12 @@
import Data.Array.Accelerate.Array.Sugar as A
import Data.Function
-import Data.Monoid hiding ( mconcat )
+#if __GLASGOW_HASKELL__ >= 800
+import Data.Monoid hiding ( (<>) )
+import Data.Semigroup
+#else
+import Data.Monoid
+#endif
import qualified Prelude as P
@@ -64,6 +70,13 @@
mempty = 0
mappend = lift2 (mappend :: Sum (Exp a) -> Sum (Exp a) -> Sum (Exp a))
+#if __GLASGOW_HASKELL__ >= 800
+-- | @since 1.2.0.0
+instance Num a => Semigroup (Exp (Sum a)) where
+ (<>) = (+)
+ -- stimes n x = lift . Sum $ n * getSum (unlift x)
+#endif
+
instance A.Num a => P.Num (Exp (Sum a)) where
(+) = lift2 ((+) :: Sum (Exp a) -> Sum (Exp a) -> Sum (Exp a))
(-) = lift2 ((-) :: Sum (Exp a) -> Sum (Exp a) -> Sum (Exp a))
@@ -113,6 +126,13 @@
mempty = 1
mappend = lift2 (mappend :: Product (Exp a) -> Product (Exp a) -> Product (Exp a))
+#if __GLASGOW_HASKELL__ >= 800
+-- | @since 1.2.0.0
+instance Num a => Semigroup (Exp (Product a)) where
+ (<>) = (*)
+ -- stimes n x = lift . Product $ getProduct (unlift x) ^ constant n
+#endif
+
instance A.Num a => P.Num (Exp (Product a)) where
(+) = lift2 ((+) :: Product (Exp a) -> Product (Exp a) -> Product (Exp a))
(-) = lift2 ((-) :: Product (Exp a) -> Product (Exp a) -> Product (Exp a))
@@ -147,26 +167,54 @@
mappend x y = let (a1,b1) = unlift x :: (Exp a, Exp b)
(a2,b2) = unlift y
in
- lift (a1<>a2, b1<>b2)
+ lift (a1 `mappend` a2, b1 `mappend` b2)
instance (Elt a, Elt b, Elt c, Monoid (Exp a), Monoid (Exp b), Monoid (Exp c)) => Monoid (Exp (a,b,c)) where
mempty = lift (mempty :: Exp a, mempty :: Exp b, mempty :: Exp c)
mappend x y = let (a1,b1,c1) = unlift x :: (Exp a, Exp b, Exp c)
(a2,b2,c2) = unlift y
in
- lift (a1<>a2, b1<>b2, c1<>c2)
+ lift (a1 `mappend` a2, b1 `mappend` b2, c1 `mappend` c2)
instance (Elt a, Elt b, Elt c, Elt d, Monoid (Exp a), Monoid (Exp b), Monoid (Exp c), Monoid (Exp d)) => Monoid (Exp (a,b,c,d)) where
mempty = lift (mempty :: Exp a, mempty :: Exp b, mempty :: Exp c, mempty :: Exp d)
mappend x y = let (a1,b1,c1,d1) = unlift x :: (Exp a, Exp b, Exp c, Exp d)
(a2,b2,c2,d2) = unlift y
in
- lift (a1<>a2, b1<>b2, c1<>c2, d1<>d2)
+ lift (a1 `mappend` a2, b1 `mappend` b2, c1 `mappend` c2, d1 `mappend` d2)
instance (Elt a, Elt b, Elt c, Elt d, Elt e, Monoid (Exp a), Monoid (Exp b), Monoid (Exp c), Monoid (Exp d), Monoid (Exp e)) => Monoid (Exp (a,b,c,d,e)) where
mempty = lift (mempty :: Exp a, mempty :: Exp b, mempty :: Exp c, mempty :: Exp d, mempty :: Exp e)
mappend x y = let (a1,b1,c1,d1,e1) = unlift x :: (Exp a, Exp b, Exp c, Exp d, Exp e)
(a2,b2,c2,d2,e2) = unlift y
in
- lift (a1<>a2, b1<>b2, c1<>c2, d1<>d2, e1<>e2)
+ lift (a1 `mappend` a2, b1 `mappend` b2, c1 `mappend` c2, d1 `mappend` d2, e1 `mappend` e2)
+
+#if __GLASGOW_HASKELL__ >= 800
+instance Semigroup (Exp ()) where
+ _ <> _ = constant ()
+
+instance (Elt a, Elt b, Semigroup (Exp a), Semigroup (Exp b)) => Semigroup (Exp (a,b)) where
+ x <> y = let (a1,b1) = unlift x :: (Exp a, Exp b)
+ (a2,b2) = unlift y
+ in
+ lift (a1 <> a2, b1 <> b2)
+
+instance (Elt a, Elt b, Elt c, Semigroup (Exp a), Semigroup (Exp b), Semigroup (Exp c)) => Semigroup (Exp (a,b,c)) where
+ x <> y = let (a1,b1,c1) = unlift x :: (Exp a, Exp b, Exp c)
+ (a2,b2,c2) = unlift y
+ in
+ lift (a1 <> a2, b1 <> b2, c1 <> c2)
+instance (Elt a, Elt b, Elt c, Elt d, Semigroup (Exp a), Semigroup (Exp b), Semigroup (Exp c), Semigroup (Exp d)) => Semigroup (Exp (a,b,c,d)) where
+ x <> y = let (a1,b1,c1,d1) = unlift x :: (Exp a, Exp b, Exp c, Exp d)
+ (a2,b2,c2,d2) = unlift y
+ in
+ lift (a1 <> a2, b1 <> b2, c1 <> c2, d1 <> d2)
+
+instance (Elt a, Elt b, Elt c, Elt d, Elt e, Semigroup (Exp a), Semigroup (Exp b), Semigroup (Exp c), Semigroup (Exp d), Semigroup (Exp e)) => Semigroup (Exp (a,b,c,d,e)) where
+ x <> y = let (a1,b1,c1,d1,e1) = unlift x :: (Exp a, Exp b, Exp c, Exp d, Exp e)
+ (a2,b2,c2,d2,e2) = unlift y
+ in
+ lift (a1 <> a2, b1 <> b2, c1 <> c2, d1 <> d2, e1 <> e2)
+#endif
diff -ru accelerate-1.2.0.0.orig/src/Data/Array/Accelerate/Data/Monoid.hs accelerate-1.2.0.0/src/Data/Array/Accelerate/Data/Monoid.hs
--- accelerate-1.2.0.0.orig/src/Data/Array/Accelerate/Data/Monoid.hs 2018-03-20 23:21:17.000000000 -0400
+++ accelerate-1.2.0.0/src/Data/Array/Accelerate/Data/Monoid.hs 2018-07-04 21:51:33.816351664 -0400
@@ -5,6 +5,7 @@
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
-- |
-- Module : Data.Array.Accelerate.Data.Monoid
diff -ru accelerate-1.2.0.0.orig/src/Data/Array/Accelerate/Data/Semigroup.hs accelerate-1.2.0.0/src/Data/Array/Accelerate/Data/Semigroup.hs
--- accelerate-1.2.0.0.orig/src/Data/Array/Accelerate/Data/Semigroup.hs 2018-03-19 00:08:29.000000000 -0400
+++ accelerate-1.2.0.0/src/Data/Array/Accelerate/Data/Semigroup.hs 2018-07-04 21:51:12.028351115 -0400
@@ -5,6 +5,7 @@
{-# LANGUAGE RebindableSyntax #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE ViewPatterns #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
-- |
diff -ru accelerate-1.2.0.0.orig/src/Data/Array/Accelerate/Lift.hs accelerate-1.2.0.0/src/Data/Array/Accelerate/Lift.hs
--- accelerate-1.2.0.0.orig/src/Data/Array/Accelerate/Lift.hs 2018-03-19 00:08:29.000000000 -0400
+++ accelerate-1.2.0.0/src/Data/Array/Accelerate/Lift.hs 2018-07-04 21:50:26.520349969 -0400
@@ -4,6 +4,7 @@
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE UndecidableInstances #-}
#if __GLASGOW_HASKELL__ <= 708
{-# LANGUAGE OverlappingInstances #-}
{-# OPTIONS_GHC -fno-warn-unrecognised-pragmas #-}
diff -ru accelerate-llvm-1.1.0.0.orig/Control/Parallel/Meta.hs accelerate-llvm-1.1.0.0/Control/Parallel/Meta.hs
--- accelerate-llvm-1.1.0.0.orig/Control/Parallel/Meta.hs 2017-07-03 19:46:40.000000000 -0400
+++ accelerate-llvm-1.1.0.0/Control/Parallel/Meta.hs 2018-01-23 19:09:25.433935263 -0500
@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP #-}
{-# OPTIONS_HADDOCK hide #-}
-- |
-- Module : Control.Parallel.Meta
@@ -24,7 +25,10 @@
import Control.Parallel.Meta.Worker
import Data.ByteString.Short ( ShortByteString )
import Data.Concurrent.Deque.Class
-import Data.Monoid
+import Data.Monoid ( Monoid(..) )
+#if __GLASGOW_HASKELL__ >= 800
+import Data.Semigroup ( Semigroup(..) )
+#endif
import Data.Sequence ( Seq )
import Data.Range.Range as R
import qualified Data.Vector as V
@@ -39,6 +43,11 @@
data Startup = Startup {
_runStartup :: Gang -> IO () }
+#if __GLASGOW_HASKELL__ >= 800
+instance Semigroup Startup where
+ Startup st1 <> Startup st2 = Startup $ \g -> st1 g >> st2 g
+#endif
+
instance Monoid Startup where
mempty = Startup $ \_ -> return ()
Startup st1 `mappend` Startup st2 = Startup $ \g -> st1 g >> st2 g
@@ -52,6 +61,17 @@
data WorkSearch = WorkSearch {
runWorkSearch :: Int -> Workers -> IO (Maybe Range) }
+#if __GLASGOW_HASKELL__ >= 800
+instance Semigroup WorkSearch where
+ {-# INLINE (<>) #-}
+ WorkSearch ws1 <> WorkSearch ws2 =
+ WorkSearch $ \tid st -> do
+ mwork <- ws1 tid st
+ case mwork of
+ Nothing -> ws2 tid st
+ _ -> return mwork
+#endif
+
instance Monoid WorkSearch where
mempty = WorkSearch $ \_ _ -> return Nothing
WorkSearch ws1 `mappend` WorkSearch ws2 =
@@ -72,9 +92,15 @@
workSearch :: WorkSearch
}
+#if __GLASGOW_HASKELL__ >= 800
+instance Semigroup Resource where
+ {-# INLINE (<>) #-}
+ Resource ws1 <> Resource ws2 = Resource (ws1 <> ws2)
+#endif
+
instance Monoid Resource where
mempty = Resource mempty
- mappend (Resource ws1) (Resource ws2) = Resource (ws1 <> ws2)
+ mappend (Resource ws1) (Resource ws2) = Resource (ws1 `mappend` ws2)
-- | An action to execute. The first parameters are the start and end indices of
@@ -112,6 +138,11 @@
_runFinalise :: Seq Range -> IO ()
}
+#if __GLASGOW_HASKELL__ >= 800
+instance Semigroup Finalise where
+ Finalise f1 <> Finalise f2 = Finalise $ \r -> f1 r >> f2 r
+#endif
+
instance Monoid Finalise where
mempty = Finalise $ \_ -> return ()
Finalise f1 `mappend` Finalise f2 = Finalise $ \r -> f1 r >> f2 r
diff -ru accelerate-llvm-1.1.0.0.orig/LLVM/AST/Type/Name.hs accelerate-llvm-1.1.0.0/LLVM/AST/Type/Name.hs
--- accelerate-llvm-1.1.0.0.orig/LLVM/AST/Type/Name.hs 2017-08-25 03:09:47.000000000 -0400
+++ accelerate-llvm-1.1.0.0/LLVM/AST/Type/Name.hs 2018-01-23 19:00:51.009922308 -0500
@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE RoleAnnotations #-}
{-# OPTIONS_HADDOCK hide #-}
@@ -16,6 +17,9 @@
import Data.ByteString.Short ( ShortByteString )
import Data.Data
+#if __GLASGOW_HASKELL__ >= 800
+import Data.Semigroup
+#endif
import Data.String
import Data.Word
import Prelude
@@ -71,6 +75,11 @@
instance IsString Label where
fromString = Label . fromString
+#if __GLASGOW_HASKELL__ >= 800
+instance Semigroup Label where
+ Label x <> Label y = Label (x <> y)
+#endif
+
instance Monoid Label where