From 48e6afa8a0b0787204864ecfb2da9c00a0d82688 Mon Sep 17 00:00:00 2001 From: Tjalle-S <91267211+Tjalle-S@users.noreply.github.com> Date: Mon, 4 May 2026 13:24:31 +0200 Subject: [PATCH 1/6] Relax constrain on Monoid instance for Maybe --- src/Data/Array/Accelerate/Data/Maybe.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Data/Array/Accelerate/Data/Maybe.hs b/src/Data/Array/Accelerate/Data/Maybe.hs index 305da9a71..60bcea2df 100644 --- a/src/Data/Array/Accelerate/Data/Maybe.hs +++ b/src/Data/Array/Accelerate/Data/Maybe.hs @@ -130,7 +130,7 @@ instance Ord a => Ord (Maybe a) where go Nothing_ Just_{} = LT_ go Just_{} Nothing_{} = GT_ -instance (Monoid (Exp a), Elt a) => Monoid (Exp (Maybe a)) where +instance (Semigroup (Exp a), Elt a) => Monoid (Exp (Maybe a)) where mempty = Nothing_ instance (Semigroup (Exp a), Elt a) => Semigroup (Exp (Maybe a)) where From f3d5d20be4a33ba1ab83ca05672f55bc29f40392 Mon Sep 17 00:00:00 2001 From: Tjalle-S <91267211+Tjalle-S@users.noreply.github.com> Date: Fri, 8 May 2026 15:47:31 +0200 Subject: [PATCH 2/6] Add re-exports id and (~) --- src/Data/Array/Accelerate.hs | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/src/Data/Array/Accelerate.hs b/src/Data/Array/Accelerate.hs index 929f2fe21..646ccaa10 100644 --- a/src/Data/Array/Accelerate.hs +++ b/src/Data/Array/Accelerate.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE ExplicitNamespaces #-} {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} @@ -411,7 +412,8 @@ module Data.Array.Accelerate ( -- --------------------------------------------------------------------------- -- * Useful re-exports - (.), ($), (&), flip, error, undefined, const, otherwise, + (.), ($), (&), flip, error, undefined, const, id, otherwise, + type (~), Show, Generic, HasCallStack, fromString, -- -XOverloadedStrings fromListN, -- -XOverloadedLists @@ -463,7 +465,7 @@ import qualified Data.Array.Accelerate.Sugar.Array as S import qualified Data.Array.Accelerate.Sugar.Shape as S import Data.Function ( (&) ) -import Prelude ( (.), ($), Char, Show, flip, undefined, error, const, otherwise ) +import Prelude ( (.), ($), Char, Show, flip, undefined, error, const, id, otherwise, type (~) ) import GHC.Exts ( fromListN, fromString ) import GHC.Generics ( Generic ) From 47b91fc6737efd14abbbcefa6f62759c38ed4e90 Mon Sep 17 00:00:00 2001 From: Tjalle-S <91267211+Tjalle-S@users.noreply.github.com> Date: Fri, 8 May 2026 15:49:03 +0200 Subject: [PATCH 3/6] Generalize Eq instance for (:.) --- src/Data/Array/Accelerate/Classes/Eq.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Data/Array/Accelerate/Classes/Eq.hs b/src/Data/Array/Accelerate/Classes/Eq.hs index 6985facdd..163815477 100644 --- a/src/Data/Array/Accelerate/Classes/Eq.hs +++ b/src/Data/Array/Accelerate/Classes/Eq.hs @@ -203,7 +203,7 @@ runQ $ do ts <- mapM mkTup [2..16] return $ concat (concat [is,fs,ns,cs,ts]) -instance Eq sh => Eq (sh :. Int) where +instance (Eq sh, Eq i) => Eq (sh :. i) where x == y = indexHead x == indexHead y && indexTail x == indexTail y x /= y = indexHead x /= indexHead y || indexTail x /= indexTail y From 3326bfb366e2361391b4dc6a5df33c545ad160b2 Mon Sep 17 00:00:00 2001 From: Tjalle-S <91267211+Tjalle-S@users.noreply.github.com> Date: Fri, 8 May 2026 15:42:55 +0200 Subject: [PATCH 4/6] Add Control.Monad.join --- src/Data/Array/Accelerate/Control/Monad.hs | 16 +++++++++++++++- 1 file changed, 15 insertions(+), 1 deletion(-) diff --git a/src/Data/Array/Accelerate/Control/Monad.hs b/src/Data/Array/Accelerate/Control/Monad.hs index 89a72ca9f..a461bf45d 100644 --- a/src/Data/Array/Accelerate/Control/Monad.hs +++ b/src/Data/Array/Accelerate/Control/Monad.hs @@ -25,6 +25,7 @@ module Data.Array.Accelerate.Control.Monad ( -- ** Basic functions (=<<), (>>), (>=>), (<=<), + join, -- ** Conditional execution of monadic expressions when, unless, @@ -40,7 +41,7 @@ import Data.Array.Accelerate.Language import Data.Array.Accelerate.Sugar.Elt import Data.Array.Accelerate.Smart -import Prelude ( Bool, flip ) +import Prelude ( Bool, flip, id ) -- | The 'Monad' class is used for scalar types which can be sequenced. @@ -134,6 +135,19 @@ infixr 1 <=< -> (Exp a -> Exp (m c)) (<=<) = flip (>=>) +-- | The 'join' function is the conventional monad join operator. It +-- is used to remove one level of monadic structure, projecting its +-- bound argument into the outer level. +-- +-- \'@'join' bss@\' can be understood as the @do@ expression +-- +-- @ +-- do bs <- bss +-- bs +-- @ +-- +join :: (Monad m, Elt a, Elt (m a), Elt (m (m a))) => Exp (m (m a)) -> Exp (m a) +join = (>>= id) -- | Conditional execution of a monadic expression -- From ac9b8a148c20746840d72388cb36c17fc554240c Mon Sep 17 00:00:00 2001 From: Tjalle-S <91267211+Tjalle-S@users.noreply.github.com> Date: Mon, 11 May 2026 15:16:50 +0200 Subject: [PATCH 5/6] Add Eq instances for Any and All --- src/Data/Array/Accelerate/Classes/Eq.hs | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/src/Data/Array/Accelerate/Classes/Eq.hs b/src/Data/Array/Accelerate/Classes/Eq.hs index 163815477..ca5ece850 100644 --- a/src/Data/Array/Accelerate/Classes/Eq.hs +++ b/src/Data/Array/Accelerate/Classes/Eq.hs @@ -119,6 +119,15 @@ instance Eq Z where _ == _ = True_ _ /= _ = False_ +instance (Shape sh) => Eq (Any sh) where + _ == _ = True_ + _ /= _ = False_ + +instance Eq All where + _ == _ = True_ + _ /= _ = False_ + + -- Instances of 'Prelude.Eq' don't make sense with the standard signatures as -- the return type is fixed to 'Bool'. This instance is provided to provide -- a useful error message. From 4f660dcfe1795276d8de6484ba0b12f6c54a2650 Mon Sep 17 00:00:00 2001 From: Tjalle-S <91267211+Tjalle-S@users.noreply.github.com> Date: Tue, 12 May 2026 16:57:31 +0200 Subject: [PATCH 6/6] Conditionally export (~) --- src/Data/Array/Accelerate.hs | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/src/Data/Array/Accelerate.hs b/src/Data/Array/Accelerate.hs index 646ccaa10..7936caa68 100644 --- a/src/Data/Array/Accelerate.hs +++ b/src/Data/Array/Accelerate.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE ExplicitNamespaces #-} {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE ScopedTypeVariables #-} @@ -413,7 +414,9 @@ module Data.Array.Accelerate ( -- --------------------------------------------------------------------------- -- * Useful re-exports (.), ($), (&), flip, error, undefined, const, id, otherwise, +#if __GLASGOW_HASKELL__ >= 904 type (~), +#endif Show, Generic, HasCallStack, fromString, -- -XOverloadedStrings fromListN, -- -XOverloadedLists @@ -465,7 +468,10 @@ import qualified Data.Array.Accelerate.Sugar.Array as S import qualified Data.Array.Accelerate.Sugar.Shape as S import Data.Function ( (&) ) -import Prelude ( (.), ($), Char, Show, flip, undefined, error, const, id, otherwise, type (~) ) +#if __GLASGOW_HASKELL__ >= 904 +import Data.Type.Equality ( type (~) ) +#endif +import Prelude ( (.), ($), Char, Show, flip, undefined, error, const, id, otherwise ) import GHC.Exts ( fromListN, fromString ) import GHC.Generics ( Generic )