From f37110b04e643f1510bf631df61881d2fbe80d24 Mon Sep 17 00:00:00 2001
From: Tjalle-S <91267211+Tjalle-S@users.noreply.github.com>
Date: Fri, 30 Jan 2026 13:05:45 +0100
Subject: [PATCH] Monoid instance for Exp Ordering

---
 src/Data/Array/Accelerate/Data/Monoid.hs | 22 ++++++++++++++++++++++
 1 file changed, 22 insertions(+)

diff --git a/src/Data/Array/Accelerate/Data/Monoid.hs b/src/Data/Array/Accelerate/Data/Monoid.hs
index 23576be77..ad9ffe130 100644
--- a/src/Data/Array/Accelerate/Data/Monoid.hs
+++ b/src/Data/Array/Accelerate/Data/Monoid.hs
@@ -1,7 +1,9 @@
+{-# LANGUAGE BlockArguments        #-}
 {-# LANGUAGE CPP                   #-}
 {-# LANGUAGE ConstraintKinds       #-}
 {-# LANGUAGE FlexibleContexts      #-}
 {-# LANGUAGE FlexibleInstances     #-}
+{-# LANGUAGE LambdaCase            #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE PatternSynonyms       #-}
 {-# LANGUAGE ScopedTypeVariables   #-}
@@ -46,6 +48,7 @@ import Data.Array.Accelerate.Pattern
 import Data.Array.Accelerate.Smart
 import Data.Array.Accelerate.Sugar.Elt
 import Data.Array.Accelerate.Type
+import Data.Array.Accelerate.Prelude                                ( match )
 
 import Data.Function
 import Data.Monoid                                                  hiding ( (<>) )
@@ -171,3 +174,22 @@ instance (Elt a, Elt b, Elt c, Elt d, Monoid (Exp a), Monoid (Exp b), Monoid (Ex
 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 = T5 mempty mempty mempty mempty mempty
 
+
+-- Lexicographical ordering
+-- ------------------------
+
+-- | @since 1.4.0.0
+instance Semigroup (Exp Ordering) where
+  x <> y = x & match \case
+    LT_ -> LT_
+    EQ_ -> y
+    GT_ -> GT_
+
+  stimes n x = case P.compare n 0 of
+      LT -> P.errorWithoutStackTrace "stimes: Exp Ordering, negative multiplier"
+      EQ -> EQ_
+      GT -> x
+
+-- | @since 1.4.0.0
+instance Monoid (Exp Ordering) where
+  mempty = EQ_