From 03a0b608727cdec0f26d691cbe84170fb2624a6b Mon Sep 17 00:00:00 2001
From: "Trevor L. McDonell" <trevor.mcdonell@gmail.com>
Date: Thu, 28 Sep 2023 15:11:09 +0200
Subject: [PATCH] update acoerceOp

---
 src/Data/Array/Accelerate/Interpreter.hs | 11 ++++++-----
 src/Data/Array/Accelerate/Smart.hs       |  2 +-
 2 files changed, 7 insertions(+), 6 deletions(-)

diff --git a/src/Data/Array/Accelerate/Interpreter.hs b/src/Data/Array/Accelerate/Interpreter.hs
index 101cb6a5c..0e3a2e168 100644
--- a/src/Data/Array/Accelerate/Interpreter.hs
+++ b/src/Data/Array/Accelerate/Interpreter.hs
@@ -215,7 +215,8 @@ evalOpenAcc (AST.Manifest pacc) aenv =
                                      (TupRpair r1 r2, (a1, a2))
     Anil                          -> (TupRunit, ())
     Atrace msg as bs              -> unsafePerformIO $ manifest bs <$ atraceOp msg (snd $ manifest as)
-    Acoerce scale bR acc          -> acoerceOp scale bR (manifest acc)
+    Acoerce scale bR acc          -> let (TupRsingle (ArrayR shR aR), as) = manifest acc
+                                      in (TupRsingle (ArrayR shR bR), acoerceOp scale aR bR as)
     Apply repr afun acc           -> (repr, evalOpenAfun afun aenv $ snd $ manifest acc)
     Aforeign repr _ afun acc      -> (repr, evalOpenAfun afun Empty $ snd $ manifest acc)
     Acond p acc1 acc2
@@ -1000,12 +1001,12 @@ evalOpenExp pexp env aenv =
 acoerceOp
     :: HasCallStack
     => RescaleFactor
+    -> TypeR a
     -> TypeR b
-    -> WithReprs (Array (sh, INT) a)
-    -> WithReprs (Array (sh, INT) b)
-acoerceOp scale bR (TupRsingle (ArrayR shR aR), Array (sz,sh) adata) = (repr', arr')
+    -> Array (sh, INT) a
+    -> Array (sh, INT) b
+acoerceOp scale aR bR (Array (sz,sh) adata) = arr'
   where
-    repr'  = TupRsingle (ArrayR shR bR)
     arr'   = Array (sz,sh') adata'
     sh'    = case compare scale 0 of
                EQ -> sh
diff --git a/src/Data/Array/Accelerate/Smart.hs b/src/Data/Array/Accelerate/Smart.hs
index 4940678da..c033c4471 100644
--- a/src/Data/Array/Accelerate/Smart.hs
+++ b/src/Data/Array/Accelerate/Smart.hs
@@ -1266,7 +1266,7 @@ instance {-# OVERLAPS #-} (IsScalar a, IsScalar b) => Acoerce a b where
         sa = scalar ta
         sb = scalar tb
         sz = case compare sa sb of
-               EQ -> 0
+               EQ -> 0  -- TLM: reuse this value for something else? rescale of ±1 achieves the same thing
                GT ->          sa `quot` sb
                LT -> negate $ sb `quot` sa
         --